1 files changed, 51 insertions, 31 deletions

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
index 741e97e0..565adef2 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -21,11 +21,13 @@ module Haddock.Backends.Xhtml.DocMarkup (
 
 import Control.Applicative ((<$>))
 
+import Data.List
+import Data.Monoid (mconcat)
 import Haddock.Backends.Xhtml.Names
 import Haddock.Backends.Xhtml.Utils
 import Haddock.Types
 import Haddock.Utils
-import Haddock.Doc (combineDocumentation)
+import Haddock.Doc (combineDocumentation, emptyMetaDoc, metaDocAppend)
 
 import Text.XHtml hiding ( name, p, quote )
 import Data.Maybe (fromMaybe)
@@ -93,8 +95,8 @@ parHtmlMarkup qual insertAnchors ppId = Markup {
 -- from changing if it is possible to recover the layout information
 -- we won't need after the fact.
 data Hack a id =
-  UntouchedDoc (DocH a id)
-  | CollapsingHeader (Header (DocH a id)) (DocH a id) Int (Maybe String)
+  UntouchedDoc (MetaDoc a id)
+  | CollapsingHeader (Header (DocH a id)) (MetaDoc a id) Int (Maybe String)
   | HackAppend (Hack a id) (Hack a id)
   deriving Eq
 
@@ -110,15 +112,15 @@ toHack :: Int -- ^ Counter for header IDs which serves to assign
        -- this should work more or less fine: it is in fact the
        -- implicit assumption the collapse/expand mechanism makes for
        -- things like ‘Instances’ boxes.
-       -> [DocH a id] -> Hack a id
-toHack _ _ [] = UntouchedDoc DocEmpty
+       -> [MetaDoc a id] -> Hack a id
+toHack _ _ [] = UntouchedDoc emptyMetaDoc
 toHack _ _ [x] = UntouchedDoc x
-toHack n nm (DocHeader (Header l (DocBold x)):xs) =
+toHack n nm (MetaDoc { _doc = DocHeader (Header l (DocBold x)) }:xs) =
   let -- Header with dropped bold
       h = Header l x
       -- Predicate for takeWhile, grab everything including ‘smaller’
       -- headers
-      p (DocHeader (Header l' _)) = l' > l
+      p (MetaDoc { _doc = DocHeader (Header l' _) }) = l' > l
       p _ = True
       -- Stuff ‘under’ this header
       r = takeWhile p xs
@@ -128,16 +130,18 @@ toHack n nm (DocHeader (Header l (DocBold x)):xs) =
       app y ys = HackAppend y (toHack (n + 1) nm ys)
   in case r of
       -- No content under this header
-      [] -> CollapsingHeader h DocEmpty n nm `app` r'
+      [] -> CollapsingHeader h emptyMetaDoc n nm `app` r'
       -- We got something out, stitch it back together into one chunk
-      y:ys -> CollapsingHeader h (foldl DocAppend y ys) n nm `app` r'
+      y:ys -> CollapsingHeader h (foldl metaDocAppend y ys) n nm `app` r'
 toHack n nm (x:xs) = HackAppend (UntouchedDoc x) (toHack n nm xs)
 
 -- | Remove ‘top-level’ 'DocAppend's turning them into a flat list.
 -- This lends itself much better to processing things in order user
 -- might look at them, such as in 'toHack'.
-flatten :: DocH a id -> [DocH a id]
-flatten (DocAppend x y) = flatten x ++ flatten y
+flatten :: MetaDoc a id -> [MetaDoc a id]
+flatten MetaDoc { _meta = m, _doc = DocAppend x y } =
+  let f z = MetaDoc { _meta = m, _doc = z }
+  in flatten (f x) ++ flatten (f y)
 flatten x = [x]
 
 -- | Generate the markup needed for collapse to happen. For
@@ -146,24 +150,40 @@ flatten x = [x]
 -- 'CollapsingHeader', we attach extra info to the generated 'Html'
 -- that allows us to expand/collapse the content.
 hackMarkup :: DocMarkup id Html -> Hack (ModuleName, OccName) id -> Html
-hackMarkup fmt h = case h of
-  UntouchedDoc d -> markup fmt d
-  CollapsingHeader (Header lvl titl) par n nm ->
-    let id_ = makeAnchorId $ "ch:" ++ fromMaybe "noid:" nm ++ show n
-        col' = collapseControl id_ True "caption"
-        instTable = (thediv ! collapseSection id_ True [] <<)
-        lvs = zip [1 .. ] [h1, h2, h3, h4, h5, h6]
-        getHeader = fromMaybe caption (lookup lvl lvs)
-        subCation = getHeader ! col' << markup fmt titl
-    in (subCation +++) . instTable $ markup fmt par
-  HackAppend d d' -> markupAppend fmt (hackMarkup fmt d) (hackMarkup fmt d')
+hackMarkup fmt' h' =
+  let (html, ms) = hackMarkup' fmt' h'
+  in html +++ renderMeta fmt' (mconcat ms)
+  where
+    hackMarkup' :: DocMarkup id Html -> Hack (ModuleName, OccName) id
+                -> (Html, [Meta])
+    hackMarkup' fmt h = case h of
+      UntouchedDoc d -> (markup fmt $ _doc d, [_meta d])
+      CollapsingHeader (Header lvl titl) par n nm ->
+        let id_ = makeAnchorId $ "ch:" ++ fromMaybe "noid:" nm ++ show n
+            col' = collapseControl id_ True "caption"
+            instTable = (thediv ! collapseSection id_ True [] <<)
+            lvs = zip [1 .. ] [h1, h2, h3, h4, h5, h6]
+            getHeader = fromMaybe caption (lookup lvl lvs)
+            subCaption = getHeader ! col' << markup fmt titl
+        in ((subCaption +++) . instTable $ markup fmt (_doc par), [_meta par])
+      HackAppend d d' -> let (x, m) = hackMarkup' fmt d
+                             (y, m') = hackMarkup' fmt d'
+                         in (markupAppend fmt x y, m ++ m')
+
+renderMeta :: DocMarkup id Html -> Meta -> Html
+renderMeta fmt (Meta { _version = Just x }) =
+  markupParagraph fmt . markupEmphasis fmt . toHtml $
+    "Since: " ++ formatVersion x
+  where
+    formatVersion v = concat . intersperse "." $ map show v
+renderMeta _ _ = noHtml
 
 -- | Goes through 'hackMarkup' to generate the 'Html' rather than
 -- skipping straight to 'markup': this allows us to employ XHtml
--- specific hacks to the tree before first.
+-- specific hacks to the tree first.
 markupHacked :: DocMarkup id Html
              -> Maybe String
-             -> Doc id
+             -> MDoc id
              -> Html
 markupHacked fmt n = hackMarkup fmt . toHack 0 n . flatten
 
@@ -171,23 +191,23 @@ markupHacked fmt n = hackMarkup fmt . toHack 0 n . flatten
 -- ugly extra whitespace with some browsers).  FIXME: Does this still apply?
 docToHtml :: Maybe String -- ^ Name of the thing this doc is for. See
                           -- comments on 'toHack' for details.
-          -> Qualification -> Doc DocName -> Html
+          -> Qualification -> MDoc DocName -> Html
 docToHtml n qual = markupHacked fmt n . cleanup
   where fmt = parHtmlMarkup qual True (ppDocName qual Raw)
 
 -- | Same as 'docToHtml' but it doesn't insert the 'anchor' element
 -- in links. This is used to generate the Contents box elements.
 docToHtmlNoAnchors :: Maybe String -- ^ See 'toHack'
-                   -> Qualification -> Doc DocName -> Html
+                   -> Qualification -> MDoc DocName -> Html
 docToHtmlNoAnchors n qual = markupHacked fmt n . cleanup
   where fmt = parHtmlMarkup qual False (ppDocName qual Raw)
 
-origDocToHtml :: Qualification -> Doc Name -> Html
+origDocToHtml :: Qualification -> MDoc Name -> Html
 origDocToHtml qual = markupHacked fmt Nothing . cleanup
   where fmt = parHtmlMarkup qual True (const $ ppName Raw)
 
 
-rdrDocToHtml :: Qualification -> Doc RdrName -> Html
+rdrDocToHtml :: Qualification -> MDoc RdrName -> Html
 rdrDocToHtml qual = markupHacked fmt Nothing . cleanup
   where fmt = parHtmlMarkup qual True (const ppRdrName)
 
@@ -205,13 +225,13 @@ docSection n qual = maybe noHtml (docSection_ n qual) . combineDocumentation
 
 
 docSection_ :: Maybe Name -- ^ Name of the thing this doc is for
-            -> Qualification -> Doc DocName -> Html
+            -> Qualification -> MDoc DocName -> Html
 docSection_ n qual =
   (docElement thediv <<) . docToHtml (getOccString <$> n) qual
 
 
-cleanup :: Doc a -> Doc a
-cleanup = markup fmtUnParagraphLists
+cleanup :: MDoc a -> MDoc a
+cleanup = overDoc (markup fmtUnParagraphLists)
   where
     -- If there is a single paragraph, then surrounding it with <P>..</P>
     -- can add too much whitespace in some browsers (eg. IE).  However if