diff options
| -rw-r--r-- | src/Haddock/Interface/Create.hs | 27 |
1 files changed, 25 insertions, 2 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index 2f8e1f01..76b59a80 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -79,8 +79,31 @@ createInterface tm flags modMap instIfaceMap = do (decls, _) = unzip declsWithDocs localInsts = filter (nameIsLocalOrFrom mdl . getName) instances - maps@(docMap, argMap, subMap, declMap) <- - liftErrMsg $ mkMaps dflags gre localInsts exportedNames declsWithDocs + (docs, argMap, subMap, declMap) <- liftErrMsg $ mkMaps dflags gre localInsts exportedNames declsWithDocs + + -- Attach warnings to documentation as appropriate. If there is a warning + -- for an identifier with no documentation, create a piece of documentation, + -- that just contains the warning. + let docMap = warningMap `combine` docs + where + combine :: (Ord k, Monoid a) => Map k a -> Map k a -> Map k a + combine = M.unionWith mappend + + warningMap = case warnings of + -- NOTE: warningMap may contain more elements than xs, e.g. when + -- we have a warning for: + -- + -- data Foo = Foo + -- + -- So you can not just map over xs! + (WarnSome xs) -> foldr f M.empty exportedNames + where + f name m = case lookup (getOccName name) xs of + Just x -> M.insert name (warningToDoc x) m + Nothing -> m + _ -> M.empty + + let maps = (docMap, argMap, subMap, declMap) let exports0 = fmap (reverse . map unLoc) mayExports exports |