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, 10 insertions, 9 deletions

diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 00c119fa..2ed25542 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -14,7 +14,7 @@
 -----------------------------------------------------------------------------
 module Haddock.Interface.Create (createInterface) where
 
-import Documentation.Haddock.Doc (docAppend)
+import Documentation.Haddock.Doc (metaDocAppend)
 import Haddock.Types
 import Haddock.Options
 import Haddock.GhcUtils
@@ -256,19 +256,19 @@ mkMaps dflags gre instances decls =
     f :: (Ord a, Monoid b) => [[(a, b)]] -> Map a b
     f = M.fromListWith (<>) . concat
 
-    f' :: [[(Name, Doc Name)]] -> Map Name (Doc Name)
-    f' = M.fromListWith docAppend . concat
+    f' :: [[(Name, MDoc Name)]] -> Map Name (MDoc Name)
+    f' = M.fromListWith metaDocAppend . concat
 
     mappings :: (LHsDecl Name, [HsDocString])
-             -> ( [(Name, Doc Name)]
-                , [(Name, Map Int (Doc Name))]
+             -> ( [(Name, MDoc Name)]
+                , [(Name, Map Int (MDoc Name))]
                 , [(Name, [Name])]
                 , [(Name,  [LHsDecl Name])]
                 )
     mappings (ldecl, docStrs) =
       let L l decl = ldecl
           declDoc :: [HsDocString] -> Map Int HsDocString
-                  -> (Maybe (Doc Name), Map Int (Doc Name))
+                  -> (Maybe (MDoc Name), Map Int (MDoc Name))
           declDoc strs m =
             let doc' = processDocStrings dflags gre strs
                 m' = M.map (processDocStringParas dflags gre) m
@@ -641,7 +641,8 @@ hiValExportItem dflags name doc splice fixity = do
 
 
 -- | Lookup docs for a declaration from maps.
-lookupDocs :: Name -> WarningMap -> DocMap Name -> ArgMap Name -> SubMap -> (DocForDecl Name, [(Name, DocForDecl Name)])
+lookupDocs :: Name -> WarningMap -> DocMap Name -> ArgMap Name -> SubMap
+           -> (DocForDecl Name, [(Name, DocForDecl Name)])
 lookupDocs n warnings docMap argMap subMap =
   let lookupArgDoc x = M.findWithDefault M.empty x argMap in
   let doc = (lookupDoc n, lookupArgDoc n) in
@@ -731,8 +732,8 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap
     expandSig = foldr f []
       where
         f :: LHsDecl name -> [LHsDecl name] -> [LHsDecl name]
-        f (L l (SigD (TypeSig    names t)))          xs = foldr (\n acc -> L l (SigD (TypeSig    [n] t))          : acc) xs names
-        f (L l (SigD (GenericSig names t)))          xs = foldr (\n acc -> L l (SigD (GenericSig [n] t))          : acc) xs names
+        f (L l (SigD (TypeSig    names t))) xs = foldr (\n acc -> L l (SigD (TypeSig    [n] t)) : acc) xs names
+        f (L l (SigD (GenericSig names t))) xs = foldr (\n acc -> L l (SigD (GenericSig [n] t)) : acc) xs names
         f x xs = x : xs
 
     mkExportItem :: LHsDecl Name -> ErrMsgGhc (Maybe (ExportItem Name))