diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Haddock/Backends/Hoogle.hs | 7 | ||||
| -rw-r--r-- | src/Haddock/Backends/Html.hs | 14 | ||||
| -rw-r--r-- | src/Haddock/Convert.hs | 8 | ||||
| -rw-r--r-- | src/Haddock/GhcUtils.hs | 16 |
4 files changed, 35 insertions, 10 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs index b1b08b95..25c5d91e 100644 --- a/src/Haddock/Backends/Hoogle.hs +++ b/src/Haddock/Backends/Hoogle.hs @@ -145,10 +145,7 @@ ppClass x = out x{tcdSigs=[]} : f t = HsForAllTy Implicit [] (reL [context]) (reL t) context = reL $ HsClassP (unL $ tcdLName x) - (map (reL . HsTyVar . tyVar . unL) (tcdTyVars x)) - - tyVar (UserTyVar v _) = v - tyVar (KindedTyVar v _) = v + (map (reL . HsTyVar . hsTyVarName . unL) (tcdTyVars x)) ppInstance :: Instance -> [String] @@ -191,7 +188,7 @@ ppCtor dat subdocs con = doc (lookupCon subdocs (con_name con)) name = out $ unL $ con_name con resType = case con_res con of - ResTyH98 -> apps $ map (reL . HsTyVar) $ unL (tcdLName dat) : [x | UserTyVar x _ <- map unL $ tcdTyVars dat] + ResTyH98 -> apps $ map (reL . HsTyVar) $ unL (tcdLName dat) : [hsTyVarName v | v@UserTyVar {} <- map unL $ tcdTyVars dat] ResTyGADT x -> x diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs index b1290fd5..47930ed4 100644 --- a/src/Haddock/Backends/Html.hs +++ b/src/Haddock/Backends/Html.hs @@ -1368,7 +1368,11 @@ ppShortConstr summary con unicode = case con_res con of mkFunTy a b = noLoc (HsFunTy a b) -- ppConstrHdr is for (non-GADT) existentials constructors' syntax +#if __GLASGOW_HASKELL__ == 612 +ppConstrHdr :: HsExplicitForAll -> [Name] -> HsContext DocName -> Bool -> Html +#else ppConstrHdr :: HsExplicitFlag -> [Name] -> HsContext DocName -> Bool -> Html +#endif ppConstrHdr forall tvs ctxt unicode = (if null tvs then noHtml else ppForall) +++ @@ -1580,7 +1584,11 @@ ppFunLhType unicode ty = ppr_mono_ty pREC_FUN ty unicode -- Drop top-level for-all type variables in user style -- since they are implicit in Haskell +#if __GLASGOW_HASKELL__ == 612 +ppForAll :: HsExplicitForAll -> [Located (HsTyVarBndr DocName)] +#else ppForAll :: HsExplicitFlag -> [Located (HsTyVarBndr DocName)] +#endif -> Located (HsContext DocName) -> Bool -> Html ppForAll expl tvs cxt unicode | show_forall = forall_part <+> ppLContext cxt unicode @@ -1610,8 +1618,12 @@ ppr_mono_ty _ (HsPArrTy ty) u = pabrackets (ppr_mono_lty pREC_TOP ppr_mono_ty _ (HsPredTy p) u = parens (ppPred u p) ppr_mono_ty _ (HsNumTy n) _ = toHtml (show n) -- generics only ppr_mono_ty _ (HsSpliceTy {}) _ = error "ppr_mono_ty HsSpliceTy" +#if __GLASGOW_HASKELL__ == 612 +ppr_mono_ty _ (HsSpliceTyOut {}) _ = error "ppr_mono_ty HsQuasiQuoteTy" +#else ppr_mono_ty _ (HsQuasiQuoteTy {}) _ = error "ppr_mono_ty HsQuasiQuoteTy" -ppr_mono_ty _ (HsRecTy _) _ = error "ppr_mono_ty HsRecTy" +#endif +ppr_mono_ty _ (HsRecTy {}) _ = error "ppr_mono_ty HsRecTy" ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode = maybeParen ctxt_prec pREC_CON $ diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs index 5a47eb2e..54bce1c8 100644 --- a/src/Haddock/Convert.hs +++ b/src/Haddock/Convert.hs @@ -20,7 +20,11 @@ module Haddock.Convert where import HsSyn import TcType ( tcSplitSigmaTy ) import TypeRep +#if __GLASGOW_HASKELL__ == 612 +import Type ( splitKindFunTys ) +#else import Coercion ( splitKindFunTys ) +#endif import Name import Var import Class @@ -226,7 +230,11 @@ synifyTyVars = map synifyTyVar kind = tyVarKind tv name = getName tv in if isLiftedTypeKind kind +#if __GLASGOW_HASKELL__ == 612 + then UserTyVar name +#else then UserTyVar name placeHolderKind +#endif else KindedTyVar name kind --states of what to do with foralls: diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs index 5c481586..c0d6707c 100644 --- a/src/Haddock/GhcUtils.hs +++ b/src/Haddock/GhcUtils.hs @@ -90,10 +90,18 @@ isVarSym = isLexVarSym . occNameFS getMainDeclBinder :: HsDecl name -> Maybe name getMainDeclBinder (TyClD d) = Just (tcdName d) -getMainDeclBinder (ValD d) - = case collectHsBindBinders d of - [] -> Nothing - (name:_) -> Just name +getMainDeclBinder (ValD d) = +#if __GLASGOW_HASKELL__ == 612 + case collectAcc d [] of + [] -> Nothing + (name:_) -> Just (unLoc name) +#else + case collectHsBindBinders d of + [] -> Nothing + (name:_) -> Just name +#endif + + getMainDeclBinder (SigD d) = sigNameNoLoc d getMainDeclBinder (ForD (ForeignImport name _ _)) = Just (unLoc name) getMainDeclBinder (ForD (ForeignExport _ _ _)) = Nothing |