    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards #-}

    -- | Rendering of types.
    module Ormolu.Printer.Meat.Type
      ( p_hsType,
        p_hsTypePostDoc,
        hasDocStrings,
        p_hsContext,
        p_hsTyVarBndr,
        p_forallBndrs,
        p_conDeclFields,
        tyVarsToTypes,
      )
    where

    import Data.Data (Data)
    import GHC hiding (isPromoted)
    import Ormolu.Printer.Combinators
    import Ormolu.Printer.Meat.Common
    import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsSplice, p_stringLit)
    import Ormolu.Printer.Operators
    import Ormolu.Utils

    p_hsType :: HsType GhcPs -> R ()
    p_hsType :: HsType GhcPs -> R ()
    p_hsType t :: HsType GhcPs
    t = Bool -> TypeDocStyle -> HsType GhcPs -> R ()
    p_hsType' (HsType GhcPs -> Bool
    hasDocStrings HsType GhcPs
    t) TypeDocStyle
    PipeStyle HsType GhcPs
    t

    p_hsTypePostDoc :: HsType GhcPs -> R ()
    p_hsTypePostDoc :: HsType GhcPs -> R ()
    p_hsTypePostDoc t :: HsType GhcPs
    t = Bool -> TypeDocStyle -> HsType GhcPs -> R ()
    p_hsType' (HsType GhcPs -> Bool
    hasDocStrings HsType GhcPs
    t) TypeDocStyle
    CaretStyle HsType GhcPs
    t

    -- | How to render Haddocks associated with a type.
    data TypeDocStyle
      = PipeStyle
      | CaretStyle

    p_hsType' :: Bool -> TypeDocStyle -> HsType GhcPs -> R ()
    p_hsType' :: Bool -> TypeDocStyle -> HsType GhcPs -> R ()
    p_hsType' multilineArgs :: Bool
    multilineArgs docStyle :: TypeDocStyle
    docStyle = \case
      HsForAllTy NoExtField visibility :: ForallVisFlag
    visibility bndrs :: [LHsTyVarBndr GhcPs]
    bndrs t :: LHsType GhcPs
    t -> do
        ForallVisFlag
    -> (HsTyVarBndr GhcPs -> R ()) -> [LHsTyVarBndr GhcPs] -> R ()
    forall a.
    Data a =>
    ForallVisFlag -> (a -> R ()) -> [Located a] -> R ()
    p_forallBndrs ForallVisFlag
    visibility HsTyVarBndr GhcPs -> R ()
    p_hsTyVarBndr [LHsTyVarBndr GhcPs]
    bndrs
        R ()
    interArgBreak
        HsType GhcPs -> R ()
    p_hsTypeR (LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
    forall a. HasSrcSpan a => a -> SrcSpanLess a
    unLoc LHsType GhcPs
    t)
      HsQualTy NoExtField qs :: LHsContext GhcPs
    qs t :: LHsType GhcPs
    t -> do
        LHsContext GhcPs -> (HsContext GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsContext GhcPs
    qs HsContext GhcPs -> R ()
    p_hsContext
        R ()
    space
        Text -> R ()
    txt "=>"
        R ()
    interArgBreak
        case LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
    forall a. HasSrcSpan a => a -> SrcSpanLess a
    unLoc LHsType GhcPs
    t of
          HsQualTy {} -> HsType GhcPs -> R ()
    p_hsTypeR (LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
    forall a. HasSrcSpan a => a -> SrcSpanLess a
    unLoc LHsType GhcPs
    t)
          HsFunTy {} -> HsType GhcPs -> R ()
    p_hsTypeR (LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
    forall a. HasSrcSpan a => a -> SrcSpanLess a
    unLoc LHsType GhcPs
    t)
          _ -> LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    t HsType GhcPs -> R ()
    p_hsTypeR
      HsTyVar NoExtField p :: PromotionFlag
    p n :: Located (IdP GhcPs)
    n -> do
        case PromotionFlag
    p of
          IsPromoted -> do
            Text -> R ()
    txt "'"
            case RdrName -> String
    forall o. Outputable o => o -> String
    showOutputable (Located RdrName -> SrcSpanLess (Located RdrName)
    forall a. HasSrcSpan a => a -> SrcSpanLess a
    unLoc Located (IdP GhcPs)
    Located RdrName
    n) of
              _ : '\'' : _ -> R ()
    space
              _ -> () -> R ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          NotPromoted -> () -> R ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Located RdrName -> R ()
    p_rdrName Located (IdP GhcPs)
    Located RdrName
    n
      HsAppTy NoExtField f :: LHsType GhcPs
    f x :: LHsType GhcPs
    x -> do
        let -- In order to format type applications with multiple parameters
            -- nicer, traverse the AST to gather the function and all the
            -- parameters together.
            gatherArgs :: LHsType pass -> [LHsType pass] -> (LHsType pass, [LHsType pass])
    gatherArgs f' :: LHsType pass
    f' knownArgs :: [LHsType pass]
    knownArgs =
              case LHsType pass
    f' of
                L _ (HsAppTy _ l :: LHsType pass
    l r :: LHsType pass
    r) -> LHsType pass -> [LHsType pass] -> (LHsType pass, [LHsType pass])
    gatherArgs LHsType pass
    l (LHsType pass
    r LHsType pass -> [LHsType pass] -> [LHsType pass]
    forall a. a -> [a] -> [a]
    : [LHsType pass]
    knownArgs)
                _ -> (LHsType pass
    f', [LHsType pass]
    knownArgs)
            (func :: LHsType GhcPs
    func, args :: HsContext GhcPs
    args) = LHsType GhcPs
    -> HsContext GhcPs -> (LHsType GhcPs, HsContext GhcPs)
    forall pass.
    LHsType pass -> [LHsType pass] -> (LHsType pass, [LHsType pass])
    gatherArgs LHsType GhcPs
    f [LHsType GhcPs
    x]
        [SrcSpan] -> R () -> R ()
    switchLayout (LHsType GhcPs -> SrcSpan
    forall a. HasSrcSpan a => a -> SrcSpan
    getLoc LHsType GhcPs
    f SrcSpan -> [SrcSpan] -> [SrcSpan]
    forall a. a -> [a] -> [a]
    : (LHsType GhcPs -> SrcSpan) -> HsContext GhcPs -> [SrcSpan]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap LHsType GhcPs -> SrcSpan
    forall a. HasSrcSpan a => a -> SrcSpan
    getLoc HsContext GhcPs
    args) (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . R () -> R ()
    sitcc (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
          LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    func HsType GhcPs -> R ()
    p_hsType
          R ()
    breakpoint
          R () -> R ()
    inci (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $
            R () -> (LHsType GhcPs -> R ()) -> HsContext GhcPs -> R ()
    forall a. R () -> (a -> R ()) -> [a] -> R ()
    sep R ()
    breakpoint ((HsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
    forall a. (a -> R ()) -> Located a -> R ()
    located' HsType GhcPs -> R ()
    p_hsType) HsContext GhcPs
    args
      HsAppKindTy _ ty :: LHsType GhcPs
    ty kd :: LHsType GhcPs
    kd -> R () -> R ()
    sitcc (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
        -- The first argument is the location of the "@..." part. Not 100% sure,
        -- but I think we can ignore it as long as we use 'located' on both the
        -- type and the kind.
        LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    ty HsType GhcPs -> R ()
    p_hsType
        R ()
    breakpoint
        R () -> R ()
    inci (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
          Text -> R ()
    txt "@"
          LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    kd HsType GhcPs -> R ()
    p_hsType
      HsFunTy NoExtField x :: LHsType GhcPs
    x y :: LHsType GhcPs
    y@(L _ y' :: HsType GhcPs
    y') -> do
        LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    x HsType GhcPs -> R ()
    p_hsType
        R ()
    space
        Text -> R ()
    txt "->"
        R ()
    interArgBreak
        case HsType GhcPs
    y' of
          HsFunTy {} -> HsType GhcPs -> R ()
    p_hsTypeR HsType GhcPs
    y'
          _ -> LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    y HsType GhcPs -> R ()
    p_hsTypeR
      HsListTy NoExtField t :: LHsType GhcPs
    t ->
        LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    t (BracketStyle -> R () -> R ()
    brackets BracketStyle
    N (R () -> R ()) -> (HsType GhcPs -> R ()) -> HsType GhcPs -> R ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsType GhcPs -> R ()
    p_hsType)
      HsTupleTy NoExtField tsort :: HsTupleSort
    tsort xs :: HsContext GhcPs
    xs ->
        let parens' :: R () -> R ()
    parens' =
              case HsTupleSort
    tsort of
                HsUnboxedTuple -> BracketStyle -> R () -> R ()
    parensHash BracketStyle
    N
                HsBoxedTuple -> BracketStyle -> R () -> R ()
    parens BracketStyle
    N
                HsConstraintTuple -> BracketStyle -> R () -> R ()
    parens BracketStyle
    N
                HsBoxedOrConstraintTuple -> BracketStyle -> R () -> R ()
    parens BracketStyle
    N
         in R () -> R ()
    parens' (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ R () -> (LHsType GhcPs -> R ()) -> HsContext GhcPs -> R ()
    forall a. R () -> (a -> R ()) -> [a] -> R ()
    sep R ()
    commaDel (R () -> R ()
    sitcc (R () -> R ()) -> (LHsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
    forall a. (a -> R ()) -> Located a -> R ()
    located' HsType GhcPs -> R ()
    p_hsType) HsContext GhcPs
    xs
      HsSumTy NoExtField xs :: HsContext GhcPs
    xs ->
        BracketStyle -> R () -> R ()
    parensHash BracketStyle
    N (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $
          R () -> (LHsType GhcPs -> R ()) -> HsContext GhcPs -> R ()
    forall a. R () -> (a -> R ()) -> [a] -> R ()
    sep (Text -> R ()
    txt "|" R () -> R () -> R ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> R ()
    breakpoint) (R () -> R ()
    sitcc (R () -> R ()) -> (LHsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
    forall a. (a -> R ()) -> Located a -> R ()
    located' HsType GhcPs -> R ()
    p_hsType) HsContext GhcPs
    xs
      HsOpTy NoExtField x :: LHsType GhcPs
    x op :: Located (IdP GhcPs)
    op y :: LHsType GhcPs
    y ->
        R () -> R ()
    sitcc (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $
          let opTree :: OpTree (LHsType GhcPs) (Located RdrName)
    opTree = OpTree (LHsType GhcPs) (Located RdrName)
    -> Located RdrName
    -> OpTree (LHsType GhcPs) (Located RdrName)
    -> OpTree (LHsType GhcPs) (Located RdrName)
    forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
    OpBranch (LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)
    tyOpTree LHsType GhcPs
    x) Located (IdP GhcPs)
    Located RdrName
    op (LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)
    tyOpTree LHsType GhcPs
    y)
           in OpTree (LHsType GhcPs) (Located RdrName) -> R ()
    p_tyOpTree ((RdrName -> Maybe RdrName)
    -> OpTree (LHsType GhcPs) (Located RdrName)
    -> OpTree (LHsType GhcPs) (Located RdrName)
    forall op ty.
    (op -> Maybe RdrName)
    -> OpTree (Located ty) (Located op)
    -> OpTree (Located ty) (Located op)
    reassociateOpTree RdrName -> Maybe RdrName
    forall a. a -> Maybe a
    Just OpTree (LHsType GhcPs) (Located RdrName)
    opTree)
      HsParTy NoExtField t :: LHsType GhcPs
    t ->
        BracketStyle -> R () -> R ()
    parens BracketStyle
    N (LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    t HsType GhcPs -> R ()
    p_hsType)
      HsIParamTy NoExtField n :: Located HsIPName
    n t :: LHsType GhcPs
    t -> R () -> R ()
    sitcc (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
        Located HsIPName -> (HsIPName -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located Located HsIPName
    n HsIPName -> R ()
    forall a. Outputable a => a -> R ()
    atom
        R ()
    space
        Text -> R ()
    txt "::"
        R ()
    breakpoint
        R () -> R ()
    inci (LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    t HsType GhcPs -> R ()
    p_hsType)
      HsStarTy NoExtField _ -> Text -> R ()
    txt "*"
      HsKindSig NoExtField t :: LHsType GhcPs
    t k :: LHsType GhcPs
    k -> R () -> R ()
    sitcc (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
        LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    t HsType GhcPs -> R ()
    p_hsType
        R ()
    space
        Text -> R ()
    txt "::"
        R ()
    breakpoint
        R () -> R ()
    inci (LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    k HsType GhcPs -> R ()
    p_hsType)
      HsSpliceTy NoExtField splice :: HsSplice GhcPs
    splice -> HsSplice GhcPs -> R ()
    p_hsSplice HsSplice GhcPs
    splice
      HsDocTy NoExtField t :: LHsType GhcPs
    t str :: LHsDocString
    str ->
        case TypeDocStyle
    docStyle of
          PipeStyle -> do
            HaddockStyle -> Bool -> LHsDocString -> R ()
    p_hsDocString HaddockStyle
    Pipe Bool
    True LHsDocString
    str
            LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    t HsType GhcPs -> R ()
    p_hsType
          CaretStyle -> do
            LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    t HsType GhcPs -> R ()
    p_hsType
            R ()
    newline
            HaddockStyle -> Bool -> LHsDocString -> R ()
    p_hsDocString HaddockStyle
    Caret Bool
    False LHsDocString
    str
      HsBangTy NoExtField (HsSrcBang _ u :: SrcUnpackedness
    u s :: SrcStrictness
    s) t :: LHsType GhcPs
    t -> do
        case SrcUnpackedness
    u of
          SrcUnpack -> Text -> R ()
    txt "{-# UNPACK #-}" R () -> R () -> R ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> R ()
    space
          SrcNoUnpack -> Text -> R ()
    txt "{-# NOUNPACK #-}" R () -> R () -> R ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> R ()
    space
          NoSrcUnpack -> () -> R ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        case SrcStrictness
    s of
          SrcLazy -> Text -> R ()
    txt "~"
          SrcStrict -> Text -> R ()
    txt "!"
          NoSrcStrict -> () -> R ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    t HsType GhcPs -> R ()
    p_hsType
      HsRecTy NoExtField fields :: [LConDeclField GhcPs]
    fields ->
        [LConDeclField GhcPs] -> R ()
    p_conDeclFields [LConDeclField GhcPs]
    fields
      HsExplicitListTy NoExtField p :: PromotionFlag
    p xs :: HsContext GhcPs
    xs -> do
        case PromotionFlag
    p of
          IsPromoted -> Text -> R ()
    txt "'"
          NotPromoted -> () -> R ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        BracketStyle -> R () -> R ()
    brackets BracketStyle
    N (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
          -- If both this list itself and the first element is promoted,
          -- we need to put a space in between or it fails to parse.
          case (PromotionFlag
    p, HsContext GhcPs
    xs) of
            (IsPromoted, L _ t :: HsType GhcPs
    t : _) | HsType GhcPs -> Bool
    forall pass. HsType pass -> Bool
    isPromoted HsType GhcPs
    t -> R ()
    space
            _ -> () -> R ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          R () -> (LHsType GhcPs -> R ()) -> HsContext GhcPs -> R ()
    forall a. R () -> (a -> R ()) -> [a] -> R ()
    sep R ()
    commaDel (R () -> R ()
    sitcc (R () -> R ()) -> (LHsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
    forall a. (a -> R ()) -> Located a -> R ()
    located' HsType GhcPs -> R ()
    p_hsType) HsContext GhcPs
    xs
      HsExplicitTupleTy NoExtField xs :: HsContext GhcPs
    xs -> do
        Text -> R ()
    txt "'"
        BracketStyle -> R () -> R ()
    parens BracketStyle
    N (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
          case HsContext GhcPs
    xs of
            L _ t :: HsType GhcPs
    t : _ | HsType GhcPs -> Bool
    forall pass. HsType pass -> Bool
    isPromoted HsType GhcPs
    t -> R ()
    space
            _ -> () -> R ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          R () -> (LHsType GhcPs -> R ()) -> HsContext GhcPs -> R ()
    forall a. R () -> (a -> R ()) -> [a] -> R ()
    sep R ()
    commaDel ((HsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
    forall a. (a -> R ()) -> Located a -> R ()
    located' HsType GhcPs -> R ()
    p_hsType) HsContext GhcPs
    xs
      HsTyLit NoExtField t :: HsTyLit
    t ->
        case HsTyLit
    t of
          HsStrTy (SourceText s :: String
    s) _ -> String -> R ()
    p_stringLit String
    s
          a :: HsTyLit
    a -> HsTyLit -> R ()
    forall a. Outputable a => a -> R ()
    atom HsTyLit
    a
      HsWildCardTy NoExtField -> Text -> R ()
    txt "_"
      XHsType (NHsCoreTy t) -> Type -> R ()
    forall a. Outputable a => a -> R ()
    atom Type
    t
      where
        isPromoted :: HsType pass -> Bool
    isPromoted = \case
          HsTyVar _ IsPromoted _ -> Bool
    True
          HsExplicitTupleTy {} -> Bool
    True
          HsExplicitListTy {} -> Bool
    True
          _ -> Bool
    False
        interArgBreak :: R ()
    interArgBreak =
          if Bool
    multilineArgs
            then R ()
    newline
            else R ()
    breakpoint
        p_hsTypeR :: HsType GhcPs -> R ()
    p_hsTypeR = Bool -> TypeDocStyle -> HsType GhcPs -> R ()
    p_hsType' Bool
    multilineArgs TypeDocStyle
    docStyle

    -- | Return 'True' if at least one argument in 'HsType' has a doc string
    -- attached to it.
    hasDocStrings :: HsType GhcPs -> Bool
    hasDocStrings :: HsType GhcPs -> Bool
    hasDocStrings = \case
      HsDocTy {} -> Bool
    True
      HsFunTy _ (L _ x :: HsType GhcPs
    x) (L _ y :: HsType GhcPs
    y) -> HsType GhcPs -> Bool
    hasDocStrings HsType GhcPs
    x Bool -> Bool -> Bool
    || HsType GhcPs -> Bool
    hasDocStrings HsType GhcPs
    y
      _ -> Bool
    False

    p_hsContext :: HsContext GhcPs -> R ()
    p_hsContext :: HsContext GhcPs -> R ()
    p_hsContext = \case
      [] -> Text -> R ()
    txt "()"
      [x :: LHsType GhcPs
    x] -> LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    x HsType GhcPs -> R ()
    p_hsType
      xs :: HsContext GhcPs
    xs -> BracketStyle -> R () -> R ()
    parens BracketStyle
    N (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ R () -> (LHsType GhcPs -> R ()) -> HsContext GhcPs -> R ()
    forall a. R () -> (a -> R ()) -> [a] -> R ()
    sep R ()
    commaDel (R () -> R ()
    sitcc (R () -> R ()) -> (LHsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsType GhcPs -> R ()) -> LHsType GhcPs -> R ()
    forall a. (a -> R ()) -> Located a -> R ()
    located' HsType GhcPs -> R ()
    p_hsType) HsContext GhcPs
    xs

    p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()
    p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()
    p_hsTyVarBndr = \case
      UserTyVar NoExtField x :: Located (IdP GhcPs)
    x ->
        Located RdrName -> R ()
    p_rdrName Located (IdP GhcPs)
    Located RdrName
    x
      KindedTyVar NoExtField l :: Located (IdP GhcPs)
    l k :: LHsType GhcPs
    k -> BracketStyle -> R () -> R ()
    parens BracketStyle
    N (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
        Located RdrName -> (RdrName -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located Located (IdP GhcPs)
    Located RdrName
    l RdrName -> R ()
    forall a. Outputable a => a -> R ()
    atom
        R ()
    space
        Text -> R ()
    txt "::"
        R ()
    breakpoint
        R () -> R ()
    inci (LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    k HsType GhcPs -> R ()
    p_hsType)
      XTyVarBndr x :: XXTyVarBndr GhcPs
    x -> NoExtCon -> R ()
    forall a. NoExtCon -> a
    noExtCon NoExtCon
    XXTyVarBndr GhcPs
    x

    -- | Render several @forall@-ed variables.
    p_forallBndrs :: Data a => ForallVisFlag -> (a -> R ()) -> [Located a] -> R ()
    p_forallBndrs :: ForallVisFlag -> (a -> R ()) -> [Located a] -> R ()
    p_forallBndrs ForallInvis _ [] = Text -> R ()
    txt "forall."
    p_forallBndrs ForallVis _ [] = Text -> R ()
    txt "forall ->"
    p_forallBndrs vis :: ForallVisFlag
    vis p :: a -> R ()
    p tyvars :: [Located a]
    tyvars =
      [SrcSpan] -> R () -> R ()
    switchLayout (Located a -> SrcSpan
    forall a. HasSrcSpan a => a -> SrcSpan
    getLoc (Located a -> SrcSpan) -> [Located a] -> [SrcSpan]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Located a]
    tyvars) (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
        Text -> R ()
    txt "forall"
        R ()
    breakpoint
        R () -> R ()
    inci (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
          R () -> R ()
    sitcc (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ R () -> (Located a -> R ()) -> [Located a] -> R ()
    forall a. R () -> (a -> R ()) -> [a] -> R ()
    sep R ()
    breakpoint (R () -> R ()
    sitcc (R () -> R ()) -> (Located a -> R ()) -> Located a -> R ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> R ()) -> Located a -> R ()
    forall a. (a -> R ()) -> Located a -> R ()
    located' a -> R ()
    p) [Located a]
    tyvars
          case ForallVisFlag
    vis of
            ForallInvis -> Text -> R ()
    txt "."
            ForallVis -> R ()
    space R () -> R () -> R ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Text -> R ()
    txt "->"

    p_conDeclFields :: [LConDeclField GhcPs] -> R ()
    p_conDeclFields :: [LConDeclField GhcPs] -> R ()
    p_conDeclFields xs :: [LConDeclField GhcPs]
    xs =
      BracketStyle -> R () -> R ()
    braces BracketStyle
    N (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ R ()
    -> (LConDeclField GhcPs -> R ()) -> [LConDeclField GhcPs] -> R ()
    forall a. R () -> (a -> R ()) -> [a] -> R ()
    sep R ()
    commaDel (R () -> R ()
    sitcc (R () -> R ())
    -> (LConDeclField GhcPs -> R ()) -> LConDeclField GhcPs -> R ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ConDeclField GhcPs -> R ()) -> LConDeclField GhcPs -> R ()
    forall a. (a -> R ()) -> Located a -> R ()
    located' ConDeclField GhcPs -> R ()
    p_conDeclField) [LConDeclField GhcPs]
    xs

    p_conDeclField :: ConDeclField GhcPs -> R ()
    p_conDeclField :: ConDeclField GhcPs -> R ()
    p_conDeclField ConDeclField {..} = do
      (LHsDocString -> R ()) -> Maybe LHsDocString -> R ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (HaddockStyle -> Bool -> LHsDocString -> R ()
    p_hsDocString HaddockStyle
    Pipe Bool
    True) Maybe LHsDocString
    cd_fld_doc
      R () -> R ()
    sitcc (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $
        R () -> (LFieldOcc GhcPs -> R ()) -> [LFieldOcc GhcPs] -> R ()
    forall a. R () -> (a -> R ()) -> [a] -> R ()
    sep
          R ()
    commaDel
          ((FieldOcc GhcPs -> R ()) -> LFieldOcc GhcPs -> R ()
    forall a. (a -> R ()) -> Located a -> R ()
    located' (Located RdrName -> R ()
    p_rdrName (Located RdrName -> R ())
    -> (FieldOcc GhcPs -> Located RdrName) -> FieldOcc GhcPs -> R ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FieldOcc GhcPs -> Located RdrName
    forall pass. FieldOcc pass -> Located RdrName
    rdrNameFieldOcc))
          [LFieldOcc GhcPs]
    cd_fld_names
      R ()
    space
      Text -> R ()
    txt "::"
      R ()
    breakpoint
      R () -> R ()
    sitcc (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . R () -> R ()
    inci (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ HsType GhcPs -> R ()
    p_hsType (LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
    forall a. HasSrcSpan a => a -> SrcSpanLess a
    unLoc LHsType GhcPs
    cd_fld_type)
    p_conDeclField (XConDeclField x :: XXConDeclField GhcPs
    x) = NoExtCon -> R ()
    forall a. NoExtCon -> a
    noExtCon NoExtCon
    XXConDeclField GhcPs
    x

    tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)
    tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)
    tyOpTree (L _ (HsOpTy NoExtField l :: LHsType GhcPs
    l op :: Located (IdP GhcPs)
    op r :: LHsType GhcPs
    r)) =
      OpTree (LHsType GhcPs) (Located RdrName)
    -> Located RdrName
    -> OpTree (LHsType GhcPs) (Located RdrName)
    -> OpTree (LHsType GhcPs) (Located RdrName)
    forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
    OpBranch (LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)
    tyOpTree LHsType GhcPs
    l) Located (IdP GhcPs)
    Located RdrName
    op (LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)
    tyOpTree LHsType GhcPs
    r)
    tyOpTree n :: LHsType GhcPs
    n = LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)
    forall ty op. ty -> OpTree ty op
    OpNode LHsType GhcPs
    n

    p_tyOpTree :: OpTree (LHsType GhcPs) (Located RdrName) -> R ()
    p_tyOpTree :: OpTree (LHsType GhcPs) (Located RdrName) -> R ()
    p_tyOpTree (OpNode n :: LHsType GhcPs
    n) = LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsType GhcPs
    n HsType GhcPs -> R ()
    p_hsType
    p_tyOpTree (OpBranch l :: OpTree (LHsType GhcPs) (Located RdrName)
    l op :: Located RdrName
    op r :: OpTree (LHsType GhcPs) (Located RdrName)
    r) = do
      [SrcSpan] -> R () -> R ()
    switchLayout [OpTree (LHsType GhcPs) (Located RdrName) -> SrcSpan
    forall a b. OpTree (Located a) b -> SrcSpan
    opTreeLoc OpTree (LHsType GhcPs) (Located RdrName)
    l] (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $
        OpTree (LHsType GhcPs) (Located RdrName) -> R ()
    p_tyOpTree OpTree (LHsType GhcPs) (Located RdrName)
    l
      R ()
    breakpoint
      R () -> R ()
    inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [SrcSpan] -> R () -> R ()
    switchLayout [OpTree (LHsType GhcPs) (Located RdrName) -> SrcSpan
    forall a b. OpTree (Located a) b -> SrcSpan
    opTreeLoc OpTree (LHsType GhcPs) (Located RdrName)
    r] (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
        Located RdrName -> R ()
    p_rdrName Located RdrName
    op
        R ()
    space
        OpTree (LHsType GhcPs) (Located RdrName) -> R ()
    p_tyOpTree OpTree (LHsType GhcPs) (Located RdrName)
    r

    ----------------------------------------------------------------------------
    -- Conversion functions

    tyVarsToTypes :: LHsQTyVars GhcPs -> [LHsType GhcPs]
    tyVarsToTypes :: LHsQTyVars GhcPs -> HsContext GhcPs
    tyVarsToTypes = \case
      HsQTvs {..} -> (HsTyVarBndr GhcPs -> HsType GhcPs)
    -> LHsTyVarBndr GhcPs -> LHsType GhcPs
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HsTyVarBndr GhcPs -> HsType GhcPs
    tyVarToType (LHsTyVarBndr GhcPs -> LHsType GhcPs)
    -> [LHsTyVarBndr GhcPs] -> HsContext GhcPs
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [LHsTyVarBndr GhcPs]
    hsq_explicit
      XLHsQTyVars x :: XXLHsQTyVars GhcPs
    x -> NoExtCon -> HsContext GhcPs
    forall a. NoExtCon -> a
    noExtCon NoExtCon
    XXLHsQTyVars GhcPs
    x

    tyVarToType :: HsTyVarBndr GhcPs -> HsType GhcPs
    tyVarToType :: HsTyVarBndr GhcPs -> HsType GhcPs
    tyVarToType = \case
      UserTyVar NoExtField tvar :: Located (IdP GhcPs)
    tvar -> XTyVar GhcPs
    -> PromotionFlag -> Located (IdP GhcPs) -> HsType GhcPs
    forall pass.
    XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
    HsTyVar NoExtField
    XTyVar GhcPs
    NoExtField PromotionFlag
    NotPromoted Located (IdP GhcPs)
    tvar
      KindedTyVar NoExtField tvar :: Located (IdP GhcPs)
    tvar kind :: LHsType GhcPs
    kind ->
        -- Note: we always add parentheses because for whatever reason GHC does
        -- not use HsParTy for left-hand sides of declarations. Please see
        -- <https://gitlab.haskell.org/ghc/ghc/issues/17404>. This is fine as
        -- long as 'tyVarToType' does not get applied to right-hand sides of
        -- declarations.
        XParTy GhcPs -> LHsType GhcPs -> HsType GhcPs
    forall pass. XParTy pass -> LHsType pass -> HsType pass
    HsParTy NoExtField
    XParTy GhcPs
    NoExtField (LHsType GhcPs -> HsType GhcPs)
    -> (HsType GhcPs -> LHsType GhcPs) -> HsType GhcPs -> HsType GhcPs
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsType GhcPs -> LHsType GhcPs
    forall a. HasSrcSpan a => SrcSpanLess a -> a
    noLoc (HsType GhcPs -> HsType GhcPs) -> HsType GhcPs -> HsType GhcPs
    forall a b. (a -> b) -> a -> b
    $
          XKindSig GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
    forall pass.
    XKindSig pass -> LHsType pass -> LHsType pass -> HsType pass
    HsKindSig NoExtField
    XKindSig GhcPs
    NoExtField (SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
    forall a. HasSrcSpan a => SrcSpanLess a -> a
    noLoc (XTyVar GhcPs
    -> PromotionFlag -> Located (IdP GhcPs) -> HsType GhcPs
    forall pass.
    XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
    HsTyVar NoExtField
    XTyVar GhcPs
    NoExtField PromotionFlag
    NotPromoted Located (IdP GhcPs)
    tvar)) LHsType GhcPs
    kind
      XTyVarBndr x :: XXTyVarBndr GhcPs
    x -> NoExtCon -> HsType GhcPs
    forall a. NoExtCon -> a
    noExtCon NoExtCon
    XXTyVarBndr GhcPs
    x