1 files changed, 36 insertions, 7 deletions

diff --git a/haddock-library/src/Documentation/Haddock/Doc.hs b/haddock-library/src/Documentation/Haddock/Doc.hs
index 4d6c10a4..66bd1c97 100644
--- a/haddock-library/src/Documentation/Haddock/Doc.hs
+++ b/haddock-library/src/Documentation/Haddock/Doc.hs
@@ -1,21 +1,50 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-module Documentation.Haddock.Doc (docParagraph) where
+module Documentation.Haddock.Doc (docParagraph, docAppend,
+                                  docConcat, metaDocConcat,
+                                  metaDocAppend, emptyMetaDoc,
+                                  metaAppend, metaConcat) where
 
-import Data.Monoid
+import Control.Applicative ((<|>), empty)
 import Documentation.Haddock.Types
 import Data.Char (isSpace)
 
--- We put it here so that we can avoid a circular import
--- anything relevant imports this module anyway
-instance Monoid (DocH mod id) where
-  mempty  = DocEmpty
-  mappend = docAppend
+docConcat :: [DocH mod id] -> DocH mod id
+docConcat = foldr docAppend DocEmpty
+
+-- | Concat using 'metaAppend'.
+metaConcat :: [Meta] -> Meta
+metaConcat = foldr metaAppend emptyMeta
+
+-- | 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' `metaAppend` m, _doc = d `docAppend` d' }
+
+-- | This is not a monoidal append, it uses '<|>' for the '_version'.
+metaAppend :: Meta -> Meta -> Meta
+metaAppend (Meta { _version = v }) (Meta { _version = v' }) =
+  Meta { _version = v <|> v' }
+
+emptyMetaDoc :: MetaDoc mod id
+emptyMetaDoc = MetaDoc { _meta = emptyMeta, _doc = DocEmpty }
+
+emptyMeta :: Meta
+emptyMeta = Meta { _version = empty }
 
 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
 docAppend (DocOrderedList ds1) (DocOrderedList ds2) = DocOrderedList (ds1 ++ ds2)
+docAppend (DocOrderedList ds1) (DocAppend (DocOrderedList ds2) d) = DocAppend (DocOrderedList (ds1++ds2)) d
 docAppend (DocUnorderedList ds1) (DocUnorderedList ds2) = DocUnorderedList (ds1 ++ ds2)
+docAppend (DocUnorderedList ds1) (DocAppend (DocUnorderedList ds2) d) = DocAppend (DocUnorderedList (ds1++ds2)) d
 docAppend DocEmpty d = d
 docAppend d DocEmpty = d
 docAppend (DocString s1) (DocString s2) = DocString (s1 ++ s2)