diff options
author | David Waern <david.waern@gmail.com> | 2011-12-03 18:56:25 +0100 |
---|---|---|
committer | David Waern <david.waern@gmail.com> | 2011-12-03 19:07:55 +0100 |
commit | 20c4bfe760b3b50c875e91e455c47f544ba5129e (patch) | |
tree | a10ece90929d756580f59b51ab5fbd48c4df57d0 /src/Haddock/Interface/Create.hs | |
parent | 0d7f4dfb3a3bba7b2a4d582a5cdc473c417b8d0d (diff) |
Cleanup.
Diffstat (limited to 'src/Haddock/Interface/Create.hs')
-rw-r--r-- | src/Haddock/Interface/Create.hs | 38 |
1 files changed, 11 insertions, 27 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index 5f633a0b..de87ca94 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -212,19 +212,6 @@ declInfos dflags 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 _ = [] @@ -254,31 +241,28 @@ classDataSubs decl , ConDeclField n _ doc <- flds ] --- All the sub declarations of a class (that we handle), ordered by +-- | All the sub declarations of a class (that we handle), ordered by -- source location, with documentation attached if it exists. classDecls :: TyClDecl Name -> [(Decl, MaybeDocStrings)] -classDecls = filterDecls . collectDocs . sortByLoc . declsFromClass - - -declsFromClass :: TyClDecl a -> [Located (HsDecl a)] -declsFromClass class_ = docs ++ defs ++ sigs ++ ats +classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls where - docs = mkDecls tcdDocs DocD class_ - defs = mkDecls (bagToList . tcdMeths) ValD class_ - sigs = mkDecls tcdSigs SigD class_ - ats = mkDecls tcdATs TyClD class_ + decls = docs ++ defs ++ sigs ++ ats + docs = mkDecls tcdDocs DocD class_ + defs = mkDecls (bagToList . tcdMeths) ValD class_ + sigs = mkDecls tcdSigs SigD class_ + ats = mkDecls tcdATs TyClD class_ -- | The top-level declarations of a module that we care about, -- ordered by source location, with documentation attached if it exists. topDecls :: HsGroup Name -> [(Decl, MaybeDocStrings)] -topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . declsFromGroup +topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . ungroup -- | Take all declarations except pragmas, infix decls, rules and value -- bindings from an 'HsGroup'. -declsFromGroup :: HsGroup Name -> [Decl] -declsFromGroup group_ = +ungroup :: HsGroup Name -> [Decl] +ungroup group_ = mkDecls (concat . hs_tyclds) TyClD group_ ++ mkDecls hs_derivds DerivD group_ ++ mkDecls hs_defds DefD group_ ++ @@ -546,7 +530,7 @@ mkExportItems modMap thisMod gre exportedNames decls declMap Nothing -> do liftErrMsg $ tell ["Warning: Couldn't find .haddock for export " ++ pretty t] - let subs = subordinatesWithNoDocs (unLoc decl) + let subs = [ (n, noDocForDecl) | (n, _, _) <- subordinates (unLoc decl) ] return [ mkExportDecl t (decl, noDocForDecl, subs) ] Just iface -> do let subs = case Map.lookup t (instSubMap iface) of |