diff options
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Hoogle.hs')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hoogle.hs | 37 |
1 files changed, 14 insertions, 23 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 149f4815..1f98ef9c 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -18,7 +18,7 @@ module Haddock.Backends.Hoogle ( ) where import BasicTypes ( OverlapFlag(..), OverlapMode(..), SourceText(..) - , PromotionFlag(..) ) + , PromotionFlag(..), TopLevelFlag(..) ) import InstEnv (ClsInst(..)) import Documentation.Haddock.Markup import Haddock.GhcUtils @@ -72,7 +72,7 @@ dropHsDocTy :: HsType a -> HsType a dropHsDocTy = f where g (L src x) = L src (f x) - f (HsForAllTy x a e) = HsForAllTy x a (g e) + f (HsForAllTy x fvf a e) = HsForAllTy x fvf a (g e) f (HsQualTy x a e) = HsQualTy x a (g e) f (HsBangTy x a b) = HsBangTy x a (g b) f (HsAppTy x a b) = HsAppTy x (g a) (g b) @@ -86,8 +86,8 @@ dropHsDocTy = f f (HsDocTy _ a _) = f $ unL a f x = x -outHsType :: (a ~ GhcPass p, OutputableBndrId a) - => DynFlags -> HsType a -> String +outHsType :: (OutputableBndrId p) + => DynFlags -> HsType (GhcPass p) -> String outHsType dflags = out dflags . reparenType . dropHsDocTy @@ -174,7 +174,7 @@ ppClass dflags decl subdocs = | null $ tcdATs decl = "" | otherwise = (" " ++) . showSDocUnqual dflags . whereWrapper $ concat [ map pprTyFam (tcdATs decl) - , map (ppr . tyFamEqnToSyn . unLoc) (tcdATDefs decl) + , map (pprTyFamInstDecl NotTopLevel . unLoc) (tcdATDefs decl) ] pprTyFam :: LFamilyDecl GhcRn -> SDoc @@ -187,15 +187,6 @@ ppClass dflags decl subdocs = , rbrace ] - tyFamEqnToSyn :: TyFamDefltEqn GhcRn -> TyClDecl GhcRn - tyFamEqnToSyn tfe = SynDecl - { tcdLName = feqn_tycon tfe - , tcdTyVars = feqn_pats tfe - , tcdFixity = feqn_fixity tfe - , tcdRhs = feqn_rhs tfe - , tcdSExt = emptyNameSet - } - ppFam :: DynFlags -> FamilyDecl GhcRn -> [String] ppFam dflags decl@(FamilyDecl { fdInfo = info }) = [out dflags decl'] @@ -205,7 +196,7 @@ ppFam dflags decl@(FamilyDecl { fdInfo = info }) -- for Hoogle, so pretend it doesn't have any. ClosedTypeFamily{} -> decl { fdInfo = OpenTypeFamily } _ -> decl -ppFam _ XFamilyDecl {} = panic "ppFam" +ppFam _ (XFamilyDecl nec) = noExtCon nec ppInstance :: DynFlags -> ClsInst -> [String] ppInstance dflags x = @@ -254,8 +245,8 @@ ppCtor dflags dat subdocs con@ConDeclH98 {} [out dflags (map (extFieldOcc . unLoc) $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]] | r <- map unLoc recs] - funs = foldr1 (\x y -> reL $ HsFunTy NoExt x y) - apps = foldl1 (\x y -> reL $ HsAppTy NoExt x y) + funs = foldr1 (\x y -> reL $ HsFunTy noExtField x y) + apps = foldl1 (\x y -> reL $ HsAppTy noExtField x y) typeSig nm flds = operator nm ++ " :: " ++ outHsType dflags (unL $ funs flds) @@ -263,13 +254,13 @@ ppCtor dflags dat subdocs con@ConDeclH98 {} -- docs for con_names on why it is a list to begin with. name = commaSeparate dflags . map unL $ getConNames con - resType = let c = HsTyVar NoExt NotPromoted (noLoc (tcdName dat)) + resType = let c = HsTyVar noExtField NotPromoted (reL (tcdName dat)) as = map (tyVarBndr2Type . unLoc) (hsQTvExplicit $ tyClDeclTyVars dat) - in apps (map noLoc (c : as)) + in apps (map reL (c : as)) tyVarBndr2Type :: HsTyVarBndr GhcRn -> HsType GhcRn - tyVarBndr2Type (UserTyVar _ n) = HsTyVar NoExt NotPromoted n - tyVarBndr2Type (KindedTyVar _ n k) = HsKindSig NoExt (noLoc (HsTyVar NoExt NotPromoted n)) k + tyVarBndr2Type (UserTyVar _ n) = HsTyVar noExtField NotPromoted n + tyVarBndr2Type (KindedTyVar _ n k) = HsKindSig noExtField (reL (HsTyVar noExtField NotPromoted n)) k tyVarBndr2Type (XTyVarBndr _) = panic "haddock:ppCtor" ppCtor dflags _dat subdocs con@(ConDeclGADT { }) @@ -279,10 +270,10 @@ ppCtor dflags _dat subdocs con@(ConDeclGADT { }) typeSig nm ty = operator nm ++ " :: " ++ outHsType dflags (unL ty) name = out dflags $ map unL $ getConNames con -ppCtor _ _ _ XConDecl {} = panic "haddock:ppCtor" +ppCtor _ _ _ (XConDecl nec) = noExtCon nec ppFixity :: DynFlags -> (Name, Fixity) -> [String] -ppFixity dflags (name, fixity) = [out dflags ((FixitySig noExt [noLoc name] fixity) :: FixitySig GhcRn)] +ppFixity dflags (name, fixity) = [out dflags ((FixitySig noExtField [noLoc name] fixity) :: FixitySig GhcRn)] --------------------------------------------------------------------- |