aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Convert.hs
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Convert.hs')
-rw-r--r--haddock-api/src/Haddock/Convert.hs33
1 files changed, 19 insertions, 14 deletions
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index f3c40be1..fa904e4b 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -610,12 +610,13 @@ synifyType _ vs (AppTy t1 t2) = let
s1 = synifyType WithinType vs t1
s2 = synifyType WithinType vs t2
in noLoc $ HsAppTy noExt s1 s2
-synifyType s vs funty@(FunTy InvisArg _ _) = synifyForAllType s vs funty
+synifyType s vs funty@(FunTy InvisArg _ _) = synifyForAllType s Inferred vs funty
synifyType _ vs (FunTy VisArg t1 t2) = let
s1 = synifyType WithinType vs t1
s2 = synifyType WithinType vs t2
in noLoc $ HsFunTy noExt s1 s2
-synifyType s vs forallty@(ForAllTy _tv _ty) = synifyForAllType s vs forallty
+synifyType s vs forallty@(ForAllTy (Bndr _ argf) _ty) =
+ synifyForAllType s argf vs forallty
synifyType _ _ (LitTy t) = noLoc $ HsTyLit noExt $ synifyTyLit t
synifyType s vs (CastTy t _) = synifyType s vs t
@@ -625,16 +626,18 @@ synifyType _ _ (CoercionTy {}) = error "synifyType:Coercion"
-- an 'HsType'
synifyForAllType
:: SynifyTypeState -- ^ what to do with the 'forall'
+ -> ArgFlag -- ^ the visibility of the @forall@
-> [TyVar] -- ^ free variables in the type to convert
-> Type -- ^ the forall type to convert
-> LHsType GhcRn
-synifyForAllType s vs ty =
- let (tvs, ctx, tau) = tcSplitSigmaTyPreserveSynonyms ty
+synifyForAllType s argf vs ty =
+ let (tvs, ctx, tau) = tcSplitSigmaTySameVisPreserveSynonyms argf ty
sPhi = HsQualTy { hst_ctxt = synifyCtx ctx
, hst_xqual = noExt
, hst_body = synifyType WithinType (tvs' ++ vs) tau }
- sTy = HsForAllTy { hst_bndrs = sTvs
+ sTy = HsForAllTy { hst_fvf = argToForallVisFlag argf
+ , hst_bndrs = sTvs
, hst_xforall = noExt
, hst_body = noLoc sPhi }
@@ -677,7 +680,8 @@ implicitForAll tycons vs tvs ctx synInner tau
= HsQualTy { hst_ctxt = synifyCtx ctx
, hst_xqual = noExt
, hst_body = synInner (tvs' ++ vs) tau }
- sTy = HsForAllTy { hst_bndrs = sTvs
+ sTy = HsForAllTy { hst_fvf = ForallInvis
+ , hst_bndrs = sTvs
, hst_xforall = noExt
, hst_body = noLoc sPhi }
@@ -825,21 +829,22 @@ See https://github.com/haskell/haddock/issues/879 for a bug where this
invariant didn't hold.
-}
--- | A version of 'TcType.tcSplitSigmaTy' that preserves type synonyms.
+-- | A version of 'TcType.tcSplitSigmaTySameVis' that preserves type synonyms.
--
-- See Note [Invariant: Never expand type synonyms]
-tcSplitSigmaTyPreserveSynonyms :: Type -> ([TyVar], ThetaType, Type)
-tcSplitSigmaTyPreserveSynonyms ty =
- case tcSplitForAllTysPreserveSynonyms ty of
+tcSplitSigmaTySameVisPreserveSynonyms :: ArgFlag -> Type -> ([TyVar], ThetaType, Type)
+tcSplitSigmaTySameVisPreserveSynonyms argf ty =
+ case tcSplitForAllTysSameVisPreserveSynonyms argf ty of
(tvs, rho) -> case tcSplitPhiTyPreserveSynonyms rho of
(theta, tau) -> (tvs, theta, tau)
-- | See Note [Invariant: Never expand type synonyms]
-tcSplitForAllTysPreserveSynonyms :: Type -> ([TyVar], Type)
-tcSplitForAllTysPreserveSynonyms ty = split ty ty []
+tcSplitForAllTysSameVisPreserveSynonyms :: ArgFlag -> Type -> ([TyVar], Type)
+tcSplitForAllTysSameVisPreserveSynonyms supplied_argf ty = split ty ty []
where
- split _ (ForAllTy (Bndr tv _) ty') tvs = split ty' ty' (tv:tvs)
- split orig_ty _ tvs = (reverse tvs, orig_ty)
+ split _ (ForAllTy (Bndr tv argf) ty') tvs
+ | argf `sameVis` supplied_argf = split ty' ty' (tv:tvs)
+ split orig_ty _ tvs = (reverse tvs, orig_ty)
-- | See Note [Invariant: Never expand type synonyms]
tcSplitPhiTyPreserveSynonyms :: Type -> (ThetaType, Type)