[commit: haddock] wip/T3384: HsTyVar and HsExplicitListTy use Promoted instead of Bool (e25358a)
git at git.haskell.org
git at git.haskell.org
Mon Nov 20 21:04:30 UTC 2017
Repository : ssh://git@git.haskell.org/haddock
On branch : wip/T3384
Link : http://git.haskell.org/haddock.git/commitdiff/e25358a44e87b09104c3c4e9af76b2f9d3502bec
>---------------------------------------------------------------
commit e25358a44e87b09104c3c4e9af76b2f9d3502bec
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date: Fri Nov 25 15:46:56 2016 +0200
HsTyVar and HsExplicitListTy use Promoted instead of Bool
>---------------------------------------------------------------
e25358a44e87b09104c3c4e9af76b2f9d3502bec
haddock-api/src/Haddock/Backends/Hoogle.hs | 2 +-
haddock-api/src/Haddock/Backends/LaTeX.hs | 8 ++++----
haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 4 ++--
haddock-api/src/Haddock/Convert.hs | 8 ++++----
haddock-api/src/Haddock/Interface/Create.hs | 2 +-
haddock-api/src/Haddock/Types.hs | 4 ++--
haddock-api/src/Haddock/Utils.hs | 2 +-
7 files changed, 15 insertions(+), 15 deletions(-)
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 5ab06f9..821b41d 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -244,7 +244,7 @@ ppCtor dflags dat subdocs con at ConDeclH98 {}
-- docs for con_names on why it is a list to begin with.
name = commaSeparate dflags . map unL $ getConNames con
- resType = apps $ map (reL . HsTyVar False . reL) $
+ resType = apps $ map (reL . HsTyVar NotPromoted . reL) $
(tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _) <- hsQTvExplicit $ tyClDeclTyVars dat]
ppCtor dflags _dat subdocs con at ConDeclGADT {}
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index a13b1d1..36a859e 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -949,8 +949,8 @@ ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode
, ppr_mono_lty pREC_TOP ty unicode ]
ppr_mono_ty _ (HsBangTy b ty) u = ppBang b <> ppLParendType u ty
-ppr_mono_ty _ (HsTyVar False (L _ name)) _ = ppDocName name
-ppr_mono_ty _ (HsTyVar True (L _ name)) _ = char '\'' <> ppDocName name
+ppr_mono_ty _ (HsTyVar NotPromoted (L _ name)) _ = ppDocName name
+ppr_mono_ty _ (HsTyVar Promoted (L _ name)) _ = char '\'' <> ppDocName name
ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) u = ppr_fun_ty ctxt_prec ty1 ty2 u
ppr_mono_ty _ (HsTupleTy con tys) u = tupleParens con (map (ppLType u) tys)
ppr_mono_ty _ (HsSumTy tys) u = sumParens (map (ppLType u) tys)
@@ -961,8 +961,8 @@ ppr_mono_ty _ (HsIParamTy n ty) u = brackets (ppIPName n <+> dcolon u
ppr_mono_ty _ (HsSpliceTy {}) _ = error "ppr_mono_ty HsSpliceTy"
ppr_mono_ty _ (HsRecTy {}) _ = error "ppr_mono_ty HsRecTy"
ppr_mono_ty _ (HsCoreTy {}) _ = error "ppr_mono_ty HsCoreTy"
-ppr_mono_ty _ (HsExplicitListTy True _ tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
-ppr_mono_ty _ (HsExplicitListTy False _ tys) u = brackets $ hsep $ punctuate comma $ map (ppLType u) tys
+ppr_mono_ty _ (HsExplicitListTy Promoted _ tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
+ppr_mono_ty _ (HsExplicitListTy NotPromoted _ tys) u = brackets $ hsep $ punctuate comma $ map (ppLType u) tys
ppr_mono_ty _ (HsExplicitTupleTy _ tys) u = Pretty.quote $ parenList $ map (ppLType u) tys
ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 29590d5..499d9e1 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -1005,8 +1005,8 @@ ppr_mono_ty _ (HsRecTy {}) _ _ = toHtml "{..}"
-- placeholder in the signature, which is followed by the field
-- declarations.
ppr_mono_ty _ (HsCoreTy {}) _ _ = error "ppr_mono_ty HsCoreTy"
-ppr_mono_ty _ (HsExplicitListTy True _ tys) u q = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q) tys
-ppr_mono_ty _ (HsExplicitListTy False _ tys) u q = brackets $ hsep $ punctuate comma $ map (ppLType u q) tys
+ppr_mono_ty _ (HsExplicitListTy Promoted _ tys) u q = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q) tys
+ppr_mono_ty _ (HsExplicitListTy NotPromoted _ tys) u q = brackets $ hsep $ punctuate comma $ map (ppLType u q) tys
ppr_mono_ty _ (HsExplicitTupleTy _ tys) u q = promoQuote $ parenList $ map (ppLType u q) tys
ppr_mono_ty _ (HsAppsTy {}) _ _ = error "ppr_mono_ty HsAppsTy"
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 9cfd854..bf45623 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -366,17 +366,17 @@ synifyPatSynSigType :: PatSyn -> LHsSigType Name
synifyPatSynSigType ps = mkEmptyImplicitBndrs (synifyPatSynType ps)
synifyType :: SynifyTypeState -> Type -> LHsType Name
-synifyType _ (TyVarTy tv) = noLoc $ HsTyVar False $ noLoc (getName tv)
+synifyType _ (TyVarTy tv) = noLoc $ HsTyVar NotPromoted $ noLoc (getName tv)
synifyType _ (TyConApp tc tys)
-- Use */# instead of TYPE 'Lifted/TYPE 'Unlifted (#473)
| tc `hasKey` tYPETyConKey
, [TyConApp lev []] <- tys
, lev `hasKey` ptrRepLiftedDataConKey
- = noLoc (HsTyVar False (noLoc starKindTyConName))
+ = noLoc (HsTyVar NotPromoted (noLoc starKindTyConName))
| tc `hasKey` tYPETyConKey
, [TyConApp lev []] <- tys
, lev `hasKey` ptrRepUnliftedDataConKey
- = noLoc (HsTyVar False (noLoc unliftedTypeKindTyConName))
+ = noLoc (HsTyVar NotPromoted (noLoc unliftedTypeKindTyConName))
-- Use non-prefix tuple syntax where possible, because it looks nicer.
| Just sort <- tyConTuple_maybe tc
, tyConArity tc == length tys
@@ -400,7 +400,7 @@ synifyType _ (TyConApp tc tys)
-- Most TyCons:
| otherwise =
foldl (\t1 t2 -> noLoc (HsAppTy t1 t2))
- (noLoc $ HsTyVar False $ noLoc (getName tc))
+ (noLoc $ HsTyVar NotPromoted $ noLoc (getName tc))
(map (synifyType WithinType) $
filterOut isCoercionTy tys)
synifyType s (AppTy t1 (CoercionTy {})) = synifyType s t1
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index d1f9be6..850089c 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -839,7 +839,7 @@ extractRecSel nm mdl t tvs (L _ con : rest) =
data_ty
-- | ResTyGADT _ ty <- con_res con = ty
| ConDeclGADT{} <- con = hsib_body $ con_type con
- | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar False (noLoc t))) tvs
+ | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs
-- | Keep export items with docs.
pruneExportItems :: [ExportItem Name] -> [ExportItem Name]
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index e7898fc..951faf5 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -380,8 +380,8 @@ mkPseudoFamilyDecl (FamilyDecl { .. }) = PseudoFamilyDecl
mkType (KindedTyVar (L loc name) lkind) =
HsKindSig tvar lkind
where
- tvar = L loc (HsTyVar False (L loc name))
- mkType (UserTyVar name) = HsTyVar False name
+ tvar = L loc (HsTyVar NotPromoted (L loc name))
+ mkType (UserTyVar name) = HsTyVar NotPromoted name
-- | An instance head that may have documentation and a source location.
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index fc112d3..ba38260 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -151,7 +151,7 @@ addClassContext _ _ sig = sig -- E.g. a MinimalSig is fine
lHsQTyVarsToTypes :: LHsQTyVars Name -> [LHsType Name]
lHsQTyVarsToTypes tvs
- = [ noLoc (HsTyVar False (noLoc (hsLTyVarName tv)))
+ = [ noLoc (HsTyVar NotPromoted (noLoc (hsLTyVarName tv)))
| tv <- hsQTvExplicit tvs ]
--------------------------------------------------------------------------------
More information about the ghc-commits
mailing list