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 | |
| parent | 0d7f4dfb3a3bba7b2a4d582a5cdc473c417b8d0d (diff) | |
Cleanup.
Diffstat (limited to 'src')
| -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 | 
