aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs10
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs16
3 files changed, 16 insertions, 12 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 29c64a2d..221580cc 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -87,7 +87,7 @@ dropHsDocTy = drop_sig_ty
drop_ty (HsFunTy x w a b) = HsFunTy x w (drop_lty a) (drop_lty b)
drop_ty (HsListTy x a) = HsListTy x (drop_lty a)
drop_ty (HsTupleTy x a b) = HsTupleTy x a (map drop_lty b)
- drop_ty (HsOpTy x a b c) = HsOpTy x (drop_lty a) b (drop_lty c)
+ drop_ty (HsOpTy x p a b c) = HsOpTy x p (drop_lty a) b (drop_lty c)
drop_ty (HsParTy x a) = HsParTy x (drop_lty a)
drop_ty (HsKindSig x a b) = HsKindSig x (drop_lty a) b
drop_ty (HsDocTy _ a _) = drop_ty $ unL a
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index eb524ec7..349c6e8e 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -24,7 +24,7 @@ import Haddock.GhcUtils
import GHC.Utils.Ppr hiding (Doc, quote)
import qualified GHC.Utils.Ppr as Pretty
-import GHC.Types.Basic ( PromotionFlag(..) )
+import GHC.Types.Basic ( PromotionFlag(..), isPromoted )
import GHC hiding (fromMaybeContext )
import GHC.Types.Name.Occurrence
import GHC.Types.Name ( nameOccName )
@@ -1133,9 +1133,13 @@ ppr_mono_ty (HsAppTy _ fun_ty arg_ty) unicode
ppr_mono_ty (HsAppKindTy _ fun_ty arg_ki) unicode
= hsep [ppr_mono_lty fun_ty unicode, atSign unicode <> ppr_mono_lty arg_ki unicode]
-ppr_mono_ty (HsOpTy _ ty1 op ty2) unicode
- = ppr_mono_lty ty1 unicode <+> ppr_op <+> ppr_mono_lty ty2 unicode
+ppr_mono_ty (HsOpTy _ prom ty1 op ty2) unicode
+ = ppr_mono_lty ty1 unicode <+> ppr_op_prom <+> ppr_mono_lty ty2 unicode
where
+ ppr_op_prom | isPromoted prom
+ = char '\'' <> ppr_op
+ | otherwise
+ = ppr_op
ppr_op | isSymOcc (getOccName op) = ppLDocName op
| otherwise = char '`' <> ppLDocName op <> char '`'
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 336f23ac..a54bb0aa 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -1281,15 +1281,15 @@ ppr_mono_ty (HsAppKindTy _ fun_ty arg_ki) unicode qual _
= hsep [ppr_mono_lty fun_ty unicode qual HideEmptyContexts
, atSign unicode <> ppr_mono_lty arg_ki unicode qual HideEmptyContexts]
-ppr_mono_ty (HsOpTy _ ty1 op ty2) unicode qual _
- = ppr_mono_lty ty1 unicode qual HideEmptyContexts <+> ppr_op <+> ppr_mono_lty ty2 unicode qual HideEmptyContexts
+ppr_mono_ty (HsOpTy _ prom ty1 op ty2) unicode qual _
+ = ppr_mono_lty ty1 unicode qual HideEmptyContexts <+> ppr_op_prom <+> ppr_mono_lty ty2 unicode qual HideEmptyContexts
where
- -- `(:)` is valid in type signature only as constructor to promoted list
- -- and needs to be quoted in code so we explicitly quote it here too.
- ppr_op
- | (getOccString . getName . unL) op == ":" = promoQuote ppr_op'
- | otherwise = ppr_op'
- ppr_op' = ppLDocName qual Infix op
+ ppr_op_prom
+ | isPromoted prom
+ = promoQuote ppr_op
+ | otherwise
+ = ppr_op
+ ppr_op = ppLDocName qual Infix op
ppr_mono_ty (HsParTy _ ty) unicode qual emptyCtxts
= parens (ppr_mono_lty ty unicode qual emptyCtxts)