aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2016-11-03 14:08:10 +0200
committerAlan Zimmerman <alan.zimm@gmail.com>2016-12-07 21:14:28 +0200
commit1dcefaddc52d968b20bb6107d620e1e0c6839970 (patch)
tree5f6600b63d773b6d8be00fd1bb09a39d58e494c9 /haddock-api/src/Haddock/Backends
parent2bd3429c40419100478545db6a8b2080786ca26d (diff)
Match changes in GHC wip/T3384 branch
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs8
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs6
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs7
4 files changed, 13 insertions, 10 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 48b97445..40106491 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -16,7 +16,7 @@ module Haddock.Backends.Hoogle (
ppHoogle
) where
-import BasicTypes (OverlapFlag(..), OverlapMode(..))
+import BasicTypes (OverlapFlag(..), OverlapMode(..), SourceText(..))
import InstEnv (ClsInst(..))
import Haddock.GhcUtils
import Haddock.Types hiding (Version)
@@ -85,7 +85,7 @@ dropHsDocTy = f
f (HsDocTy a _) = f $ unL a
f x = x
-outHsType :: (OutputableBndr a, OutputableBndr (NameOrRdrName a))
+outHsType :: (OutputableBndrId a, HasOccNameId a)
=> DynFlags -> HsType a -> String
outHsType dflags = out dflags . dropHsDocTy
@@ -196,7 +196,7 @@ ppInstance dflags x =
-- safety information to a state where the Outputable instance
-- produces no output which means no overlap and unsafe (or [safe]
-- is generated).
- cls = x { is_flag = OverlapFlag { overlapMode = NoOverlap mempty
+ cls = x { is_flag = OverlapFlag { overlapMode = NoOverlap NoSourceText
, isSafeOverlap = False } }
ppSynonym :: DynFlags -> TyClDecl Name -> [String]
@@ -244,7 +244,7 @@ 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 = apps $ map (reL . HsTyVar . reL) $
+ resType = apps $ map (reL . HsTyVar NotPromoted . reL) $
(tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _) <- hsQTvExplicit $ tyClDeclTyVars dat]
ppCtor dflags _dat subdocs con@ConDeclGADT {}
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index be17cb8b..1d9fbe20 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -72,7 +72,7 @@ types =
everything (<|>) ty
where
ty term = case cast term of
- (Just (GHC.L sspan (GHC.HsTyVar name))) ->
+ (Just (GHC.L sspan (GHC.HsTyVar _ name))) ->
pure (sspan, RtkType (GHC.unLoc name))
_ -> empty
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index ffb4d782..36a859e6 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -949,7 +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 (L _ name)) _ = 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)
@@ -960,7 +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 _ tys) u = Pretty.quote $ 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 c6f1100b..499d9e11 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -984,12 +984,12 @@ ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode qual
ppLContext ctxt unicode qual <+> ppr_mono_lty pREC_TOP ty unicode qual
-- UnicodeSyntax alternatives
-ppr_mono_ty _ (HsTyVar (L _ name)) True _
+ppr_mono_ty _ (HsTyVar _ (L _ name)) True _
| getOccString (getName name) == "*" = toHtml "★"
| getOccString (getName name) == "(->)" = toHtml "(→)"
ppr_mono_ty _ (HsBangTy b ty) u q = ppBang b +++ ppLParendType u q ty
-ppr_mono_ty _ (HsTyVar (L _ name)) _ q = ppDocName q Prefix True name
+ppr_mono_ty _ (HsTyVar _ (L _ name)) _ q = ppDocName q Prefix True name
ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) u q = ppr_fun_ty ctxt_prec ty1 ty2 u q
ppr_mono_ty _ (HsTupleTy con tys) u q = tupleParens con (map (ppLType u q) tys)
ppr_mono_ty _ (HsSumTy tys) u q = sumParens (map (ppLType u q) tys)
@@ -1005,7 +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 _ tys) u q = promoQuote $ 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"