aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/Hoogle.hs
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2015-10-27 17:34:18 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2015-10-27 17:34:18 +0000
commitec20bd15e724d580a01d9fad98791bb53db5e57c (patch)
tree54f8660aae0aefa1474ff22b82e9a45a685b7699 /haddock-api/src/Haddock/Backends/Hoogle.hs
parenta394ee884befd8cc8ba31a6071afaec7cca14e7c (diff)
Follow changes to HsTYpe
Not yet complete (but on a wip/ branch)
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Hoogle.hs')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs31
1 files changed, 11 insertions, 20 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 8664db27..b7dfad64 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -113,38 +113,29 @@ ppExport dflags ExportDecl { expItemDecl = L _ decl
f (TyClD d@DataDecl{}) = ppData dflags d subdocs
f (TyClD d@SynDecl{}) = ppSynonym dflags d
f (TyClD d@ClassDecl{}) = ppClass dflags d
- f (ForD (ForeignImport name typ _ _)) = ppSig dflags $ TypeSig [name] typ
- f (ForD (ForeignExport name typ _ _)) = ppSig dflags $ TypeSig [name] typ
+ f (ForD (ForeignImport name typ _ _)) = pp_sig dflags [name] (hsSigType typ)
+ f (ForD (ForeignExport name typ _ _)) = pp_sig dflags [name] (hsSigType typ)
f (SigD sig) = ppSig dflags sig
f _ = []
ppExport _ _ = []
ppSig :: DynFlags -> Sig Name -> [String]
-ppSig dflags (TypeSig names sig)
- = [operator prettyNames ++ " :: " ++ outHsType dflags typ]
- where
- prettyNames = intercalate ", " $ map (out dflags) names
- typ = unL (hsSigType sig)
+ppSig dflags (TypeSig names sig) = pp_sig dflags names (hsSigWcType sig)
ppSig _ _ = []
+pp_sig :: DynFlags -> [Located Name] -> LHsType Name -> [String]
+pp_sig dflags names (L _ typ)
+ = [operator prettyNames ++ " :: " ++ outHsType dflags typ]
+ where
+ prettyNames = intercalate ", " $ map (out dflags) names
-- note: does not yet output documentation for class methods
ppClass :: DynFlags -> TyClDecl Name -> [String]
ppClass dflags x = out dflags x{tcdSigs=[]} :
- concatMap (ppSig dflags . addContext . unL) (tcdSigs x)
- where
- addContext (TypeSig name sig) = TypeSig name (mkHsSigType (f (hsSigType sig)))
- addContext (MinimalSig src sig) = MinimalSig src sig
- addContext _ = error "expected TypeSig"
-
- f (L _ (HsForAllTy a ty)) = reL (HsForallTy a (f ty))
- f (L _ (HsQualTy cxt ty)) = HsQualTy (reL (context : unLoc cxt)) ty
- f ty = HsQualTy (reL [context]) ty
-
- context = nlHsTyConApp (tcdName x)
- (map (reL . HsTyVar . hsTyVarName . unL) (hsQTvBndrs (tyClDeclTyVars x)))
-
+ concatMap (ppSig dflags . unL . add_ctxt) (tcdSigs x)
+ where
+ add_ctxt = addClassContext (tcdName x) (tyClDeclTyVars x)
ppInstance :: DynFlags -> ClsInst -> [String]
ppInstance dflags x = [dropComment $ out dflags x]