3 files changed, 43 insertions, 3 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
diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index 1cc277b8..b88a8c7f 100644
--- a/haddock-library/src/Documentation/Haddock/Parser.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser.hs
@@ -86,9 +86,11 @@ parse p = either err id . parseOnly (p <* endOfInput)
 -- | Main entry point to the parser. Appends the newline character
 -- to the input string.
 parseParas :: String -- ^ String to parse
-           -> (Maybe Version, DocH mod Identifier)
+           -> MetaDoc mod Identifier
 parseParas input = case parseParasState input of
-  (state, a) -> (parserStateSince state, a)
+  (state, a) -> MetaDoc { _meta = Meta { _version = parserStateSince state }
+                        , _doc = a
+                        }
 
 parseParasState :: String -> (ParserState, DocH mod Identifier)
 parseParasState = parse (p <* skipSpace) . encodeUtf8 . (++ "\n")
diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs
index 92ddeb7e..6f22efb5 100644
--- a/haddock-library/src/Documentation/Haddock/Types.hs
+++ b/haddock-library/src/Documentation/Haddock/Types.hs
@@ -15,8 +15,28 @@
 module Documentation.Haddock.Types where
 
 import Data.Foldable
+import Data.Monoid
 import Data.Traversable
 
+-- | With the advent of 'Version', we may want to start attaching more
+-- meta-data to comments. We make a structure for this ahead of time
+-- so we don't have to gut half the core each time we want to add such
+-- info.
+newtype Meta = Meta { _version :: Maybe Version } deriving (Eq, Show)
+
+instance Monoid Meta where
+  mempty = Meta { _version = Nothing }
+  Meta { _version = v } `mappend` Meta { _version = v' } =
+    Meta { _version = v `mappend` v' }
+
+data MetaDoc mod id =
+  MetaDoc { _meta :: Meta
+          , _doc :: DocH mod id
+          } deriving (Eq, Show, Functor, Foldable, Traversable)
+
+overDoc :: (DocH a b -> DocH c d) -> MetaDoc a b -> MetaDoc c d
+overDoc f d = d { _doc = f $ _doc d }
+
 type Version = [Int]
 
 data Hyperlink = Hyperlink