aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock
diff options
context:
space:
mode:
authorDavid Waern <david.waern@gmail.com>2011-11-06 00:47:21 +0100
committerDavid Waern <david.waern@gmail.com>2011-11-06 01:20:37 +0100
commitf19cc291ca05b0a7fc8f716007224216c74e22a2 (patch)
treea1bf9648326ed5a2364de8c3edc87f6ee87810ff /src/Haddock
parent2f1036494c17b8bc38ec8b63d12d3944a0054e3b (diff)
Use getDeclMainBinder instead of declNames.
Diffstat (limited to 'src/Haddock')
-rw-r--r--src/Haddock/GhcUtils.hs8
-rw-r--r--src/Haddock/Interface/Create.hs37
2 files changed, 5 insertions, 40 deletions
diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs
index 33ae1b6d..d5423bee 100644
--- a/src/Haddock/GhcUtils.hs
+++ b/src/Haddock/GhcUtils.hs
@@ -85,21 +85,15 @@ isVarSym = isLexVarSym . occNameFS
getMainDeclBinder :: HsDecl name -> [name]
getMainDeclBinder (TyClD d) = [tcdName d]
getMainDeclBinder (ValD d) =
-#if __GLASGOW_HASKELL__ == 612
- case collectAcc d [] of
- [] -> []
- (name:_) -> [unLoc name]
-#else
case collectHsBindBinders d of
[] -> []
(name:_) -> [name]
-#endif
-
getMainDeclBinder (SigD d) = sigNameNoLoc d
getMainDeclBinder (ForD (ForeignImport name _ _ _)) = [unLoc name]
getMainDeclBinder (ForD (ForeignExport _ _ _ _)) = []
getMainDeclBinder _ = []
+
-- Useful when there is a signature with multiple names, e.g.
-- foo, bar :: Types..
-- but only one of the names is exported and we have to change the
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 3a2bae1f..94c2a7e7 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -34,8 +34,6 @@ import Name
import Bag
import RdrName (GlobalRdrEnv)
--- From GHC API:
-import Outputable(ppr, runSDoc, initSDocContext)
-- | Use a 'TypecheckedModule' to produce an 'Interface'.
-- To do this, we need access to already processed modules in the topological
@@ -180,7 +178,7 @@ mkDeclMap :: [DeclInfo] -> Map Name DeclInfo
mkDeclMap decls = Map.fromList . concat $
[ decls_ ++ subDecls
| (parent@(L _ d), doc, subs) <- decls
- , let decls_ = [ (name, (parent, doc, subs)) | name <- declNames d ]
+ , let decls_ = [ (name, (parent, doc, subs)) | name <- getMainDeclBinder d ]
subDecls = [ (n, (parent, doc', [])) | (n, doc') <- subs ]
, not (isDocD d), not (isInstD d) ]
@@ -232,7 +230,7 @@ classDataSubs decl
where
classSubs = [ (name, doc, fnArgsDoc)
| (L _ d, doc) <- classDecls decl
- , name <- declNames d
+ , name <- getMainDeclBinder d
, let fnArgsDoc = getDeclFnArgDocs d ]
dataSubs = constrs ++ fields
where
@@ -263,33 +261,6 @@ declsFromClass class_ = docs ++ defs ++ sigs ++ ats
ats = mkDecls tcdATs TyClD class_
-declNames :: HsDecl a -> [a]
-declNames (TyClD d) = [tcdName d]
-declNames (ForD (ForeignImport n _ _)) = [unLoc n]
--- we have normal sigs only (since they are taken from ValBindsOut)
-declNames (SigD sig) = sigNameNoLoc sig
-declNames (DocD _) = []
-declNames x = error$ "unexpected argument to declNames: " ++ showHsDecl x
-
-showHsDecl x =
- case x of
- TyClD _ -> "TyClD" -- (TyClDecl id)
- InstD _ -> "InstD" -- (InstDecl id)
- DerivD _ -> "DerivD" -- (DerivDecl id)
- ValD _ -> "ValD" -- (HsBind id)
- SigD _ -> "SigD" -- (Sig id)
- DefD _ -> "DefD" -- (DefaultDecl id)
- ForD _ -> "ForD" -- (ForeignDecl id)
- WarningD _ -> "WarningD" -- (WarnDecl id)
- AnnD _ -> "AnnD" -- (AnnDecl id)
- RuleD _ -> "RuleD" -- (RuleDecl id)
- VectD _ -> "VectD" -- (VectDecl id)
- SpliceD _ -> "SpliceD" -- (SpliceDecl id)
- DocD _ -> "DocD" -- DocDecl
- QuasiQuoteD _ -> "QuasiQuoteD" -- (HsQuasiQuote id)
-
-
-
-- | 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)]
@@ -516,7 +487,7 @@ mkExportItems modMap thisMod gre exportedNames decls declMap
declWith t =
case findDecl t of
Just (decl, doc, subs) ->
- let declNames_ = getMainDeclBinder (unL decl)
+ let declNames = getMainDeclBinder (unL decl)
in case () of
_
-- temp hack: we filter out separately exported ATs, since we haven't decided how
@@ -526,7 +497,7 @@ mkExportItems modMap thisMod gre exportedNames decls declMap
-- We should not show a subordinate by itself if any of its
-- parents is also exported. See note [1].
- | not $ t `elem` declNames_,
+ | not $ t `elem` declNames,
Just p <- find isExported (parents t $ unL decl) ->
do liftErrMsg $ tell [
"Warning: " ++ moduleString thisMod ++ ": " ++