aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/Hoogle.hs
diff options
context:
space:
mode:
authorƁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-08-10 14:38:43 +0200
committerMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2015-08-21 18:31:31 +0100
commitfbfd09c8bf12b6991fb0aab24bf01e272f89a131 (patch)
tree9c87d3f33280f9e8a0f1abb2dcc23c86ed9388ff /haddock-api/src/Haddock/Backends/Hoogle.hs
parentff8464058e226f3f2cdf7df4b0f395ba826d5190 (diff)
Add missing default family equations in Hoogle output.
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Hoogle.hs')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs14
1 files changed, 13 insertions, 1 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 0a174fd6..71e7cbc4 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -24,6 +24,7 @@ import Haddock.Utils hiding (out)
import Bag
import GHC
import Outputable
+import NameSet
import Data.Char
import Data.List
@@ -169,7 +170,10 @@ ppClass dflags decl subdocs = (out dflags decl' ++ " " ++ ppTyFams) : ppMethods
ppMethods = concat . map (ppSig' . unLoc) $ tcdSigs decl
ppSig' = flip (ppSigWithDoc dflags) subdocs . addContext
- ppTyFams = showSDocUnqual dflags . whereWrapper . map ppr $ tcdATs decl
+ ppTyFams = showSDocUnqual dflags . whereWrapper $ concat
+ [ map ppr (tcdATs decl)
+ , map (ppr . tyFamEqnToSyn . unLoc) (tcdATDefs decl)
+ ]
addContext (TypeSig name (L l sig) nwcs) = TypeSig name (L l $ f sig) nwcs
addContext (MinimalSig src sig) = MinimalSig src sig
@@ -181,6 +185,14 @@ ppClass dflags decl subdocs = (out dflags decl' ++ " " ++ ppTyFams) : ppMethods
context = nlHsTyConApp (tcdName decl)
(map (reL . HsTyVar . hsTyVarName . unL) (hsQTvBndrs (tyClDeclTyVars decl)))
+ tyFamEqnToSyn :: TyFamDefltEqn Name -> TyClDecl Name
+ tyFamEqnToSyn tfe = SynDecl
+ { tcdLName = tfe_tycon tfe
+ , tcdTyVars = tfe_pats tfe
+ , tcdRhs = tfe_rhs tfe
+ , tcdFVs = emptyNameSet
+ }
+
ppInstance :: DynFlags -> ClsInst -> [String]
ppInstance dflags x =