diff options
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hoogle.hs | 14 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker.hs | 21 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 23 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 33 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 44 | 
5 files changed, 77 insertions, 58 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 9e39d98d..582c535d 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 @@ -246,11 +246,11 @@ ppCtor dflags dat subdocs con@ConDeclH98 { con_args = con_args' }          f (PrefixCon _ args) = [typeSig name $ (map hsScaledThing args) ++ [resType]]          f (InfixCon a1 a2) = f $ PrefixCon [] [a1,a2]          f (RecCon (L _ recs)) = f (PrefixCon [] $ map (hsLinear . cd_fld_type . unLoc) recs) ++ concat -                          [(concatMap (lookupCon dflags subdocs . noLocA . extFieldOcc . unLoc) (cd_fld_names r)) ++ -                           [out dflags (map (extFieldOcc . unLoc) $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]] +                          [(concatMap (lookupCon dflags subdocs . noLocA . foExt . unLoc) (cd_fld_names r)) ++ +                           [out dflags (map (foExt . unLoc) $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]]                            | r <- map unLoc recs] -        funs = foldr1 (\x y -> reL $ HsFunTy noAnn (HsUnrestrictedArrow NormalSyntax) x y) +        funs = foldr1 (\x y -> reL $ HsFunTy noAnn (HsUnrestrictedArrow noHsUniTok) x y)          apps = foldl1 (\x y -> reL $ HsAppTy noExtField x y)          typeSig nm flds = operator nm ++ " :: " ++ @@ -279,12 +279,12 @@ ppCtor dflags _dat subdocs (ConDeclGADT { con_names = names          name = out dflags $ map unL names          con_sig_ty = HsSig noExtField outer_bndrs theta_ty where            theta_ty = case mcxt of -            Just theta -> noLocA (HsQualTy { hst_xqual = noExtField, hst_ctxt = Just theta, hst_body = tau_ty }) +            Just theta -> noLocA (HsQualTy { hst_xqual = noExtField, hst_ctxt = theta, hst_body = tau_ty })              Nothing -> tau_ty            tau_ty = foldr mkFunTy res_ty $              case args of PrefixConGADT pos_args -> map hsScaledThing pos_args -                         RecConGADT (L _ flds) -> map (cd_fld_type . unL) flds -          mkFunTy a b = noLocA (HsFunTy noAnn (HsUnrestrictedArrow NormalSyntax) a b) +                         RecConGADT (L _ flds) _ -> map (cd_fld_type . unL) flds +          mkFunTy a b = noLocA (HsFunTy noAnn (HsUnrestrictedArrow noHsUniTok) a b)  ppFixity :: DynFlags -> (Name, Fixity) -> [String]  ppFixity dflags (name, fixity) = [out dflags ((FixitySig noExtField [noLocA name] fixity) :: FixitySig GhcRn)] diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs index 5bbea77b..89828e30 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs @@ -9,6 +9,7 @@ module Haddock.Backends.Hyperlinker  import Haddock.Types  import Haddock.Utils (writeUtf8File, out, verbose, Verbosity) +import Haddock.InterfaceFile  import Haddock.Backends.Hyperlinker.Renderer  import Haddock.Backends.Hyperlinker.Parser  import Haddock.Backends.Hyperlinker.Types @@ -20,8 +21,8 @@ import System.Directory  import System.FilePath  import GHC.Iface.Ext.Types  ( pattern HiePath, HieFile(..), HieASTs(..), HieAST(..), SourcedNodeInfo(..) ) -import GHC.Iface.Ext.Binary ( readHieFile, hie_file_result, NameCacheUpdater(..)) -import GHC.Types.SrcLoc     ( realSrcLocSpan, mkRealSrcLoc ) +import GHC.Iface.Ext.Binary ( readHieFile, hie_file_result ) +import GHC.Types.SrcLoc     ( realSrcLocSpan, mkRealSrcLoc, srcSpanFile )  import Data.Map as M  import GHC.Data.FastString     ( mkFastString )  import GHC.Unit.Module         ( Module, moduleName ) @@ -58,21 +59,19 @@ ppHyperlinkedModuleSource :: Verbosity -> FilePath -> Bool -> SrcMaps -> Interfa  ppHyperlinkedModuleSource verbosity srcdir pretty srcs iface = case ifaceHieFile iface of      Just hfp -> do          -- Parse the GHC-produced HIE file -        u <- mkSplitUniqSupply 'a' -        let nc = (initNameCache u []) -            ncu = NCU $ \f -> pure $ snd $ f nc +        nc <- freshNameCache          HieFile { hie_hs_file = file                  , hie_asts = HieASTs asts                  , hie_types = types                  , hie_hs_src = rawSrc                  } <- hie_file_result -                 <$> (readHieFile ncu hfp) +                 <$> (readHieFile nc hfp)          -- Get the AST and tokens corresponding to the source file we want          let fileFs = mkFastString file              mast | M.size asts == 1 = snd <$> M.lookupMin asts                   | otherwise        = M.lookup (HiePath (mkFastString file)) asts -            tokens = parse df file rawSrc +            tokens' = parse df file rawSrc              ast = fromMaybe (emptyHieAst fileFs) mast              fullAst = recoverFullIfaceTypes df types ast @@ -82,6 +81,14 @@ ppHyperlinkedModuleSource verbosity srcdir pretty srcs iface = case ifaceHieFile            else out verbosity verbose $ unwords [ "couldn't find ast for"                                                 , file, show (M.keys asts) ] +        -- The C preprocessor can double the backslashes on tokens (see #19236), +        -- which means the source spans will not be comparable and we will not +        -- be able to associate the HieAST with the correct tokens. +        -- +        -- We work around this by setting the source span of the tokens to the file +        -- name from the HieAST +        let tokens = fmap (\tk -> tk {tkSpan = (tkSpan tk){srcSpanFile = srcSpanFile $ nodeSpan fullAst}}) tokens' +          -- Produce and write out the hyperlinked sources          writeUtf8File path . renderToString pretty . render' fullAst $ tokens      Nothing -> return () diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs index d9a2e0cd..9f28d72a 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs @@ -10,14 +10,17 @@ import Data.List           ( isPrefixOf, isSuffixOf )  import qualified Data.ByteString as BS +import GHC.Platform  import GHC.Types.SourceText  import GHC.Driver.Session +import GHC.Driver.Config.Diagnostic  import GHC.Utils.Error     ( pprLocMsgEnvelope )  import GHC.Data.FastString ( mkFastString ) -import GHC.Parser.Errors.Ppr ( pprError ) +import GHC.Parser.Errors.Ppr () +import qualified GHC.Types.Error as E  import GHC.Parser.Lexer    as Lexer                             ( P(..), ParseResult(..), PState(..), Token(..) -                           , initParserState, lexer, mkParserOpts, getErrorMessages) +                           , initParserState, lexer, mkParserOpts, getPsErrorMessages)  import GHC.Data.Bag         ( bagToList )  import GHC.Utils.Outputable ( text, ($$) )  import GHC.Utils.Panic      ( panic ) @@ -40,7 +43,7 @@ parse  parse dflags fpath bs = case unP (go False []) initState of      POk _ toks -> reverse toks      PFailed pst -> -      let err:_ = bagToList (fmap pprError (getErrorMessages pst)) in +      let err:_ = bagToList (E.getMessages $ getPsErrorMessages pst) in        panic $ showSDoc dflags $          text "Hyperlinker parse error:" $$ pprLocMsgEnvelope err    where @@ -48,8 +51,10 @@ parse dflags fpath bs = case unP (go False []) initState of      initState = initParserState pflags buf start      buf = stringBufferFromByteString bs      start = mkRealSrcLoc (mkFastString fpath) 1 1 -    pflags = mkParserOpts   (warningFlags dflags) -                            (extensionFlags dflags) +    arch_os = platformArchOS (targetPlatform dflags) +    pflags = mkParserOpts   (extensionFlags dflags) +                            (initDiagOpts dflags) +                            (supportedLanguagesAndExtensions arch_os)                              (safeImportsOn dflags)                              False -- lex Haddocks as comment tokens                              True  -- produce comment tokens @@ -233,6 +238,7 @@ classify tok =      ITrequires             -> TkKeyword      ITinline_prag       {} -> TkPragma +    ITopaque_prag       {} -> TkPragma      ITspec_prag         {} -> TkPragma      ITspec_inline_prag  {} -> TkPragma      ITsource_prag       {} -> TkPragma @@ -263,6 +269,7 @@ classify tok =      ITequal                -> TkGlyph      ITlam                  -> TkGlyph      ITlcase                -> TkGlyph +    ITlcases               -> TkGlyph      ITvbar                 -> TkGlyph      ITlarrow            {} -> TkGlyph      ITrarrow            {} -> TkGlyph @@ -350,10 +357,7 @@ classify tok =      ITeof                  -> TkUnknown      ITlineComment       {} -> TkComment -    ITdocCommentNext    {} -> TkComment -    ITdocCommentPrev    {} -> TkComment -    ITdocCommentNamed   {} -> TkComment -    ITdocSection        {} -> TkComment +    ITdocComment        {} -> TkComment      ITdocOptions        {} -> TkComment      -- The lexer considers top-level pragmas as comments (see `pragState` in @@ -374,6 +378,7 @@ inPragma True _ = True  inPragma False tok =    case tok of      ITinline_prag       {} -> True +    ITopaque_prag       {} -> True      ITspec_prag         {} -> True      ITspec_inline_prag  {} -> True      ITsource_prag       {} -> True diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index b045fa90..faa23d6a 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 ) @@ -843,7 +843,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =      fieldPart = case con of          ConDeclGADT{con_g_args = con_args'} -> case con_args' of            -- GADT record declarations -          RecConGADT _                    -> doConstrArgsWithDocs [] +          RecConGADT _ _                  -> doConstrArgsWithDocs []            -- GADT prefix data constructors            PrefixConGADT args | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing args)            _                               -> empty @@ -887,12 +887,12 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =  -- | Pretty-print a record field  ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocNameI ->  LaTeX  ppSideBySideField subdocs unicode (ConDeclField _ names ltype _) = -  decltt (cat (punctuate comma (map (ppBinder . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names)) +  decltt (cat (punctuate comma (map (ppBinder . rdrNameOcc . unLoc . foLabel . unLoc) names))      <+> dcolon unicode <+> ppLType unicode ltype) <-> rDoc mbDoc    where      -- don't use cd_fld_doc for same reason we don't use con_doc above      -- Where there is more than one name, they all have the same documentation -    mbDoc = lookup (extFieldOcc $ unLoc $ head names) subdocs >>= fmap _doc . combineDocumentation . fst +    mbDoc = lookup (foExt $ unLoc $ head names) subdocs >>= fmap _doc . combineDocumentation . fst  -- | Pretty-print a bundled pattern synonym @@ -983,11 +983,12 @@ ppTypeApp n ts ppDN ppT = ppDN n <+> hsep (map ppT ts)  ------------------------------------------------------------------------------- -ppLContext, ppLContextNoArrow :: Maybe (LHsContext DocNameI) -> Bool -> LaTeX -ppLContext        Nothing _ = empty -ppLContext        (Just ctxt) unicode  = ppContext        (unLoc ctxt) unicode -ppLContextNoArrow Nothing _ = empty -ppLContextNoArrow (Just ctxt) unicode = ppContextNoArrow (unLoc ctxt) unicode +ppLContext :: Maybe (LHsContext DocNameI) -> Bool -> LaTeX +ppLContext Nothing _ = empty +ppLContext (Just ctxt) unicode  = ppContext (unLoc ctxt) unicode + +ppLContextNoArrow :: LHsContext DocNameI -> Bool -> LaTeX +ppLContextNoArrow ctxt unicode = ppContextNoArrow (unLoc ctxt) unicode  ppContextNoLocsMaybe :: [HsType DocNameI] -> Bool -> Maybe LaTeX  ppContextNoLocsMaybe [] _ = Nothing @@ -1101,15 +1102,15 @@ ppr_mono_ty (HsForAllTy _ tele ty) unicode    = sep [ ppHsForAllTelescope tele unicode          , ppr_mono_lty ty unicode ]  ppr_mono_ty (HsQualTy _ ctxt ty) unicode -  = sep [ ppLContext ctxt unicode +  = sep [ ppLContext (Just ctxt) unicode          , ppr_mono_lty ty unicode ]  ppr_mono_ty (HsFunTy _ mult ty1 ty2)   u    = sep [ ppr_mono_lty ty1 u          , arr <+> ppr_mono_lty ty2 u ]     where arr = case mult of -                 HsLinearArrow _ _ -> lollipop u +                 HsLinearArrow _ -> lollipop u                   HsUnrestrictedArrow _ -> arrow u -                 HsExplicitMult _ _ m -> multAnnotation <> ppr_mono_lty m u <+> arrow u +                 HsExplicitMult _ m _ -> multAnnotation <> ppr_mono_lty m u <+> arrow u  ppr_mono_ty (HsBangTy _ b ty)     u = ppBang b <> ppLParendType u ty  ppr_mono_ty (HsTyVar _ NotPromoted (L _ name)) _ = ppDocName name @@ -1132,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 8de1b1b8..a54bb0aa 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -167,7 +167,7 @@ ppSubSigLike unicode qual typ argDocs subdocs sep emptyCtxts = do_sig_args 0 sep          leader' = leader <+> ppForAllPart unicode qual tele      do_args n leader (HsQualTy _ lctxt ltype) -      | null (fromMaybeContext lctxt) +      | null (unLoc lctxt)        = do_largs n leader ltype        | otherwise        = (leader <+> ppLContextNoArrow lctxt unicode qual emptyCtxts, Nothing, []) @@ -436,12 +436,14 @@ ppTypeApp n ts ppDN ppT = ppDN Prefix n <+> hsep (map ppT ts)  ------------------------------------------------------------------------------- -ppLContext, ppLContextNoArrow :: Maybe (LHsContext DocNameI) -> Unicode +ppLContext :: Maybe (LHsContext DocNameI) -> Unicode                                -> Qualification -> HideEmptyContexts -> Html  ppLContext        Nothing  u q h = ppContext        []        u q h  ppLContext        (Just c) u q h = ppContext        (unLoc c) u q h -ppLContextNoArrow Nothing  u q h = ppContextNoArrow []        u q h -ppLContextNoArrow (Just c) u q h = ppContextNoArrow (unLoc c) u q h + +ppLContextNoArrow :: LHsContext DocNameI -> Unicode +                              -> Qualification -> HideEmptyContexts -> Html +ppLContextNoArrow c u q h = ppContextNoArrow (unLoc c) u q h  ppContextNoArrow :: HsContext DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html  ppContextNoArrow cxt unicode qual emptyCtxts = fromMaybe noHtml $ @@ -967,7 +969,7 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con)      fieldPart = case con of          ConDeclGADT{con_g_args = con_args'} -> case con_args' of            -- GADT record declarations -          RecConGADT _                    -> [ doConstrArgsWithDocs [] ] +          RecConGADT _ _                  -> [ doConstrArgsWithDocs [] ]            -- GADT prefix data constructors            PrefixConGADT args | hasArgDocs -> [ doConstrArgsWithDocs args ]            _                               -> [] @@ -1025,7 +1027,7 @@ ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Unicode -> Qualification  ppSideBySideField subdocs unicode qual (ConDeclField _ names ltype _) =    ( hsep (punctuate comma [ ppBinder False (rdrNameOcc field)                            | L _ name <- names -                          , let field = (unLoc . rdrNameFieldOcc) name +                          , let field = (unLoc . foLabel) name                            ])        <+> dcolon unicode        <+> ppLType unicode qual HideEmptyContexts ltype @@ -1035,12 +1037,12 @@ ppSideBySideField subdocs unicode qual (ConDeclField _ names ltype _) =    where      -- don't use cd_fld_doc for same reason we don't use con_doc above      -- Where there is more than one name, they all have the same documentation -    mbDoc = lookup (extFieldOcc $ unLoc $ head names) subdocs >>= combineDocumentation . fst +    mbDoc = lookup (foExt $ unLoc $ head names) subdocs >>= combineDocumentation . fst  ppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocNameI -> Html  ppShortField summary unicode qual (ConDeclField _ names ltype _) -  = hsep (punctuate comma (map ((ppBinder summary) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names)) +  = hsep (punctuate comma (map ((ppBinder summary) . rdrNameOcc . unLoc . foLabel . unLoc) names))      <+> dcolon unicode <+> ppLType unicode qual HideEmptyContexts ltype @@ -1185,13 +1187,13 @@ patSigContext sig_typ | hasNonEmptyContext typ && isFirstContextEmpty typ =  Sho      hasNonEmptyContext t =        case unLoc t of          HsForAllTy _ _ s -> hasNonEmptyContext s -        HsQualTy _ cxt s -> if null (fromMaybeContext cxt) then hasNonEmptyContext s else True +        HsQualTy _ cxt s -> if null (unLoc cxt) then hasNonEmptyContext s else True          HsFunTy _ _ _ s    -> hasNonEmptyContext s          _ -> False      isFirstContextEmpty t =        case unLoc t of          HsForAllTy _ _ s -> isFirstContextEmpty s -        HsQualTy _ cxt _ -> null (fromMaybeContext cxt) +        HsQualTy _ cxt _ -> null (unLoc cxt)          HsFunTy _ _ _ s    -> isFirstContextEmpty s          _ -> False @@ -1230,7 +1232,7 @@ ppr_mono_ty (HsForAllTy _ tele ty) unicode qual emptyCtxts    = ppForAllPart unicode qual tele <+> ppr_mono_lty ty unicode qual emptyCtxts  ppr_mono_ty (HsQualTy _ ctxt ty) unicode qual emptyCtxts -  = ppLContext ctxt unicode qual emptyCtxts <+> ppr_mono_lty ty unicode qual emptyCtxts +  = ppLContext (Just ctxt) unicode qual emptyCtxts <+> ppr_mono_lty ty unicode qual emptyCtxts  -- UnicodeSyntax alternatives  ppr_mono_ty (HsTyVar _ _ (L _ name)) True _ _ @@ -1248,9 +1250,9 @@ ppr_mono_ty (HsFunTy _ mult ty1 ty2) u q e =         , arr <+> ppr_mono_lty ty2 u q e         ]     where arr = case mult of -                 HsLinearArrow _ _ -> lollipop u +                 HsLinearArrow _ -> lollipop u                   HsUnrestrictedArrow _ -> arrow u -                 HsExplicitMult _ _ m -> multAnnotation <> ppr_mono_lty m u q e <+> arrow u +                 HsExplicitMult _ m _ -> multAnnotation <> ppr_mono_lty m u q e <+> arrow u  ppr_mono_ty (HsTupleTy _ con tys) u q _ =    tupleParens con (map (ppLType u q HideEmptyContexts) tys) @@ -1279,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)  | 
