{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

-- | Rendering of types.
module Ormolu.Printer.Meat.Type
  ( p_hsType,
    p_hsTypeAnnotation,
    hasDocStrings,
    p_hsContext,
    p_hsContext',
    p_hsTyVarBndr,
    ForAllVisibility (..),
    p_forallBndrs,
    p_conDeclFields,
    p_lhsTypeArg,
    p_hsSigType,
    FunRepr (..),
    ParsedFunRepr (..),
    p_hsFun,
    hsOuterTyVarBndrsToHsType,
    hsSigTypeToType,
    lhsTypeToSigType,
  )
where

import Control.Monad
import Control.Monad.Cont qualified as Cont
import Control.Monad.State qualified as State
import Control.Monad.Trans qualified as Trans
import Data.Choice (Choice, pattern Is, pattern Isn't, pattern With, pattern Without)
import Data.Choice qualified as Choice
import Data.Foldable (traverse_)
import Data.Functor ((<&>))
import Data.List (sortOn)
import Data.Maybe (isJust)
import GHC.Data.Strict qualified as Strict
import GHC.Hs hiding (isPromoted)
import GHC.Types.SourceText
import GHC.Types.SrcLoc
import GHC.Types.Var
import GHC.Utils.Outputable (Outputable)
import Ormolu.Config
import Ormolu.Printer.Combinators
import Ormolu.Printer.Meat.Common
import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.OpTree (p_tyOpTree, tyOpTree)
import Ormolu.Printer.Meat.Declaration.StringLiteral
import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsUntypedSplice)
import Ormolu.Printer.Operators
import Ormolu.Utils

p_hsType :: HsType GhcPs -> R ()
p_hsType :: HsType GhcPs -> R ()
p_hsType = \case
  ty :: HsType GhcPs
ty@HsForAllTy {} ->
    HsType GhcPs -> R ()
forall a. FunRepr a => a -> R ()
p_hsFun HsType GhcPs
ty
  ty :: HsType GhcPs
ty@HsQualTy {} ->
    HsType GhcPs -> R ()
forall a. FunRepr a => a -> R ()
p_hsFun HsType GhcPs
ty
  HsTyVar XTyVar GhcPs
_ PromotionFlag
p LIdP GhcPs
n -> do
    case PromotionFlag
p of
      PromotionFlag
IsPromoted -> do
        Text -> R ()
txt Text
"'"
        case RdrName -> String
forall o. Outputable o => o -> String
showOutputable (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
n) of
          Char
_ : Char
'\'' : String
_ -> R ()
space
          String
_ -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      PromotionFlag
NotPromoted -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    GenLocated SrcSpanAnnN RdrName -> R ()
p_rdrName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
n
  HsAppTy XAppTy GhcPs
_ XRec GhcPs (HsType GhcPs)
f XRec GhcPs (HsType 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 :: GenLocated l (HsType pass)
-> [GenLocated l (HsType pass)]
-> (GenLocated l (HsType pass), [GenLocated l (HsType pass)])
gatherArgs GenLocated l (HsType pass)
f' [GenLocated l (HsType pass)]
knownArgs =
          case GenLocated l (HsType pass)
f' of
            L l
_ (HsAppTy XAppTy pass
_ XRec pass (HsType pass)
l XRec pass (HsType pass)
r) -> GenLocated l (HsType pass)
-> [GenLocated l (HsType pass)]
-> (GenLocated l (HsType pass), [GenLocated l (HsType pass)])
gatherArgs XRec pass (HsType pass)
GenLocated l (HsType pass)
l (XRec pass (HsType pass)
GenLocated l (HsType pass)
r GenLocated l (HsType pass)
-> [GenLocated l (HsType pass)] -> [GenLocated l (HsType pass)]
forall a. a -> [a] -> [a]
: [GenLocated l (HsType pass)]
knownArgs)
            GenLocated l (HsType pass)
_ -> (GenLocated l (HsType pass)
f', [GenLocated l (HsType pass)]
knownArgs)
        (GenLocated SrcSpanAnnA (HsType GhcPs)
func, [GenLocated SrcSpanAnnA (HsType GhcPs)]
args) = GenLocated SrcSpanAnnA (HsType GhcPs)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> (GenLocated SrcSpanAnnA (HsType GhcPs),
    [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall {pass} {l}.
(XRec pass (HsType pass) ~ GenLocated l (HsType pass)) =>
GenLocated l (HsType pass)
-> [GenLocated l (HsType pass)]
-> (GenLocated l (HsType pass), [GenLocated l (HsType pass)])
gatherArgs XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
f [XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
x]
    [SrcSpan] -> R () -> R ()
switchLayout (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
f SrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
: (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA [GenLocated SrcSpanAnnA (HsType 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
      GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsType GhcPs)
func HsType GhcPs -> R ()
p_hsType
      R ()
breakpoint
      R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
        R ()
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((HsType GhcPs -> R ())
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' HsType GhcPs -> R ()
p_hsType) [GenLocated SrcSpanAnnA (HsType GhcPs)]
args
  HsAppKindTy XAppKindTy GhcPs
_ XRec GhcPs (HsType GhcPs)
ty XRec GhcPs (HsType 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.
    GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType 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 Text
"@"
      GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
kd HsType GhcPs -> R ()
p_hsType
  ty :: HsType GhcPs
ty@HsFunTy {} ->
    HsType GhcPs -> R ()
forall a. FunRepr a => a -> R ()
p_hsFun HsType GhcPs
ty
  HsListTy XListTy GhcPs
_ XRec GhcPs (HsType GhcPs)
t ->
    GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType 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 XTupleTy GhcPs
_ HsTupleSort
tsort [XRec GhcPs (HsType GhcPs)]
xs ->
    let parens' :: R () -> R ()
parens' =
          case HsTupleSort
tsort of
            HsTupleSort
HsUnboxedTuple -> BracketStyle -> R () -> R ()
parensHash BracketStyle
N
            HsTupleSort
HsBoxedOrConstraintTuple -> BracketStyle -> R () -> R ()
parens BracketStyle
N
     in R () -> R ()
parens' (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> R ())
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsType GhcPs -> R ())
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' HsType GhcPs -> R ()
p_hsType) [XRec GhcPs (HsType GhcPs)]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
xs
  HsSumTy XSumTy GhcPs
_ [XRec GhcPs (HsType GhcPs)]
xs ->
    BracketStyle -> R () -> R ()
parensHash BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      R ()
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|" R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> R ())
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsType GhcPs -> R ())
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' HsType GhcPs -> R ()
p_hsType) [XRec GhcPs (HsType GhcPs)]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
xs
  HsOpTy XOpTy GhcPs
_ PromotionFlag
_ XRec GhcPs (HsType GhcPs)
x LIdP GhcPs
op XRec GhcPs (HsType GhcPs)
y -> do
    ModuleFixityMap
modFixityMap <- R ModuleFixityMap
askModuleFixityMap
    Choice "debug"
debug <- R (Choice "debug")
askDebug
    let opTree :: OpTree
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnN RdrName)
opTree = OpTree
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnN RdrName)
-> GenLocated SrcSpanAnnN RdrName
-> OpTree
     (GenLocated SrcSpanAnnA (HsType GhcPs))
     (GenLocated SrcSpanAnnN RdrName)
-> OpTree
     (GenLocated SrcSpanAnnA (HsType GhcPs))
     (GenLocated SrcSpanAnnN RdrName)
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
BinaryOpBranches (XRec GhcPs (HsType GhcPs)
-> OpTree
     (XRec GhcPs (HsType GhcPs)) (GenLocated SrcSpanAnnN RdrName)
tyOpTree XRec GhcPs (HsType GhcPs)
x) LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
op (XRec GhcPs (HsType GhcPs)
-> OpTree
     (XRec GhcPs (HsType GhcPs)) (GenLocated SrcSpanAnnN RdrName)
tyOpTree XRec GhcPs (HsType GhcPs)
y)
    OpTree
  (XRec GhcPs (HsType GhcPs))
  (OpInfo (GenLocated SrcSpanAnnN RdrName))
-> R ()
p_tyOpTree
      (Choice "debug"
-> (GenLocated SrcSpanAnnN RdrName -> Maybe RdrName)
-> ModuleFixityMap
-> OpTree
     (GenLocated SrcSpanAnnA (HsType GhcPs))
     (GenLocated SrcSpanAnnN RdrName)
-> OpTree
     (GenLocated SrcSpanAnnA (HsType GhcPs))
     (OpInfo (GenLocated SrcSpanAnnN RdrName))
forall op ty.
Choice "debug"
-> (op -> Maybe RdrName)
-> ModuleFixityMap
-> OpTree ty op
-> OpTree ty (OpInfo op)
reassociateOpTree Choice "debug"
debug (RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just (RdrName -> Maybe RdrName)
-> (GenLocated SrcSpanAnnN RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName
-> Maybe RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc) ModuleFixityMap
modFixityMap OpTree
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnN RdrName)
opTree)
  HsParTy XParTy GhcPs
_ XRec GhcPs (HsType GhcPs)
t -> do
    [SrcSpan]
csSpans <-
      (GenLocated RealSrcSpan Comment -> SrcSpan)
-> [GenLocated RealSrcSpan Comment] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RealSrcSpan -> Maybe BufSpan -> SrcSpan)
-> Maybe BufSpan -> RealSrcSpan -> SrcSpan
forall a b c. (a -> b -> c) -> b -> a -> c
flip RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan Maybe BufSpan
forall a. Maybe a
Strict.Nothing (RealSrcSpan -> SrcSpan)
-> (GenLocated RealSrcSpan Comment -> RealSrcSpan)
-> GenLocated RealSrcSpan Comment
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated RealSrcSpan Comment -> RealSrcSpan
forall l e. GenLocated l e -> l
getLoc) ([GenLocated RealSrcSpan Comment] -> [SrcSpan])
-> R [GenLocated RealSrcSpan Comment] -> R [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R [GenLocated RealSrcSpan Comment]
getEnclosingComments
    [SrcSpan] -> R () -> R ()
switchLayout (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
t SrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
: [SrcSpan]
csSpans) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
t HsType GhcPs -> R ()
p_hsType)
  HsIParamTy XIParamTy GhcPs
_ XRec GhcPs HsIPName
n XRec GhcPs (HsType GhcPs)
t -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    GenLocated EpAnnCO HsIPName -> (HsIPName -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs HsIPName
GenLocated EpAnnCO HsIPName
n HsIPName -> R ()
forall a. Outputable a => a -> R ()
atom
    R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsType GhcPs) -> R ()
p_hsTypeAnnotation XRec GhcPs (HsType GhcPs)
t
  HsStarTy XStarTy GhcPs
_ Bool
_ -> R ()
token'star
  HsKindSig XKindSig GhcPs
_ XRec GhcPs (HsType GhcPs)
t XRec GhcPs (HsType GhcPs)
k -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
t HsType GhcPs -> R ()
p_hsType
    R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsType GhcPs) -> R ()
p_hsTypeAnnotation XRec GhcPs (HsType GhcPs)
k
  HsSpliceTy XSpliceTy GhcPs
_ HsUntypedSplice GhcPs
splice -> SpliceDecoration -> HsUntypedSplice GhcPs -> R ()
p_hsUntypedSplice SpliceDecoration
DollarSplice HsUntypedSplice GhcPs
splice
  HsDocTy XDocTy GhcPs
_ XRec GhcPs (HsType GhcPs)
t LHsDoc GhcPs
str -> do
    -- Usually handled by p_hsFun, but it's possible to have a bare type
    -- with docstrings, e.g.
    --
    --   type Name =
    --     -- | The name of a user as a string
    --     String
    --
    --   data User =
    --     User
    --       -- | Name
    --       String
    --       -- | Age
    --       Int
    Bool
usePipe <-
      (forall (f :: * -> *). PrinterOpts f -> f FunctionArrowsStyle)
-> R FunctionArrowsStyle
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f FunctionArrowsStyle
forall (f :: * -> *). PrinterOpts f -> f FunctionArrowsStyle
poFunctionArrows R FunctionArrowsStyle -> (FunctionArrowsStyle -> Bool) -> R Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        FunctionArrowsStyle
TrailingArrows -> Bool
True
        FunctionArrowsStyle
LeadingArrows -> Bool
False
        FunctionArrowsStyle
LeadingArgsArrows -> Bool
False
    if Bool
usePipe
      then do
        HaddockStyle -> Choice "endNewline" -> LHsDoc GhcPs -> R ()
p_hsDoc HaddockStyle
Pipe (Label "endNewline" -> Choice "endNewline"
forall (a :: Symbol). Label a -> Choice a
With Label "endNewline"
#endNewline) LHsDoc GhcPs
str
        GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
t HsType GhcPs -> R ()
p_hsType
      else do
        GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
t HsType GhcPs -> R ()
p_hsType
        R ()
newline
        HaddockStyle -> Choice "endNewline" -> LHsDoc GhcPs -> R ()
p_hsDoc HaddockStyle
Caret (Label "endNewline" -> Choice "endNewline"
forall (a :: Symbol). Label a -> Choice a
Without Label "endNewline"
#endNewline) LHsDoc GhcPs
str
  HsBangTy XBangTy GhcPs
_ (HsBang SrcUnpackedness
u SrcStrictness
s) XRec GhcPs (HsType GhcPs)
t -> do
    case SrcUnpackedness
u of
      SrcUnpackedness
SrcUnpack -> Text -> R ()
txt Text
"{-# UNPACK #-}" R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space
      SrcUnpackedness
SrcNoUnpack -> Text -> R ()
txt Text
"{-# NOUNPACK #-}" R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space
      SrcUnpackedness
NoSrcUnpack -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case SrcStrictness
s of
      SrcStrictness
SrcLazy -> Text -> R ()
txt Text
"~"
      SrcStrictness
SrcStrict -> Text -> R ()
txt Text
"!"
      SrcStrictness
NoSrcStrict -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
t HsType GhcPs -> R ()
p_hsType
  HsRecTy XRecTy GhcPs
_ [LConDeclField GhcPs]
fields ->
    [LConDeclField GhcPs] -> R ()
p_conDeclFields [LConDeclField GhcPs]
fields
  HsExplicitListTy XExplicitListTy GhcPs
_ PromotionFlag
p [XRec GhcPs (HsType GhcPs)]
xs -> do
    case PromotionFlag
p of
      PromotionFlag
IsPromoted -> Text -> R ()
txt Text
"'"
      PromotionFlag
NotPromoted -> () -> R ()
forall a. a -> R a
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 this list is promoted and the first element starts with a single
      -- quote, we need to put a space in between or it fails to parse.
      case (PromotionFlag
p, [XRec GhcPs (HsType GhcPs)]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
xs) of
        (PromotionFlag
IsPromoted, L SrcSpanAnnA
_ HsType GhcPs
t : [GenLocated SrcSpanAnnA (HsType GhcPs)]
_) | HsType GhcPs -> Bool
startsWithSingleQuote HsType GhcPs
t -> R ()
space
        (PromotionFlag, [GenLocated SrcSpanAnnA (HsType GhcPs)])
_ -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      R ()
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> R ())
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsType GhcPs -> R ())
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' HsType GhcPs -> R ()
p_hsType) [XRec GhcPs (HsType GhcPs)]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
xs
  HsExplicitTupleTy XExplicitTupleTy GhcPs
_ PromotionFlag
p [XRec GhcPs (HsType GhcPs)]
xs -> do
    case PromotionFlag
p of
      PromotionFlag
IsPromoted -> Text -> R ()
txt Text
"'"
      PromotionFlag
NotPromoted -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      -- If this tuple is promoted and the first element starts with a single
      -- quote, we need to put a space in between or it fails to parse.
      case (PromotionFlag
p, [XRec GhcPs (HsType GhcPs)]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
xs) of
        (PromotionFlag
IsPromoted, L SrcSpanAnnA
_ HsType GhcPs
t : [GenLocated SrcSpanAnnA (HsType GhcPs)]
_) | HsType GhcPs -> Bool
startsWithSingleQuote HsType GhcPs
t -> R ()
space
        (PromotionFlag, [GenLocated SrcSpanAnnA (HsType GhcPs)])
_ -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      R ()
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((HsType GhcPs -> R ())
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' HsType GhcPs -> R ()
p_hsType) [XRec GhcPs (HsType GhcPs)]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
xs
  HsTyLit XTyLit GhcPs
_ HsTyLit GhcPs
t ->
    case HsTyLit GhcPs
t of
      HsStrTy (SourceText FastString
s) FastString
_ -> FastString -> R ()
p_stringLit FastString
s
      HsTyLit GhcPs
a -> HsTyLit GhcPs -> R ()
forall a. Outputable a => a -> R ()
atom HsTyLit GhcPs
a
  HsWildCardTy XWildCardTy GhcPs
_ -> Text -> R ()
txt Text
"_"
  XHsType XXType GhcPs
t -> HsCoreTy -> R ()
forall a. Outputable a => a -> R ()
atom XXType GhcPs
HsCoreTy
t
  where
    startsWithSingleQuote :: HsType GhcPs -> Bool
startsWithSingleQuote = \case
      HsAppTy XAppTy GhcPs
_ (L SrcSpanAnnA
_ HsType GhcPs
f) XRec GhcPs (HsType GhcPs)
_ -> HsType GhcPs -> Bool
startsWithSingleQuote HsType GhcPs
f
      HsTyVar XTyVar GhcPs
_ PromotionFlag
IsPromoted LIdP GhcPs
_ -> Bool
True
      HsExplicitTupleTy {} -> Bool
True
      HsExplicitListTy {} -> Bool
True
      HsTyLit XTyLit GhcPs
_ HsCharTy {} -> Bool
True
      HsType GhcPs
_ -> Bool
False

p_hsTypeAnnotation :: LHsType GhcPs -> R ()
p_hsTypeAnnotation :: XRec GhcPs (HsType GhcPs) -> R ()
p_hsTypeAnnotation = ParsedFunRepr (HsType GhcPs) -> R ()
forall a. FunRepr a => ParsedFunRepr a -> R ()
p_hsFunParsed (ParsedFunRepr (HsType GhcPs) -> R ())
-> (GenLocated SrcSpanAnnA (HsType GhcPs)
    -> ParsedFunRepr (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedFunRepr (HsType GhcPs) -> ParsedFunRepr (HsType GhcPs)
forall a. ParsedFunRepr a -> ParsedFunRepr a
ParsedFunSig (ParsedFunRepr (HsType GhcPs) -> ParsedFunRepr (HsType GhcPs))
-> (GenLocated SrcSpanAnnA (HsType GhcPs)
    -> ParsedFunRepr (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> ParsedFunRepr (HsType GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsType GhcPs)
-> ParsedFunRepr (HsType GhcPs)
forall a. FunRepr a => LocatedA a -> ParsedFunRepr a
parseFunRepr

-- | 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 XFunTy GhcPs
_ HsArrow GhcPs
_ (L SrcSpanAnnA
_ HsType GhcPs
x) (L SrcSpanAnnA
_ HsType GhcPs
y) -> HsType GhcPs -> Bool
hasDocStrings HsType GhcPs
x Bool -> Bool -> Bool
|| HsType GhcPs -> Bool
hasDocStrings HsType GhcPs
y
  HsForAllTy XForAllTy GhcPs
_ HsForAllTelescope GhcPs
_ (L SrcSpanAnnA
_ HsType GhcPs
x) -> HsType GhcPs -> Bool
hasDocStrings HsType GhcPs
x
  HsQualTy XQualTy GhcPs
_ LHsContext GhcPs
_ (L SrcSpanAnnA
_ HsType GhcPs
x) -> HsType GhcPs -> Bool
hasDocStrings HsType GhcPs
x
  HsType GhcPs
_ -> Bool
False

p_hsContext :: HsContext GhcPs -> R ()
p_hsContext :: [XRec GhcPs (HsType GhcPs)] -> R ()
p_hsContext = (HsType GhcPs -> R ()) -> [XRec GhcPs (HsType GhcPs)] -> R ()
forall a.
(Outputable (GenLocated (Anno a) a), HasLoc (Anno a)) =>
(a -> R ()) -> [XRec GhcPs a] -> R ()
p_hsContext' HsType GhcPs -> R ()
p_hsType

p_hsContext' ::
  (Outputable (GenLocated (Anno a) a), HasLoc (Anno a)) =>
  (a -> R ()) ->
  [XRec GhcPs a] ->
  R ()
p_hsContext' :: forall a.
(Outputable (GenLocated (Anno a) a), HasLoc (Anno a)) =>
(a -> R ()) -> [XRec GhcPs a] -> R ()
p_hsContext' a -> R ()
f = \case
  [] -> Text -> R ()
txt Text
"()"
  [XRec GhcPs a
x] -> GenLocated (Anno a) a -> (a -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs a
GenLocated (Anno a) a
x a -> R ()
f
  [XRec GhcPs a]
xs -> do
    Bool
shouldSort <- (forall (f :: * -> *). PrinterOpts f -> f Bool) -> R Bool
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f Bool
forall (f :: * -> *). PrinterOpts f -> f Bool
poSortConstraints
    let sort :: [GenLocated (Anno a) a] -> [GenLocated (Anno a) a]
sort = if Bool
shouldSort then (GenLocated (Anno a) a -> String)
-> [GenLocated (Anno a) a] -> [GenLocated (Anno a) a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn GenLocated (Anno a) a -> String
forall o. Outputable o => o -> String
showOutputable else [GenLocated (Anno a) a] -> [GenLocated (Anno a) a]
forall a. a -> a
id
    BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated (Anno a) a -> R ())
-> [GenLocated (Anno a) a]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated (Anno a) a -> R ()) -> GenLocated (Anno a) a -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> R ()) -> GenLocated (Anno a) a -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' a -> R ()
f) ([GenLocated (Anno a) a] -> [GenLocated (Anno a) a]
sort [XRec GhcPs a]
[GenLocated (Anno a) a]
xs)

class IsTyVarBndrFlag flag where
  isInferred :: flag -> Bool
  p_tyVarBndrFlag :: flag -> R ()
  p_tyVarBndrFlag flag
_ = () -> R ()
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance IsTyVarBndrFlag () where
  isInferred :: () -> Bool
isInferred () = Bool
False

instance IsTyVarBndrFlag Specificity where
  isInferred :: Specificity -> Bool
isInferred = \case
    Specificity
InferredSpec -> Bool
True
    Specificity
SpecifiedSpec -> Bool
False

instance IsTyVarBndrFlag (HsBndrVis GhcPs) where
  isInferred :: HsBndrVis GhcPs -> Bool
isInferred HsBndrVis GhcPs
_ = Bool
False
  p_tyVarBndrFlag :: HsBndrVis GhcPs -> R ()
p_tyVarBndrFlag = \case
    HsBndrRequired NoExtField
XBndrRequired GhcPs
NoExtField -> () -> R ()
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    HsBndrInvisible XBndrInvisible GhcPs
_ -> Text -> R ()
txt Text
"@"

p_hsTyVarBndr :: (IsTyVarBndrFlag flag) => HsTyVarBndr flag GhcPs -> R ()
p_hsTyVarBndr :: forall flag. IsTyVarBndrFlag flag => HsTyVarBndr flag GhcPs -> R ()
p_hsTyVarBndr HsTvb {flag
XTyVarBndr GhcPs
HsBndrKind GhcPs
HsBndrVar GhcPs
tvb_ext :: XTyVarBndr GhcPs
tvb_flag :: flag
tvb_var :: HsBndrVar GhcPs
tvb_kind :: HsBndrKind GhcPs
tvb_kind :: forall flag pass. HsTyVarBndr flag pass -> HsBndrKind pass
tvb_var :: forall flag pass. HsTyVarBndr flag pass -> HsBndrVar pass
tvb_flag :: forall flag pass. HsTyVarBndr flag pass -> flag
tvb_ext :: forall flag pass. HsTyVarBndr flag pass -> XTyVarBndr pass
..} = do
  flag -> R ()
forall flag. IsTyVarBndrFlag flag => flag -> R ()
p_tyVarBndrFlag flag
tvb_flag
  let wrap :: R () -> R ()
wrap
        | flag -> Bool
forall flag. IsTyVarBndrFlag flag => flag -> Bool
isInferred flag
tvb_flag = BracketStyle -> R () -> R ()
braces BracketStyle
N
        | Bool
otherwise = case HsBndrKind GhcPs
tvb_kind of
            HsBndrKind {} -> BracketStyle -> R () -> R ()
parens BracketStyle
N
            HsBndrNoKind {} -> R () -> R ()
forall a. a -> a
id
  R () -> R ()
wrap (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    case HsBndrVar GhcPs
tvb_var of
      HsBndrVar XBndrVar GhcPs
_ LIdP GhcPs
x -> GenLocated SrcSpanAnnN RdrName -> R ()
p_rdrName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
x
      HsBndrWildCard XBndrWildCard GhcPs
_ -> Text -> R ()
txt Text
"_"
    case HsBndrKind GhcPs
tvb_kind of
      HsBndrKind XBndrKind GhcPs
_ XRec GhcPs (HsType GhcPs)
k -> R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsType GhcPs) -> R ()
p_hsTypeAnnotation XRec GhcPs (HsType GhcPs)
k
      HsBndrNoKind XBndrNoKind GhcPs
_ -> () -> R ()
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

data ForAllVisibility = ForAllInvis | ForAllVis

-- | Render several @forall@-ed variables.
p_forallBndrs ::
  (HasLoc l) =>
  ForAllVisibility ->
  (a -> R ()) ->
  [GenLocated l a] ->
  R ()
p_forallBndrs :: forall l a.
HasLoc l =>
ForAllVisibility -> (a -> R ()) -> [GenLocated l a] -> R ()
p_forallBndrs ForAllVisibility
vis a -> R ()
p [GenLocated l a]
tyvars = do
  (a -> R ()) -> [GenLocated l a] -> R ()
forall l a. HasLoc l => (a -> R ()) -> [GenLocated l a] -> R ()
p_forallBndrsStart a -> R ()
p [GenLocated l a]
tyvars
  Choice "extraSpace" -> ForAllVisibility -> R ()
p_forallBndrsEnd (Label "extraSpace" -> Choice "extraSpace"
forall (a :: Symbol). Label a -> Choice a
Without Label "extraSpace"
#extraSpace) ForAllVisibility
vis

p_forallBndrsStart :: (HasLoc l) => (a -> R ()) -> [GenLocated l a] -> R ()
p_forallBndrsStart :: forall l a. HasLoc l => (a -> R ()) -> [GenLocated l a] -> R ()
p_forallBndrsStart a -> R ()
_ [] = R ()
token'forall
p_forallBndrsStart a -> R ()
p [GenLocated l a]
tyvars = do
  [SrcSpan] -> R () -> R ()
switchLayout (GenLocated l a -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA (GenLocated l a -> SrcSpan) -> [GenLocated l a] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated l a]
tyvars) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    R ()
token'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 () -> (GenLocated l a -> R ()) -> [GenLocated l a] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated l a -> R ()) -> GenLocated l a -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> R ()) -> GenLocated l a -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' a -> R ()
p) [GenLocated l a]
tyvars

p_forallBndrsEnd :: Choice "extraSpace" -> ForAllVisibility -> R ()
p_forallBndrsEnd :: Choice "extraSpace" -> ForAllVisibility -> R ()
p_forallBndrsEnd Choice "extraSpace"
extraSpace = \case
  ForAllVisibility
ForAllInvis -> Text -> R ()
txt Text
dot R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space
  ForAllVisibility
ForAllVis -> R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
token'rarrow
  where
    dot :: Text
dot = if Choice "extraSpace" -> Bool
forall (a :: Symbol). Choice a -> Bool
Choice.isTrue Choice "extraSpace"
extraSpace then Text
" ." else Text
"."

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

p_conDeclField :: ConDeclField GhcPs -> R ()
p_conDeclField :: ConDeclField GhcPs -> R ()
p_conDeclField ConDeclField {[LFieldOcc GhcPs]
Maybe (LHsDoc GhcPs)
XConDeclField GhcPs
XRec GhcPs (HsType GhcPs)
cd_fld_ext :: XConDeclField GhcPs
cd_fld_names :: [LFieldOcc GhcPs]
cd_fld_type :: XRec GhcPs (HsType GhcPs)
cd_fld_doc :: Maybe (LHsDoc GhcPs)
cd_fld_doc :: forall pass. ConDeclField pass -> Maybe (LHsDoc pass)
cd_fld_type :: forall pass. ConDeclField pass -> LBangType pass
cd_fld_names :: forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_ext :: forall pass. ConDeclField pass -> XConDeclField pass
..} = do
  CommaStyle
commaStyle <- (forall (f :: * -> *). PrinterOpts f -> f CommaStyle)
-> R CommaStyle
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f CommaStyle
forall (f :: * -> *). PrinterOpts f -> f CommaStyle
poCommaStyle
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CommaStyle
commaStyle CommaStyle -> CommaStyle -> Bool
forall a. Eq a => a -> a -> Bool
== CommaStyle
Trailing) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
    (LHsDoc GhcPs -> R ()) -> Maybe (LHsDoc GhcPs) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HaddockStyle -> Choice "endNewline" -> LHsDoc GhcPs -> R ()
p_hsDoc HaddockStyle
Pipe (Label "endNewline" -> Choice "endNewline"
forall (a :: Symbol). Label a -> Choice a
With Label "endNewline"
#endNewline)) Maybe (LHsDoc GhcPs)
cd_fld_doc
  R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
    R ()
-> (GenLocated SrcSpanAnnA (FieldOcc GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (FieldOcc GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
      R ()
commaDel
      ((FieldOcc GhcPs -> R ())
-> GenLocated SrcSpanAnnA (FieldOcc GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' (GenLocated SrcSpanAnnN RdrName -> R ()
p_rdrName (GenLocated SrcSpanAnnN RdrName -> R ())
-> (FieldOcc GhcPs -> GenLocated SrcSpanAnnN RdrName)
-> FieldOcc GhcPs
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc GhcPs -> LIdP GhcPs
FieldOcc GhcPs -> GenLocated SrcSpanAnnN RdrName
forall pass. FieldOcc pass -> LIdP pass
foLabel))
      [LFieldOcc GhcPs]
[GenLocated SrcSpanAnnA (FieldOcc GhcPs)]
cd_fld_names
  R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsType GhcPs) -> R ()
p_hsTypeAnnotation XRec GhcPs (HsType GhcPs)
cd_fld_type
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CommaStyle
commaStyle CommaStyle -> CommaStyle -> Bool
forall a. Eq a => a -> a -> Bool
== CommaStyle
Leading) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
    (LHsDoc GhcPs -> R ()) -> Maybe (LHsDoc GhcPs) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Rational -> R () -> R ()
inciByFrac (-Rational
1) (R () -> R ()) -> (LHsDoc GhcPs -> R ()) -> LHsDoc GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (R ()
newline >>) (R () -> R ()) -> (LHsDoc GhcPs -> R ()) -> LHsDoc GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HaddockStyle -> Choice "endNewline" -> LHsDoc GhcPs -> R ()
p_hsDoc HaddockStyle
Caret (Label "endNewline" -> Choice "endNewline"
forall (a :: Symbol). Label a -> Choice a
Without Label "endNewline"
#endNewline)) Maybe (LHsDoc GhcPs)
cd_fld_doc

p_lhsTypeArg :: LHsTypeArg GhcPs -> R ()
p_lhsTypeArg :: LHsTypeArg GhcPs -> R ()
p_lhsTypeArg = \case
  HsValArg NoExtField
XValArg GhcPs
NoExtField XRec GhcPs (HsType GhcPs)
ty -> GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
ty HsType GhcPs -> R ()
p_hsType
  -- first argument is the SrcSpan of the @,
  -- but the @ always has to be directly before the type argument
  HsTypeArg XTypeArg GhcPs
_ XRec GhcPs (HsType GhcPs)
ty -> Text -> R ()
txt Text
"@" R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
ty HsType GhcPs -> R ()
p_hsType
  -- NOTE(amesgen) is this unreachable or just not implemented?
  HsArgPar XArgPar GhcPs
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsArgPar"

p_hsSigType :: HsSigType GhcPs -> R ()
p_hsSigType :: HsSigType GhcPs -> R ()
p_hsSigType = HsType GhcPs -> R ()
p_hsType (HsType GhcPs -> R ())
-> (HsSigType GhcPs -> HsType GhcPs) -> HsSigType GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsSigType GhcPs -> HsType GhcPs
hsSigTypeToType

----------------------------------------------------------------------------
-- Rendering function types

-- | The parsed representation of a function
data ParsedFunRepr a
  = ParsedFunSig (ParsedFunRepr a)
  | ParsedFunForall
      (LocatedA (HsForAllTelescope GhcPs))
      (ParsedFunRepr a)
  | ParsedFunQuals
      [LocatedA (LocatedC [LocatedA a])]
      (ParsedFunRepr a)
  | -- | The argument, its optional docstring, and the arrow going to the next arg/return
    ParsedFunArgs
      [ LocatedA
          ( LocatedA a,
            Maybe (LHsDoc GhcPs),
            HsArrowOf (LocatedA a) GhcPs
          )
      ]
      (ParsedFunRepr a)
  | ParsedFunReturn
      ( LocatedA a,
        Maybe (LHsDoc GhcPs)
      )

class (Anno a ~ SrcSpanAnnA, Outputable a) => FunRepr a where
  renderFunItem :: a -> R ()

  parseFunRepr :: LocatedA a -> ParsedFunRepr a

instance FunRepr (HsType GhcPs) where
  renderFunItem :: HsType GhcPs -> R ()
renderFunItem = HsType GhcPs -> R ()
p_hsType
  parseFunRepr :: GenLocated SrcSpanAnnA (HsType GhcPs)
-> ParsedFunRepr (HsType GhcPs)
parseFunRepr = \case
    -- `forall a. _`
    L SrcSpanAnnA
ann (HsForAllTy XForAllTy GhcPs
_ HsForAllTelescope GhcPs
tele XRec GhcPs (HsType GhcPs)
ty) ->
      LocatedA (HsForAllTelescope GhcPs)
-> ParsedFunRepr (HsType GhcPs) -> ParsedFunRepr (HsType GhcPs)
forall a.
LocatedA (HsForAllTelescope GhcPs)
-> ParsedFunRepr a -> ParsedFunRepr a
ParsedFunForall (SrcSpanAnnA
-> HsForAllTelescope GhcPs -> LocatedA (HsForAllTelescope GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
ann HsForAllTelescope GhcPs
tele) (GenLocated SrcSpanAnnA (HsType GhcPs)
-> ParsedFunRepr (HsType GhcPs)
forall a. FunRepr a => LocatedA a -> ParsedFunRepr a
parseFunRepr XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
ty)
    -- `HasCallStack => _`
    ty :: GenLocated SrcSpanAnnA (HsType GhcPs)
ty@(L SrcSpanAnnA
_ HsQualTy {}) ->
      let ([GenLocated SrcSpanAnnA (LHsContext GhcPs)]
ctxs, GenLocated SrcSpanAnnA (HsType GhcPs)
rest) = GenLocated SrcSpanAnnA (HsType GhcPs)
-> ([GenLocated SrcSpanAnnA (LHsContext GhcPs)],
    GenLocated SrcSpanAnnA (HsType GhcPs))
getContexts GenLocated SrcSpanAnnA (HsType GhcPs)
ty
       in [LocatedA (LocatedC [GenLocated SrcSpanAnnA (HsType GhcPs)])]
-> ParsedFunRepr (HsType GhcPs) -> ParsedFunRepr (HsType GhcPs)
forall a.
[LocatedA (LocatedC [LocatedA a])]
-> ParsedFunRepr a -> ParsedFunRepr a
ParsedFunQuals [GenLocated SrcSpanAnnA (LHsContext GhcPs)]
[LocatedA (LocatedC [GenLocated SrcSpanAnnA (HsType GhcPs)])]
ctxs (GenLocated SrcSpanAnnA (HsType GhcPs)
-> ParsedFunRepr (HsType GhcPs)
forall a. FunRepr a => LocatedA a -> ParsedFunRepr a
parseFunRepr GenLocated SrcSpanAnnA (HsType GhcPs)
rest)
    -- `Int -> _`
    ty :: GenLocated SrcSpanAnnA (HsType GhcPs)
ty@(L SrcSpanAnnA
_ HsFunTy {}) ->
      let ([GenLocated
   SrcSpanAnnA
   (GenLocated SrcSpanAnnA (HsType GhcPs), Maybe (LHsDoc GhcPs),
    HsArrowOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs)]
args, GenLocated SrcSpanAnnA (HsType GhcPs)
ret) = GenLocated SrcSpanAnnA (HsType GhcPs)
-> ([GenLocated
       SrcSpanAnnA
       (GenLocated SrcSpanAnnA (HsType GhcPs), Maybe (LHsDoc GhcPs),
        HsArrowOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs)],
    GenLocated SrcSpanAnnA (HsType GhcPs))
getArgsAndReturn GenLocated SrcSpanAnnA (HsType GhcPs)
ty
       in [GenLocated
   SrcSpanAnnA
   (GenLocated SrcSpanAnnA (HsType GhcPs), Maybe (LHsDoc GhcPs),
    HsArrowOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs)]
-> ParsedFunRepr (HsType GhcPs) -> ParsedFunRepr (HsType GhcPs)
forall a.
[LocatedA
   (LocatedA a, Maybe (LHsDoc GhcPs), HsArrowOf (LocatedA a) GhcPs)]
-> ParsedFunRepr a -> ParsedFunRepr a
ParsedFunArgs [GenLocated
   SrcSpanAnnA
   (GenLocated SrcSpanAnnA (HsType GhcPs), Maybe (LHsDoc GhcPs),
    HsArrowOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs)]
args (GenLocated SrcSpanAnnA (HsType GhcPs)
-> ParsedFunRepr (HsType GhcPs)
forall a. FunRepr a => LocatedA a -> ParsedFunRepr a
parseFunRepr GenLocated SrcSpanAnnA (HsType GhcPs)
ret)
    -- `_ -> Int`
    L SrcSpanAnnA
_ (HsDocTy XDocTy GhcPs
_ XRec GhcPs (HsType GhcPs)
ty LHsDoc GhcPs
doc) -> (GenLocated SrcSpanAnnA (HsType GhcPs), Maybe (LHsDoc GhcPs))
-> ParsedFunRepr (HsType GhcPs)
forall a. (LocatedA a, Maybe (LHsDoc GhcPs)) -> ParsedFunRepr a
ParsedFunReturn (XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
ty, LHsDoc GhcPs -> Maybe (LHsDoc GhcPs)
forall a. a -> Maybe a
Just LHsDoc GhcPs
doc)
    GenLocated SrcSpanAnnA (HsType GhcPs)
ty -> (GenLocated SrcSpanAnnA (HsType GhcPs), Maybe (LHsDoc GhcPs))
-> ParsedFunRepr (HsType GhcPs)
forall a. (LocatedA a, Maybe (LHsDoc GhcPs)) -> ParsedFunRepr a
ParsedFunReturn (GenLocated SrcSpanAnnA (HsType GhcPs)
ty, Maybe (LHsDoc GhcPs)
forall a. Maybe a
Nothing)
    where
      getContexts :: GenLocated SrcSpanAnnA (HsType GhcPs)
-> ([GenLocated SrcSpanAnnA (LHsContext GhcPs)],
    GenLocated SrcSpanAnnA (HsType GhcPs))
getContexts =
        let go :: [GenLocated l (XRec pass [XRec pass (HsType pass)])]
-> GenLocated l (HsType pass)
-> ([GenLocated l (XRec pass [XRec pass (HsType pass)])],
    GenLocated l (HsType pass))
go [GenLocated l (XRec pass [XRec pass (HsType pass)])]
ctxs = \case
              L l
ann (HsQualTy XQualTy pass
_ XRec pass [XRec pass (HsType pass)]
ctx XRec pass (HsType pass)
ty) ->
                [GenLocated l (XRec pass [XRec pass (HsType pass)])]
-> GenLocated l (HsType pass)
-> ([GenLocated l (XRec pass [XRec pass (HsType pass)])],
    GenLocated l (HsType pass))
go (l
-> XRec pass [XRec pass (HsType pass)]
-> GenLocated l (XRec pass [XRec pass (HsType pass)])
forall l e. l -> e -> GenLocated l e
L l
ann XRec pass [XRec pass (HsType pass)]
ctx GenLocated l (XRec pass [XRec pass (HsType pass)])
-> [GenLocated l (XRec pass [XRec pass (HsType pass)])]
-> [GenLocated l (XRec pass [XRec pass (HsType pass)])]
forall a. a -> [a] -> [a]
: [GenLocated l (XRec pass [XRec pass (HsType pass)])]
ctxs) XRec pass (HsType pass)
GenLocated l (HsType pass)
ty
              GenLocated l (HsType pass)
ty ->
                ([GenLocated l (XRec pass [XRec pass (HsType pass)])]
-> [GenLocated l (XRec pass [XRec pass (HsType pass)])]
forall a. [a] -> [a]
reverse [GenLocated l (XRec pass [XRec pass (HsType pass)])]
ctxs, GenLocated l (HsType pass)
ty)
         in [GenLocated SrcSpanAnnA (LHsContext GhcPs)]
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> ([GenLocated SrcSpanAnnA (LHsContext GhcPs)],
    GenLocated SrcSpanAnnA (HsType GhcPs))
forall {pass} {l}.
(XRec pass (HsType pass) ~ GenLocated l (HsType pass)) =>
[GenLocated l (XRec pass [XRec pass (HsType pass)])]
-> GenLocated l (HsType pass)
-> ([GenLocated l (XRec pass [XRec pass (HsType pass)])],
    GenLocated l (HsType pass))
go []
      getArgsAndReturn :: GenLocated SrcSpanAnnA (HsType GhcPs)
-> ([GenLocated
       SrcSpanAnnA
       (GenLocated SrcSpanAnnA (HsType GhcPs), Maybe (LHsDoc GhcPs),
        HsArrowOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs)],
    GenLocated SrcSpanAnnA (HsType GhcPs))
getArgsAndReturn =
        let go :: [GenLocated
   l
   (GenLocated l (HsType pass), Maybe (LHsDoc pass),
    HsArrowOf (GenLocated l (HsType pass)) pass)]
-> GenLocated l (HsType pass)
-> ([GenLocated
       l
       (GenLocated l (HsType pass), Maybe (LHsDoc pass),
        HsArrowOf (GenLocated l (HsType pass)) pass)],
    GenLocated l (HsType pass))
go [GenLocated
   l
   (GenLocated l (HsType pass), Maybe (LHsDoc pass),
    HsArrowOf (GenLocated l (HsType pass)) pass)]
args = \case
              L l
ann (HsFunTy XFunTy pass
_ HsArrow pass
arrow (L l
_ (HsDocTy XDocTy pass
_ XRec pass (HsType pass)
l LHsDoc pass
doc)) XRec pass (HsType pass)
r) ->
                [GenLocated
   l
   (GenLocated l (HsType pass), Maybe (LHsDoc pass),
    HsArrowOf (GenLocated l (HsType pass)) pass)]
-> GenLocated l (HsType pass)
-> ([GenLocated
       l
       (GenLocated l (HsType pass), Maybe (LHsDoc pass),
        HsArrowOf (GenLocated l (HsType pass)) pass)],
    GenLocated l (HsType pass))
go (l
-> (GenLocated l (HsType pass), Maybe (LHsDoc pass),
    HsArrowOf (GenLocated l (HsType pass)) pass)
-> GenLocated
     l
     (GenLocated l (HsType pass), Maybe (LHsDoc pass),
      HsArrowOf (GenLocated l (HsType pass)) pass)
forall l e. l -> e -> GenLocated l e
L l
ann (XRec pass (HsType pass)
GenLocated l (HsType pass)
l, LHsDoc pass -> Maybe (LHsDoc pass)
forall a. a -> Maybe a
Just LHsDoc pass
doc, HsArrow pass
HsArrowOf (GenLocated l (HsType pass)) pass
arrow) GenLocated
  l
  (GenLocated l (HsType pass), Maybe (LHsDoc pass),
   HsArrowOf (GenLocated l (HsType pass)) pass)
-> [GenLocated
      l
      (GenLocated l (HsType pass), Maybe (LHsDoc pass),
       HsArrowOf (GenLocated l (HsType pass)) pass)]
-> [GenLocated
      l
      (GenLocated l (HsType pass), Maybe (LHsDoc pass),
       HsArrowOf (GenLocated l (HsType pass)) pass)]
forall a. a -> [a] -> [a]
: [GenLocated
   l
   (GenLocated l (HsType pass), Maybe (LHsDoc pass),
    HsArrowOf (GenLocated l (HsType pass)) pass)]
args) XRec pass (HsType pass)
GenLocated l (HsType pass)
r
              L l
ann (HsFunTy XFunTy pass
_ HsArrow pass
arrow XRec pass (HsType pass)
l XRec pass (HsType pass)
r) ->
                [GenLocated
   l
   (GenLocated l (HsType pass), Maybe (LHsDoc pass),
    HsArrowOf (GenLocated l (HsType pass)) pass)]
-> GenLocated l (HsType pass)
-> ([GenLocated
       l
       (GenLocated l (HsType pass), Maybe (LHsDoc pass),
        HsArrowOf (GenLocated l (HsType pass)) pass)],
    GenLocated l (HsType pass))
go (l
-> (GenLocated l (HsType pass), Maybe (LHsDoc pass),
    HsArrowOf (GenLocated l (HsType pass)) pass)
-> GenLocated
     l
     (GenLocated l (HsType pass), Maybe (LHsDoc pass),
      HsArrowOf (GenLocated l (HsType pass)) pass)
forall l e. l -> e -> GenLocated l e
L l
ann (XRec pass (HsType pass)
GenLocated l (HsType pass)
l, Maybe (LHsDoc pass)
forall a. Maybe a
Nothing, HsArrow pass
HsArrowOf (GenLocated l (HsType pass)) pass
arrow) GenLocated
  l
  (GenLocated l (HsType pass), Maybe (LHsDoc pass),
   HsArrowOf (GenLocated l (HsType pass)) pass)
-> [GenLocated
      l
      (GenLocated l (HsType pass), Maybe (LHsDoc pass),
       HsArrowOf (GenLocated l (HsType pass)) pass)]
-> [GenLocated
      l
      (GenLocated l (HsType pass), Maybe (LHsDoc pass),
       HsArrowOf (GenLocated l (HsType pass)) pass)]
forall a. a -> [a] -> [a]
: [GenLocated
   l
   (GenLocated l (HsType pass), Maybe (LHsDoc pass),
    HsArrowOf (GenLocated l (HsType pass)) pass)]
args) XRec pass (HsType pass)
GenLocated l (HsType pass)
r
              GenLocated l (HsType pass)
ty ->
                ([GenLocated
   l
   (GenLocated l (HsType pass), Maybe (LHsDoc pass),
    HsArrowOf (GenLocated l (HsType pass)) pass)]
-> [GenLocated
      l
      (GenLocated l (HsType pass), Maybe (LHsDoc pass),
       HsArrowOf (GenLocated l (HsType pass)) pass)]
forall a. [a] -> [a]
reverse [GenLocated
   l
   (GenLocated l (HsType pass), Maybe (LHsDoc pass),
    HsArrowOf (GenLocated l (HsType pass)) pass)]
args, GenLocated l (HsType pass)
ty)
         in [GenLocated
   SrcSpanAnnA
   (GenLocated SrcSpanAnnA (HsType GhcPs), Maybe (LHsDoc GhcPs),
    HsArrowOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs)]
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> ([GenLocated
       SrcSpanAnnA
       (GenLocated SrcSpanAnnA (HsType GhcPs), Maybe (LHsDoc GhcPs),
        HsArrowOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs)],
    GenLocated SrcSpanAnnA (HsType GhcPs))
forall {pass} {l}.
(XRec pass (HsType pass) ~ GenLocated l (HsType pass)) =>
[GenLocated
   l
   (GenLocated l (HsType pass), Maybe (LHsDoc pass),
    HsArrowOf (GenLocated l (HsType pass)) pass)]
-> GenLocated l (HsType pass)
-> ([GenLocated
       l
       (GenLocated l (HsType pass), Maybe (LHsDoc pass),
        HsArrowOf (GenLocated l (HsType pass)) pass)],
    GenLocated l (HsType pass))
go []

-- | For implementing function-arrows and related configuration, we'll collect
-- all the components of the function type first, then render as a block instead
-- of rendering each part independently, which will let us track local state
-- within a function type.
--
-- This function should be passed the first function-related construct we find;
-- see FunRepr for more details.
p_hsFun :: (FunRepr a) => a -> R ()
p_hsFun :: forall a. FunRepr a => a -> R ()
p_hsFun = ParsedFunRepr a -> R ()
forall a. FunRepr a => ParsedFunRepr a -> R ()
p_hsFunParsed (ParsedFunRepr a -> R ()) -> (a -> ParsedFunRepr a) -> a -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA a -> ParsedFunRepr a
forall a. FunRepr a => LocatedA a -> ParsedFunRepr a
parseFunRepr (LocatedA a -> ParsedFunRepr a)
-> (a -> LocatedA a) -> a -> ParsedFunRepr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA -> a -> LocatedA a
forall l e. l -> e -> GenLocated l e
L (forall a. NoAnn a => a
noAnn @SrcSpanAnnA)

p_hsFunParsed :: (FunRepr a) => ParsedFunRepr a -> R ()
p_hsFunParsed :: forall a. FunRepr a => ParsedFunRepr a -> R ()
p_hsFunParsed ParsedFunRepr a
fun = do
  FunctionArrowsStyle
arrowsStyle <- (forall (f :: * -> *). PrinterOpts f -> f FunctionArrowsStyle)
-> R FunctionArrowsStyle
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f FunctionArrowsStyle
forall (f :: * -> *). PrinterOpts f -> f FunctionArrowsStyle
poFunctionArrows
  FunctionArrowsStyle -> ParsedFunRepr a -> R ()
forall a.
FunRepr a =>
FunctionArrowsStyle -> ParsedFunRepr a -> R ()
p_hsFunParsed' FunctionArrowsStyle
arrowsStyle ParsedFunRepr a
fun

type PrintHsFun x = State.StateT PrintHsFunState (Cont.ContT () R) x

type PrintHsFunState =
  ( Maybe (R ()), -- The leading delimiter to output at the next line
    Choice "forceMultiline"
  )

p_hsFunParsed' ::
  (FunRepr a) =>
  FunctionArrowsStyle ->
  ParsedFunRepr a ->
  R ()
p_hsFunParsed' :: forall a.
FunRepr a =>
FunctionArrowsStyle -> ParsedFunRepr a -> R ()
p_hsFunParsed' FunctionArrowsStyle
arrowsStyle ParsedFunRepr a
fun0 = ContT () R () -> R ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
Cont.evalContT (ContT () R () -> R ())
-> (ParsedFunRepr a -> ContT () R ()) -> ParsedFunRepr a -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
-> (Maybe (R ()), Choice "forceMultiline") -> ContT () R ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
`State.evalStateT` (Maybe (R ()), Choice "forceMultiline")
forall {a}. (Maybe a, Choice "forceMultiline")
initialState) (StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
 -> ContT () R ())
-> (ParsedFunRepr a
    -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> ParsedFunRepr a
-> ContT () R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedFunRepr a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
go (ParsedFunRepr a -> R ()) -> ParsedFunRepr a -> R ()
forall a b. (a -> b) -> a -> b
$ ParsedFunRepr a
fun0
  where
    go :: ParsedFunRepr a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
go = \case
      ParsedFunSig ParsedFunRepr a
fun' -> do
        -- Should only happen at the very beginning, if at all
        StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
p_parsedFunSig
        ParsedFunRepr a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a} {a :: Symbol} {m :: * -> *} {a}.
MonadState (a, Choice a) m =>
ParsedFunRepr a -> m ()
setMultilineContext ParsedFunRepr a
fun'
        ParsedFunRepr a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
go ParsedFunRepr a
fun'
      ParsedFunForall LocatedA (HsForAllTelescope GhcPs)
tele ParsedFunRepr a
fun' -> do
        LocatedA (HsForAllTelescope GhcPs)
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
p_parsedFunForall LocatedA (HsForAllTelescope GhcPs)
tele
        ParsedFunRepr a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a} {a :: Symbol} {m :: * -> *} {a}.
MonadState (a, Choice a) m =>
ParsedFunRepr a -> m ()
setMultilineContext ParsedFunRepr a
fun'
        ParsedFunRepr a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
go ParsedFunRepr a
fun'
      ParsedFunQuals [LocatedA (LocatedC [GenLocated SrcSpanAnnA a])]
ctxs ParsedFunRepr a
fun' -> do
        [LocatedA (LocatedC [GenLocated SrcSpanAnnA a])]
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
p_parsedFunQuals [LocatedA (LocatedC [GenLocated SrcSpanAnnA a])]
ctxs
        ParsedFunRepr a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a} {a :: Symbol} {m :: * -> *} {a}.
MonadState (a, Choice a) m =>
ParsedFunRepr a -> m ()
setMultilineContext ParsedFunRepr a
fun'
        ParsedFunRepr a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
go ParsedFunRepr a
fun'
      ParsedFunArgs [LocatedA
   (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
    HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)]
args ParsedFunRepr a
fun' -> do
        [LocatedA
   (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
    HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)]
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
p_parsedFunArgs [LocatedA
   (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
    HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)]
args
        ParsedFunRepr a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
go ParsedFunRepr a
fun'
      ParsedFunReturn (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs))
ret -> do
        (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs))
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
p_parsedFunReturn (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs))
ret

    liftR :: R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR = ContT () R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Maybe (R ()), Choice "forceMultiline") m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ContT () R a
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a)
-> (R a -> ContT () R a)
-> R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R a -> ContT () R a
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift
    initialState :: (Maybe a, Choice "forceMultiline")
initialState = (Maybe a
forall a. Maybe a
Nothing, Label "forceMultiline" -> Choice "forceMultiline"
forall (a :: Symbol). Label a -> Choice a
Without Label "forceMultiline"
#forceMultiline)

    withApplyLeadingDelim :: (Maybe a -> m b) -> m b
withApplyLeadingDelim Maybe a -> m b
f = do
      (Maybe a
leadingDelim, b
_) <- m (Maybe a, b)
forall s (m :: * -> *). MonadState s m => m s
State.get
      b
a <- Maybe a -> m b
f Maybe a
leadingDelim
      ((Maybe a, b) -> (Maybe a, b)) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((Maybe a, b) -> (Maybe a, b)) -> m ())
-> ((Maybe a, b) -> (Maybe a, b)) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Maybe a
_, b
x) -> (Maybe a
forall a. Maybe a
Nothing, b
x)
      b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
    applyLeadingDelim :: StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
applyLeadingDelim = (Maybe (R ())
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {m :: * -> *} {a} {b} {b}.
MonadState (Maybe a, b) m =>
(Maybe a -> m b) -> m b
withApplyLeadingDelim ((R ()
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> Maybe (R ())
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR)

    setLeadingDelim :: a -> m ()
setLeadingDelim a
delim =
      ((Maybe a, b) -> (Maybe a, b)) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((Maybe a, b) -> (Maybe a, b)) -> m ())
-> ((Maybe a, b) -> (Maybe a, b)) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Maybe a
_, b
x) -> (a -> Maybe a
forall a. a -> Maybe a
Just a
delim, b
x)

    getIsMultiline :: StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) Bool
getIsMultiline = do
      (Maybe (R ())
_, Choice "forceMultiline"
forceMultiline) <- StateT
  (Maybe (R ()), Choice "forceMultiline")
  (ContT () R)
  (Maybe (R ()), Choice "forceMultiline")
forall s (m :: * -> *). MonadState s m => m s
State.get
      Layout
layout <- R Layout
-> StateT
     (Maybe (R ()), Choice "forceMultiline") (ContT () R) Layout
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR R Layout
getLayout
      Bool
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) Bool
forall a.
a -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
 -> StateT
      (Maybe (R ()), Choice "forceMultiline") (ContT () R) Bool)
-> Bool
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) Bool
forall a b. (a -> b) -> a -> b
$ Choice "forceMultiline" -> Bool
forall (a :: Symbol). Choice a -> Bool
Choice.toBool Choice "forceMultiline"
forceMultiline Bool -> Bool -> Bool
|| Layout
layout Layout -> Layout -> Bool
forall a. Eq a => a -> a -> Bool
== Layout
MultiLine

    setMultilineContext :: ParsedFunRepr a -> m ()
setMultilineContext ParsedFunRepr a
fun =
      ((a, Choice a) -> (a, Choice a)) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (((a, Choice a) -> (a, Choice a)) -> m ())
-> ((a, Choice a) -> (a, Choice a)) -> m ()
forall a b. (a -> b) -> a -> b
$ \(a
x, Choice a
_) -> (a
x, Bool -> Choice a
forall (a :: Symbol). Bool -> Choice a
Choice.fromBool (Bool -> Choice a) -> Bool -> Choice a
forall a b. (a -> b) -> a -> b
$ ParsedFunRepr a -> Bool
forall {a}. ParsedFunRepr a -> Bool
hasDocs ParsedFunRepr a
fun)

    -- Make everything afterwards occur within a located block, with the
    -- magic of ContT. `item <- setLocated litem; ...` is equivalent to
    -- `located litem $ \item -> ...`.
    setLocated :: (HasLoc ann) => GenLocated ann x -> PrintHsFun x
    setLocated :: forall ann x. HasLoc ann => GenLocated ann x -> PrintHsFun x
setLocated GenLocated ann x
litem = ContT () R x
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) x
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Maybe (R ()), Choice "forceMultiline") m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ContT () R x
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) x)
-> ContT () R x
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) x
forall a b. (a -> b) -> a -> b
$ ((x -> R ()) -> R ()) -> ContT () R x
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
Cont.ContT (GenLocated ann x -> (x -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated ann x
litem)

    p_parsedFunSig :: StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
p_parsedFunSig = do
      if Choice "argDelim" -> Bool
isTrailing (Label "argDelim" -> Choice "argDelim"
forall (a :: Symbol). Label a -> Choice a
Isn't Label "argDelim"
#argDelim)
        then R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR (R ()
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ do
          R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
token'dcolon
          if ParsedFunRepr a -> Bool
forall {a}. ParsedFunRepr a -> Bool
hasDocs ParsedFunRepr a
fun0 then R ()
newline else R ()
breakpoint
        else do
          R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR R ()
breakpoint
          R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a} {b} {m :: * -> *}.
MonadState (Maybe a, b) m =>
a -> m ()
setLeadingDelim (R ()
token'dcolon R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space)

    p_parsedFunForall :: LocatedA (HsForAllTelescope GhcPs)
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
p_parsedFunForall x :: LocatedA (HsForAllTelescope GhcPs)
x@(L SrcSpanAnnA
_ HsForAllTelescope GhcPs
tele) = do
      StateT
  (Maybe (R ()), Choice "forceMultiline")
  (ContT () R)
  (HsForAllTelescope GhcPs)
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT
   (Maybe (R ()), Choice "forceMultiline")
   (ContT () R)
   (HsForAllTelescope GhcPs)
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> StateT
     (Maybe (R ()), Choice "forceMultiline")
     (ContT () R)
     (HsForAllTelescope GhcPs)
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ LocatedA (HsForAllTelescope GhcPs)
-> StateT
     (Maybe (R ()), Choice "forceMultiline")
     (ContT () R)
     (HsForAllTelescope GhcPs)
forall ann x. HasLoc ann => GenLocated ann x -> PrintHsFun x
setLocated LocatedA (HsForAllTelescope GhcPs)
x
      StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
applyLeadingDelim
      ForAllVisibility
vis <-
        case HsForAllTelescope GhcPs
tele of
          HsForAllInvis XHsForAllInvis GhcPs
_ [LHsTyVarBndr Specificity GhcPs]
bndrs -> do
            R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR (R ()
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ (HsTyVarBndr Specificity GhcPs -> R ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)] -> R ()
forall l a. HasLoc l => (a -> R ()) -> [GenLocated l a] -> R ()
p_forallBndrsStart HsTyVarBndr Specificity GhcPs -> R ()
forall flag. IsTyVarBndrFlag flag => HsTyVarBndr flag GhcPs -> R ()
p_hsTyVarBndr [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
bndrs
            ForAllVisibility
-> StateT
     (Maybe (R ()), Choice "forceMultiline")
     (ContT () R)
     ForAllVisibility
forall a.
a -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForAllVisibility
ForAllInvis
          HsForAllVis XHsForAllVis GhcPs
_ [LHsTyVarBndr () GhcPs]
bndrs -> do
            R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR (R ()
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ (HsTyVarBndr () GhcPs -> R ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> R ()
forall l a. HasLoc l => (a -> R ()) -> [GenLocated l a] -> R ()
p_forallBndrsStart HsTyVarBndr () GhcPs -> R ()
forall flag. IsTyVarBndrFlag flag => HsTyVarBndr flag GhcPs -> R ()
p_hsTyVarBndr [LHsTyVarBndr () GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
bndrs
            ForAllVisibility
-> StateT
     (Maybe (R ()), Choice "forceMultiline")
     (ContT () R)
     ForAllVisibility
forall a.
a -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForAllVisibility
ForAllVis
      Bool
isMultiline <- StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) Bool
getIsMultiline
      if Choice "argDelim" -> Bool
isTrailing (Label "argDelim" -> Choice "argDelim"
forall (a :: Symbol). Label a -> Choice a
Isn't Label "argDelim"
#argDelim) Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
isMultiline
        then do
          R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR (R ()
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ Choice "extraSpace" -> ForAllVisibility -> R ()
p_forallBndrsEnd (Label "extraSpace" -> Choice "extraSpace"
forall (a :: Symbol). Label a -> Choice a
Without Label "extraSpace"
#extraSpace) ForAllVisibility
vis
          StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
interArgBreak
        else do
          StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
interArgBreak
          let extraSpace :: Choice "extraSpace"
extraSpace = if Bool
isMultiline then Label "extraSpace" -> Choice "extraSpace"
forall (a :: Symbol). Label a -> Choice a
With Label "extraSpace"
#extraSpace else Label "extraSpace" -> Choice "extraSpace"
forall (a :: Symbol). Label a -> Choice a
Without Label "extraSpace"
#extraSpace
          R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a} {b} {m :: * -> *}.
MonadState (Maybe a, b) m =>
a -> m ()
setLeadingDelim (Choice "extraSpace" -> ForAllVisibility -> R ()
p_forallBndrsEnd Choice "extraSpace"
extraSpace ForAllVisibility
vis)

    p_parsedFunQuals :: [LocatedA (LocatedC [GenLocated SrcSpanAnnA a])]
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
p_parsedFunQuals [LocatedA (LocatedC [GenLocated SrcSpanAnnA a])]
ctxs = do
      -- we only want to set located on the first context
      case [LocatedA (LocatedC [GenLocated SrcSpanAnnA a])]
ctxs of
        LocatedA (LocatedC [GenLocated SrcSpanAnnA a])
ctx : [LocatedA (LocatedC [GenLocated SrcSpanAnnA a])]
_ -> StateT
  (Maybe (R ()), Choice "forceMultiline")
  (ContT () R)
  (LocatedC [GenLocated SrcSpanAnnA a])
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT
   (Maybe (R ()), Choice "forceMultiline")
   (ContT () R)
   (LocatedC [GenLocated SrcSpanAnnA a])
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> StateT
     (Maybe (R ()), Choice "forceMultiline")
     (ContT () R)
     (LocatedC [GenLocated SrcSpanAnnA a])
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ LocatedA (LocatedC [GenLocated SrcSpanAnnA a])
-> StateT
     (Maybe (R ()), Choice "forceMultiline")
     (ContT () R)
     (LocatedC [GenLocated SrcSpanAnnA a])
forall ann x. HasLoc ann => GenLocated ann x -> PrintHsFun x
setLocated LocatedA (LocatedC [GenLocated SrcSpanAnnA a])
ctx
        [LocatedA (LocatedC [GenLocated SrcSpanAnnA a])]
_ -> ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a.
a -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      [LocatedA (LocatedC [GenLocated SrcSpanAnnA a])]
-> (LocatedA (LocatedC [GenLocated SrcSpanAnnA a])
    -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [LocatedA (LocatedC [GenLocated SrcSpanAnnA a])]
ctxs ((LocatedA (LocatedC [GenLocated SrcSpanAnnA a])
  -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> (LocatedA (LocatedC [GenLocated SrcSpanAnnA a])
    -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ \(L SrcSpanAnnA
_ LocatedC [GenLocated SrcSpanAnnA a]
lctx) -> do
        StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
applyLeadingDelim
        R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR (R ()
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ LocatedC [GenLocated SrcSpanAnnA a]
-> ([GenLocated SrcSpanAnnA a] -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedC [GenLocated SrcSpanAnnA a]
lctx ((a -> R ()) -> [XRec GhcPs a] -> R ()
forall a.
(Outputable (GenLocated (Anno a) a), HasLoc (Anno a)) =>
(a -> R ()) -> [XRec GhcPs a] -> R ()
p_hsContext' a -> R ()
forall a. FunRepr a => a -> R ()
renderFunItem)
        if Choice "argDelim" -> Bool
isTrailing (Label "argDelim" -> Choice "argDelim"
forall (a :: Symbol). Label a -> Choice a
Isn't Label "argDelim"
#argDelim)
          then do
            R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR (R ()
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
token'darrow
            StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
interArgBreak
          else do
            StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
interArgBreak
            R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a} {b} {m :: * -> *}.
MonadState (Maybe a, b) m =>
a -> m ()
setLeadingDelim (R ()
token'darrow R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space)

    p_parsedFunArgs :: [LocatedA
   (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
    HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)]
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
p_parsedFunArgs [LocatedA
   (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
    HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)]
args = do
      -- we only want to set located on the first arg
      case [LocatedA
   (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
    HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)]
args of
        LocatedA
  (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
   HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)
arg : [LocatedA
   (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
    HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)]
_ -> StateT
  (Maybe (R ()), Choice "forceMultiline")
  (ContT () R)
  (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
   HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT
   (Maybe (R ()), Choice "forceMultiline")
   (ContT () R)
   (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
    HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> StateT
     (Maybe (R ()), Choice "forceMultiline")
     (ContT () R)
     (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
      HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ LocatedA
  (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
   HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)
-> StateT
     (Maybe (R ()), Choice "forceMultiline")
     (ContT () R)
     (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
      HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)
forall ann x. HasLoc ann => GenLocated ann x -> PrintHsFun x
setLocated LocatedA
  (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
   HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)
arg
        [LocatedA
   (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
    HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)]
_ -> ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a.
a -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      [LocatedA
   (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
    HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)]
-> (LocatedA
      (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
       HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)
    -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [LocatedA
   (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
    HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)]
args ((LocatedA
    (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
     HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)
  -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> (LocatedA
      (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs),
       HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs)
    -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ \(L SrcSpanAnnA
_ (GenLocated SrcSpanAnnA a
larg, Maybe (LHsDoc GhcPs)
doc, HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs
arrow)) -> do
        let renderArrow :: R ()
renderArrow = (GenLocated SrcSpanAnnA a -> R ())
-> HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs -> R ()
forall mult. (mult -> R ()) -> HsArrowOf mult GhcPs -> R ()
p_arrow ((a -> R ()) -> GenLocated SrcSpanAnnA a -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' a -> R ()
forall a. FunRepr a => a -> R ()
renderFunItem) HsArrowOf (GenLocated SrcSpanAnnA a) GhcPs
arrow
        Choice "end"
-> Maybe (LHsDoc GhcPs)
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
withHaddocks (Label "end" -> Choice "end"
forall (a :: Symbol). Label a -> Choice a
Isn't Label "end"
#end) Maybe (LHsDoc GhcPs)
doc (StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ do
          (Maybe (R ())
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {m :: * -> *} {a} {b} {b}.
MonadState (Maybe a, b) m =>
(Maybe a -> m b) -> m b
withApplyLeadingDelim ((Maybe (R ())
  -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> (Maybe (R ())
    -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ \Maybe (R ())
applyLeadingDelim' ->
            R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR (R ()
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> ((a -> R ()) -> R ())
-> (a -> R ())
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA a -> (a -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA a
larg ((a -> R ())
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> (a -> R ())
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ \a
arg -> do
              (R () -> R ()) -> Maybe (R ()) -> R ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ R () -> R ()
forall a. a -> a
id Maybe (R ())
applyLeadingDelim'
              a -> R ()
forall a. FunRepr a => a -> R ()
renderFunItem a
arg
          if Choice "argDelim" -> Bool
isTrailing (Label "argDelim" -> Choice "argDelim"
forall (a :: Symbol). Label a -> Choice a
Is Label "argDelim"
#argDelim)
            then do
              R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR (R ()
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
renderArrow
              StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
interArgBreak
            else do
              StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
interArgBreak
              R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a} {b} {m :: * -> *}.
MonadState (Maybe a, b) m =>
a -> m ()
setLeadingDelim (R ()
renderArrow R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space)

    p_parsedFunReturn :: (GenLocated SrcSpanAnnA a, Maybe (LHsDoc GhcPs))
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
p_parsedFunReturn (GenLocated SrcSpanAnnA a
ret, Maybe (LHsDoc GhcPs)
doc) = do
      StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
forall ann x. HasLoc ann => GenLocated ann x -> PrintHsFun x
setLocated GenLocated SrcSpanAnnA a
ret
      Choice "end"
-> Maybe (LHsDoc GhcPs)
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
withHaddocks (Label "end" -> Choice "end"
forall (a :: Symbol). Label a -> Choice a
Is Label "end"
#end) Maybe (LHsDoc GhcPs)
doc (StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ do
        StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
applyLeadingDelim
        R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR (R ()
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA a -> (a -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA a
ret a -> R ()
forall a. FunRepr a => a -> R ()
renderFunItem

    withHaddocks :: Choice "end"
-> Maybe (LHsDoc GhcPs)
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
withHaddocks Choice "end"
isEnd Maybe (LHsDoc GhcPs)
doc StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
m = do
      Choice "pipe"
isLeadingHaddock <-
        R (Choice "pipe")
-> StateT
     (Maybe (R ()), Choice "forceMultiline")
     (ContT () R)
     (Choice "pipe")
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR (R (Choice "pipe")
 -> StateT
      (Maybe (R ()), Choice "forceMultiline")
      (ContT () R)
      (Choice "pipe"))
-> R (Choice "pipe")
-> StateT
     (Maybe (R ()), Choice "forceMultiline")
     (ContT () R)
     (Choice "pipe")
forall a b. (a -> b) -> a -> b
$
          (forall (f :: * -> *). PrinterOpts f -> f HaddockLocSignature)
-> R HaddockLocSignature
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f HaddockLocSignature
forall (f :: * -> *). PrinterOpts f -> f HaddockLocSignature
poHaddockLocSignature R HaddockLocSignature
-> (HaddockLocSignature -> Choice "pipe") -> R (Choice "pipe")
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            HaddockLocSignature
HaddockLocSigAuto ->
              if Choice "argDelim" -> Bool
isTrailing (Label "argDelim" -> Choice "argDelim"
forall (a :: Symbol). Label a -> Choice a
Is Label "argDelim"
#argDelim) then Label "pipe" -> Choice "pipe"
forall (a :: Symbol). Label a -> Choice a
With Label "pipe"
#pipe else Label "pipe" -> Choice "pipe"
forall (a :: Symbol). Label a -> Choice a
Without Label "pipe"
#pipe
            HaddockLocSignature
HaddockLocSigLeading ->
              Label "pipe" -> Choice "pipe"
forall (a :: Symbol). Label a -> Choice a
With Label "pipe"
#pipe
            HaddockLocSignature
HaddockLocSigTrailing ->
              Label "pipe" -> Choice "pipe"
forall (a :: Symbol). Label a -> Choice a
Without Label "pipe"
#pipe

      if Choice "pipe" -> Bool
forall (a :: Symbol). Choice a -> Bool
Choice.isTrue Choice "pipe"
isLeadingHaddock
        then do
          (LHsDoc GhcPs
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> Maybe (LHsDoc GhcPs)
-> StateT
     (Maybe (R ()), Choice "forceMultiline") (ContT () R) (Maybe ())
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR (R ()
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> (LHsDoc GhcPs -> R ())
-> LHsDoc GhcPs
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HaddockStyle -> Choice "endNewline" -> LHsDoc GhcPs -> R ()
p_hsDoc HaddockStyle
Pipe (Label "endNewline" -> Choice "endNewline"
forall (a :: Symbol). Label a -> Choice a
With Label "endNewline"
#endNewline)) Maybe (LHsDoc GhcPs)
doc StateT
  (Maybe (R ()), Choice "forceMultiline") (ContT () R) (Maybe ())
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b.
StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) b
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
m
        else do
          let (StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
pre, Choice "endNewline"
endNewline) =
                if Choice "end" -> Bool
forall (a :: Symbol). Choice a -> Bool
Choice.isTrue Choice "end"
isEnd
                  then (Bool
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (LHsDoc GhcPs) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (LHsDoc GhcPs)
doc) (R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR R ()
newline), Label "endNewline" -> Choice "endNewline"
forall (a :: Symbol). Label a -> Choice a
Without Label "endNewline"
#endNewline)
                  else (()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a.
a -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (), Label "endNewline" -> Choice "endNewline"
forall (a :: Symbol). Label a -> Choice a
With Label "endNewline"
#endNewline)
          StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
m StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b.
StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) b
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
pre StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
-> StateT
     (Maybe (R ()), Choice "forceMultiline") (ContT () R) (Maybe ())
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b.
StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) b
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (LHsDoc GhcPs
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> Maybe (LHsDoc GhcPs)
-> StateT
     (Maybe (R ()), Choice "forceMultiline") (ContT () R) (Maybe ())
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR (R ()
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> (LHsDoc GhcPs -> R ())
-> LHsDoc GhcPs
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HaddockStyle -> Choice "endNewline" -> LHsDoc GhcPs -> R ()
p_hsDoc HaddockStyle
Caret Choice "endNewline"
endNewline) Maybe (LHsDoc GhcPs)
doc

    interArgBreak :: StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
interArgBreak = do
      Bool
isMultiline <- StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) Bool
getIsMultiline
      R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall {a}.
R a
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) a
liftR (R ()
 -> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ())
-> R ()
-> StateT (Maybe (R ()), Choice "forceMultiline") (ContT () R) ()
forall a b. (a -> b) -> a -> b
$ if Bool
isMultiline then R ()
newline else R ()
breakpoint

    hasDocs :: ParsedFunRepr a -> Bool
hasDocs = \case
      ParsedFunSig ParsedFunRepr a
fun -> ParsedFunRepr a -> Bool
hasDocs ParsedFunRepr a
fun
      ParsedFunForall LocatedA (HsForAllTelescope GhcPs)
_ ParsedFunRepr a
fun -> ParsedFunRepr a -> Bool
hasDocs ParsedFunRepr a
fun
      ParsedFunQuals [LocatedA (LocatedC [LocatedA a])]
_ ParsedFunRepr a
fun -> ParsedFunRepr a -> Bool
hasDocs ParsedFunRepr a
fun
      ParsedFunArgs [LocatedA
   (LocatedA a, Maybe (LHsDoc GhcPs), HsArrowOf (LocatedA a) GhcPs)]
args ParsedFunRepr a
fun -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Maybe (LHsDoc GhcPs) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (LHsDoc GhcPs)
doc | L SrcSpanAnnA
_ (LocatedA a
_, Maybe (LHsDoc GhcPs)
doc, HsArrowOf (LocatedA a) GhcPs
_) <- [LocatedA
   (LocatedA a, Maybe (LHsDoc GhcPs), HsArrowOf (LocatedA a) GhcPs)]
args] Bool -> Bool -> Bool
|| ParsedFunRepr a -> Bool
hasDocs ParsedFunRepr a
fun
      ParsedFunReturn (LocatedA a
_, Maybe (LHsDoc GhcPs)
doc) -> Maybe (LHsDoc GhcPs) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (LHsDoc GhcPs)
doc

    isTrailing :: Choice "argDelim" -> Bool
isTrailing Choice "argDelim"
isArgDelim =
      case FunctionArrowsStyle
arrowsStyle of
        FunctionArrowsStyle
TrailingArrows -> Bool
True
        FunctionArrowsStyle
LeadingArgsArrows -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Choice "argDelim" -> Bool
forall (a :: Symbol). Choice a -> Bool
Choice.isTrue Choice "argDelim"
isArgDelim
        FunctionArrowsStyle
LeadingArrows -> Bool
False

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

hsSigTypeToType :: HsSigType GhcPs -> HsType GhcPs
hsSigTypeToType :: HsSigType GhcPs -> HsType GhcPs
hsSigTypeToType HsSig {XHsSig GhcPs
XRec GhcPs (HsType GhcPs)
HsOuterSigTyVarBndrs GhcPs
sig_ext :: XHsSig GhcPs
sig_bndrs :: HsOuterSigTyVarBndrs GhcPs
sig_body :: XRec GhcPs (HsType GhcPs)
sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_ext :: forall pass. HsSigType pass -> XHsSig pass
..} = HsOuterSigTyVarBndrs GhcPs
-> XRec GhcPs (HsType GhcPs) -> HsType GhcPs
hsOuterTyVarBndrsToHsType HsOuterSigTyVarBndrs GhcPs
sig_bndrs XRec GhcPs (HsType GhcPs)
sig_body

-- could be generalized to also handle () instead of Specificity
hsOuterTyVarBndrsToHsType ::
  HsOuterTyVarBndrs Specificity GhcPs ->
  LHsType GhcPs ->
  HsType GhcPs
hsOuterTyVarBndrsToHsType :: HsOuterSigTyVarBndrs GhcPs
-> XRec GhcPs (HsType GhcPs) -> HsType GhcPs
hsOuterTyVarBndrsToHsType HsOuterSigTyVarBndrs GhcPs
obndrs XRec GhcPs (HsType GhcPs)
ty = case HsOuterSigTyVarBndrs GhcPs
obndrs of
  HsOuterImplicit XHsOuterImplicit GhcPs
NoExtField
NoExtField -> GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
  HsOuterExplicit XHsOuterExplicit GhcPs Specificity
_ [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
bndrs ->
    XForAllTy GhcPs
-> HsForAllTelescope GhcPs
-> XRec GhcPs (HsType GhcPs)
-> HsType GhcPs
forall pass.
XForAllTy pass
-> HsForAllTelescope pass -> LHsType pass -> HsType pass
HsForAllTy XForAllTy GhcPs
NoExtField
NoExtField (EpAnnForallInvis
-> [LHsTyVarBndr Specificity GhcPs] -> HsForAllTelescope GhcPs
forall (p :: Pass).
EpAnnForallInvis
-> [LHsTyVarBndr Specificity (GhcPass p)]
-> HsForAllTelescope (GhcPass p)
mkHsForAllInvisTele EpAnnForallInvis
forall a. NoAnn a => a
noAnn [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
[LHsTyVarBndr Specificity GhcPs]
bndrs) XRec GhcPs (HsType GhcPs)
ty

lhsTypeToSigType :: LHsType GhcPs -> LHsSigType GhcPs
lhsTypeToSigType :: XRec GhcPs (HsType GhcPs) -> LHsSigType GhcPs
lhsTypeToSigType XRec GhcPs (HsType GhcPs)
ty =
  SrcSpanAnnA
-> HsSigType GhcPs -> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall l e. l -> e -> GenLocated l e
L (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
ty) (HsSigType GhcPs -> LHsSigType GhcPs)
-> (XRec GhcPs (HsType GhcPs) -> HsSigType GhcPs)
-> XRec GhcPs (HsType GhcPs)
-> LHsSigType GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XHsSig GhcPs
-> HsOuterSigTyVarBndrs GhcPs
-> XRec GhcPs (HsType GhcPs)
-> HsSigType GhcPs
forall pass.
XHsSig pass
-> HsOuterSigTyVarBndrs pass -> LHsType pass -> HsSigType pass
HsSig XHsSig GhcPs
NoExtField
NoExtField (XHsOuterImplicit GhcPs -> HsOuterSigTyVarBndrs GhcPs
forall flag pass.
XHsOuterImplicit pass -> HsOuterTyVarBndrs flag pass
HsOuterImplicit XHsOuterImplicit GhcPs
NoExtField
NoExtField) (XRec GhcPs (HsType GhcPs) -> LHsSigType GhcPs)
-> XRec GhcPs (HsType GhcPs) -> LHsSigType GhcPs
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsType GhcPs)
ty