{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

module Ormolu.Printer.Meat.Declaration.Value
  ( p_valDecl,
    p_pat,
    p_hsExpr,
    p_hsSplice,
    p_stringLit,
    p_hsExpr',
    p_hsCmdTop,
    exprPlacement,
    cmdTopPlacement,
  )
where

import Control.Monad
import Data.Bool (bool)
import Data.Coerce (coerce)
import Data.Data hiding (Infix, Prefix)
import Data.Function (on)
import Data.Functor ((<&>))
import Data.Generics.Schemes (everything)
import Data.List (intersperse, sortBy)
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Void
import GHC.Data.Bag (bagToList)
import GHC.Data.FastString (FastString, lengthFS)
import GHC.Hs
import GHC.LanguageExtensions.Type (Extension (NegativeLiterals))
import GHC.Parser.CharClass (is_space)
import GHC.Types.Basic
import GHC.Types.Fixity
import GHC.Types.Name.Reader
import GHC.Types.SourceText
import GHC.Types.SrcLoc
import Ormolu.Config
import Ormolu.Printer.Combinators
import Ormolu.Printer.Internal (sitccIfTrailing)
import Ormolu.Printer.Meat.Common
import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration
import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.OpTree
import Ormolu.Printer.Meat.Declaration.Signature
import Ormolu.Printer.Meat.Type
import Ormolu.Printer.Operators
import Ormolu.Utils

-- | Style of a group of equations.
data MatchGroupStyle
  = Function (LocatedN RdrName)
  | PatternBind
  | Case
  | Lambda
  | LambdaCase

-- | Style of equations in a group.
data GroupStyle
  = EqualSign
  | RightArrow

p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
p_valDecl = \case
  FunBind XFunBind GhcPs GhcPs
_ LIdP GhcPs
funId MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
funMatches [CoreTickish]
_ -> LocatedN RdrName
-> MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_funBind LIdP GhcPs
funId MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
funMatches
  PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
pat GRHSs GhcPs (XRec GhcPs (HsExpr GhcPs))
grhss ([CoreTickish], [[CoreTickish]])
_ -> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (XRec GhcPs (HsExpr GhcPs))
-> R ()
p_match MatchGroupStyle
PatternBind Bool
False SrcStrictness
NoSrcStrict [LPat GhcPs
pat] GRHSs GhcPs (XRec GhcPs (HsExpr GhcPs))
grhss
  VarBind {} -> forall a. String -> a
notImplemented String
"VarBinds" -- introduced by the type checker
  AbsBinds {} -> forall a. String -> a
notImplemented String
"AbsBinds" -- introduced by the type checker
  PatSynBind XPatSynBind GhcPs GhcPs
_ PatSynBind GhcPs GhcPs
psb -> PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PatSynBind GhcPs GhcPs
psb

p_funBind ::
  LocatedN RdrName ->
  MatchGroup GhcPs (LHsExpr GhcPs) ->
  R ()
p_funBind :: LocatedN RdrName
-> MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_funBind LocatedN RdrName
name = MatchGroupStyle
-> MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_matchGroup (LocatedN RdrName -> MatchGroupStyle
Function LocatedN RdrName
name)

p_matchGroup ::
  MatchGroupStyle ->
  MatchGroup GhcPs (LHsExpr GhcPs) ->
  R ()
p_matchGroup :: MatchGroupStyle
-> MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_matchGroup = forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr

p_matchGroup' ::
  ( Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
    Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
  ) =>
  -- | How to get body placement
  (body -> Placement) ->
  -- | How to print body
  (body -> R ()) ->
  -- | Style of this group of equations
  MatchGroupStyle ->
  -- | Match group
  MatchGroup GhcPs (LocatedA body) ->
  R ()
p_matchGroup' :: forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
style mg :: MatchGroup GhcPs (LocatedA body)
mg@MG {XRec GhcPs [LMatch GhcPs (LocatedA body)]
XMG GhcPs (LocatedA body)
Origin
mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_origin :: forall p body. MatchGroup p body -> Origin
mg_origin :: Origin
mg_alts :: XRec GhcPs [LMatch GhcPs (LocatedA body)]
mg_ext :: XMG GhcPs (LocatedA body)
..} = do
  let ob :: R () -> R ()
ob = case MatchGroupStyle
style of
        MatchGroupStyle
Case -> R () -> R ()
bracesIfEmpty
        MatchGroupStyle
LambdaCase -> R () -> R ()
bracesIfEmpty
        MatchGroupStyle
_ -> R () -> R ()
dontUseBraces
        where
          bracesIfEmpty :: R () -> R ()
bracesIfEmpty = if forall (p :: Pass) body. MatchGroup (GhcPass p) body -> Bool
isEmptyMatchGroup MatchGroup GhcPs (LocatedA body)
mg then R () -> R ()
useBraces else forall a. a -> a
id
  -- Since we are forcing braces on 'sepSemi' based on 'ob', we have to
  -- restore the brace state inside the sepsemi.
  R () -> R ()
ub <- forall a. a -> a -> Bool -> a
bool R () -> R ()
dontUseBraces R () -> R ()
useBraces forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Bool
canUseBraces
  R () -> R ()
ob forall a b. (a -> b) -> a -> b
$ forall a. (a -> R ()) -> [a] -> R ()
sepSemi (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (R () -> R ()
ub forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs (LocatedA body) -> R ()
p_Match)) (forall l e. GenLocated l e -> e
unLoc XRec GhcPs [LMatch GhcPs (LocatedA body)]
mg_alts)
  where
    p_Match :: Match GhcPs (LocatedA body) -> R ()
p_Match m :: Match GhcPs (LocatedA body)
m@Match {[LPat GhcPs]
HsMatchContext (NoGhcTc GhcPs)
GRHSs GhcPs (LocatedA body)
XCMatch GhcPs (LocatedA body)
m_ext :: forall p body. Match p body -> XCMatch p body
m_ctxt :: forall p body. Match p body -> HsMatchContext (NoGhcTc p)
m_pats :: forall p body. Match p body -> [LPat p]
m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss :: GRHSs GhcPs (LocatedA body)
m_pats :: [LPat GhcPs]
m_ctxt :: HsMatchContext (NoGhcTc GhcPs)
m_ext :: XCMatch GhcPs (LocatedA body)
..} =
      forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
p_match'
        body -> Placement
placer
        body -> R ()
render
        (forall body. Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle Match GhcPs (LocatedA body)
m MatchGroupStyle
style)
        (forall id body. Match id body -> Bool
isInfixMatch Match GhcPs (LocatedA body)
m)
        (forall id body. Match id body -> SrcStrictness
matchStrictness Match GhcPs (LocatedA body)
m)
        [LPat GhcPs]
m_pats
        GRHSs GhcPs (LocatedA body)
m_grhss

-- | Function id obtained through pattern matching on 'FunBind' should not
-- be used to print the actual equations because the different ‘RdrNames’
-- used in the equations may have different “decorations” (such as backticks
-- and paretheses) associated with them. It is necessary to use per-equation
-- names obtained from 'm_ctxt' of 'Match'. This function replaces function
-- name inside of 'Function' accordingly.
adjustMatchGroupStyle ::
  Match GhcPs body ->
  MatchGroupStyle ->
  MatchGroupStyle
adjustMatchGroupStyle :: forall body. Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle Match GhcPs body
m = \case
  Function LocatedN RdrName
_ -> (LocatedN RdrName -> MatchGroupStyle
Function forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. HsMatchContext p -> LIdP p
mc_fun forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p body. Match p body -> HsMatchContext (NoGhcTc p)
m_ctxt) Match GhcPs body
m
  MatchGroupStyle
style -> MatchGroupStyle
style

matchStrictness :: Match id body -> SrcStrictness
matchStrictness :: forall id body. Match id body -> SrcStrictness
matchStrictness Match id body
match =
  case forall p body. Match p body -> HsMatchContext (NoGhcTc p)
m_ctxt Match id body
match of
    FunRhs {mc_strictness :: forall p. HsMatchContext p -> SrcStrictness
mc_strictness = SrcStrictness
s} -> SrcStrictness
s
    HsMatchContext (NoGhcTc id)
_ -> SrcStrictness
NoSrcStrict

p_match ::
  -- | Style of the group
  MatchGroupStyle ->
  -- | Is this an infix match?
  Bool ->
  -- | Strictness prefix (FunBind)
  SrcStrictness ->
  -- | Argument patterns
  [LPat GhcPs] ->
  -- | Equations
  GRHSs GhcPs (LHsExpr GhcPs) ->
  R ()
p_match :: MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (XRec GhcPs (HsExpr GhcPs))
-> R ()
p_match = forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
p_match' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr

p_match' ::
  (Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan) =>
  -- | How to get body placement
  (body -> Placement) ->
  -- | How to print body
  (body -> R ()) ->
  -- | Style of this group of equations
  MatchGroupStyle ->
  -- | Is this an infix match?
  Bool ->
  -- | Strictness prefix (FunBind)
  SrcStrictness ->
  -- | Argument patterns
  [LPat GhcPs] ->
  -- | Equations
  GRHSs GhcPs (LocatedA body) ->
  R ()
p_match' :: forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
p_match' body -> Placement
placer body -> R ()
render MatchGroupStyle
style Bool
isInfix SrcStrictness
strictness [LPat GhcPs]
m_pats GRHSs {[LGRHS GhcPs (LocatedA body)]
HsLocalBinds GhcPs
XCGRHSs GhcPs (LocatedA body)
grhssExt :: forall p body. GRHSs p body -> XCGRHSs p body
grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
grhssLocalBinds :: HsLocalBinds GhcPs
grhssGRHSs :: [LGRHS GhcPs (LocatedA body)]
grhssExt :: XCGRHSs GhcPs (LocatedA body)
..} = do
  -- Normally, since patterns may be placed in a multi-line layout, it is
  -- necessary to bump indentation for the pattern group so it's more
  -- indented than function name. This in turn means that indentation for
  -- the body should also be bumped. Normally this would mean that bodies
  -- would start with two indentation steps applied, which is ugly, so we
  -- need to be a bit more clever here and bump indentation level only when
  -- pattern group is multiline.
  case SrcStrictness
strictness of
    SrcStrictness
NoSrcStrict -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    SrcStrictness
SrcStrict -> Text -> R ()
txt Text
"!"
    SrcStrictness
SrcLazy -> Text -> R ()
txt Text
"~"
  Bool
indentBody <- case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
m_pats of
    Maybe (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)))
Nothing ->
      Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ case MatchGroupStyle
style of
        Function LocatedN RdrName
name -> LocatedN RdrName -> R ()
p_rdrName LocatedN RdrName
name
        MatchGroupStyle
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
ne_pats -> do
      let combinedSpans :: SrcSpan
combinedSpans = case MatchGroupStyle
style of
            Function LocatedN RdrName
name -> SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedN RdrName
name) SrcSpan
patSpans
            MatchGroupStyle
_ -> SrcSpan
patSpans
          patSpans :: SrcSpan
patSpans = NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
ne_pats)
          indentBody :: Bool
indentBody = Bool -> Bool
not (SrcSpan -> Bool
isOneLineSpan SrcSpan
combinedSpans)
      [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
combinedSpans] forall a b. (a -> b) -> a -> b
$ do
        let stdCase :: R ()
stdCase = forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
m_pats
        case MatchGroupStyle
style of
          Function LocatedN RdrName
name ->
            Bool -> Bool -> R () -> [R ()] -> R ()
p_infixDefHelper
              Bool
isInfix
              Bool
indentBody
              (LocatedN RdrName -> R ()
p_rdrName LocatedN RdrName
name)
              (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs]
m_pats)
          MatchGroupStyle
PatternBind -> R ()
stdCase
          MatchGroupStyle
Case -> R ()
stdCase
          MatchGroupStyle
Lambda -> do
            let needsSpace :: Bool
needsSpace = case forall l e. GenLocated l e -> e
unLoc (forall a. NonEmpty a -> a
NE.head NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
ne_pats) of
                  LazyPat XLazyPat GhcPs
_ LPat GhcPs
_ -> Bool
True
                  BangPat XBangPat GhcPs
_ LPat GhcPs
_ -> Bool
True
                  SplicePat XSplicePat GhcPs
_ HsSplice GhcPs
_ -> Bool
True
                  Pat GhcPs
_ -> Bool
False
            Text -> R ()
txt Text
"\\"
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsSpace R ()
space
            R () -> R ()
sitcc R ()
stdCase
          MatchGroupStyle
LambdaCase -> R ()
stdCase
      forall (m :: * -> *) a. Monad m => a -> m a
return Bool
indentBody
  let -- Calculate position of end of patterns. This is useful when we decide
      -- about putting certain constructions in hanging positions.
      endOfPats :: Maybe SrcSpan
endOfPats = case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
m_pats of
        Maybe (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)))
Nothing -> case MatchGroupStyle
style of
          Function LocatedN RdrName
name -> forall a. a -> Maybe a
Just (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedN RdrName
name)
          MatchGroupStyle
_ -> forall a. Maybe a
Nothing
        Just NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
pats -> (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.last) NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
pats
      isCase :: MatchGroupStyle -> Bool
isCase = \case
        MatchGroupStyle
Case -> Bool
True
        MatchGroupStyle
LambdaCase -> Bool
True
        MatchGroupStyle
_ -> Bool
False
      hasGuards :: Bool
hasGuards = forall body. [LGRHS GhcPs body] -> Bool
withGuards [LGRHS GhcPs (LocatedA body)]
grhssGRHSs
      grhssSpan :: SrcSpan
grhssSpan =
        NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' forall a b. (a -> b) -> a -> b
$
          forall body. GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> NonEmpty a
NE.fromList [LGRHS GhcPs (LocatedA body)]
grhssGRHSs
      patGrhssSpan :: SrcSpan
patGrhssSpan =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          SrcSpan
grhssSpan
          (SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
grhssSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcLoc -> SrcSpan
srcLocSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanEnd)
          Maybe SrcSpan
endOfPats
      placement :: Placement
placement =
        case Maybe SrcSpan
endOfPats of
          Just SrcSpan
spn
            | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall body. Located (GRHS GhcPs body) -> Bool
guardNeedsLineBreak [LGRHS GhcPs (LocatedA body)]
grhssGRHSs
                Bool -> Bool -> Bool
|| Bool -> Bool
not (SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn SrcSpan
grhssSpan) ->
                Placement
Normal
          Maybe SrcSpan
_ -> forall body.
(body -> Placement) -> [LGRHS GhcPs (LocatedA body)] -> Placement
blockPlacement body -> Placement
placer [LGRHS GhcPs (LocatedA body)]
grhssGRHSs
      guardNeedsLineBreak :: Located (GRHS GhcPs body) -> Bool
      guardNeedsLineBreak :: forall body. Located (GRHS GhcPs body) -> Bool
guardNeedsLineBreak (L SrcSpan
_ (GRHS XCGRHS GhcPs body
_ [GuardLStmt GhcPs]
guardLStmts body
_)) = case [GuardLStmt GhcPs]
guardLStmts of
        [] -> Bool
False
        [GuardLStmt GhcPs
g] -> Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Bool
isOneLineSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall a b. (a -> b) -> a -> b
$ GuardLStmt GhcPs
g
        [GuardLStmt GhcPs]
_ -> Bool
True
      p_body :: R ()
p_body = do
        let groupStyle :: GroupStyle
groupStyle =
              if MatchGroupStyle -> Bool
isCase MatchGroupStyle
style Bool -> Bool -> Bool
&& Bool
hasGuards
                then GroupStyle
RightArrow
                else GroupStyle
EqualSign
        forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
          R ()
breakpoint
          (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (forall body.
Placement
-> (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA body)
-> R ()
p_grhs' Placement
placement body -> Placement
placer body -> R ()
render GroupStyle
groupStyle) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e ann. Located e -> LocatedAn ann e
reLocA)
          [LGRHS GhcPs (LocatedA body)]
grhssGRHSs
      p_where :: R ()
p_where = do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a b. HsLocalBindsLR a b -> Bool
eqEmptyLocalBinds HsLocalBinds GhcPs
grhssLocalBinds) forall a b. (a -> b) -> a -> b
$ do
          R ()
breakpoint
          Bool
indentWhere <- forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f Bool
poIndentWheres
          forall a. a -> a -> Bool -> a
bool (ConTag -> R () -> R ()
inciByFrac forall a b. (a -> b) -> a -> b
$ -ConTag
2) forall a. a -> a
id Bool
indentWhere forall a b. (a -> b) -> a -> b
$ Text -> R ()
txt Text
"where"
          R ()
breakpoint
          Bool -> R () -> R ()
inciIf Bool
indentWhere forall a b. (a -> b) -> a -> b
$ HsLocalBinds GhcPs -> R ()
p_hsLocalBinds HsLocalBinds GhcPs
grhssLocalBinds
  Bool -> R () -> R ()
inciIf Bool
indentBody forall a b. (a -> b) -> a -> b
$ do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [LGRHS GhcPs (LocatedA body)]
grhssGRHSs forall a. Ord a => a -> a -> Bool
> ConTag
1) forall a b. (a -> b) -> a -> b
$
      case MatchGroupStyle
style of
        Function LocatedN RdrName
_ | Bool
hasGuards -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Function LocatedN RdrName
_ -> R ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
equals
        MatchGroupStyle
PatternBind -> R ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
equals
        MatchGroupStyle
s | MatchGroupStyle -> Bool
isCase MatchGroupStyle
s Bool -> Bool -> Bool
&& Bool
hasGuards -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        MatchGroupStyle
_ -> R ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"->"
    [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
patGrhssSpan] forall a b. (a -> b) -> a -> b
$
      Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body
    R () -> R ()
inci R ()
p_where

p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
p_grhs :: GroupStyle -> GRHS GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_grhs = forall body.
Placement
-> (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA body)
-> R ()
p_grhs' Placement
Normal HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr

p_grhs' ::
  -- | Placement of the parent RHS construct
  Placement ->
  -- | How to get body placement
  (body -> Placement) ->
  -- | How to print body
  (body -> R ()) ->
  GroupStyle ->
  GRHS GhcPs (LocatedA body) ->
  R ()
p_grhs' :: forall body.
Placement
-> (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA body)
-> R ()
p_grhs' Placement
parentPlacement body -> Placement
placer body -> R ()
render GroupStyle
style (GRHS XCGRHS GhcPs (LocatedA body)
_ [GuardLStmt GhcPs]
guards LocatedA body
body) =
  case [GuardLStmt GhcPs]
guards of
    [] -> R ()
p_body
    [GuardLStmt GhcPs]
xs -> do
      Text -> R ()
txt Text
"|"
      R ()
space
      R () -> R ()
sitccIfTrailing (forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_stmt) [GuardLStmt GhcPs]
xs)
      R ()
space
      R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ case GroupStyle
style of
        GroupStyle
EqualSign -> R ()
equals
        GroupStyle
RightArrow -> Text -> R ()
txt Text
"->"
      -- If we have a sequence of guards and it is placed in the normal way,
      -- then we indent one level more for readability. Otherwise (all
      -- guards are on the same line) we do not need to indent, as it would
      -- look like double indentation without a good reason.
      ConTag
indent <- forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f ConTag
poIndentation
      Bool -> R () -> R ()
inciIf (ConTag
indent forall a. Ord a => a -> a -> Bool
<= ConTag
2 Bool -> Bool -> Bool
&& Placement
parentPlacement forall a. Eq a => a -> a -> Bool
== Placement
Normal) (Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body)
  where
    placement :: Placement
placement =
      case Maybe SrcSpan
endOfGuards of
        Maybe SrcSpan
Nothing -> body -> Placement
placer (forall l e. GenLocated l e -> e
unLoc LocatedA body
body)
        Just SrcSpan
spn ->
          if SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedA body
body)
            then body -> Placement
placer (forall l e. GenLocated l e -> e
unLoc LocatedA body
body)
            else Placement
Normal
    endOfGuards :: Maybe SrcSpan
endOfGuards =
      case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [GuardLStmt GhcPs]
guards of
        Maybe
  (NonEmpty
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
Nothing -> forall a. Maybe a
Nothing
        Just NonEmpty
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
gs -> (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.last) NonEmpty
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
gs
    p_body :: R ()
p_body = forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
body body -> R ()
render

p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd = BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
N

p_hsCmd' :: BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' :: BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
s = \case
  HsCmdArrApp XCmdArrApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
body XRec GhcPs (HsExpr GhcPs)
input HsArrAppType
arrType Bool
rightToLeft -> do
    let (GenLocated SrcSpanAnnA (HsExpr GhcPs)
l, GenLocated SrcSpanAnnA (HsExpr GhcPs)
r) = if Bool
rightToLeft then (XRec GhcPs (HsExpr GhcPs)
body, XRec GhcPs (HsExpr GhcPs)
input) else (XRec GhcPs (HsExpr GhcPs)
input, XRec GhcPs (HsExpr GhcPs)
body)
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
l HsExpr GhcPs -> R ()
p_hsExpr
    R ()
breakpoint
    R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
      case (HsArrAppType
arrType, Bool
rightToLeft) of
        (HsArrAppType
HsFirstOrderApp, Bool
True) -> Text -> R ()
txt Text
"-<"
        (HsArrAppType
HsHigherOrderApp, Bool
True) -> Text -> R ()
txt Text
"-<<"
        (HsArrAppType
HsFirstOrderApp, Bool
False) -> Text -> R ()
txt Text
">-"
        (HsArrAppType
HsHigherOrderApp, Bool
False) -> Text -> R ()
txt Text
">>-"
      Placement -> R () -> R ()
placeHanging (HsExpr GhcPs -> Placement
exprPlacement (forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
input)) forall a b. (a -> b) -> a -> b
$
        forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
r HsExpr GhcPs -> R ()
p_hsExpr
  HsCmdArrForm XCmdArrForm GhcPs
_ XRec GhcPs (HsExpr GhcPs)
form LexicalFixity
Prefix Maybe Fixity
_ [LHsCmdTop GhcPs]
cmds -> BracketStyle -> R () -> R ()
banana BracketStyle
s forall a b. (a -> b) -> a -> b
$ do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
form HsExpr GhcPs -> R ()
p_hsExpr
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsCmdTop GhcPs]
cmds) forall a b. (a -> b) -> a -> b
$ do
      R ()
breakpoint
      R () -> R ()
inci (forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (forall a. a -> [a] -> [a]
intersperse R ()
breakpoint (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (BracketStyle -> HsCmdTop GhcPs -> R ()
p_hsCmdTop BracketStyle
N) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsCmdTop GhcPs]
cmds)))
  HsCmdArrForm XCmdArrForm GhcPs
_ XRec GhcPs (HsExpr GhcPs)
form LexicalFixity
Infix Maybe Fixity
_ [LHsCmdTop GhcPs
left, LHsCmdTop GhcPs
right] -> do
    FixityMap
fixityOverrides <- R FixityMap
askFixityOverrides
    LazyFixityMap
fixityMap <- R LazyFixityMap
askFixityMap
    let opTree :: OpTree
  (GenLocated SrcSpan (HsCmdTop GhcPs))
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
opTree = forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches [LHsCmdTop GhcPs
-> OpTree (LHsCmdTop GhcPs) (XRec GhcPs (HsExpr GhcPs))
cmdOpTree LHsCmdTop GhcPs
left, LHsCmdTop GhcPs
-> OpTree (LHsCmdTop GhcPs) (XRec GhcPs (HsExpr GhcPs))
cmdOpTree LHsCmdTop GhcPs
right] [XRec GhcPs (HsExpr GhcPs)
form]
    BracketStyle
-> OpTree (LHsCmdTop GhcPs) (OpInfo (XRec GhcPs (HsExpr GhcPs)))
-> R ()
p_cmdOpTree
      BracketStyle
s
      (forall op ty.
(op -> Maybe RdrName)
-> FixityMap
-> LazyFixityMap
-> OpTree ty op
-> OpTree ty (OpInfo op)
reassociateOpTree (HsExpr GhcPs -> Maybe RdrName
getOpName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) FixityMap
fixityOverrides LazyFixityMap
fixityMap OpTree
  (GenLocated SrcSpan (HsCmdTop GhcPs))
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
opTree)
  HsCmdArrForm XCmdArrForm GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ LexicalFixity
Infix Maybe Fixity
_ [LHsCmdTop GhcPs]
_ -> forall a. String -> a
notImplemented String
"HsCmdArrForm"
  HsCmdApp XCmdApp GhcPs
_ LHsCmd GhcPs
cmd XRec GhcPs (HsExpr GhcPs)
expr -> do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
cmd (BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
s)
    R ()
space
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
  HsCmdLam XCmdLam GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
mgroup -> forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd MatchGroupStyle
Lambda MatchGroup GhcPs (LHsCmd GhcPs)
mgroup
  HsCmdPar XCmdPar GhcPs
_ LHsCmd GhcPs
c -> BracketStyle -> R () -> R ()
parens BracketStyle
N forall a b. (a -> b) -> a -> b
$ R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
c HsCmd GhcPs -> R ()
p_hsCmd
  HsCmdCase XCmdCase GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (LHsCmd GhcPs)
mgroup ->
    forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_case HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (LHsCmd GhcPs)
mgroup
  HsCmdLamCase XCmdLamCase GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
mgroup ->
    forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ()) -> MatchGroup GhcPs (LocatedA body) -> R ()
p_lamcase HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd MatchGroup GhcPs (LHsCmd GhcPs)
mgroup
  HsCmdIf XCmdIf GhcPs
_ SyntaxExpr GhcPs
_ XRec GhcPs (HsExpr GhcPs)
if' LHsCmd GhcPs
then' LHsCmd GhcPs
else' ->
    forall body.
(body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> LocatedA body
-> LocatedA body
-> R ()
p_if HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd XRec GhcPs (HsExpr GhcPs)
if' LHsCmd GhcPs
then' LHsCmd GhcPs
else'
  HsCmdLet XCmdLet GhcPs
_ HsLocalBinds GhcPs
localBinds LHsCmd GhcPs
c ->
    forall body.
(body -> R ()) -> HsLocalBinds GhcPs -> LocatedA body -> R ()
p_let HsCmd GhcPs -> R ()
p_hsCmd HsLocalBinds GhcPs
localBinds LHsCmd GhcPs
c
  HsCmdDo XCmdDo GhcPs
_ XRec GhcPs [CmdLStmt GhcPs]
es -> do
    Text -> R ()
txt Text
"do"
    forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
 Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ())
-> LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> R ()
p_stmts HsCmd GhcPs -> Placement
cmdPlacement (BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
S) XRec GhcPs [CmdLStmt GhcPs]
es

-- | Print a top-level command.
p_hsCmdTop :: BracketStyle -> HsCmdTop GhcPs -> R ()
p_hsCmdTop :: BracketStyle -> HsCmdTop GhcPs -> R ()
p_hsCmdTop BracketStyle
s (HsCmdTop XCmdTop GhcPs
_ LHsCmd GhcPs
cmd) = forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
cmd (BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
s)

-- | Render an expression preserving blank lines between such consecutive
-- expressions found in the original source code.
withSpacing ::
  -- | Rendering function
  (a -> R ()) ->
  -- | Entity to render
  LocatedAn ann a ->
  R ()
withSpacing :: forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing a -> R ()
f LocatedAn ann a
l = forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedAn ann a
l forall a b. (a -> b) -> a -> b
$ \a
x -> do
  case forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedAn ann a
l of
    UnhelpfulSpan UnhelpfulSpanReason
_ -> a -> R ()
f a
x
    RealSrcSpan RealSrcSpan
currentSpn Maybe BufSpan
_ -> do
      R (Maybe SpanMark)
getSpanMark forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        -- Spacing before comments will be handled by the code
        -- that prints comments, so we just have to deal with
        -- blank lines between statements here.
        Just (StatementSpan RealSrcSpan
lastSpn) ->
          if RealSrcSpan -> ConTag
srcSpanStartLine RealSrcSpan
currentSpn forall a. Ord a => a -> a -> Bool
> RealSrcSpan -> ConTag
srcSpanEndLine RealSrcSpan
lastSpn forall a. Num a => a -> a -> a
+ ConTag
1
            then R ()
newline
            else forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Maybe SpanMark
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      a -> R ()
f a
x
      -- In some cases the (f x) expression may insert a new mark. We want
      -- to be careful not to override comment marks.
      R (Maybe SpanMark)
getSpanMark forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just (HaddockSpan HaddockStyle
_ RealSrcSpan
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (CommentSpan RealSrcSpan
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Maybe SpanMark
_ -> SpanMark -> R ()
setSpanMark (RealSrcSpan -> SpanMark
StatementSpan RealSrcSpan
currentSpn)

p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt :: Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_stmt = forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
 Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
p_stmt' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr

p_stmt' ::
  ( Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
    Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL
  ) =>
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (body -> R ()) ->
  -- | Statement to render
  Stmt GhcPs (LocatedA body) ->
  R ()
p_stmt' :: forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
 Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render = \case
  LastStmt XLastStmt GhcPs GhcPs (LocatedA body)
_ LocatedA body
body Maybe Bool
_ SyntaxExpr GhcPs
_ -> forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
body body -> R ()
render
  BindStmt XBindStmt GhcPs GhcPs (LocatedA body)
_ LPat GhcPs
p f :: LocatedA body
f@(forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA -> SrcSpan
l) -> do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
p Pat GhcPs -> R ()
p_pat
    R ()
space
    Text -> R ()
txt Text
"<-"
    let loc :: SrcSpan
loc = forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
p
        placement :: Placement
placement
          | SrcSpan -> Bool
isOneLineSpan (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (SrcSpan -> SrcLoc
srcSpanEnd SrcSpan
loc) (SrcSpan -> SrcLoc
srcSpanStart SrcSpan
l)) = body -> Placement
placer (forall l e. GenLocated l e -> e
unLoc LocatedA body
f)
          | Bool
otherwise = Placement
Normal
    [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
loc, SrcSpan
l] forall a b. (a -> b) -> a -> b
$
      Placement -> R () -> R ()
placeHanging Placement
placement (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
f body -> R ()
render)
  ApplicativeStmt {} -> forall a. String -> a
notImplemented String
"ApplicativeStmt" -- generated by renamer
  BodyStmt XBodyStmt GhcPs GhcPs (LocatedA body)
_ LocatedA body
body SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ -> forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
body body -> R ()
render
  LetStmt XLetStmt GhcPs GhcPs (LocatedA body)
_ HsLocalBinds GhcPs
binds -> do
    Text -> R ()
txt Text
"let"
    R ()
space
    R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ HsLocalBinds GhcPs -> R ()
p_hsLocalBinds HsLocalBinds GhcPs
binds
  ParStmt {} ->
    -- 'ParStmt' should always be eliminated in 'gatherStmt' already, such
    -- that it never occurs in 'p_stmt''. Consequently, handling it here
    -- would be redundant.
    forall a. String -> a
notImplemented String
"ParStmt"
  TransStmt {[(IdP GhcPs, IdP GhcPs)]
[GuardLStmt GhcPs]
Maybe (XRec GhcPs (HsExpr GhcPs))
TransForm
HsExpr GhcPs
SyntaxExpr GhcPs
XRec GhcPs (HsExpr GhcPs)
XTransStmt GhcPs GhcPs (LocatedA body)
trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
trS_fmap :: HsExpr GhcPs
trS_bind :: SyntaxExpr GhcPs
trS_ret :: SyntaxExpr GhcPs
trS_by :: Maybe (XRec GhcPs (HsExpr GhcPs))
trS_using :: XRec GhcPs (HsExpr GhcPs)
trS_bndrs :: [(IdP GhcPs, IdP GhcPs)]
trS_stmts :: [GuardLStmt GhcPs]
trS_form :: TransForm
trS_ext :: XTransStmt GhcPs GhcPs (LocatedA body)
..} ->
    -- 'TransStmt' only needs to account for render printing itself, since
    -- pretty printing of relevant statements (e.g., in 'trS_stmts') is
    -- handled through 'gatherStmt'.
    case (TransForm
trS_form, Maybe (XRec GhcPs (HsExpr GhcPs))
trS_by) of
      (TransForm
ThenForm, Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
Nothing) -> do
        Text -> R ()
txt Text
"then"
        R ()
breakpoint
        R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
trS_using HsExpr GhcPs -> R ()
p_hsExpr
      (TransForm
ThenForm, Just GenLocated SrcSpanAnnA (HsExpr GhcPs)
e) -> do
        Text -> R ()
txt Text
"then"
        R ()
breakpoint
        R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
trS_using HsExpr GhcPs -> R ()
p_hsExpr
        R ()
breakpoint
        Text -> R ()
txt Text
"by"
        R ()
breakpoint
        R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
      (TransForm
GroupForm, Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
Nothing) -> do
        Text -> R ()
txt Text
"then group using"
        R ()
breakpoint
        R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
trS_using HsExpr GhcPs -> R ()
p_hsExpr
      (TransForm
GroupForm, Just GenLocated SrcSpanAnnA (HsExpr GhcPs)
e) -> do
        Text -> R ()
txt Text
"then group by"
        R ()
breakpoint
        R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
        R ()
breakpoint
        Text -> R ()
txt Text
"using"
        R ()
breakpoint
        R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
trS_using HsExpr GhcPs -> R ()
p_hsExpr
  RecStmt {[IdP GhcPs]
SyntaxExpr GhcPs
XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA body)]
XRecStmt GhcPs GhcPs (LocatedA body)
recS_ext :: forall idL idR body. StmtLR idL idR body -> XRecStmt idL idR body
recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_bind_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_ret_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_mfix_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_mfix_fn :: SyntaxExpr GhcPs
recS_ret_fn :: SyntaxExpr GhcPs
recS_bind_fn :: SyntaxExpr GhcPs
recS_rec_ids :: [IdP GhcPs]
recS_later_ids :: [IdP GhcPs]
recS_stmts :: XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA body)]
recS_ext :: XRecStmt GhcPs GhcPs (LocatedA body)
..} -> do
    Text -> R ()
txt Text
"rec"
    R ()
space
    R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA body)]
recS_stmts forall a b. (a -> b) -> a -> b
$ forall a. (a -> R ()) -> [a] -> R ()
sepSemi (forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing (forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
 Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render))

p_stmts ::
  ( Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
    Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL
  ) =>
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (body -> R ()) ->
  -- | Statements to render
  LocatedL [LocatedA (Stmt GhcPs (LocatedA body))] ->
  R ()
p_stmts :: forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
 Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ())
-> LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> R ()
p_stmts body -> Placement
placer body -> R ()
render LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
es = do
  R ()
breakpoint
  R () -> R ()
ub <- Layout -> R () -> R ()
layoutToBraces forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Layout
getLayout
  R () -> R ()
inci forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
es forall a b. (a -> b) -> a -> b
$
    forall a. (a -> R ()) -> [a] -> R ()
sepSemi
      (R () -> R ()
ub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing (forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
 Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render))

gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]
gatherStmt :: GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt (L SrcSpanAnnA
_ (ParStmt XParStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [ParStmtBlock GhcPs GhcPs]
block HsExpr GhcPs
_ SyntaxExpr GhcPs
_)) =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]]
gatherStmtBlock) [] [ParStmtBlock GhcPs GhcPs]
block
gatherStmt (L SrcSpanAnnA
s stmt :: StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
stmt@TransStmt {[(IdP GhcPs, IdP GhcPs)]
[GuardLStmt GhcPs]
Maybe (XRec GhcPs (HsExpr GhcPs))
TransForm
HsExpr GhcPs
SyntaxExpr GhcPs
XRec GhcPs (HsExpr GhcPs)
XTransStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
trS_fmap :: HsExpr GhcPs
trS_bind :: SyntaxExpr GhcPs
trS_ret :: SyntaxExpr GhcPs
trS_by :: Maybe (XRec GhcPs (HsExpr GhcPs))
trS_using :: XRec GhcPs (HsExpr GhcPs)
trS_bndrs :: [(IdP GhcPs, IdP GhcPs)]
trS_stmts :: [GuardLStmt GhcPs]
trS_form :: TransForm
trS_ext :: XTransStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
..}) =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend [] ((GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuardLStmt GhcPs]
trS_stmts) forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Applicative f => a -> f a
pure [[forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
s StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
stmt]])
gatherStmt GuardLStmt GhcPs
stmt = [[GuardLStmt GhcPs
stmt]]

gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[ExprLStmt GhcPs]]
gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]]
gatherStmtBlock (ParStmtBlock XParStmtBlock GhcPs GhcPs
_ [GuardLStmt GhcPs]
stmts [IdP GhcPs]
_ SyntaxExpr GhcPs
_) =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt) [] [GuardLStmt GhcPs]
stmts

p_hsLocalBinds :: HsLocalBinds GhcPs -> R ()
p_hsLocalBinds :: HsLocalBinds GhcPs -> R ()
p_hsLocalBinds = \case
  HsValBinds XHsValBinds GhcPs GhcPs
epAnn (ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
bag [LSig GhcPs]
lsigs) -> EpAnn AnnList -> R () -> R ()
pseudoLocated XHsValBinds GhcPs GhcPs
epAnn forall a b. (a -> b) -> a -> b
$ do
    -- When in a single-line layout, there is a chance that the inner
    -- elements will also contain semicolons and they will confuse the
    -- parser. so we request braces around every element except the last.
    R () -> R ()
br <- Layout -> R () -> R ()
layoutToBraces forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Layout
getLayout
    let items :: [GenLocated
   SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
items =
          let injectLeft :: GenLocated l a -> GenLocated l (Either a b)
injectLeft (L l
l a
x) = forall l e. l -> e -> GenLocated l e
L l
l (forall a b. a -> Either a b
Left a
x)
              injectRight :: GenLocated l b -> GenLocated l (Either a b)
injectRight (L l
l b
x) = forall l e. l -> e -> GenLocated l e
L l
l (forall a b. b -> Either a b
Right b
x)
           in (forall {l} {a} {b}. GenLocated l a -> GenLocated l (Either a b)
injectLeft forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
bag) forall a. [a] -> [a] -> [a]
++ (forall {l} {b} {a}. GenLocated l b -> GenLocated l (Either a b)
injectRight forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LSig GhcPs]
lsigs)
        positionToBracing :: RelativePos -> R () -> R ()
positionToBracing = \case
          RelativePos
SinglePos -> forall a. a -> a
id
          RelativePos
FirstPos -> R () -> R ()
br
          RelativePos
MiddlePos -> R () -> R ()
br
          RelativePos
LastPos -> forall a. a -> a
id
          RelativePos
FirstAfterDocPos -> R () -> R ()
br
        p_item' :: (RelativePos,
 GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> R ()
p_item' (RelativePos
p, GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
item) =
          RelativePos -> R () -> R ()
positionToBracing RelativePos
p forall a b. (a -> b) -> a -> b
$
            forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsBindLR GhcPs GhcPs -> R ()
p_valDecl Sig GhcPs -> R ()
p_sigDecl) GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
item
        binds :: [GenLocated
   SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
binds = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
leftmost_smallest forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) [GenLocated
   SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
items
    R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ forall a. (a -> R ()) -> [a] -> R ()
sepSemi (RelativePos,
 GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> R ()
p_item' (forall a. [a] -> [(RelativePos, a)]
attachRelativePos [GenLocated
   SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
binds)
  HsValBinds XHsValBinds GhcPs GhcPs
_ HsValBindsLR GhcPs GhcPs
_ -> forall a. String -> a
notImplemented String
"HsValBinds"
  HsIPBinds XHsIPBinds GhcPs GhcPs
epAnn (IPBinds XIPBinds GhcPs
_ [LIPBind GhcPs]
xs) -> EpAnn AnnList -> R () -> R ()
pseudoLocated XHsIPBinds GhcPs GhcPs
epAnn forall a b. (a -> b) -> a -> b
$ do
    -- Second argument of IPBind is always Left before type-checking.
    let p_ipBind :: IPBind GhcPs -> R ()
p_ipBind (IPBind XCIPBind GhcPs
_ (Left XRec GhcPs HsIPName
name) XRec GhcPs (HsExpr GhcPs)
expr) = do
          forall a. Outputable a => a -> R ()
atom XRec GhcPs HsIPName
name
          R ()
space
          R ()
equals
          R ()
breakpoint
          R () -> R ()
useBraces forall a b. (a -> b) -> a -> b
$ R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
        p_ipBind (IPBind XCIPBind GhcPs
_ (Right IdP GhcPs
_) XRec GhcPs (HsExpr GhcPs)
_) =
          -- Should only occur after the type checker
          forall a. String -> a
notImplemented String
"IPBind _ (Right _) _"
    forall a. (a -> R ()) -> [a] -> R ()
sepSemi (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' IPBind GhcPs -> R ()
p_ipBind) [LIPBind GhcPs]
xs
  EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    -- HsLocalBinds is no longer wrapped in a Located (see call sites
    -- of p_hsLocalBinds). Hence, we introduce a manual Located as we
    -- depend on the layout being correctly set.
    pseudoLocated :: EpAnn AnnList -> R () -> R ()
pseudoLocated = \case
      EpAnn {anns :: forall ann. EpAnn ann -> ann
anns = AnnList {al_anchor :: AnnList -> Maybe Anchor
al_anchor = Just Anchor {RealSrcSpan
anchor :: Anchor -> RealSrcSpan
anchor :: RealSrcSpan
anchor}}} ->
        forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (forall l e. l -> e -> GenLocated l e
L (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
anchor forall a. Maybe a
Nothing) ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
      EpAnn AnnList
_ -> forall a. a -> a
id

p_lhsFieldLabel :: Located (HsFieldLabel GhcPs) -> R ()
p_lhsFieldLabel :: Located (HsFieldLabel GhcPs) -> R ()
p_lhsFieldLabel = forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan FastString -> R ()
p_lFieldLabelString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. HsFieldLabel p -> GenLocated SrcSpan FastString
hflLabel
  where
    p_lFieldLabelString :: GenLocated SrcSpan FastString -> R ()
p_lFieldLabelString (L SrcSpan
s FastString
fs) = R () -> R ()
parensIfOp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> R ()
atom @FastString forall a b. (a -> b) -> a -> b
$ FastString
fs
      where
        -- HACK For OverloadedRecordUpdate:
        -- In operator field updates (i.e. `f {(+) = 1}`), we don't have
        -- information whether parens are necessary. As a workaround,
        -- we look if the RealSrcSpan is bigger than the string fs.
        parensIfOp :: R () -> R ()
parensIfOp
          | SrcSpan -> Bool
isOneLineSpan SrcSpan
s,
            Just RealSrcSpan
realS <- SrcSpan -> Maybe RealSrcSpan
srcSpanToRealSrcSpan SrcSpan
s,
            let spanLength :: ConTag
spanLength = RealSrcSpan -> ConTag
srcSpanEndCol RealSrcSpan
realS forall a. Num a => a -> a -> a
- RealSrcSpan -> ConTag
srcSpanStartCol RealSrcSpan
realS,
            FastString -> ConTag
lengthFS FastString
fs forall a. Ord a => a -> a -> Bool
< ConTag
spanLength =
              BracketStyle -> R () -> R ()
parens BracketStyle
N
          | Bool
otherwise = forall a. a -> a
id

p_fieldLabels :: [Located (HsFieldLabel GhcPs)] -> R ()
p_fieldLabels :: [Located (HsFieldLabel GhcPs)] -> R ()
p_fieldLabels [Located (HsFieldLabel GhcPs)]
flss =
  forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt Text
".") Located (HsFieldLabel GhcPs) -> R ()
p_lhsFieldLabel [Located (HsFieldLabel GhcPs)]
flss

p_hsRecField ::
  (id -> R ()) ->
  HsRecField' id (LHsExpr GhcPs) ->
  R ()
p_hsRecField :: forall id.
(id -> R ()) -> HsRecField' id (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_hsRecField id -> R ()
p_lbl HsRecField {Bool
XRec GhcPs (HsExpr GhcPs)
XHsRecField id
Located id
hsRecFieldAnn :: forall id arg. HsRecField' id arg -> XHsRecField id
hsRecFieldLbl :: forall id arg. HsRecField' id arg -> Located id
hsRecFieldArg :: forall id arg. HsRecField' id arg -> arg
hsRecPun :: forall id arg. HsRecField' id arg -> Bool
hsRecPun :: Bool
hsRecFieldArg :: XRec GhcPs (HsExpr GhcPs)
hsRecFieldLbl :: Located id
hsRecFieldAnn :: XHsRecField id
..} = do
  forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located Located id
hsRecFieldLbl id -> R ()
p_lbl
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hsRecPun forall a b. (a -> b) -> a -> b
$ do
    R ()
space
    R ()
equals
    let placement :: Placement
placement =
          if SrcSpan -> SrcSpan -> Bool
onTheSameLine (forall l e. GenLocated l e -> l
getLoc Located id
hsRecFieldLbl) (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA XRec GhcPs (HsExpr GhcPs)
hsRecFieldArg)
            then HsExpr GhcPs -> Placement
exprPlacement (forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
hsRecFieldArg)
            else Placement
Normal
    Placement -> R () -> R ()
placeHanging Placement
placement (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
hsRecFieldArg HsExpr GhcPs -> R ()
p_hsExpr)

p_hsExpr :: HsExpr GhcPs -> R ()
p_hsExpr :: HsExpr GhcPs -> R ()
p_hsExpr = BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
N

p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s = \case
  HsVar XVar GhcPs
_ LIdP GhcPs
name -> LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
name
  HsUnboundVar XUnboundVar GhcPs
_ OccName
occ -> forall a. Outputable a => a -> R ()
atom OccName
occ
  HsConLikeOut XConLikeOut GhcPs
_ ConLike
_ -> forall a. String -> a
notImplemented String
"HsConLikeOut"
  HsRecFld XRecFld GhcPs
_ AmbiguousFieldOcc GhcPs
x ->
    case AmbiguousFieldOcc GhcPs
x of
      Unambiguous XUnambiguous GhcPs
_ LocatedN RdrName
name -> LocatedN RdrName -> R ()
p_rdrName LocatedN RdrName
name
      Ambiguous XAmbiguous GhcPs
_ LocatedN RdrName
name -> LocatedN RdrName -> R ()
p_rdrName LocatedN RdrName
name
  HsOverLabel XOverLabel GhcPs
_ FastString
v -> do
    Text -> R ()
txt Text
"#"
    forall a. Outputable a => a -> R ()
atom FastString
v
  HsIPVar XIPVar GhcPs
_ (HsIPName FastString
name) -> do
    Text -> R ()
txt Text
"?"
    forall a. Outputable a => a -> R ()
atom FastString
name
  HsOverLit XOverLitE GhcPs
_ HsOverLit GhcPs
v -> forall a. Outputable a => a -> R ()
atom (forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit GhcPs
v)
  HsLit XLitE GhcPs
_ HsLit GhcPs
lit ->
    case HsLit GhcPs
lit of
      HsString (SourceText String
stxt) FastString
_ -> String -> R ()
p_stringLit String
stxt
      HsStringPrim (SourceText String
stxt) ByteString
_ -> String -> R ()
p_stringLit String
stxt
      HsLit GhcPs
r -> forall a. Outputable a => a -> R ()
atom HsLit GhcPs
r
  HsLam XLam GhcPs
_ MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup ->
    MatchGroupStyle
-> MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_matchGroup MatchGroupStyle
Lambda MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup
  HsLamCase XLamCase GhcPs
_ MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup ->
    forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ()) -> MatchGroup GhcPs (LocatedA body) -> R ()
p_lamcase HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup
  HsApp XApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
f XRec GhcPs (HsExpr GhcPs)
x -> do
    let -- In order to format function applications with multiple parameters
        -- nicer, traverse the AST to gather the function and all the
        -- parameters together.
        gatherArgs :: GenLocated l (HsExpr p)
-> NonEmpty (XRec p (HsExpr p))
-> (GenLocated l (HsExpr p), NonEmpty (XRec p (HsExpr p)))
gatherArgs GenLocated l (HsExpr p)
f' NonEmpty (XRec p (HsExpr p))
knownArgs =
          case GenLocated l (HsExpr p)
f' of
            L l
_ (HsApp XApp p
_ XRec p (HsExpr p)
l XRec p (HsExpr p)
r) -> GenLocated l (HsExpr p)
-> NonEmpty (XRec p (HsExpr p))
-> (GenLocated l (HsExpr p), NonEmpty (XRec p (HsExpr p)))
gatherArgs XRec p (HsExpr p)
l (XRec p (HsExpr p)
r forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty (XRec p (HsExpr p))
knownArgs)
            GenLocated l (HsExpr p)
_ -> (GenLocated l (HsExpr p)
f', NonEmpty (XRec p (HsExpr p))
knownArgs)
        (GenLocated SrcSpanAnnA (HsExpr GhcPs)
func, NonEmpty (XRec GhcPs (HsExpr GhcPs))
args) = forall {p} {l}.
(XRec p (HsExpr p) ~ GenLocated l (HsExpr p)) =>
GenLocated l (HsExpr p)
-> NonEmpty (XRec p (HsExpr p))
-> (GenLocated l (HsExpr p), NonEmpty (XRec p (HsExpr p)))
gatherArgs XRec GhcPs (HsExpr GhcPs)
f (XRec GhcPs (HsExpr GhcPs)
x forall a. a -> [a] -> NonEmpty a
:| [])
        -- We need to handle the last argument specially if it is a
        -- hanging construct, so separate it from the rest.
        ([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
initp, GenLocated SrcSpanAnnA (HsExpr GhcPs)
lastp) = (forall a. NonEmpty a -> [a]
NE.init NonEmpty (XRec GhcPs (HsExpr GhcPs))
args, forall a. NonEmpty a -> a
NE.last NonEmpty (XRec GhcPs (HsExpr GhcPs))
args)
        initSpan :: SrcSpan
initSpan =
          NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' forall a b. (a -> b) -> a -> b
$
            forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA XRec GhcPs (HsExpr GhcPs)
f forall a. a -> [a] -> NonEmpty a
:| [(SrcLoc -> SrcSpan
srcLocSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) GenLocated SrcSpanAnnA (HsExpr GhcPs)
lastp]
        -- Hang the last argument only if the initial arguments span one
        -- line.
        placement :: Placement
placement =
          if SrcSpan -> Bool
isOneLineSpan SrcSpan
initSpan
            then HsExpr GhcPs -> Placement
exprPlacement (forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
lastp)
            else Placement
Normal
    -- If the last argument is not hanging, just separate every argument as
    -- usual. If it is hanging, print the initial arguments and hang the
    -- last one. Also, use braces around the every argument except the last
    -- one.
    case Placement
placement of
      Placement
Normal -> do
        let -- Usually we want to bump indentation for arguments for the
            -- sake of readability. However:
            -- When the function is itself a multi line do-block or a case
            -- expression, we can't indent by indentStep or more.
            -- When we are on the other hand *in* a do block, we have to
            -- indent by at least 1.
            -- Thus, we indent by half of indentStep when the function is
            -- a multi line do block or case expression.
            indentArg :: R () -> R ()
indentArg
              | SrcSpan -> Bool
isOneLineSpan (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (HsExpr GhcPs)
func) = case forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
func of
                  HsDo {} -> ConTag -> R () -> R ()
inciBy ConTag
2
                  HsExpr GhcPs
_ -> R () -> R ()
inci
              | Bool
otherwise = case forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
func of
                  HsDo {} -> R () -> R ()
inciHalf
                  HsCase {} -> R () -> R ()
inciHalf
                  HsLamCase {} -> R () -> R ()
inciHalf
                  HsExpr GhcPs
_ -> R () -> R ()
inci
        R () -> R ()
ub <-
          R Layout
getLayout forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            Layout
SingleLine -> R () -> R ()
useBraces
            Layout
MultiLine -> forall a. a -> a
id
        R () -> R ()
ub forall a b. (a -> b) -> a -> b
$ do
          forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
func (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
          R ()
breakpoint
          R () -> R ()
indentArg forall a b. (a -> b) -> a -> b
$ forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
initp
        R () -> R ()
indentArg forall a b. (a -> b) -> a -> b
$ do
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
initp) R ()
breakpoint
          forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
lastp HsExpr GhcPs -> R ()
p_hsExpr
      Placement
Hanging -> do
        R () -> R ()
useBraces forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
initSpan] forall a b. (a -> b) -> a -> b
$ do
          forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
func (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
          R ()
breakpoint
          forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
initp
        Placement -> R () -> R ()
placeHanging Placement
placement forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
dontUseBraces forall a b. (a -> b) -> a -> b
$
          forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
lastp HsExpr GhcPs -> R ()
p_hsExpr
  HsAppType XAppTypeE GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e LHsWcType (NoGhcTc GhcPs)
a -> do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
    R ()
breakpoint
    R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
      Text -> R ()
txt Text
"@"
      -- Insert a space when the type is represented as a TH splice to avoid
      -- gluing @ and $ together.
      case forall l e. GenLocated l e -> e
unLoc (forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsWcType (NoGhcTc GhcPs)
a) of
        HsSpliceTy {} -> R ()
space
        HsType GhcPs
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsWcType (NoGhcTc GhcPs)
a) HsType GhcPs -> R ()
p_hsType
  OpApp XOpApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
x XRec GhcPs (HsExpr GhcPs)
op XRec GhcPs (HsExpr GhcPs)
y -> do
    FixityMap
fixityOverrides <- R FixityMap
askFixityOverrides
    LazyFixityMap
fixityMap <- R LazyFixityMap
askFixityMap
    let opTree :: OpTree
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
opTree = forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches [XRec GhcPs (HsExpr GhcPs)
-> OpTree (XRec GhcPs (HsExpr GhcPs)) (XRec GhcPs (HsExpr GhcPs))
exprOpTree XRec GhcPs (HsExpr GhcPs)
x, XRec GhcPs (HsExpr GhcPs)
-> OpTree (XRec GhcPs (HsExpr GhcPs)) (XRec GhcPs (HsExpr GhcPs))
exprOpTree XRec GhcPs (HsExpr GhcPs)
y] [XRec GhcPs (HsExpr GhcPs)
op]
    BracketStyle
-> OpTree
     (XRec GhcPs (HsExpr GhcPs)) (OpInfo (XRec GhcPs (HsExpr GhcPs)))
-> R ()
p_exprOpTree
      BracketStyle
s
      (forall op ty.
(op -> Maybe RdrName)
-> FixityMap
-> LazyFixityMap
-> OpTree ty op
-> OpTree ty (OpInfo op)
reassociateOpTree (HsExpr GhcPs -> Maybe RdrName
getOpName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) FixityMap
fixityOverrides LazyFixityMap
fixityMap OpTree
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
opTree)
  NegApp XNegApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e SyntaxExpr GhcPs
_ -> do
    Bool
negativeLiterals <- Extension -> R Bool
isExtensionEnabled Extension
NegativeLiterals
    let isLiteral :: Bool
isLiteral = case forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
e of
          HsLit {} -> Bool
True
          HsOverLit {} -> Bool
True
          HsExpr GhcPs
_ -> Bool
False
    Text -> R ()
txt Text
"-"
    -- If NegativeLiterals is enabled, we have to insert a space before
    -- negated literals, as `- 1` and `-1` have differing AST.
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
negativeLiterals Bool -> Bool -> Bool
&& Bool
isLiteral) R ()
space
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
  HsPar XPar GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e ->
    BracketStyle -> R () -> R ()
parens BracketStyle
s forall a b. (a -> b) -> a -> b
$ R () -> R ()
sitcc (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
e (R () -> R ()
dontUseBraces forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr))
  SectionL XSectionL GhcPs
_ XRec GhcPs (HsExpr GhcPs)
x XRec GhcPs (HsExpr GhcPs)
op -> do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr
    R ()
breakpoint
    R () -> R ()
inci (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
op HsExpr GhcPs -> R ()
p_hsExpr)
  SectionR XSectionR GhcPs
_ XRec GhcPs (HsExpr GhcPs)
op XRec GhcPs (HsExpr GhcPs)
x -> do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
op HsExpr GhcPs -> R ()
p_hsExpr
    R ()
breakpoint
    R () -> R ()
inci (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr)
  ExplicitTuple XExplicitTuple GhcPs
_ [HsTupArg GhcPs]
args Boxity
boxity -> do
    let isSection :: Bool
isSection = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall {id}. HsTupArg id -> Bool
isMissing [HsTupArg GhcPs]
args
        isMissing :: HsTupArg id -> Bool
isMissing = \case
          Missing XMissing id
_ -> Bool
True
          HsTupArg id
_ -> Bool
False
        p_arg :: HsTupArg GhcPs -> R ()
p_arg =
          R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
            Present XPresent GhcPs
_ XRec GhcPs (HsExpr GhcPs)
x -> forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExprListItem
            Missing XMissing GhcPs
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        parens' :: BracketStyle -> R () -> R ()
parens' =
          case Boxity
boxity of
            Boxity
Boxed -> BracketStyle -> R () -> R ()
parens
            Boxity
Unboxed -> BracketStyle -> R () -> R ()
parensHash
    [SrcSpan]
enclSpan <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan forall a. Maybe a
Nothing) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> [a]
maybeToList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RealSrcSpan -> Bool) -> R (Maybe RealSrcSpan)
getEnclosingSpan (forall a b. a -> b -> a
const Bool
True)
    if Bool
isSection
      then
        [SrcSpan] -> R () -> R ()
switchLayout [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s forall a b. (a -> b) -> a -> b
$
          forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
comma HsTupArg GhcPs -> R ()
p_arg [HsTupArg GhcPs]
args
      else
        [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
enclSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s forall a b. (a -> b) -> a -> b
$
          forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel HsTupArg GhcPs -> R ()
p_arg [HsTupArg GhcPs]
args
  ExplicitSum XExplicitSum GhcPs
_ ConTag
tag ConTag
arity XRec GhcPs (HsExpr GhcPs)
e ->
    BracketStyle -> ConTag -> ConTag -> R () -> R ()
p_unboxedSum BracketStyle
N ConTag
tag ConTag
arity (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr)
  HsCase XCase GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup ->
    forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_case HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup
  HsIf XIf GhcPs
_ XRec GhcPs (HsExpr GhcPs)
if' XRec GhcPs (HsExpr GhcPs)
then' XRec GhcPs (HsExpr GhcPs)
else' ->
    forall body.
(body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> LocatedA body
-> LocatedA body
-> R ()
p_if HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr XRec GhcPs (HsExpr GhcPs)
if' XRec GhcPs (HsExpr GhcPs)
then' XRec GhcPs (HsExpr GhcPs)
else'
  HsMultiIf XMultiIf GhcPs
_ [LGRHS GhcPs (XRec GhcPs (HsExpr GhcPs))]
guards -> do
    Text -> R ()
txt Text
"if"
    R ()
breakpoint
    R () -> R ()
inci forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (GroupStyle -> GRHS GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_grhs GroupStyle
RightArrow)) [LGRHS GhcPs (XRec GhcPs (HsExpr GhcPs))]
guards
  HsLet XLet GhcPs
_ HsLocalBinds GhcPs
localBinds XRec GhcPs (HsExpr GhcPs)
e ->
    forall body.
(body -> R ()) -> HsLocalBinds GhcPs -> LocatedA body -> R ()
p_let HsExpr GhcPs -> R ()
p_hsExpr HsLocalBinds GhcPs
localBinds XRec GhcPs (HsExpr GhcPs)
e
  HsDo XDo GhcPs
_ HsStmtContext (HsDoRn GhcPs)
ctx XRec GhcPs [GuardLStmt GhcPs]
es -> do
    let doBody :: Maybe ModuleName -> Text -> R ()
doBody Maybe ModuleName
moduleName Text
header = do
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ModuleName
moduleName forall a b. (a -> b) -> a -> b
$ \ModuleName
m -> forall a. Outputable a => a -> R ()
atom ModuleName
m forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> R ()
txt Text
"."
          Text -> R ()
txt Text
header
          forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
 Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ())
-> LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> R ()
p_stmts HsExpr GhcPs -> Placement
exprPlacement (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
S) XRec GhcPs [GuardLStmt GhcPs]
es
        compBody :: R ()
compBody = BracketStyle -> R () -> R ()
brackets BracketStyle
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs [GuardLStmt GhcPs]
es forall a b. (a -> b) -> a -> b
$ \[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs -> do
          let p_parBody :: [[GenLocated
    SrcSpanAnnA
    (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> R ()
p_parBody =
                forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
                  (R ()
breakpoint forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space)
                  [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
p_seqBody
              p_seqBody :: [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
p_seqBody =
                R () -> R ()
sitccIfTrailing
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
                    R ()
commaDel
                    (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_stmt))
              stmts :: [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts = forall a. [a] -> [a]
init [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
              yield :: GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
yield = forall a. [a] -> a
last [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
              lists :: [[GenLocated
    SrcSpanAnnA
    (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
lists = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt) [] [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts
          forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
yield Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_stmt
          R ()
breakpoint
          Text -> R ()
txt Text
"|"
          R ()
space
          [[GenLocated
    SrcSpanAnnA
    (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> R ()
p_parBody [[GenLocated
    SrcSpanAnnA
    (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
lists
    case HsStmtContext (HsDoRn GhcPs)
ctx of
      DoExpr Maybe ModuleName
moduleName -> Maybe ModuleName -> Text -> R ()
doBody Maybe ModuleName
moduleName Text
"do"
      MDoExpr Maybe ModuleName
moduleName -> Maybe ModuleName -> Text -> R ()
doBody Maybe ModuleName
moduleName Text
"mdo"
      HsStmtContext (HsDoRn GhcPs)
ListComp -> R ()
compBody
      HsStmtContext (HsDoRn GhcPs)
MonadComp -> R ()
compBody
      HsStmtContext (HsDoRn GhcPs)
ArrowExpr -> forall a. String -> a
notImplemented String
"ArrowExpr"
      HsStmtContext (HsDoRn GhcPs)
GhciStmtCtxt -> forall a. String -> a
notImplemented String
"GhciStmtCtxt"
      PatGuard HsMatchContext (HsDoRn GhcPs)
_ -> forall a. String -> a
notImplemented String
"PatGuard"
      ParStmtCtxt HsStmtContext (HsDoRn GhcPs)
_ -> forall a. String -> a
notImplemented String
"ParStmtCtxt"
      TransStmtCtxt HsStmtContext (HsDoRn GhcPs)
_ -> forall a. String -> a
notImplemented String
"TransStmtCtxt"
  ExplicitList XExplicitList GhcPs
_ [XRec GhcPs (HsExpr GhcPs)]
xs ->
    BracketStyle -> R () -> R ()
brackets BracketStyle
s forall a b. (a -> b) -> a -> b
$
      forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExprListItem) [XRec GhcPs (HsExpr GhcPs)]
xs
  RecordCon {HsRecordBinds GhcPs
XRec GhcPs (ConLikeP GhcPs)
XRecordCon GhcPs
rcon_ext :: forall p. HsExpr p -> XRecordCon p
rcon_con :: forall p. HsExpr p -> XRec p (ConLikeP p)
rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_flds :: HsRecordBinds GhcPs
rcon_con :: XRec GhcPs (ConLikeP GhcPs)
rcon_ext :: XRecordCon GhcPs
..} -> do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (ConLikeP GhcPs)
rcon_con forall a. Outputable a => a -> R ()
atom
    R ()
breakpointPreRecordBrace
    let HsRecFields {[LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
Maybe (Located ConTag)
rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (Located ConTag)
rec_dotdot :: Maybe (Located ConTag)
rec_flds :: [LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
..} = HsRecordBinds GhcPs
rcon_flds
        p_lbl :: FieldOcc pass -> R ()
p_lbl = LocatedN RdrName -> R ()
p_rdrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. FieldOcc pass -> LocatedN RdrName
rdrNameFieldOcc
        fields :: [R ()]
fields = forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (forall id.
(id -> R ()) -> HsRecField' id (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_hsRecField forall {pass}. FieldOcc pass -> R ()
p_lbl) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
rec_flds
        dotdot :: [R ()]
dotdot =
          case Maybe (Located ConTag)
rec_dotdot of
            Just {} -> [Text -> R ()
txt Text
".."]
            Maybe (Located ConTag)
Nothing -> []
    R () -> R ()
inci forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N forall a b. (a -> b) -> a -> b
$
      forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel R () -> R ()
sitcc ([R ()]
fields forall a. Semigroup a => a -> a -> a
<> [R ()]
dotdot)
  RecordUpd {Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
XRec GhcPs (HsExpr GhcPs)
XRecordUpd GhcPs
rupd_ext :: forall p. HsExpr p -> XRecordUpd p
rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_flds :: forall p. HsExpr p -> Either [LHsRecUpdField p] [LHsRecUpdProj p]
rupd_flds :: Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
rupd_expr :: XRec GhcPs (HsExpr GhcPs)
rupd_ext :: XRecordUpd GhcPs
..} -> do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
rupd_expr HsExpr GhcPs -> R ()
p_hsExpr
    R ()
breakpointPreRecordBrace
    let p_updLbl :: AmbiguousFieldOcc GhcPs -> R ()
p_updLbl =
          LocatedN RdrName -> R ()
p_rdrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
            Unambiguous NoExtField
XUnambiguous GhcPs
NoExtField LocatedN RdrName
n -> LocatedN RdrName
n
            Ambiguous NoExtField
XAmbiguous GhcPs
NoExtField LocatedN RdrName
n -> LocatedN RdrName
n
        p_recFields :: (id -> R ())
-> [GenLocated
      l (HsRecField' id (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
p_recFields id -> R ()
p_lbl =
          forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (forall id.
(id -> R ()) -> HsRecField' id (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_hsRecField id -> R ()
p_lbl))
    R () -> R ()
inci forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N forall a b. (a -> b) -> a -> b
$
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (forall {l} {id}.
HasSrcSpan l =>
(id -> R ())
-> [GenLocated
      l (HsRecField' id (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
p_recFields AmbiguousFieldOcc GhcPs -> R ()
p_updLbl)
        (forall {l} {id}.
HasSrcSpan l =>
(id -> R ())
-> [GenLocated
      l (HsRecField' id (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
p_recFields ([Located (HsFieldLabel GhcPs)] -> R ()
p_fieldLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce))
        Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
rupd_flds
  HsGetField {XRec GhcPs (HsExpr GhcPs)
XGetField GhcPs
Located (HsFieldLabel GhcPs)
gf_ext :: forall p. HsExpr p -> XGetField p
gf_expr :: forall p. HsExpr p -> LHsExpr p
gf_field :: forall p. HsExpr p -> Located (HsFieldLabel p)
gf_field :: Located (HsFieldLabel GhcPs)
gf_expr :: XRec GhcPs (HsExpr GhcPs)
gf_ext :: XGetField GhcPs
..} -> do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
gf_expr HsExpr GhcPs -> R ()
p_hsExpr
    Text -> R ()
txt Text
"."
    Located (HsFieldLabel GhcPs) -> R ()
p_lhsFieldLabel Located (HsFieldLabel GhcPs)
gf_field
  HsProjection {NonEmpty (Located (HsFieldLabel GhcPs))
XProjection GhcPs
proj_ext :: forall p. HsExpr p -> XProjection p
proj_flds :: forall p. HsExpr p -> NonEmpty (Located (HsFieldLabel p))
proj_flds :: NonEmpty (Located (HsFieldLabel GhcPs))
proj_ext :: XProjection GhcPs
..} -> BracketStyle -> R () -> R ()
parens BracketStyle
N forall a b. (a -> b) -> a -> b
$ do
    Text -> R ()
txt Text
"."
    [Located (HsFieldLabel GhcPs)] -> R ()
p_fieldLabels (forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Located (HsFieldLabel GhcPs))
proj_flds)
  ExprWithTySig XExprWithTySig GhcPs
_ XRec GhcPs (HsExpr GhcPs)
x HsWC {LHsSigType (NoGhcTc GhcPs)
hswc_body :: LHsSigType (NoGhcTc GhcPs)
hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body} -> R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr
    R ()
space
    Text -> R ()
txt Text
"::"
    R ()
breakpoint
    R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsSigType (NoGhcTc GhcPs)
hswc_body HsSigType GhcPs -> R ()
p_hsSigType
  ArithSeq XArithSeq GhcPs
_ Maybe (SyntaxExpr GhcPs)
_ ArithSeqInfo GhcPs
x ->
    case ArithSeqInfo GhcPs
x of
      From XRec GhcPs (HsExpr GhcPs)
from -> BracketStyle -> R () -> R ()
brackets BracketStyle
s forall a b. (a -> b) -> a -> b
$ do
        forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
from HsExpr GhcPs -> R ()
p_hsExpr
        R ()
breakpoint
        Text -> R ()
txt Text
".."
      FromThen XRec GhcPs (HsExpr GhcPs)
from XRec GhcPs (HsExpr GhcPs)
next -> BracketStyle -> R () -> R ()
brackets BracketStyle
s forall a b. (a -> b) -> a -> b
$ do
        forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [XRec GhcPs (HsExpr GhcPs)
from, XRec GhcPs (HsExpr GhcPs)
next]
        R ()
breakpoint
        Text -> R ()
txt Text
".."
      FromTo XRec GhcPs (HsExpr GhcPs)
from XRec GhcPs (HsExpr GhcPs)
to -> BracketStyle -> R () -> R ()
brackets BracketStyle
s forall a b. (a -> b) -> a -> b
$ do
        forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
from HsExpr GhcPs -> R ()
p_hsExpr
        R ()
breakpoint
        Text -> R ()
txt Text
".."
        R ()
space
        forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
to HsExpr GhcPs -> R ()
p_hsExpr
      FromThenTo XRec GhcPs (HsExpr GhcPs)
from XRec GhcPs (HsExpr GhcPs)
next XRec GhcPs (HsExpr GhcPs)
to -> BracketStyle -> R () -> R ()
brackets BracketStyle
s forall a b. (a -> b) -> a -> b
$ do
        forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [XRec GhcPs (HsExpr GhcPs)
from, XRec GhcPs (HsExpr GhcPs)
next]
        R ()
breakpoint
        Text -> R ()
txt Text
".."
        R ()
space
        forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
to HsExpr GhcPs -> R ()
p_hsExpr
  HsBracket XBracket GhcPs
epAnn HsBracket GhcPs
x -> EpAnn [AddEpAnn] -> HsBracket GhcPs -> R ()
p_hsBracket XBracket GhcPs
epAnn HsBracket GhcPs
x
  HsRnBracketOut {} -> forall a. String -> a
notImplemented String
"HsRnBracketOut"
  HsTcBracketOut {} -> forall a. String -> a
notImplemented String
"HsTcBracketOut"
  HsSpliceE XSpliceE GhcPs
_ HsSplice GhcPs
splice -> HsSplice GhcPs -> R ()
p_hsSplice HsSplice GhcPs
splice
  HsProc XProc GhcPs
_ LPat GhcPs
p LHsCmdTop GhcPs
e -> do
    Text -> R ()
txt Text
"proc"
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
p forall a b. (a -> b) -> a -> b
$ \Pat GhcPs
x -> do
      R ()
breakpoint
      R () -> R ()
inci (Pat GhcPs -> R ()
p_pat Pat GhcPs
x)
      R ()
breakpoint
    Text -> R ()
txt Text
"->"
    Placement -> R () -> R ()
placeHanging (HsCmdTop GhcPs -> Placement
cmdTopPlacement (forall l e. GenLocated l e -> e
unLoc LHsCmdTop GhcPs
e)) forall a b. (a -> b) -> a -> b
$
      forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
e (BracketStyle -> HsCmdTop GhcPs -> R ()
p_hsCmdTop BracketStyle
N)
  HsStatic XStatic GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e -> do
    Text -> R ()
txt Text
"static"
    R ()
breakpoint
    R () -> R ()
inci (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr)
  HsTick {} -> forall a. String -> a
notImplemented String
"HsTick"
  HsBinTick {} -> forall a. String -> a
notImplemented String
"HsBinTick"
  HsPragE XPragE GhcPs
_ HsPragE GhcPs
prag XRec GhcPs (HsExpr GhcPs)
x -> case HsPragE GhcPs
prag of
    HsPragSCC XSCC GhcPs
_ SourceText
_ StringLiteral
name -> do
      Text -> R ()
txt Text
"{-# SCC "
      forall a. Outputable a => a -> R ()
atom StringLiteral
name
      Text -> R ()
txt Text
" #-}"
      R ()
breakpoint
      forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr

p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PSB {HsPatSynDir GhcPs
HsPatSynDetails GhcPs
LPat GhcPs
LIdP GhcPs
XPSB GhcPs GhcPs
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_dir :: HsPatSynDir GhcPs
psb_def :: LPat GhcPs
psb_args :: HsPatSynDetails GhcPs
psb_id :: LIdP GhcPs
psb_ext :: XPSB GhcPs GhcPs
..} = do
  let rhs :: [SrcSpan] -> R ()
rhs [SrcSpan]
conSpans = do
        R ()
space
        let pattern_def_spans :: [SrcSpan]
pattern_def_spans = [forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
psb_id, forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
psb_def] forall a. [a] -> [a] -> [a]
++ [SrcSpan]
conSpans
        case HsPatSynDir GhcPs
psb_dir of
          HsPatSynDir GhcPs
Unidirectional ->
            [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
pattern_def_spans forall a b. (a -> b) -> a -> b
$ do
              Text -> R ()
txt Text
"<-"
              R ()
breakpoint
              forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
psb_def Pat GhcPs -> R ()
p_pat
          HsPatSynDir GhcPs
ImplicitBidirectional ->
            [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
pattern_def_spans forall a b. (a -> b) -> a -> b
$ do
              R ()
equals
              R ()
breakpoint
              forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
psb_def Pat GhcPs -> R ()
p_pat
          ExplicitBidirectional MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup -> do
            [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
pattern_def_spans forall a b. (a -> b) -> a -> b
$ do
              Text -> R ()
txt Text
"<-"
              R ()
breakpoint
              forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
psb_def Pat GhcPs -> R ()
p_pat
            R ()
breakpoint
            Text -> R ()
txt Text
"where"
            R ()
breakpoint
            R () -> R ()
inci (MatchGroupStyle
-> MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_matchGroup (LocatedN RdrName -> MatchGroupStyle
Function LIdP GhcPs
psb_id) MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup)
  Text -> R ()
txt Text
"pattern"
  case HsPatSynDetails GhcPs
psb_args of
    PrefixCon [] [LIdP GhcPs]
xs -> do
      R ()
space
      LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
psb_id
      R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
        let conSpans :: [SrcSpan]
conSpans = forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LIdP GhcPs]
xs
        [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conSpans forall a b. (a -> b) -> a -> b
$ do
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIdP GhcPs]
xs) R ()
breakpoint
          R () -> R ()
sitcc (forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint LocatedN RdrName -> R ()
p_rdrName [LIdP GhcPs]
xs)
        [SrcSpan] -> R ()
rhs [SrcSpan]
conSpans
    PrefixCon (Void
v : [Void]
_) [LIdP GhcPs]
_ -> forall a. Void -> a
absurd Void
v
    RecCon [RecordPatSynField GhcPs]
xs -> do
      R ()
space
      LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
psb_id
      R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
        let conSpans :: [SrcSpan]
conSpans = forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. RecordPatSynField pass -> LIdP pass
recordPatSynPatVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RecordPatSynField GhcPs]
xs
        [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conSpans forall a b. (a -> b) -> a -> b
$ do
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RecordPatSynField GhcPs]
xs) R ()
breakpointPreRecordBrace
          BracketStyle -> R () -> R ()
braces BracketStyle
N forall a b. (a -> b) -> a -> b
$
            forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (LocatedN RdrName -> R ()
p_rdrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. RecordPatSynField pass -> LIdP pass
recordPatSynPatVar) [RecordPatSynField GhcPs]
xs
        [SrcSpan] -> R ()
rhs [SrcSpan]
conSpans
    InfixCon LIdP GhcPs
l LIdP GhcPs
r -> do
      let conSpans :: [SrcSpan]
conSpans = [forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
l, forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
r]
      [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conSpans forall a b. (a -> b) -> a -> b
$ do
        R ()
space
        LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
l
        R ()
breakpoint
        R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
          LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
psb_id
          R ()
space
          LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
r
      R () -> R ()
inci ([SrcSpan] -> R ()
rhs [SrcSpan]
conSpans)

p_case ::
  ( Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
    Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
  ) =>
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (body -> R ()) ->
  -- | Expression
  LHsExpr GhcPs ->
  -- | Match group
  MatchGroup GhcPs (LocatedA body) ->
  R ()
p_case :: forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_case body -> Placement
placer body -> R ()
render XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (LocatedA body)
mgroup = do
  Text -> R ()
txt Text
"case"
  R ()
space
  forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
  R ()
space
  Text -> R ()
txt Text
"of"
  R ()
breakpoint
  R () -> R ()
inci (forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
Case MatchGroup GhcPs (LocatedA body)
mgroup)

p_lamcase ::
  ( Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
    Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
  ) =>
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (body -> R ()) ->
  -- | Expression
  MatchGroup GhcPs (LocatedA body) ->
  R ()
p_lamcase :: forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ()) -> MatchGroup GhcPs (LocatedA body) -> R ()
p_lamcase body -> Placement
placer body -> R ()
render MatchGroup GhcPs (LocatedA body)
mgroup = do
  Text -> R ()
txt Text
"\\case"
  R ()
breakpoint
  R () -> R ()
inci (forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
LambdaCase MatchGroup GhcPs (LocatedA body)
mgroup)

p_if ::
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (body -> R ()) ->
  -- | If
  LHsExpr GhcPs ->
  -- | Then
  LocatedA body ->
  -- | Else
  LocatedA body ->
  R ()
p_if :: forall body.
(body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> LocatedA body
-> LocatedA body
-> R ()
p_if body -> Placement
placer body -> R ()
render XRec GhcPs (HsExpr GhcPs)
if' LocatedA body
then' LocatedA body
else' = do
  Text -> R ()
txt Text
"if"
  R ()
space
  forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
if' HsExpr GhcPs -> R ()
p_hsExpr
  R ()
breakpoint
  R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
    Text -> R ()
txt Text
"then"
    R ()
space
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
then' forall a b. (a -> b) -> a -> b
$ \body
x ->
      Placement -> R () -> R ()
placeHanging (body -> Placement
placer body
x) (body -> R ()
render body
x)
    R ()
breakpoint
    Text -> R ()
txt Text
"else"
    R ()
space
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
else' forall a b. (a -> b) -> a -> b
$ \body
x ->
      Placement -> R () -> R ()
placeHanging (body -> Placement
placer body
x) (body -> R ()
render body
x)

p_let ::
  -- | Render
  (body -> R ()) ->
  HsLocalBinds GhcPs ->
  LocatedA body ->
  R ()
p_let :: forall body.
(body -> R ()) -> HsLocalBinds GhcPs -> LocatedA body -> R ()
p_let body -> R ()
render HsLocalBinds GhcPs
localBinds LocatedA body
e = R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ do
  Text -> R ()
txt Text
"let"
  R ()
space
  R () -> R ()
dontUseBraces forall a b. (a -> b) -> a -> b
$ R () -> R ()
sitcc (HsLocalBinds GhcPs -> R ()
p_hsLocalBinds HsLocalBinds GhcPs
localBinds)
  forall a. R a -> R a -> R a
vlayout R ()
space (R ()
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
" ")
  Text -> R ()
txt Text
"in"
  R ()
space
  R () -> R ()
sitcc (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
e body -> R ()
render)

p_pat :: Pat GhcPs -> R ()
p_pat :: Pat GhcPs -> R ()
p_pat = \case
  WildPat XWildPat GhcPs
_ -> Text -> R ()
txt Text
"_"
  VarPat XVarPat GhcPs
_ LIdP GhcPs
name -> LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
name
  LazyPat XLazyPat GhcPs
_ LPat GhcPs
pat -> do
    Text -> R ()
txt Text
"~"
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
pat Pat GhcPs -> R ()
p_pat
  AsPat XAsPat GhcPs
_ LIdP GhcPs
name LPat GhcPs
pat -> do
    LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
name
    Text -> R ()
txt Text
"@"
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
pat Pat GhcPs -> R ()
p_pat
  ParPat XParPat GhcPs
_ LPat GhcPs
pat ->
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
pat (BracketStyle -> R () -> R ()
parens BracketStyle
S forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat GhcPs -> R ()
p_pat)
  BangPat XBangPat GhcPs
_ LPat GhcPs
pat -> do
    Text -> R ()
txt Text
"!"
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
pat Pat GhcPs -> R ()
p_pat
  ListPat XListPat GhcPs
_ [LPat GhcPs]
pats ->
    BracketStyle -> R () -> R ()
brackets BracketStyle
S forall a b. (a -> b) -> a -> b
$ forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
pats
  TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
pats Boxity
boxing -> do
    let parens' :: R () -> R ()
parens' =
          case Boxity
boxing of
            Boxity
Boxed -> BracketStyle -> R () -> R ()
parens BracketStyle
S
            Boxity
Unboxed -> BracketStyle -> R () -> R ()
parensHash BracketStyle
S
    R () -> R ()
parens' forall a b. (a -> b) -> a -> b
$ forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
pats
  SumPat XSumPat GhcPs
_ LPat GhcPs
pat ConTag
tag ConTag
arity ->
    BracketStyle -> ConTag -> ConTag -> R () -> R ()
p_unboxedSum BracketStyle
S ConTag
tag ConTag
arity (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
pat Pat GhcPs -> R ()
p_pat)
  ConPat XConPat GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
pat HsConPatDetails GhcPs
details ->
    case HsConPatDetails GhcPs
details of
      PrefixCon [] [LPat GhcPs]
xs -> R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ do
        LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
pat
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
xs) forall a b. (a -> b) -> a -> b
$ do
          R ()
breakpoint
          R () -> R ()
inci forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
xs
      -- The first field of PrefixCon is filled in later stages
      PrefixCon {} -> forall a. String -> a
notImplemented String
"Unexpected types in constructor pattern"
      RecCon (HsRecFields [LHsRecField GhcPs (LPat GhcPs)]
fields Maybe (Located ConTag)
dotdot) -> do
        LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
pat
        R ()
breakpointPreRecordBrace
        let f :: Maybe
  (GenLocated
     SrcSpanAnnA
     (HsRecField'
        (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
-> R ()
f = \case
              Maybe
  (GenLocated
     SrcSpanAnnA
     (HsRecField'
        (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
Nothing -> Text -> R ()
txt Text
".."
              Just GenLocated
  SrcSpanAnnA
  (HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
x -> forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated
  SrcSpanAnnA
  (HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
x HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
p_pat_hsRecField
        R () -> R ()
inci forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel Maybe
  (GenLocated
     SrcSpanAnnA
     (HsRecField'
        (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
-> R ()
f forall a b. (a -> b) -> a -> b
$
          case Maybe (Located ConTag)
dotdot of
            Maybe (Located ConTag)
Nothing -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (LPat GhcPs)]
fields
            Just (L SrcSpan
_ ConTag
n) -> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ConTag -> [a] -> [a]
take ConTag
n [LHsRecField GhcPs (LPat GhcPs)]
fields) forall a. [a] -> [a] -> [a]
++ [forall a. Maybe a
Nothing]
      InfixCon LPat GhcPs
l LPat GhcPs
r -> do
        [SrcSpan] -> R () -> R ()
switchLayout [forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
l, forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
r] forall a b. (a -> b) -> a -> b
$ do
          forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
l Pat GhcPs -> R ()
p_pat
          R ()
breakpoint
          R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
            LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
pat
            R ()
space
            forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
r Pat GhcPs -> R ()
p_pat
  ViewPat XViewPat GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr LPat GhcPs
pat -> R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
    R ()
space
    Text -> R ()
txt Text
"->"
    R ()
breakpoint
    R () -> R ()
inci (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
pat Pat GhcPs -> R ()
p_pat)
  SplicePat XSplicePat GhcPs
_ HsSplice GhcPs
splice -> HsSplice GhcPs -> R ()
p_hsSplice HsSplice GhcPs
splice
  LitPat XLitPat GhcPs
_ HsLit GhcPs
p -> forall a. Outputable a => a -> R ()
atom HsLit GhcPs
p
  NPat XNPat GhcPs
_ XRec GhcPs (HsOverLit GhcPs)
v (forall a. Maybe a -> Bool
isJust -> Bool
isNegated) SyntaxExpr GhcPs
_ -> do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isNegated forall a b. (a -> b) -> a -> b
$ do
      Text -> R ()
txt Text
"-"
      Bool
negativeLiterals <- Extension -> R Bool
isExtensionEnabled Extension
NegativeLiterals
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
negativeLiterals R ()
space
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsOverLit GhcPs)
v (forall a. Outputable a => a -> R ()
atom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. HsOverLit p -> OverLitVal
ol_val)
  NPlusKPat XNPlusKPat GhcPs
_ LIdP GhcPs
n XRec GhcPs (HsOverLit GhcPs)
k HsOverLit GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ -> R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ do
    LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
n
    R ()
breakpoint
    R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
      Text -> R ()
txt Text
"+"
      R ()
space
      forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsOverLit GhcPs)
k (forall a. Outputable a => a -> R ()
atom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. HsOverLit p -> OverLitVal
ol_val)
  SigPat XSigPat GhcPs
_ LPat GhcPs
pat HsPS {LHsType (NoGhcTc GhcPs)
XHsPS (NoGhcTc GhcPs)
hsps_ext :: forall pass. HsPatSigType pass -> XHsPS pass
hsps_body :: forall pass. HsPatSigType pass -> LHsType pass
hsps_body :: LHsType (NoGhcTc GhcPs)
hsps_ext :: XHsPS (NoGhcTc GhcPs)
..} -> do
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
pat Pat GhcPs -> R ()
p_pat
    LHsSigType GhcPs -> R ()
p_typeAscription (LHsType GhcPs -> LHsSigType GhcPs
lhsTypeToSigType LHsType (NoGhcTc GhcPs)
hsps_body)

p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
p_pat_hsRecField HsRecField {Bool
LPat GhcPs
XHsRecField (FieldOcc GhcPs)
Located (FieldOcc GhcPs)
hsRecPun :: Bool
hsRecFieldArg :: LPat GhcPs
hsRecFieldLbl :: Located (FieldOcc GhcPs)
hsRecFieldAnn :: XHsRecField (FieldOcc GhcPs)
hsRecFieldAnn :: forall id arg. HsRecField' id arg -> XHsRecField id
hsRecFieldLbl :: forall id arg. HsRecField' id arg -> Located id
hsRecFieldArg :: forall id arg. HsRecField' id arg -> arg
hsRecPun :: forall id arg. HsRecField' id arg -> Bool
..} = do
  forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located Located (FieldOcc GhcPs)
hsRecFieldLbl forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> R ()
p_rdrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. FieldOcc pass -> LocatedN RdrName
rdrNameFieldOcc
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hsRecPun forall a b. (a -> b) -> a -> b
$ do
    R ()
space
    R ()
equals
    R ()
breakpoint
    R () -> R ()
inci (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
hsRecFieldArg Pat GhcPs -> R ()
p_pat)

p_unboxedSum :: BracketStyle -> ConTag -> Arity -> R () -> R ()
p_unboxedSum :: BracketStyle -> ConTag -> ConTag -> R () -> R ()
p_unboxedSum BracketStyle
s ConTag
tag ConTag
arity R ()
m = do
  let before :: ConTag
before = ConTag
tag forall a. Num a => a -> a -> a
- ConTag
1
      after :: ConTag
after = ConTag
arity forall a. Num a => a -> a -> a
- ConTag
before forall a. Num a => a -> a -> a
- ConTag
1
      args :: [Maybe (R ())]
args = forall a. ConTag -> a -> [a]
replicate ConTag
before forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> [forall a. a -> Maybe a
Just R ()
m] forall a. Semigroup a => a -> a -> a
<> forall a. ConTag -> a -> [a]
replicate ConTag
after forall a. Maybe a
Nothing
      f :: Maybe (R ()) -> R ()
f Maybe (R ())
x =
        case Maybe (R ())
x :: Maybe (R ()) of
          Maybe (R ())
Nothing ->
            R ()
space
          Just R ()
m' -> do
            R ()
space
            R ()
m'
            R ()
space
  BracketStyle -> R () -> R ()
parensHash BracketStyle
s forall a b. (a -> b) -> a -> b
$ forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt Text
"|") Maybe (R ()) -> R ()
f [Maybe (R ())]
args

p_hsSplice :: HsSplice GhcPs -> R ()
p_hsSplice :: HsSplice GhcPs -> R ()
p_hsSplice = \case
  HsTypedSplice XTypedSplice GhcPs
_ SpliceDecoration
deco IdP GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr -> Bool -> XRec GhcPs (HsExpr GhcPs) -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
True XRec GhcPs (HsExpr GhcPs)
expr SpliceDecoration
deco
  HsUntypedSplice XUntypedSplice GhcPs
_ SpliceDecoration
deco IdP GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr -> Bool -> XRec GhcPs (HsExpr GhcPs) -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
False XRec GhcPs (HsExpr GhcPs)
expr SpliceDecoration
deco
  HsQuasiQuote XQuasiQuote GhcPs
_ IdP GhcPs
_ IdP GhcPs
quoterName SrcSpan
_ FastString
str -> do
    Text -> R ()
txt Text
"["
    LocatedN RdrName -> R ()
p_rdrName (forall a an. a -> LocatedAn an a
noLocA IdP GhcPs
quoterName)
    Text -> R ()
txt Text
"|"
    -- QuasiQuoters often rely on precise custom strings. We cannot do any
    -- formatting here without potentially breaking someone's code.
    forall a. Outputable a => a -> R ()
atom FastString
str
    Text -> R ()
txt Text
"|]"
  HsSpliced {} -> forall a. String -> a
notImplemented String
"HsSpliced"

p_hsSpliceTH ::
  -- | Typed splice?
  Bool ->
  -- | Splice expression
  LHsExpr GhcPs ->
  -- | Splice decoration
  SpliceDecoration ->
  R ()
p_hsSpliceTH :: Bool -> XRec GhcPs (HsExpr GhcPs) -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
isTyped XRec GhcPs (HsExpr GhcPs)
expr = \case
  SpliceDecoration
DollarSplice -> do
    Text -> R ()
txt Text
decoSymbol
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
expr (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
  SpliceDecoration
BareSplice ->
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
expr (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
  where
    decoSymbol :: Text
decoSymbol = if Bool
isTyped then Text
"$$" else Text
"$"

p_hsBracket :: EpAnn [AddEpAnn] -> HsBracket GhcPs -> R ()
p_hsBracket :: EpAnn [AddEpAnn] -> HsBracket GhcPs -> R ()
p_hsBracket EpAnn [AddEpAnn]
epAnn = \case
  ExpBr XExpBr GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr -> do
    let name :: Text
name
          | forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool
True | AddEpAnn AnnKeywordId
AnnOpenEQ EpaLocation
_ <- EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns EpAnn [AddEpAnn]
epAnn] = Text
""
          | Bool
otherwise = Text
"e"
    Text -> R () -> R ()
quote Text
name (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr)
  PatBr XPatBr GhcPs
_ LPat GhcPs
pat -> forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
pat (Text -> R () -> R ()
quote Text
"p" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat GhcPs -> R ()
p_pat)
  DecBrL XDecBrL GhcPs
_ [LHsDecl GhcPs]
decls -> Text -> R () -> R ()
quote Text
"d" (forall a. Data a => a -> R () -> R ()
handleStarIsType [LHsDecl GhcPs]
decls (FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDecls FamilyStyle
Free [LHsDecl GhcPs]
decls))
  DecBrG XDecBrG GhcPs
_ HsGroup GhcPs
_ -> forall a. String -> a
notImplemented String
"DecBrG" -- result of renamer
  TypBr XTypBr GhcPs
_ LHsType GhcPs
ty -> Text -> R () -> R ()
quote Text
"t" (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsType GhcPs
ty (forall a. Data a => a -> R () -> R ()
handleStarIsType LHsType GhcPs
ty forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType GhcPs -> R ()
p_hsType))
  VarBr XVarBr GhcPs
_ Bool
isSingleQuote LIdP GhcPs
name -> do
    Text -> R ()
txt (forall a. a -> a -> Bool -> a
bool Text
"''" Text
"'" Bool
isSingleQuote)
    LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
name
  TExpBr XTExpBr GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr -> do
    Text -> R ()
txt Text
"[||"
    R ()
breakpoint'
    forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
    R ()
breakpoint'
    Text -> R ()
txt Text
"||]"
  where
    quote :: Text -> R () -> R ()
    quote :: Text -> R () -> R ()
quote Text
name R ()
body = do
      Text -> R ()
txt Text
"["
      Text -> R ()
txt Text
name
      Text -> R ()
txt Text
"|"
      R ()
breakpoint'
      R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
        R () -> R ()
dontUseBraces R ()
body
        R ()
breakpoint'
        Text -> R ()
txt Text
"|]"
    -- With StarIsType, type and declaration brackets might end with a *,
    -- so we have to insert a space in the end to prevent the (mis)parsing
    -- of an (*|) operator.
    -- The detection is a bit overcautious, as it adds the spaces as soon as
    -- HsStarTy is anywhere in the type/declaration.
    handleStarIsType :: Data a => a -> R () -> R ()
    handleStarIsType :: forall a. Data a => a -> R () -> R ()
handleStarIsType a
a R ()
p
      | a -> Bool
containsHsStarTy a
a = R ()
space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> R ()
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* R ()
space
      | Bool
otherwise = R ()
p
      where
        containsHsStarTy :: a -> Bool
containsHsStarTy = forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything Bool -> Bool -> Bool
(||) forall a b. (a -> b) -> a -> b
$ \a
b -> case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast @_ @(HsType GhcPs) a
b of
          Just HsStarTy {} -> Bool
True
          Maybe (HsType GhcPs)
_ -> Bool
False

-- | Print the source text of a string literal while indenting gaps correctly.
p_stringLit :: String -> R ()
p_stringLit :: String -> R ()
p_stringLit String
src =
  let s :: [String]
s = String -> [String]
splitGaps String
src
      singleLine :: R ()
singleLine =
        Text -> R ()
txt forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (forall a. Monoid a => [a] -> a
mconcat [String]
s)
      multiLine :: R ()
multiLine =
        R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (Text -> R ()
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) ([String] -> [String]
backslashes [String]
s)
   in forall a. R a -> R a -> R a
vlayout R ()
singleLine R ()
multiLine
  where
    -- Split a string on gaps (backslash delimited whitespaces)
    --
    -- > splitGaps "bar\\  \\fo\\&o" == ["bar", "fo\\&o"]
    splitGaps :: String -> [String]
    splitGaps :: String -> [String]
splitGaps String
"" = []
    splitGaps String
s =
      let -- A backslash and a whitespace starts a "gap"
          p :: (Maybe Char, Char, Maybe Char) -> Bool
p (Just Char
'\\', Char
_, Maybe Char
_) = Bool
True
          p (Maybe Char
_, Char
'\\', Just Char
c) | Char -> Bool
ghcSpace Char
c = Bool
False
          p (Maybe Char, Char, Maybe Char)
_ = Bool
True
       in case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Maybe Char, Char, Maybe Char) -> Bool
p (forall a. [a] -> [(Maybe a, a, Maybe a)]
zipPrevNext String
s) of
            ([(Maybe Char, Char, Maybe Char)]
l, [(Maybe Char, Char, Maybe Char)]
r) ->
              let -- drop the initial '\', any amount of 'ghcSpace', and another '\'
                  r' :: String
r' = forall a. ConTag -> [a] -> [a]
drop ConTag
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
ghcSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ConTag -> [a] -> [a]
drop ConTag
1 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {c}. (a, b, c) -> b
orig [(Maybe Char, Char, Maybe Char)]
r
               in forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {c}. (a, b, c) -> b
orig [(Maybe Char, Char, Maybe Char)]
l forall a. a -> [a] -> [a]
: String -> [String]
splitGaps String
r'
    -- GHC's definition of whitespaces in strings
    -- See: https://gitlab.haskell.org/ghc/ghc/blob/86753475/compiler/parser/Lexer.x#L1653
    ghcSpace :: Char -> Bool
    ghcSpace :: Char -> Bool
ghcSpace Char
c = Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x7f' Bool -> Bool -> Bool
&& Char -> Bool
is_space Char
c
    -- Add backslashes to the inner side of the strings
    --
    -- > backslashes ["a", "b", "c"] == ["a\\", "\\b\\", "\\c"]
    backslashes :: [String] -> [String]
    backslashes :: [String] -> [String]
backslashes (String
x : String
y : [String]
xs) = (String
x forall a. [a] -> [a] -> [a]
++ String
"\\") forall a. a -> [a] -> [a]
: [String] -> [String]
backslashes ((Char
'\\' forall a. a -> [a] -> [a]
: String
y) forall a. a -> [a] -> [a]
: [String]
xs)
    backslashes [String]
xs = [String]
xs
    -- Attaches previous and next items to each list element
    zipPrevNext :: [a] -> [(Maybe a, a, Maybe a)]
    zipPrevNext :: forall a. [a] -> [(Maybe a, a, Maybe a)]
zipPrevNext [a]
xs =
      let z :: [((Maybe a, a), Maybe a)]
z =
            forall a b. [a] -> [b] -> [(a, b)]
zip
              (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Maybe a
Nothing forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just [a]
xs) [a]
xs)
              (forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just (forall a. [a] -> [a]
tail [a]
xs) forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat forall a. Maybe a
Nothing)
       in forall a b. (a -> b) -> [a] -> [b]
map (\((Maybe a
p, a
x), Maybe a
n) -> (Maybe a
p, a
x, Maybe a
n)) [((Maybe a, a), Maybe a)]
z
    orig :: (a, b, c) -> b
orig (a
_, b
x, c
_) = b
x

----------------------------------------------------------------------------
-- Helpers

-- | Return the wrapping function controlling the use of braces according to
-- the current layout.
layoutToBraces :: Layout -> R () -> R ()
layoutToBraces :: Layout -> R () -> R ()
layoutToBraces = \case
  Layout
SingleLine -> R () -> R ()
useBraces
  Layout
MultiLine -> forall a. a -> a
id

-- | Append each element in both lists with semigroups. If one list is shorter
-- than the other, return the rest of the longer list unchanged.
liftAppend :: Semigroup a => [a] -> [a] -> [a]
liftAppend :: forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend [] [] = []
liftAppend [] (a
y : [a]
ys) = a
y forall a. a -> [a] -> [a]
: [a]
ys
liftAppend (a
x : [a]
xs) [] = a
x forall a. a -> [a] -> [a]
: [a]
xs
liftAppend (a
x : [a]
xs) (a
y : [a]
ys) = a
x forall a. Semigroup a => a -> a -> a
<> a
y forall a. a -> [a] -> [a]
: forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend [a]
xs [a]
ys

getGRHSSpan :: GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan :: forall body. GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan (GRHS XCGRHS GhcPs (LocatedA body)
_ [GuardLStmt GhcPs]
guards LocatedA body
body) =
  NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' forall a b. (a -> b) -> a -> b
$ forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedA body
body forall a. a -> [a] -> NonEmpty a
:| forall a b. (a -> b) -> [a] -> [b]
map forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA [GuardLStmt GhcPs]
guards

-- | Determine placement of a given block.
blockPlacement ::
  (body -> Placement) ->
  [LGRHS GhcPs (LocatedA body)] ->
  Placement
blockPlacement :: forall body.
(body -> Placement) -> [LGRHS GhcPs (LocatedA body)] -> Placement
blockPlacement body -> Placement
placer [L Anno (GRHS GhcPs (LocatedA body))
_ (GRHS XCGRHS GhcPs (LocatedA body)
_ [GuardLStmt GhcPs]
_ (L SrcSpanAnnA
_ body
x))] = body -> Placement
placer body
x
blockPlacement body -> Placement
_ [LGRHS GhcPs (LocatedA body)]
_ = Placement
Normal

-- | Determine placement of a given command.
cmdPlacement :: HsCmd GhcPs -> Placement
cmdPlacement :: HsCmd GhcPs -> Placement
cmdPlacement = \case
  HsCmdLam XCmdLam GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
_ -> Placement
Hanging
  HsCmdCase XCmdCase GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ MatchGroup GhcPs (LHsCmd GhcPs)
_ -> Placement
Hanging
  HsCmdLamCase XCmdLamCase GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
_ -> Placement
Hanging
  HsCmdDo XCmdDo GhcPs
_ XRec GhcPs [CmdLStmt GhcPs]
_ -> Placement
Hanging
  HsCmd GhcPs
_ -> Placement
Normal

-- | Determine placement of a top level command.
cmdTopPlacement :: HsCmdTop GhcPs -> Placement
cmdTopPlacement :: HsCmdTop GhcPs -> Placement
cmdTopPlacement (HsCmdTop XCmdTop GhcPs
_ (L SrcSpanAnnA
_ HsCmd GhcPs
x)) = HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs
x

-- | Check if given expression has a hanging form.
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement = \case
  -- Only hang lambdas with single line parameter lists
  HsLam XLam GhcPs
_ MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mg -> case MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mg of
    MG XMG GhcPs (XRec GhcPs (HsExpr GhcPs))
_ (L SrcSpanAnnL
_ [L SrcSpanAnnA
_ (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ HsMatchContext (NoGhcTc GhcPs)
_ (LPat GhcPs
x : [LPat GhcPs]
xs) GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_)]) Origin
_
      | SrcSpan -> Bool
isOneLineSpan (NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (LPat GhcPs
x forall a. a -> [a] -> NonEmpty a
:| [LPat GhcPs]
xs)) ->
          Placement
Hanging
    MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
_ -> Placement
Normal
  HsLamCase XLamCase GhcPs
_ MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
_ -> Placement
Hanging
  HsCase XCase GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
_ -> Placement
Hanging
  HsDo XDo GhcPs
_ (DoExpr Maybe ModuleName
_) XRec GhcPs [GuardLStmt GhcPs]
_ -> Placement
Hanging
  HsDo XDo GhcPs
_ (MDoExpr Maybe ModuleName
_) XRec GhcPs [GuardLStmt GhcPs]
_ -> Placement
Hanging
  OpApp XOpApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ XRec GhcPs (HsExpr GhcPs)
op XRec GhcPs (HsExpr GhcPs)
y ->
    case (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> String
getOpNameStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> Maybe RdrName
getOpName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) XRec GhcPs (HsExpr GhcPs)
op of
      Just String
"$" -> HsExpr GhcPs -> Placement
exprPlacement (forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
y)
      Maybe String
_ -> Placement
Normal
  HsApp XApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ XRec GhcPs (HsExpr GhcPs)
y -> HsExpr GhcPs -> Placement
exprPlacement (forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
y)
  HsProc XProc GhcPs
_ LPat GhcPs
p LHsCmdTop GhcPs
_ ->
    -- Indentation breaks if pattern is longer than one line and left
    -- hanging. Consequently, only apply hanging when it is safe.
    if SrcSpan -> Bool
isOneLineSpan (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
p)
      then Placement
Hanging
      else Placement
Normal
  HsExpr GhcPs
_ -> Placement
Normal

-- | Return 'True' if any of the RHS expressions has guards.
withGuards :: [LGRHS GhcPs body] -> Bool
withGuards :: forall body. [LGRHS GhcPs body] -> Bool
withGuards = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall {p} {body}. GRHS p body -> Bool
checkOne forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc)
  where
    checkOne :: GRHS p body -> Bool
checkOne (GRHS XCGRHS p body
_ [] body
_) = Bool
False
    checkOne GRHS p body
_ = Bool
True

-- | For use before record braces. Collapse to empty if not 'poRecordBraceSpace'.
breakpointPreRecordBrace :: R ()
breakpointPreRecordBrace :: R ()
breakpointPreRecordBrace = do
  Bool
useSpace <- forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f Bool
poRecordBraceSpace
  if Bool
useSpace
    then R ()
breakpoint
    else R ()
breakpoint'

-- | For nested lists/tuples, pad with whitespace so that we always indent correctly,
-- rather than sometimes indenting by 2 regardless of 'poIndentation'.
p_hsExprListItem :: HsExpr GhcPs -> R ()
p_hsExprListItem :: HsExpr GhcPs -> R ()
p_hsExprListItem HsExpr GhcPs
e = do
  ConTag
indent <- forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f ConTag
poIndentation
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {p}. HsExpr p -> Bool
listLike HsExpr GhcPs
e) forall a b. (a -> b) -> a -> b
$ do
    forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f CommaStyle
poCommaStyle forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      CommaStyle
Leading -> R ()
breakpoint'
      CommaStyle
Trailing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    forall a. R a -> R a -> R a
vlayout (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (ConTag -> R ()
spaces forall a b. (a -> b) -> a -> b
$ ConTag
indent forall a. Num a => a -> a -> a
- ConTag
2)
  HsExpr GhcPs -> R ()
p_hsExpr HsExpr GhcPs
e
  where
    spaces :: ConTag -> R ()
spaces ConTag
n = Text -> R ()
txt forall a b. (a -> b) -> a -> b
$ ConTag -> Text -> Text
Text.replicate ConTag
n Text
" "
    listLike :: HsExpr p -> Bool
listLike = \case
      ExplicitList {} -> Bool
True
      ExplicitTuple {} -> Bool
True
      HsExpr p
_ -> Bool
False