From a482831b5a2f9a7460f6fa5003f9593420117f73 Mon Sep 17 00:00:00 2001 From: Isaac Dupree Date: Mon, 24 Aug 2009 01:22:44 +0000 Subject: refactor out subordinatesWithNoDocs dep of inferenced-decls fix --- src/Haddock/Interface/Create.hs | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) (limited to 'src/Haddock') diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index 3cfb5836..50bd3a74 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -169,6 +169,19 @@ declInfos gre decls = return (parent, (mbDoc, fnArgsDoc), subs) +-- | If you know the HsDecl can't contain any docs +-- (e.g., it was loaded from a .hi file and you don't have a .haddock file +-- to help you find out about the subs or docs) +-- then you can use this to get its subs. +subordinatesWithNoDocs :: HsDecl Name -> [(Name, DocForDecl Name)] +subordinatesWithNoDocs decl = map noDocs (subordinates decl) + where + -- check the condition... or shouldn't we be checking? + noDocs (n, doc1, doc2) | null doc1, Map.null doc2 + = (n, noDocForDecl) + noDocs _ = error ("no-docs thing has docs! " ++ pretty decl) + + subordinates :: HsDecl Name -> [(Name, MaybeDocStrings, Map Int HsDocString)] subordinates (TyClD d) = classDataSubs d subordinates _ = [] @@ -520,8 +533,7 @@ mkExportItems modMap this_mod gre exported_names decls declMap liftErrMsg $ tell ["Warning: Couldn't find .haddock for exported " ++ exportInfoString] - let subs = map (\(n,_,_) -> (n, noDocForDecl)) - (subordinates (unLoc hsdecl)) + let subs = subordinatesWithNoDocs (unLoc hsdecl) return [ mkExportDecl t (hsdecl, noDocForDecl, subs) ] Just iface -> do let subs = case Map.lookup t (instSubMap iface) of -- cgit v1.2.3