diff options
author | Ćukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-08-10 14:38:43 +0200 |
---|---|---|
committer | Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> | 2015-08-21 18:31:31 +0100 |
commit | fbfd09c8bf12b6991fb0aab24bf01e272f89a131 (patch) | |
tree | 9c87d3f33280f9e8a0f1abb2dcc23c86ed9388ff /haddock-api | |
parent | ff8464058e226f3f2cdf7df4b0f395ba826d5190 (diff) |
Add missing default family equations in Hoogle output.
Diffstat (limited to 'haddock-api')
-rw-r--r-- | haddock-api/src/Haddock/Backends/Hoogle.hs | 14 |
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 = |