diff options
| author | alexbiehl <alex.biehl@gmail.com> | 2017-11-02 12:16:22 +0100 | 
|---|---|---|
| committer | alexbiehl <alex.biehl@gmail.com> | 2017-11-02 12:16:22 +0100 | 
| commit | 1789c77a6ed1580dc10a4391dc8c398e902f03b1 (patch) | |
| tree | 632f6bcae5fc6682870926dace7237aa1db0e2f9 /haddock-api/src/Haddock | |
| parent | aee89dcde08a80957b55e0872eff919a48cc13f9 (diff) | |
Always return documentation for exported subordinates
... event if they have no documentation (e.g. noDocForDecl)
By using the information in the AvailInfo we don't need additional
export checks.
Diffstat (limited to 'haddock-api/src/Haddock')
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 29 | 
1 files changed, 17 insertions, 12 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 4a13f386..27456998 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -739,10 +739,7 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames                  Nothing -> do                     liftErrMsg $ tell                        ["Warning: Couldn't find .haddock for export " ++ pretty dflags t] -                   let subs_ = [ (n, noDocForDecl) -                               | n <- availNamesWithSelectors avail -                               , n /= availName avail -                               ] +                   let subs_ = availNoDocs avail                     availExportDecl avail decl (noDocForDecl, subs_)                  Just iface ->                    availExportDecl avail decl (lookupDocs avail warnings (instDocMap iface) (instArgMap iface)) @@ -808,19 +805,19 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames                  -- from the type.                  mb_r <- hiDecl dflags n                  case mb_r of -                    Nothing -> return ([], (noDocForDecl, [])) +                    Nothing -> return ([], (noDocForDecl, availNoDocs avail))                      -- TODO: If we try harder, we might be able to find                      -- a Haddock!  Look in the Haddocks for each thing in                      -- requirementContext (pkgState) -                    Just decl -> return ([decl], (noDocForDecl, [])) +                    Just decl -> return ([decl], (noDocForDecl, availNoDocs avail))                | otherwise -> -                return ([], (noDocForDecl, [])) +                return ([], (noDocForDecl, availNoDocs avail))        | Just iface <- M.lookup (semToIdMod (moduleUnitId thisMod) m) modMap        , Just ds <- M.lookup n (ifaceDeclMap iface) =            return (ds, lookupDocs avail warnings                              (ifaceDocMap iface)                              (ifaceArgMap iface)) -      | otherwise = return ([], (noDocForDecl, [])) +      | otherwise = return ([], (noDocForDecl, availNoDocs avail))        where          n = availName avail          m = nameModule n @@ -841,8 +838,8 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames            _ -> pure []        pure (concat patsyns)        where -        mightBeBundledPatSyn n = isDataConName n && n /= availName avail -        constructor_names = filter mightBeBundledPatSyn (availNames avail) +        constructor_names = +          filter isDataConName (availSubordinates avail)  -- this heavily depends on the invariants stated in Avail  availExportsDecl :: AvailInfo -> Bool @@ -851,6 +848,14 @@ availExportsDecl (AvailTC ty_name names _)    | otherwise      = False  availExportsDecl _ = True +availSubordinates :: AvailInfo -> [Name] +availSubordinates avail = +  filter (/= availName avail) (availNamesWithSelectors avail) + +availNoDocs :: AvailInfo -> [(Name, DocForDecl Name)] +availNoDocs avail = +  zip (availSubordinates avail) (repeat noDocForDecl) +  -- | Given a 'Module' from a 'Name', convert it into a 'Module' that  -- we can actually find in the 'IfaceMap'.  semToIdMod :: UnitId -> Module -> Module @@ -901,8 +906,8 @@ lookupDocs avail warnings docMap argMap =    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 <- availNamesWithSelectors avail -                , s /= n ] in +                | s <- availSubordinates avail +                ] in    (doc, subDocs)    where      lookupDoc name = Documentation (M.lookup name docMap) (M.lookup name warnings)  | 
