Allow the parser to spit out meta-info

Currently we only use it only for ‘since’ annotations but with these
patches it should be fairly simple to add new attributes if we wish to.

Closes #26. It seems to work fine but due to 7.10 rush I don't have the
chance to do more exhaustive testing right now. The way the meta is
output (emphasis at the end of the whole comment) is fairly arbitrary
and subject to bikeshedding.

Note that this makes test for Bug310 fail due to interface version bump:
it can't find the docs for base with this interface version so it fails.
There is not much we can do to help this because it tests for ’built-in’
identifier, not something we can provide ourselves.

1 files changed, 19 insertions, 1 deletions

diff --git a/haddock-library/src/Documentation/Haddock/Doc.hs b/haddock-library/src/Documentation/Haddock/Doc.hs
index 1c20555d..fe8cf99b 100644
--- a/haddock-library/src/Documentation/Haddock/Doc.hs
+++ b/haddock-library/src/Documentation/Haddock/Doc.hs
@@ -1,12 +1,30 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-module Documentation.Haddock.Doc (docParagraph, docAppend, docConcat) where
+module Documentation.Haddock.Doc (docParagraph, docAppend,
+                                  docConcat, metaDocConcat,
+                                  metaDocAppend, emptyMetaDoc) where
 
+import Data.Monoid (mempty, (<>))
 import Documentation.Haddock.Types
 import Data.Char (isSpace)
 
 docConcat :: [DocH mod id] -> DocH mod id
 docConcat = foldr docAppend DocEmpty
 
+-- | Like 'docConcat' but also joins the 'Meta' info.
+metaDocConcat :: [MetaDoc mod id] -> MetaDoc mod id
+metaDocConcat = foldr metaDocAppend emptyMetaDoc
+
+-- | We do something perhaps unexpected here and join the meta info
+-- in ‘reverse’: this results in the metadata from the ‘latest’
+-- paragraphs taking precedence.
+metaDocAppend :: MetaDoc mod id -> MetaDoc mod id -> MetaDoc mod id
+metaDocAppend (MetaDoc { _meta = m, _doc = d })
+              (MetaDoc { _meta = m', _doc = d' }) =
+  MetaDoc { _meta = m' <> m, _doc = d `docAppend` d' }
+
+emptyMetaDoc :: MetaDoc mod id
+emptyMetaDoc = MetaDoc { _meta = mempty, _doc = DocEmpty }
+
 docAppend :: DocH mod id -> DocH mod id -> DocH mod id
 docAppend (DocDefList ds1) (DocDefList ds2) = DocDefList (ds1++ds2)
 docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d) = DocAppend (DocDefList (ds1++ds2)) d