From 6221c9314bac2c9e0bbeaa06b2ed2e579ac36b6b Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Mon, 20 Aug 2018 11:33:34 -0700 Subject: [PATCH 1/2] Remove unused arguments/fields --- haddock-api/src/Haddock/Interface/Create.hs | 75 +++++++-------------- haddock-api/src/Haddock/Types.hs | 5 -- 2 files changed, 25 insertions(+), 55 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index df53b3d02e..2470bc9f43 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -110,8 +110,7 @@ createInterface mod_iface flags modMap instIfaceMap = do ++ map getName fam_instances instanceMap = M.fromList (map (getSrcSpan &&& id) localInsts) - let maps = (docMap, argMap, instanceMap) - allWarnings = M.unions (warningMap : map ifaceWarningMap (M.elems modMap)) + let allWarnings = M.unions (warningMap : map ifaceWarningMap (M.elems modMap)) -- Locations of all TH splices -- TODO: We use the splice info in 'Haddock.Backends.Xhtml.Layout.links' to @@ -122,12 +121,12 @@ createInterface mod_iface flags modMap instIfaceMap = do -- The MAIN functionality: compute the export items which will -- each be the actual documentation of this module. - exportItems <- mkExportItems is_sig modMap pkgName mdl sem_mdl allWarnings renamer - exportedNames maps fixMap splices + exportItems <- mkExportItems modMap pkgName mdl allWarnings renamer + docMap argMap fixMap splices (docs_named_chunks mod_iface_docs) (docs_structure mod_iface_docs) instIfaceMap - let !visibleNames = mkVisibleNames maps exportItems opts + let !visibleNames = mkVisibleNames instanceMap exportItems opts -- Measure haddock documentation coverage. let prunedExportItems0 = pruneExportItems exportItems @@ -157,7 +156,6 @@ createInterface mod_iface flags modMap instIfaceMap = do , ifaceRnExportItems = [] , ifaceExports = exportedNames , ifaceVisibleExports = visibleNames - , ifaceDeclMap = M.empty -- TODO: get rid of this , ifaceFixMap = fixMap , ifaceInstances = instances , ifaceFamInstances = fam_instances @@ -270,8 +268,6 @@ parseOption "not-home" = return (Just OptNotHome) parseOption "show-extensions" = return (Just OptShowExtensions) parseOption other = tell ["Unrecognised option: " ++ other] >> return Nothing -type Maps = (DocMap Name, ArgMap Name, InstMap) - -- | Extract a map of fixity declarations only mkFixMap :: [Name] -> [(OccName, Fixity)] -> FixMap mkFixMap exps occFixs = @@ -281,15 +277,13 @@ mkFixMap exps occFixs = expsOccEnv = mkOccEnv (map (nameOccName &&& id) exps) mkExportItems - :: Bool -- is it a signature - -> IfaceMap + :: IfaceMap -> Maybe Package -- this package -> Module -- this module - -> Module -- semantic module -> WarningMap -> Renamer - -> [Name] -- exported names (orig) - -> Maps + -> DocMap Name -- docs (keyed by 'Name's) + -> ArgMap Name -- docs for arguments (keyed by 'Name's) -> FixMap -> [SrcSpan] -- splice locations -> Map String HsDoc' -- named chunks @@ -297,8 +291,8 @@ mkExportItems -> InstIfaceMap -> ErrMsgGhc [ExportItem GhcRn] mkExportItems - is_sig modMap mbPkgName thisMod semMod warnings renamer exportedNames - maps fixMap splices namedChunks dsItems instIfaceMap = + modMap mbPkgName thisMod warnings renamer + docMap argMap fixMap splices namedChunks dsItems instIfaceMap = concat <$> traverse lookupExport dsItems where lookupExport :: DocStructureItem -> ErrMsgGhc [ExportItem GhcRn] @@ -329,23 +323,21 @@ mkExportItems pure (map ExportModule unrestricted_mods ++ avail_exps) availExport avail = - availExportItem is_sig modMap thisMod semMod warnings exportedNames - maps fixMap splices instIfaceMap avail + availExportItem modMap thisMod warnings + docMap argMap fixMap splices instIfaceMap avail -availExportItem :: Bool -- is it a signature - -> IfaceMap +availExportItem :: IfaceMap -> Module -- this module - -> Module -- semantic module -> WarningMap - -> [Name] -- exported names (orig) - -> Maps + -> DocMap Name -- docs (keyed by 'Name's) + -> ArgMap Name -- docs for arguments (keyed by 'Name's) -> FixMap -> [SrcSpan] -- splice locations -> InstIfaceMap -> AvailInfo -> ErrMsgGhc [ExportItem GhcRn] -availExportItem is_sig modMap thisMod semMod warnings exportedNames - (docMap, argMap, _) fixMap splices instIfaceMap +availExportItem modMap thisMod warnings + docMap argMap fixMap splices instIfaceMap availInfo = declWith availInfo where declWith :: AvailInfo -> ErrMsgGhc [ ExportItem GhcRn ] @@ -482,32 +474,15 @@ hiDecl t = do lookupDocs :: AvailInfo -> WarningMap -> DocMap Name -> ArgMap Name -> (DocForDecl Name, [(Name, DocForDecl Name)]) lookupDocs avail warnings docMap argMap = - let n = availName avail in - let lookupArgDoc x = M.findWithDefault M.empty x argMap in - let doc = (lookupDoc n, lookupArgDoc n) in - let subDocs = [ (s, (lookupDoc s, lookupArgDoc s)) - | s <- availSubordinates avail - ] in - (doc, subDocs) + let n = availName avail in + ( lookupDocForDecl n + , [ (s, lookupDocForDecl s) | s <- availSubordinates avail ] + ) where - lookupDoc name = Documentation (M.lookup name docMap) (M.lookup name warnings) - + lookupDoc x = Documentation (M.lookup x docMap) (M.lookup x warnings) + lookupArgDoc x = M.findWithDefault M.empty x argMap + lookupDocForDecl x = (lookupDoc x, lookupArgDoc x) --- Note [1]: ------------- --- It is unnecessary to document a subordinate by itself at the top level if --- any of its parents is also documented. Furthermore, if the subordinate is a --- record field or a class method, documenting it under its parent --- indicates its special status. --- --- A user might expect that it should show up separately, so we issue a --- warning. It's a fine opportunity to also tell the user she might want to --- export the subordinate through the parent export item for clarity. --- --- The code removes top-level subordinates also when the parent is exported --- through a 'module' export. I think that is fine. --- --- (For more information, see Trac #69) -- | 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 @@ -651,8 +626,8 @@ pruneExportItems = filter hasDoc hasDoc _ = True -mkVisibleNames :: Maps -> [ExportItem GhcRn] -> [DocOption] -> [Name] -mkVisibleNames (_, _, instMap) exports opts +mkVisibleNames :: InstMap -> [ExportItem GhcRn] -> [DocOption] -> [Name] +mkVisibleNames instMap exports opts | OptHide `elem` opts = [] | otherwise = let ns = concatMap exportName exports in seqList ns `seq` ns diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index d654d0b9fd..ed8a7ff1d7 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -93,11 +93,6 @@ data Interface = Interface -- | Haddock options for this module (prune, not-home, etc). , ifaceOptions :: ![DocOption] - -- | 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 [LHsDecl GhcRn]) - -- | Documentation of declarations originating from the module (including -- subordinates). , ifaceDocMap :: !(DocMap Name) From 5a697c139c3284a5f5d31c4833851a5ec1818484 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Mon, 20 Aug 2018 12:03:38 -0700 Subject: [PATCH 2/2] inline binding --- haddock-api/src/Haddock/Interface/Create.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 2470bc9f43..9f85ca8e55 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -474,8 +474,7 @@ hiDecl t = do lookupDocs :: AvailInfo -> WarningMap -> DocMap Name -> ArgMap Name -> (DocForDecl Name, [(Name, DocForDecl Name)]) lookupDocs avail warnings docMap argMap = - let n = availName avail in - ( lookupDocForDecl n + ( lookupDocForDecl (availName avail) , [ (s, lookupDocForDecl s) | s <- availSubordinates avail ] ) where