diff options
| author | Ryan Newton <rrnewton@gmail.com> | 2011-11-05 05:59:58 -0400 |
|---|---|---|
| committer | Ryan Newton <rrnewton@gmail.com> | 2011-11-05 05:59:58 -0400 |
| commit | 8ae2b7df6749d37df93a4ba5d7e3a6a2e7002b1a (patch) | |
| tree | 3fcabf0b74ba1acfb6286a540388ecc7d17409cf /src | |
| parent | 2deba11b49ed5ca29e947e875349f870310d3746 (diff) | |
Improved declNames internal error. Added a case to handle DocD.
Diffstat (limited to 'src')
| -rw-r--r-- | src/Haddock/Interface/Create.hs | 27 |
1 files changed, 24 insertions, 3 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index 057fceb7..3a2bae1f 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -34,6 +34,8 @@ 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 @@ -263,10 +265,29 @@ declsFromClass class_ = docs ++ defs ++ sigs ++ ats declNames :: HsDecl a -> [a] declNames (TyClD d) = [tcdName d] -declNames (ForD (ForeignImport n _ _ _)) = [unLoc n] +declNames (ForD (ForeignImport n _ _)) = [unLoc n] -- we have normal sigs only (since they are taken from ValBindsOut) declNames (SigD sig) = sigNameNoLoc sig -declNames _ = error "unexpected argument to declNames" +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, @@ -770,7 +791,7 @@ extractClassDecl c tvs0 (L pos (TypeSig lname ltype)) = case ltype of _ -> L pos (TypeSig lname (noLoc (mkImplicitHsForAllTy (lctxt []) ltype))) where lctxt = noLoc . ctxt - ctxt preds = nlHsTyConApp c (map toTypeNoLoc tvs0) : preds + ctxt preds = noLoc (HsClassP c (map toTypeNoLoc tvs0)) : preds extractClassDecl _ _ _ = error "extractClassDecl: unexpected decl" |