aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Documentation/Haddock.hs1
-rw-r--r--src/Haddock/GhcUtils.hs2
-rw-r--r--src/Haddock/Interface/AttachInstances.hs9
-rw-r--r--src/Haddock/Interface/Create.hs232
-rw-r--r--src/Haddock/Interface/Rename.hs19
-rw-r--r--src/Haddock/InterfaceFile.hs10
-rw-r--r--src/Haddock/Types.hs32
7 files changed, 149 insertions, 156 deletions
diff --git a/src/Documentation/Haddock.hs b/src/Documentation/Haddock.hs
index 96198494..052f1044 100644
--- a/src/Documentation/Haddock.hs
+++ b/src/Documentation/Haddock.hs
@@ -22,7 +22,6 @@ module Documentation.Haddock (
-- * Export items & declarations
ExportItem(..),
Decl,
- DeclInfo,
DocForDecl,
FnArgsDoc,
diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs
index 989563b7..fc04351b 100644
--- a/src/Haddock/GhcUtils.hs
+++ b/src/Haddock/GhcUtils.hs
@@ -78,7 +78,7 @@ isVarSym = isLexVarSym . occNameFS
getMainDeclBinder :: HsDecl name -> [name]
-getMainDeclBinder (TyClD d) = [tcdName d]
+getMainDeclBinder (TyClD d) | not (isFamInstDecl d) = [tcdName d]
getMainDeclBinder (ValD d) =
case collectHsBindBinders d of
[] -> []
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index 5b7771ec..c012f2e0 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -73,20 +73,17 @@ lookupInstDoc :: Name -> Interface -> IfaceMap -> InstIfaceMap -> Maybe (Doc Nam
-- TODO: capture this pattern in a function (when we have streamlined the
-- handling of instances)
lookupInstDoc name iface ifaceMap instIfaceMap =
- case Map.lookup name (ifaceInstanceDocMap iface) of
+ case Map.lookup name (ifaceDocMap iface) of
Just doc -> Just doc
Nothing ->
case Map.lookup modName ifaceMap of
Just iface2 ->
- case Map.lookup name (ifaceInstanceDocMap iface2) of
+ case Map.lookup name (ifaceDocMap iface2) of
Just doc -> Just doc
Nothing -> Nothing
Nothing ->
case Map.lookup modName instIfaceMap of
- Just instIface ->
- case Map.lookup name (instDocMap instIface) of
- Just (doc, _) -> doc
- Nothing -> Nothing
+ Just instIface -> Map.lookup name (instDocMap instIface)
Nothing -> Nothing
where
modName = nameModule name
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 74c98dd9..a9f6c2ed 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
-----------------------------------------------------------------------------
-- |
-- Module : Haddock.Interface.Create
@@ -20,11 +21,13 @@ import Haddock.Convert
import Haddock.Interface.LexParseRn
import qualified Data.Map as Map
+import qualified Data.Map as M
import Data.Map (Map)
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Ord
+import Control.Applicative
import Control.Monad
import qualified Data.Traversable as Traversable
@@ -61,22 +64,20 @@ createInterface tm flags modMap instIfaceMap = do
| otherwise = opts0
(info, mbDoc) <- liftErrMsg $ lexParseRnHaddockModHeader dflags gre optDocHeader
- decls0 <- liftErrMsg $ declInfos dflags gre (topDecls group_)
- let localInsts = filter (nameIsLocalOrFrom mdl . getName) instances
- declDocs = [ (decl, doc) | (L _ decl, (Just doc, _), _) <- decls0 ]
- instanceDocMap = mkInstanceDocMap localInsts declDocs
+ let declsWithDocs = topDecls group_
+ (decls, _) = unzip declsWithDocs
+ localInsts = filter (nameIsLocalOrFrom mdl . getName) instances
+ (docMap, argMap, subMap, declMap) <- liftErrMsg $ maps dflags gre localInsts exportedNames declsWithDocs
- declMap = mkDeclMap decls0
- decls = filter (\(L _ d, _, _) -> not (isInstD d || isValD d)) decls0
- exports0 = fmap (reverse . map unLoc) optExports
- exports
+ let exports0 = fmap (reverse . map unLoc) optExports
+ exports
| OptIgnoreExports `elem` opts = Nothing
| otherwise = exports0
- liftErrMsg $ warnAboutFilteredDecls mdl decls0
+ liftErrMsg $ warnAboutFilteredDecls mdl decls
- exportItems <- mkExportItems modMap mdl gre exportedNames decls declMap
+ exportItems <- mkExportItems modMap mdl gre exportedNames decls docMap argMap subMap declMap
exports instances instIfaceMap dflags
let visibleNames = mkVisibleNames exportItems opts
@@ -102,15 +103,17 @@ createInterface tm flags modMap instIfaceMap = do
ifaceDoc = mbDoc,
ifaceRnDoc = Nothing,
ifaceOptions = opts,
+ ifaceDocMap = docMap,
+ ifaceArgMap = argMap,
ifaceRnDocMap = Map.empty,
+ ifaceRnArgMap = Map.empty,
ifaceExportItems = prunedExportItems,
ifaceRnExportItems = [],
ifaceExports = exportedNames,
ifaceVisibleExports = visibleNames,
ifaceDeclMap = declMap,
- ifaceSubMap = mkSubMap declMap exportedNames,
+ ifaceSubMap = subMap,
ifaceInstances = instances,
- ifaceInstanceDocMap = instanceDocMap,
ifaceHaddockCoverage = coverage
}
@@ -147,68 +150,55 @@ parseOption other = tell ["Unrecognised option: " ++ other] >> return Nothing
--------------------------------------------------------------------------------
-mkInstanceDocMap :: [Instance] -> [(HsDecl name, doc)] -> Map Name doc
-mkInstanceDocMap instances decls =
- -- We relate Instances to InstDecls using the SrcSpans buried inside them.
- -- That should work for normal user-written instances (from looking at GHC
- -- sources). We can assume that commented instances are user-written.
- -- This lets us relate Names (from Instances) to comments (associated
- -- with InstDecls).
- let docMap = Map.fromList [ (loc, doc)
- | (InstD (InstDecl (L loc _) _ _ _), doc) <- decls ]
+type Maps = (DocMap Name, ArgMap Name, SubMap, DeclMap)
- in Map.fromList [ (name, doc) | inst <- instances
- , let name = getName inst
- , Just doc <- [ Map.lookup (getSrcSpan name) docMap ] ]
-
--- | Make a sub map from a declaration map. Make sure we only include exported
--- names.
-mkSubMap :: Map Name DeclInfo -> [Name] -> Map Name [Name]
-mkSubMap declMap exports =
- Map.filterWithKey (\k _ -> k `elem` exports) (Map.map filterSubs declMap)
+maps :: DynFlags -> GlobalRdrEnv -> [Instance] -> [Name] -> [(Decl, MaybeDocStrings)] -> ErrMsgM Maps
+maps dflags gre instances exports decls = do
+ maps_ <- mapM f decls
+ let mergeMaps (a,b,c,d) (x,y,z,w) =
+ (M.unionWith mappend a x, M.unionWith mappend b y,
+ M.unionWith mappend c z, M.unionWith mappend d w)
+ let emptyMaps = (M.empty, M.empty, M.empty, M.empty)
+ return (foldl' mergeMaps emptyMaps maps_)
where
- filterSubs (_, _, subs) = [ sub | (sub, _) <- subs, sub `elem` exports ]
+ instanceMap = M.fromList [ (getSrcSpan n, n) | i <- instances, let n = getName i ]
+ f :: (Decl, MaybeDocStrings) -> ErrMsgM Maps
+ f (decl@(L _ d), docs) = do
+ mayDoc <- lexParseRnHaddockCommentList dflags NormalHaddockComment gre docs
+ argDocs <- fmap (Map.mapMaybe id) $ Traversable.forM (typeDocs d) $
+ \doc -> lexParseRnHaddockComment dflags NormalHaddockComment gre doc
--- Make a map from names to 'DeclInfo's.
---
--- Exclude nameless declarations (e.g. instances and stand-alone documentation
--- comments). Merge declarations of same names (i.e. type signatures and
--- bindings). Include subordinate names, mapped to their parent declarations.
-mkDeclMap :: [DeclInfo] -> Map Name DeclInfo
-mkDeclMap decls = Map.fromListWith merge . concat $
- [ decls_ ++ subDecls | (parent@(L _ d), doc, subs) <- decls
- , let decls_ = [ (name, (parent, doc, subs)) | name <- getMainDeclBinder d ]
- subDecls = [ (n, (parent, doc', [])) | (n, doc') <- subs ]
- , not (isDocD d), not (isInstD d)
- ]
- where
- merge (s@(L _ (SigD _)), s_doc, _) (v@(L _ (ValD _)), v_doc, _) = (s, f s s_doc v v_doc, [])
- merge (v@(L _ (ValD _)), v_doc, _) (s@(L _ (SigD _)), s_doc, _) = (s, f s s_doc v v_doc, [])
- merge a _ = a
- f s s_doc v v_doc | s `before` v = s_doc `mappend` v_doc | otherwise = v_doc `mappend` s_doc
+ let subs_ = subordinates d
+ let subs_' = filter (\(name, _, _) -> name `elem` exports) subs_
+ (subDocs, subArgMap) <- unzip <$> (forM subs_' $ \(name, mbSubDocStr, subFnArgsDocStr) -> do
+ mbSubDoc <- lexParseRnHaddockCommentList dflags NormalHaddockComment gre mbSubDocStr
+ subFnArgsDoc <- fmap (Map.mapMaybe id) $ Traversable.forM subFnArgsDocStr $
+ \doc -> lexParseRnHaddockComment dflags NormalHaddockComment gre doc
+ return ((name, mbSubDoc), (name, subFnArgsDoc)))
-declInfos :: DynFlags -> GlobalRdrEnv -> [(Decl, MaybeDocStrings)] -> ErrMsgM [DeclInfo]
-declInfos dflags gre decls =
- forM decls $ \(parent@(L _ d), mbDocString) -> do
- mbDoc <- lexParseRnHaddockCommentList dflags NormalHaddockComment
- gre mbDocString
- fnArgsDoc <- fmap (Map.mapMaybe id) $
- Traversable.forM (typeDocs d) $
- \doc -> lexParseRnHaddockComment dflags NormalHaddockComment gre doc
+ let subNames = map fst subDocs
- let subs_ = subordinates d
- subs <- forM subs_ $ \(subName, mbSubDocStr, subFnArgsDocStr) -> do
- mbSubDoc <- lexParseRnHaddockCommentList dflags NormalHaddockComment
- gre mbSubDocStr
- subFnArgsDoc <- fmap (Map.mapMaybe id) $
- Traversable.forM subFnArgsDocStr $
- \doc -> lexParseRnHaddockComment dflags NormalHaddockComment gre doc
- return (subName, (mbSubDoc, subFnArgsDoc))
+ let names = case d of
+ InstD (InstDecl (L l _) _ _ _) -> maybeToList (M.lookup l instanceMap) -- See note [2].
+ _ -> filter (`elem` exports) (getMainDeclBinder d)
- return (parent, (mbDoc, fnArgsDoc), subs)
+ let docMap' = M.fromList (mapMaybe (\(n,doc) -> fmap (n,) doc) ([ (n, mayDoc) | n <- names ] ++ subDocs))
+ let argMap' = M.fromList [ (n, argDocs) | n <- names ] `mappend` M.fromList subArgMap
+ let subMap' = M.fromList [ (n, subNames) | n <- names ]
+ let dclMap' = M.fromList [ (n, [decl]) | n <- names ++ subNames ]
+ return (docMap', argMap', subMap', dclMap')
+
+
+-- Note [2]:
+------------
+-- We relate Instances to InstDecls using the SrcSpans buried inside them.
+-- That should work for normal user-written instances (from looking at GHC
+-- sources). We can assume that commented instances are user-written.
+-- This lets us relate Names (from Instances) to comments (associated
+-- with InstDecls).
subordinates :: HsDecl Name -> [(Name, MaybeDocStrings, Map Int HsDocString)]
@@ -217,7 +207,7 @@ subordinates (TyClD decl)
| isDataDecl decl = dataSubs
where
classSubs = [ (name, doc, typeDocs d) | (L _ d, doc) <- classDecls decl
- , name <- getMainDeclBinder d
+ , name <- getMainDeclBinder d, not (isValD d)
]
dataSubs = constrs ++ fields
where
@@ -299,11 +289,11 @@ sortByLoc :: [Located a] -> [Located a]
sortByLoc = sortBy (comparing getLoc)
-warnAboutFilteredDecls :: Module -> [(LHsDecl Name, b, c)] -> ErrMsgM ()
+warnAboutFilteredDecls :: Module -> [LHsDecl Name] -> ErrMsgM ()
warnAboutFilteredDecls mdl decls = do
let modStr = moduleString mdl
let typeInstances =
- nub [ tcdName d | (L _ (TyClD d), _, _) <- decls, isFamInstDecl d ]
+ nub [ tcdName d | L _ (TyClD d) <- decls, isFamInstDecl d ]
unless (null typeInstances) $
tell [
@@ -312,7 +302,7 @@ warnAboutFilteredDecls mdl decls = do
++ "will be filtered out:\n " ++ concat (intersperse ", "
$ map (occNameString . nameOccName) typeInstances) ]
- let instances = nub [ pretty i | (L _ (InstD (InstDecl i _ _ ats)), _, _) <- decls
+ let instances = nub [ pretty i | L _ (InstD (InstDecl i _ _ ats)) <- decls
, not (null ats) ]
unless (null instances) $
@@ -434,19 +424,24 @@ mkExportItems
-> Module -- this module
-> GlobalRdrEnv
-> [Name] -- exported names (orig)
- -> [DeclInfo]
- -> Map Name DeclInfo -- maps local names to declarations
+ -> [LHsDecl Name]
+ -> DocMap Name
+ -> ArgMap Name
+ -> SubMap
+ -> DeclMap -- maps local names to declarations
-> Maybe [IE Name]
-> [Instance]
-> InstIfaceMap
-> DynFlags
-> ErrMsgGhc [ExportItem Name]
-mkExportItems modMap thisMod gre exportedNames decls declMap
+mkExportItems modMap thisMod gre exportedNames decls0 docMap argMap subMap declMap
optExports _ instIfaceMap dflags =
case optExports of
- Nothing -> liftErrMsg $ fullContentsOfThisModule dflags gre decls
+ Nothing -> liftErrMsg $ fullContentsOfThisModule dflags gre docMap argMap subMap decls
Just exports -> liftM (nubBy commaDeclared . concat) $ mapM lookupExport exports
where
+ decls = filter (\(L _ d) -> not (isInstD d || isValD d)) decls0
+
-- A type signature can have multiple names, like:
-- foo, bar :: Types..
-- When going throug the exported names we have to take care to detect such
@@ -461,7 +456,7 @@ mkExportItems modMap thisMod gre exportedNames decls declMap
lookupExport (IEThingAll t) = declWith t
lookupExport (IEThingWith t _) = declWith t
lookupExport (IEModuleContents m) =
- moduleExports thisMod m dflags gre exportedNames decls modMap instIfaceMap
+ moduleExports thisMod m dflags gre exportedNames decls modMap instIfaceMap docMap argMap subMap
lookupExport (IEGroup lev docStr) = liftErrMsg $
ifDoc (lexParseRnHaddockComment dflags DocSectionComment gre docStr)
(\doc -> return [ ExportGroup lev "" doc ])
@@ -469,7 +464,7 @@ mkExportItems modMap thisMod gre exportedNames decls declMap
ifDoc (lexParseRnHaddockComment dflags NormalHaddockComment gre docStr)
(\doc -> return [ ExportDoc doc ])
lookupExport (IEDocNamed str) = liftErrMsg $
- ifDoc (findNamedDoc str [ unL d | (d,_,_) <- decls ])
+ ifDoc (findNamedDoc str [ unL d | d <- decls ])
(\docStr ->
ifDoc (lexParseRnHaddockComment dflags NormalHaddockComment gre docStr)
(\doc -> return [ ExportDoc doc ]))
@@ -483,16 +478,16 @@ mkExportItems modMap thisMod gre exportedNames decls declMap
declWith :: Name -> ErrMsgGhc [ ExportItem Name ]
declWith t =
+ let doc = (Map.lookup t docMap, maybe Map.empty id (Map.lookup t argMap)) in
case findDecl t of
- -- Top-level binding from this package without type signature
- Just (L _ (ValD _), doc, _) -> do
+ [L _ (ValD _)] -> do
+ -- Top-level binding without type signature
mayDecl <- ifaceDecl t
case mayDecl of
Nothing -> return [ ExportNoDecl t [] ]
Just decl -> return [ ExportDecl decl doc [] [] ]
- -- Top-level declaration from this module
- Just (decl, doc, subs) ->
+ ds | decl : _ <- filter (not . isValD . unLoc) ds ->
let declNames = getMainDeclBinder (unL decl)
in case () of
_
@@ -514,7 +509,7 @@ mkExportItems modMap thisMod gre exportedNames decls declMap
return []
-- normal case
- | otherwise -> return [ mkExportDecl t (newDecl, doc, subs) ]
+ | otherwise -> return [ mkExportDecl t newDecl (exportDecl t newDecl docMap argMap subMap) ]
where
-- Since a single signature might refer to many names, we
-- need to filter the ones that are actually exported. This
@@ -528,7 +523,7 @@ mkExportItems modMap thisMod gre exportedNames decls declMap
_ -> decl
-- Declaration from another package
- Nothing -> do
+ [] -> do
mayDecl <- ifaceDecl t
case mayDecl of
Nothing -> return [ ExportNoDecl t [] ]
@@ -540,26 +535,15 @@ mkExportItems modMap thisMod gre exportedNames decls declMap
liftErrMsg $ tell
["Warning: Couldn't find .haddock for export " ++ pretty t]
let subs = [ (n, noDocForDecl) | (n, _, _) <- subordinates (unLoc decl) ]
- return [ mkExportDecl t (decl, noDocForDecl, subs) ]
+ return [ mkExportDecl t decl (noDocForDecl, subs) ]
Just iface -> do
- let subs = case Map.lookup t (instSubMap iface) of
- Nothing -> []
- Just x -> x
- return [ mkExportDecl t
- ( decl
- , fromMaybe noDocForDecl $
- Map.lookup t (instDocMap iface)
- , map (\subt ->
- ( subt ,
- fromMaybe noDocForDecl $
- Map.lookup subt (instDocMap iface)
- )
- ) subs
- )]
-
-
- mkExportDecl :: Name -> DeclInfo -> ExportItem Name
- mkExportDecl n (decl, doc, subs) = decl'
+ return [ mkExportDecl t decl (exportDecl t decl (instDocMap iface) (instArgMap iface) (instSubMap iface)) ]
+
+ _ -> return []
+
+
+ mkExportDecl :: Name -> Decl -> (DocForDecl Name, [(Name, DocForDecl Name)]) -> ExportItem Name
+ mkExportDecl n decl (doc, subs) = decl'
where
decl' = ExportDecl (restrictTo sub_names (extractDecl n mdl decl)) doc subs' []
mdl = nameModule n
@@ -570,12 +554,12 @@ mkExportItems modMap thisMod gre exportedNames decls declMap
isExported = (`elem` exportedNames)
- findDecl :: Name -> Maybe DeclInfo
+ findDecl :: Name -> [Decl]
findDecl n
- | m == thisMod = Map.lookup n declMap
+ | m == thisMod = maybe [] id (Map.lookup n declMap)
| otherwise = case Map.lookup m modMap of
- Just iface -> Map.lookup n (ifaceDeclMap iface)
- Nothing -> Nothing
+ Just iface -> maybe [] id (Map.lookup n (ifaceDeclMap iface))
+ Nothing -> []
where
m = nameModule n
@@ -590,6 +574,14 @@ ifaceDecl t = do
Just x -> return (Just (tyThingToLHsDecl x))
+exportDecl :: Name -> Decl -> DocMap Name -> ArgMap Name -> SubMap -> (DocForDecl Name, [(Name, DocForDecl Name)])
+exportDecl name _ docMap argMap subMap =
+ let lookupArgMap x = maybe M.empty id (M.lookup x argMap) in
+ let doc = (M.lookup name docMap, lookupArgMap name) in
+ let subs = [ (sub, (M.lookup sub docMap, lookupArgMap sub)) | sub <- maybe [] id (M.lookup name subMap) ] in
+ (doc, subs)
+
+
-- | Return all export items produced by an exported module. That is, we're
-- interested in the exports produced by \"module B\" in such a scenario:
--
@@ -608,12 +600,15 @@ moduleExports :: Module -- ^ Module A
-> DynFlags -- ^ The flag used when typechecking A
-> GlobalRdrEnv -- ^ The renaming environment used for A
-> [Name] -- ^ All the exports of A
- -> [DeclInfo] -- ^ All the declarations in A
+ -> [Decl] -- ^ All the declarations in A
-> IfaceMap -- ^ Already created interfaces
-> InstIfaceMap -- ^ Interfaces in other packages
+ -> DocMap Name
+ -> ArgMap Name
+ -> SubMap
-> ErrMsgGhc [ExportItem Name] -- ^ Resulting export items
-moduleExports thisMod expMod dflags gre _exports decls ifaceMap instIfaceMap
- | m == thisMod = liftErrMsg $ fullContentsOfThisModule dflags gre decls
+moduleExports thisMod expMod dflags gre _exports decls ifaceMap instIfaceMap docMap argMap subMap
+ | m == thisMod = liftErrMsg $ fullContentsOfThisModule dflags gre docMap argMap subMap decls
| otherwise =
case Map.lookup m ifaceMap of
Just iface
@@ -651,17 +646,20 @@ moduleExports thisMod expMod dflags gre _exports decls ifaceMap instIfaceMap
-- (For more information, see Trac #69)
-fullContentsOfThisModule :: DynFlags -> GlobalRdrEnv -> [DeclInfo] -> ErrMsgM [ExportItem Name]
-fullContentsOfThisModule dflags gre decls = liftM catMaybes $ mapM mkExportItem decls
+fullContentsOfThisModule :: DynFlags -> GlobalRdrEnv -> DocMap Name -> ArgMap Name -> SubMap -> [Decl] -> ErrMsgM [ExportItem Name]
+fullContentsOfThisModule dflags gre docMap argMap subMap decls = liftM catMaybes $ mapM mkExportItem decls
where
- mkExportItem (L _ (DocD (DocGroup lev docStr)), _, _) = do
- mbDoc <- lexParseRnHaddockComment dflags DocSectionComment gre docStr
- return $ fmap (ExportGroup lev "") mbDoc
- mkExportItem (L _ (DocD (DocCommentNamed _ docStr)), _, _) = do
- mbDoc <- lexParseRnHaddockComment dflags NormalHaddockComment gre docStr
- return $ fmap ExportDoc mbDoc
- mkExportItem (decl, doc, subs) = return $ Just $ ExportDecl decl doc subs []
-
+ mkExportItem (L _ (DocD (DocGroup lev docStr))) = do
+ mbDoc <- lexParseRnHaddockComment dflags DocSectionComment gre docStr
+ return $ fmap (ExportGroup lev "") mbDoc
+ mkExportItem (L _ (DocD (DocCommentNamed _ docStr))) = do
+ mbDoc <- lexParseRnHaddockComment dflags NormalHaddockComment gre docStr
+ return $ fmap ExportDoc mbDoc
+ mkExportItem decl
+ | name : _ <- getMainDeclBinder (unLoc decl) =
+ let (doc, subs) = exportDecl name decl docMap argMap subMap in
+ return $ Just (ExportDecl decl doc subs [])
+ | otherwise = return Nothing
-- | Sometimes the declaration we want to export is not the "main" declaration:
-- it might be an individual record selector or a class method. In these
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 35ff8542..691dafbc 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -36,30 +36,22 @@ renameInterface renamingEnv warnings iface =
let localEnv = foldl fn renamingEnv (ifaceVisibleExports iface)
where fn env name = Map.insert name (ifaceMod iface) env
- docMap = Map.map (\(_,x,_) -> x) (ifaceDeclMap iface)
-
- -- make instance docs into 'docForDecls'
- instDocs = [ (name, (Just doc, Map.empty))
- | (name, doc) <- Map.toList (ifaceInstanceDocMap iface) ]
-
- docs = Map.toList docMap ++ instDocs
- renameMapElem (k,d) = do d' <- renameDocForDecl d; return (k, d')
-
-- rename names in the exported declarations to point to things that
-- are closer to, or maybe even exported by, the current module.
(renamedExportItems, missingNames1)
= runRnFM localEnv (renameExportItems (ifaceExportItems iface))
- (rnDocMap, missingNames2)
- = runRnFM localEnv (liftM Map.fromList (mapM renameMapElem docs))
+ (rnDocMap, missingNames2) = runRnFM localEnv (mapM renameDoc (ifaceDocMap iface))
+
+ (rnArgMap, missingNames3) = runRnFM localEnv (mapM (mapM renameDoc) (ifaceArgMap iface))
- (finalModuleDoc, missingNames3)
+ (finalModuleDoc, missingNames4)
= runRnFM localEnv (renameMaybeDoc (ifaceDoc iface))
-- combine the missing names and filter out the built-ins, which would
-- otherwise allways be missing.
missingNames = nub $ filter isExternalName -- XXX: isExternalName filters out too much
- (missingNames1 ++ missingNames2 ++ missingNames3)
+ (missingNames1 ++ missingNames2 ++ missingNames3 ++ missingNames4)
-- filter out certain built in type constructors using their string
-- representation. TODO: use the Name constants from the GHC API.
@@ -77,6 +69,7 @@ renameInterface renamingEnv warnings iface =
return $ iface { ifaceRnDoc = finalModuleDoc,
ifaceRnDocMap = rnDocMap,
+ ifaceRnArgMap = rnArgMap,
ifaceRnExportItems = renamedExportItems }
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index 1da46662..21179885 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -65,9 +65,9 @@ binaryInterfaceMagic = 0xD0Cface
-- we version our interface files accordingly.
binaryInterfaceVersion :: Word16
#if __GLASGOW_HASKELL__ == 702
-binaryInterfaceVersion = 18
+binaryInterfaceVersion = 19
#elif __GLASGOW_HASKELL__ == 703
-binaryInterfaceVersion = 18
+binaryInterfaceVersion = 19
#else
#error Unknown GHC version
#endif
@@ -355,10 +355,11 @@ instance Binary InterfaceFile where
instance Binary InstalledInterface where
- put_ bh (InstalledInterface modu info docMap exps visExps opts subMap) = do
+ put_ bh (InstalledInterface modu info docMap argMap exps visExps opts subMap) = do
put_ bh modu
put_ bh info
put_ bh docMap
+ put_ bh argMap
put_ bh exps
put_ bh visExps
put_ bh opts
@@ -368,12 +369,13 @@ instance Binary InstalledInterface where
modu <- get bh
info <- get bh
docMap <- get bh
+ argMap <- get bh
exps <- get bh
visExps <- get bh
opts <- get bh
subMap <- get bh
- return (InstalledInterface modu info docMap
+ return (InstalledInterface modu info docMap argMap
exps visExps opts subMap)
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 2b78905c..3baa4a94 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -36,8 +36,11 @@ import OccName
type IfaceMap = Map Module Interface
-type InstIfaceMap = Map Module InstalledInterface
-type DocMap = Map Name (Doc DocName)
+type InstIfaceMap = Map Module InstalledInterface -- TODO: rename
+type DocMap a = Map Name (Doc a)
+type ArgMap a = Map Name (Map Int (Doc a))
+type SubMap = Map Name [Name]
+type DeclMap = Map Name [Decl]
type SrcMap = Map PackageId FilePath
type Decl = LHsDecl Name
type GhcDocHdr = Maybe LHsDocString
@@ -77,11 +80,17 @@ data Interface = Interface
-- | Declarations originating from the module. Excludes declarations without
-- names (instances and stand-alone documentation comments). Includes
-- names of subordinate declarations mapped to their parent declarations.
- , ifaceDeclMap :: Map Name DeclInfo
+ , ifaceDeclMap :: Map Name [Decl]
-- | Documentation of declarations originating from the module (including
-- subordinates).
- , ifaceRnDocMap :: Map Name (DocForDecl DocName)
+ , ifaceDocMap :: DocMap Name
+ , ifaceArgMap :: ArgMap Name
+
+ -- | Documentation of declarations originating from the module (including
+ -- subordinates).
+ , ifaceRnDocMap :: DocMap DocName
+ , ifaceRnArgMap :: ArgMap DocName
, ifaceSubMap :: Map Name [Name]
@@ -99,9 +108,6 @@ data Interface = Interface
-- | Instances exported by the module.
, ifaceInstances :: ![Instance]
- -- | Documentation of instances defined in the module.
- , ifaceInstanceDocMap :: Map Name (Doc Name)
-
-- | The number of haddockable and haddocked items in the module, as a
-- tuple. Haddockable items are the exports and the module itself.
, ifaceHaddockCoverage :: (Int,Int)
@@ -120,7 +126,9 @@ data InstalledInterface = InstalledInterface
-- | Documentation of declarations originating from the module (including
-- subordinates).
- , instDocMap :: Map Name (DocForDecl Name)
+ , instDocMap :: DocMap Name
+
+ , instArgMap :: ArgMap Name
-- | All names exported by this module.
, instExports :: [Name]
@@ -142,7 +150,8 @@ toInstalledIface :: Interface -> InstalledInterface
toInstalledIface interface = InstalledInterface
{ instMod = ifaceMod interface
, instInfo = ifaceInfo interface
- , instDocMap = fmap unrenameDocForDecl $ ifaceRnDocMap interface
+ , instDocMap = ifaceDocMap interface
+ , instArgMap = ifaceArgMap interface
, instExports = ifaceExports interface
, instVisibleExports = ifaceVisibleExports interface
, instOptions = ifaceOptions interface
@@ -204,11 +213,6 @@ data ExportItem name
| ExportModule Module
--- | A declaration that may have documentation, including its subordinates,
--- which may also have documentation.
-type DeclInfo = (Decl, DocForDecl Name, [(Name, DocForDecl Name)])
-
-
-- | Arguments and result are indexed by Int, zero-based from the left,
-- because that's the easiest to use when recursing over types.
type FnArgsDoc name = Map Int (Doc name)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 03:55:32 +0000