aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends/Hoogle.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/Backends/Hoogle.hs')
-rw-r--r--src/Haddock/Backends/Hoogle.hs20
1 files changed, 12 insertions, 8 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 020c4a71..b96dfc45 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -109,9 +109,9 @@ operator x = x
-- How to print each export
ppExport :: ExportItem Name -> [String]
-ppExport (ExportDecl decl dc _ _) = doc dc ++ f (unL decl)
+ppExport (ExportDecl decl dc subdocs _) = doc dc ++ f (unL decl)
where
- f (TyClD d@TyData{}) = ppData d
+ f (TyClD d@TyData{}) = ppData d subdocs
f (TyClD d@ClassDecl{}) = ppClass d
f (TyClD d@TySynonym{}) = ppSynonym d
f (ForD (ForeignImport name typ _)) = ppSig $ TypeSig name typ
@@ -156,9 +156,9 @@ ppInstance :: Instance -> [String]
ppInstance x = [dropComment $ out x]
-ppData :: TyClDecl Name -> [String]
-ppData x = showData x{tcdCons=[],tcdDerivs=Nothing} :
- concatMap (ppCtor x . unL) (tcdCons x)
+ppData :: TyClDecl Name -> [(Name, Maybe (HsDoc Name))] -> [String]
+ppData x subdocs = showData x{tcdCons=[],tcdDerivs=Nothing} :
+ concatMap (ppCtor x subdocs . unL) (tcdCons x)
where
-- GHC gives out "data Bar =", we want to delete the equals
-- also writes data : a b, when we want data (:) a b
@@ -168,14 +168,18 @@ ppData x = showData x{tcdCons=[],tcdDerivs=Nothing} :
nam = out $ tcdLName d
f w = if w == nam then operator nam else w
+-- | for constructors, and named-fields...
+lookupCon :: [(Name, Maybe (HsDoc Name))] -> Located Name -> Maybe (HsDoc Name)
+lookupCon subdocs (L _ name) = join{-Maybe-} $ lookup name subdocs
-ppCtor :: TyClDecl Name -> ConDecl Name -> [String]
-ppCtor dat con = ldoc (con_doc con) ++ f (con_details con)
+ppCtor :: TyClDecl Name -> [(Name, Maybe (HsDoc Name))] -> ConDecl Name -> [String]
+ppCtor dat subdocs con = doc (lookupCon subdocs (con_name con))
+ ++ f (con_details con)
where
f (PrefixCon args) = [typeSig name $ args ++ [resType]]
f (InfixCon a1 a2) = f $ PrefixCon [a1,a2]
f (RecCon recs) = f (PrefixCon $ map cd_fld_type recs) ++ concat
- [ldoc (cd_fld_doc r) ++
+ [doc (lookupCon subdocs (cd_fld_name r)) ++
[out (unL $ cd_fld_name r) `typeSig` [resType, cd_fld_type r]]
| r <- recs]