diff options
| author | David Waern <david.waern@gmail.com> | 2011-11-06 00:47:21 +0100 | 
|---|---|---|
| committer | David Waern <david.waern@gmail.com> | 2011-11-06 01:20:37 +0100 | 
| commit | f19cc291ca05b0a7fc8f716007224216c74e22a2 (patch) | |
| tree | a1bf9648326ed5a2364de8c3edc87f6ee87810ff /src | |
| parent | 2f1036494c17b8bc38ec8b63d12d3944a0054e3b (diff) | |
Use getDeclMainBinder instead of declNames.
Diffstat (limited to 'src')
| -rw-r--r-- | src/Haddock/GhcUtils.hs | 8 | ||||
| -rw-r--r-- | src/Haddock/Interface/Create.hs | 37 | 
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 ++ ": " ++  | 
