diff options
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r-- | haddock-api/src/Haddock/Backends/Hoogle.hs | 2 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 10 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 16 |
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) |