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

module Ormolu.Printer.Meat.Declaration.Value
  ( p_valDecl,
    p_pat,
    p_hsExpr,
    p_hsUntypedSplice,
    p_stringLit,
    IsApplicand (..),
    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 Data.List.NonEmpty qualified as NE
import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Void
import GHC.Data.Bag (bagToList)
import GHC.Data.Strict qualified as Strict
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 Language.Haskell.Syntax.Basic
import Ormolu.Printer.Combinators
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 :: HsBind GhcPs -> R ()
p_valDecl :: HsBind GhcPs -> R ()
p_valDecl = \case
  FunBind XFunBind GhcPs GhcPs
_ LIdP GhcPs
funId MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
funMatches -> 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 -> 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
  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)) ~ SrcAnn NoEpAnns,
 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)) ~ SrcAnn NoEpAnns,
    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)) ~ SrcAnn NoEpAnns,
 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)
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_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 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 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 GhcPs
m_ext :: XCMatch GhcPs (LocatedA body)
..} =
      forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns) =>
(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 (NoGhcTc p)
mc_fun forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p body. Match p body -> HsMatchContext 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 p
m_ctxt Match id body
match of
    FunRhs {mc_strictness :: forall p. HsMatchContext p -> SrcStrictness
mc_strictness = SrcStrictness
s} -> SrcStrictness
s
    HsMatchContext 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)) ~ SrcAnn NoEpAnns) =>
(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)) ~ SrcAnn NoEpAnns) =>
  -- | 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)) ~ SrcAnn NoEpAnns) =>
(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 ne_pats :: NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
ne_pats@(GenLocated SrcSpanAnnA (Pat GhcPs)
head_pat :| [GenLocated SrcSpanAnnA (Pat GhcPs)]
tail_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 GenLocated SrcSpanAnnA (Pat GhcPs)
head_pat of
                  LazyPat XLazyPat GhcPs
_ LPat GhcPs
_ -> Bool
True
                  BangPat XBangPat GhcPs
_ LPat GhcPs
_ -> Bool
True
                  SplicePat XSplicePat GhcPs
_ HsUntypedSplice 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 -> do
            forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat GenLocated SrcSpanAnnA (Pat GhcPs)
head_pat
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (Pat GhcPs)]
tail_pats) forall a b. (a -> b) -> a -> b
$ do
              R ()
breakpoint
              -- When we have multiple patterns (with `\cases`) across multiple
              -- lines, we have to indent all but the first pattern.
              R () -> R ()
inci 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' Pat GhcPs -> R ()
p_pat) [GenLocated SrcSpanAnnA (Pat GhcPs)]
tail_pats
      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. XRec GhcPs (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 :: XRec GhcPs (GRHS GhcPs body) -> Bool
      guardNeedsLineBreak :: forall body. XRec GhcPs (GRHS GhcPs body) -> Bool
guardNeedsLineBreak (L Anno (GRHS GhcPs body)
_ (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))
          [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
          Text -> R ()
txt Text
"where"
          R ()
breakpoint
          R () -> R ()
inci 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 ()
sitcc (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.
      Bool -> R () -> R ()
inciIf (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 = IsApplicand -> BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' IsApplicand
NotApplicand BracketStyle
N

p_hsCmd' :: IsApplicand -> BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' :: IsApplicand -> BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' IsApplicand
isApp 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
    ModuleFixityMap
modFixityMap <- R ModuleFixityMap
askModuleFixityMap
    let opTree :: OpTree
  (GenLocated (SrcAnn NoEpAnns) (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)
-> ModuleFixityMap -> 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) ModuleFixityMap
modFixityMap OpTree
  (GenLocated (SrcAnn NoEpAnns) (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 (IsApplicand -> BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' IsApplicand
Applicand BracketStyle
s)
    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)
expr HsExpr GhcPs -> R ()
p_hsExpr
  HsCmdLam XCmdLam GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
mgroup -> forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
 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
_ LHsToken "(" GhcPs
_ LHsCmd GhcPs
c LHsToken ")" GhcPs
_ -> BracketStyle -> R () -> R ()
parens BracketStyle
N (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)) ~ SrcAnn NoEpAnns,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
IsApplicand
-> (body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_case IsApplicand
isApp HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (LHsCmd GhcPs)
mgroup
  HsCmdLamCase XCmdLamCase GhcPs
_ LamCaseVariant
variant MatchGroup GhcPs (LHsCmd GhcPs)
mgroup ->
    forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
IsApplicand
-> LamCaseVariant
-> (body -> Placement)
-> (body -> R ())
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_lamcase IsApplicand
isApp LamCaseVariant
variant 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
_ LHsToken "let" GhcPs
_ HsLocalBinds GhcPs
localBinds LHsToken "in" GhcPs
_ 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) =>
IsApplicand
-> (body -> Placement)
-> (body -> R ())
-> LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> R ()
p_stmts IsApplicand
isApp HsCmd GhcPs -> Placement
cmdPlacement (IsApplicand -> BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' IsApplicand
NotApplicand 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 (IsApplicand -> BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' IsApplicand
NotApplicand 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
  ) =>
  IsApplicand ->
  -- | 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) =>
IsApplicand
-> (body -> Placement)
-> (body -> R ())
-> LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> R ()
p_stmts IsApplicand
isApp 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
  IsApplicand -> R () -> R ()
inciApplicand IsApplicand
isApp 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 (HsBind 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
        p_item' :: (RelativePos,
 GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs)))
-> R ()
p_item' (RelativePos
p, GenLocated SrcSpanAnnA (Either (HsBind 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 HsBind GhcPs -> R ()
p_valDecl Sig GhcPs -> R ()
p_sigDecl) GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
item
        binds :: [GenLocated SrcSpanAnnA (Either (HsBind 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 (HsBind 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 (HsBind GhcPs) (Sig GhcPs)))
-> R ()
p_item' (forall a. [a] -> [(RelativePos, a)]
attachRelativePos [GenLocated SrcSpanAnnA (Either (HsBind 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
    let p_ipBind :: IPBind GhcPs -> R ()
p_ipBind (IPBind XCIPBind GhcPs
_ (L SrcAnn NoEpAnns
_ HsIPName
name) XRec GhcPs (HsExpr GhcPs)
expr) = do
          forall a. Outputable a => a -> R ()
atom @HsIPName 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
    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}}}
        | let sp :: SrcSpan
sp = RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
anchor forall a. Maybe a
Strict.Nothing,
          -- excluding cases where there are no bindings
          Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ SrcSpan -> Bool
isZeroWidthSpan SrcSpan
sp ->
            forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (forall l e. l -> e -> GenLocated l e
L SrcSpan
sp ()) 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_ldotFieldOcc :: XRec GhcPs (DotFieldOcc GhcPs) -> R ()
p_ldotFieldOcc :: XRec GhcPs (DotFieldOcc GhcPs) -> R ()
p_ldotFieldOcc =
  forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> R ()
p_rdrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FastString -> RdrName
mkVarUnqual forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabelString -> FastString
field_label) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. DotFieldOcc p -> XRec p FieldLabelString
dfoLabel

p_ldotFieldOccs :: [XRec GhcPs (DotFieldOcc GhcPs)] -> R ()
p_ldotFieldOccs :: [XRec GhcPs (DotFieldOcc GhcPs)] -> R ()
p_ldotFieldOccs = forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt Text
".") XRec GhcPs (DotFieldOcc GhcPs) -> R ()
p_ldotFieldOcc

p_fieldOcc :: FieldOcc GhcPs -> R ()
p_fieldOcc :: FieldOcc GhcPs -> R ()
p_fieldOcc FieldOcc {XRec GhcPs RdrName
XCFieldOcc GhcPs
foExt :: forall pass. FieldOcc pass -> XCFieldOcc pass
foLabel :: forall pass. FieldOcc pass -> XRec pass RdrName
foLabel :: XRec GhcPs RdrName
foExt :: XCFieldOcc GhcPs
..} = LocatedN RdrName -> R ()
p_rdrName XRec GhcPs RdrName
foLabel

p_hsFieldBind ::
  (lhs ~ GenLocated l a, HasSrcSpan l) =>
  (lhs -> R ()) ->
  HsFieldBind lhs (LHsExpr GhcPs) ->
  R ()
p_hsFieldBind :: forall lhs l a.
(lhs ~ GenLocated l a, HasSrcSpan l) =>
(lhs -> R ())
-> HsFieldBind lhs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_hsFieldBind lhs -> R ()
p_lhs HsFieldBind {lhs
Bool
XRec GhcPs (HsExpr GhcPs)
XHsFieldBind lhs
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbPun :: Bool
hfbRHS :: XRec GhcPs (HsExpr GhcPs)
hfbLHS :: lhs
hfbAnn :: XHsFieldBind lhs
..} = do
  lhs -> R ()
p_lhs lhs
hfbLHS
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hfbPun forall a b. (a -> b) -> a -> b
$ do
    R ()
space
    R ()
equals
    let placement :: Placement
placement =
          if SrcSpan -> SrcSpan -> Bool
onTheSameLine (forall l a. HasSrcSpan l => GenLocated l a -> SrcSpan
getLoc' lhs
hfbLHS) (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA XRec GhcPs (HsExpr GhcPs)
hfbRHS)
            then HsExpr GhcPs -> Placement
exprPlacement (forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
hfbRHS)
            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)
hfbRHS HsExpr GhcPs -> R ()
p_hsExpr)

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

-- | An applicand is the left-hand side in a function application, i.e. @f@ in
-- @f a@. We need to track this in order to add extra identation in cases like
--
-- > foo =
-- >   do
-- >       succ
-- >     1
data IsApplicand = Applicand | NotApplicand

inciApplicand :: IsApplicand -> R () -> R ()
inciApplicand :: IsApplicand -> R () -> R ()
inciApplicand = \case
  IsApplicand
Applicand -> R () -> R ()
inci forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
inci
  IsApplicand
NotApplicand -> R () -> R ()
inci

p_hsExpr' :: IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' :: IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' IsApplicand
isApp BracketStyle
s = \case
  HsVar XVar GhcPs
_ LIdP GhcPs
name -> LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
name
  HsUnboundVar XUnboundVar GhcPs
_ RdrName
occ -> forall a. Outputable a => a -> R ()
atom RdrName
occ
  HsRecSel XRecSel GhcPs
_ FieldOcc GhcPs
fldOcc -> FieldOcc GhcPs -> R ()
p_fieldOcc FieldOcc GhcPs
fldOcc
  HsOverLabel XOverLabel GhcPs
_ SourceText
sourceText FastString
_ -> do
    Text -> R ()
txt Text
"#"
    SourceText -> R ()
p_sourceText SourceText
sourceText
  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
_ LamCaseVariant
variant MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup ->
    forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
IsApplicand
-> LamCaseVariant
-> (body -> Placement)
-> (body -> R ())
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_lamcase IsApplicand
isApp LamCaseVariant
variant 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
        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 (IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' IsApplicand
Applicand BracketStyle
s)
          R ()
breakpoint
          R () -> R ()
inci 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 ()
inci 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 (IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' IsApplicand
Applicand 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 LHsToken "@" GhcPs
_ 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
    ModuleFixityMap
modFixityMap <- R ModuleFixityMap
askModuleFixityMap
    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)
-> ModuleFixityMap -> 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) ModuleFixityMap
modFixityMap 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
_ LHsToken "(" GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e LHsToken ")" GhcPs
_ ->
    BracketStyle -> R () -> R ()
parens BracketStyle
s (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_hsExpr
            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
Strict.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
<$> R (Maybe RealSrcSpan)
getEnclosingSpan
    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)) ~ SrcAnn NoEpAnns,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
IsApplicand
-> (body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_case IsApplicand
isApp 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
    IsApplicand -> R () -> R ()
inciApplicand IsApplicand
isApp 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
_ LHsToken "let" GhcPs
_ HsLocalBinds GhcPs
localBinds LHsToken "in" GhcPs
_ 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
_ HsDoFlavour
doFlavor 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) =>
IsApplicand
-> (body -> Placement)
-> (body -> R ())
-> LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> R ()
p_stmts IsApplicand
isApp HsExpr GhcPs -> Placement
exprPlacement (IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' IsApplicand
NotApplicand 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 ()
sitcc
                  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 HsDoFlavour
doFlavor 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"
      HsDoFlavour
ListComp -> R ()
compBody
      HsDoFlavour
MonadComp -> R ()
compBody
      HsDoFlavour
GhciStmtCtxt -> forall a. String -> a
notImplemented String
"GhciStmtCtxt"
  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_hsExpr) [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
    LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
rcon_con
    R ()
breakpoint
    let HsRecFields {[LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
Maybe (XRec GhcPs RecFieldsDotDot)
rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_dotdot :: Maybe (XRec GhcPs RecFieldsDotDot)
rec_flds :: [LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
..} = HsRecordBinds GhcPs
rcon_flds
        p_lhs :: GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> R ()
p_lhs = forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' 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 -> XRec pass RdrName
foLabel
        fields :: [R ()]
fields = forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (forall lhs l a.
(lhs ~ GenLocated l a, HasSrcSpan l) =>
(lhs -> R ())
-> HsFieldBind lhs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_hsFieldBind GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> R ()
p_lhs) 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 (XRec GhcPs RecFieldsDotDot)
rec_dotdot of
          Just {} -> [Text -> R ()
txt Text
".."]
          Maybe (XRec GhcPs RecFieldsDotDot)
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 ()
breakpoint
    let p_updLbl :: GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs) -> R ()
p_updLbl =
          forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' forall a b. (a -> b) -> a -> b
$
            LocatedN RdrName -> R ()
p_rdrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
              (Unambiguous NoExtField
XUnambiguous GhcPs
NoExtField XRec GhcPs RdrName
n :: AmbiguousFieldOcc GhcPs) -> XRec GhcPs RdrName
n
              Ambiguous NoExtField
XAmbiguous GhcPs
NoExtField XRec GhcPs RdrName
n -> XRec GhcPs RdrName
n
        p_recFields :: (GenLocated l a -> R ())
-> [GenLocated
      l
      (HsFieldBind
         (GenLocated l a) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
p_recFields GenLocated l a -> 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 lhs l a.
(lhs ~ GenLocated l a, HasSrcSpan l) =>
(lhs -> R ())
-> HsFieldBind lhs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_hsFieldBind GenLocated l a -> 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} {l} {a}.
(HasSrcSpan l, HasSrcSpan l) =>
(GenLocated l a -> R ())
-> [GenLocated
      l
      (HsFieldBind
         (GenLocated l a) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
p_recFields GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs) -> R ()
p_updLbl)
        (forall {l} {l} {a}.
(HasSrcSpan l, HasSrcSpan l) =>
(GenLocated l a -> R ())
-> [GenLocated
      l
      (HsFieldBind
         (GenLocated l a) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
p_recFields forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce [XRec GhcPs (DotFieldOcc GhcPs)] -> R ()
p_ldotFieldOccs)
        Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
rupd_flds
  HsGetField {XRec GhcPs (DotFieldOcc GhcPs)
XRec GhcPs (HsExpr GhcPs)
XGetField GhcPs
gf_ext :: forall p. HsExpr p -> XGetField p
gf_expr :: forall p. HsExpr p -> LHsExpr p
gf_field :: forall p. HsExpr p -> XRec p (DotFieldOcc p)
gf_field :: XRec GhcPs (DotFieldOcc 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
"."
    XRec GhcPs (DotFieldOcc GhcPs) -> R ()
p_ldotFieldOcc XRec GhcPs (DotFieldOcc GhcPs)
gf_field
  HsProjection {NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
XProjection GhcPs
proj_ext :: forall p. HsExpr p -> XProjection p
proj_flds :: forall p. HsExpr p -> NonEmpty (XRec p (DotFieldOcc p))
proj_flds :: NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
proj_ext :: XProjection GhcPs
..} -> BracketStyle -> R () -> R ()
parens BracketStyle
N forall a b. (a -> b) -> a -> b
$ do
    Text -> R ()
txt Text
"."
    [XRec GhcPs (DotFieldOcc GhcPs)] -> R ()
p_ldotFieldOccs (forall a. NonEmpty a -> [a]
NE.toList NonEmpty (XRec GhcPs (DotFieldOcc 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
  HsTypedBracket XTypedBracket 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
"||]"
  HsUntypedBracket XUntypedBracket GhcPs
epAnn HsQuote GhcPs
x -> EpAnn [AddEpAnn] -> HsQuote GhcPs -> R ()
p_hsQuote XUntypedBracket GhcPs
epAnn HsQuote GhcPs
x
  HsTypedSplice XTypedSplice GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr -> Bool -> XRec GhcPs (HsExpr GhcPs) -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
True XRec GhcPs (HsExpr GhcPs)
expr SpliceDecoration
DollarSplice
  HsUntypedSplice XUntypedSplice GhcPs
_ HsUntypedSplice GhcPs
untySplice -> SpliceDecoration -> HsUntypedSplice GhcPs -> R ()
p_hsUntypedSplice SpliceDecoration
DollarSplice HsUntypedSplice GhcPs
untySplice
  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)
  HsPragE XPragE GhcPs
_ HsPragE GhcPs
prag XRec GhcPs (HsExpr GhcPs)
x -> case HsPragE GhcPs
prag of
    HsPragSCC XSCC GhcPs
_ StringLiteral
name -> do
      Text -> R ()
txt Text
"{-# SCC "
      forall a. Outputable a => a -> R ()
atom StringLiteral
name
      Text -> R ()
txt Text
" #-}"
      R ()
breakpoint
      let inciIfS :: R () -> R ()
inciIfS = case BracketStyle
s of BracketStyle
N -> forall a. a -> a
id; BracketStyle
S -> R () -> R ()
inci
      R () -> R ()
inciIfS forall a b. (a -> b) -> a -> b
$ 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 ()
breakpoint
          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)) ~ SrcAnn NoEpAnns,
    Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
  ) =>
  IsApplicand ->
  -- | 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)) ~ SrcAnn NoEpAnns,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
IsApplicand
-> (body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_case IsApplicand
isApp 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
  IsApplicand -> R () -> R ()
inciApplicand IsApplicand
isApp (forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
 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)) ~ SrcAnn NoEpAnns,
    Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
  ) =>
  IsApplicand ->
  -- | Variant (@\\case@ or @\\cases@)
  LamCaseVariant ->
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (body -> R ()) ->
  -- | Expression
  MatchGroup GhcPs (LocatedA body) ->
  R ()
p_lamcase :: forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
IsApplicand
-> LamCaseVariant
-> (body -> Placement)
-> (body -> R ())
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_lamcase IsApplicand
isApp LamCaseVariant
variant body -> Placement
placer body -> R ()
render MatchGroup GhcPs (LocatedA body)
mgroup = do
  Text -> R ()
txt forall a b. (a -> b) -> a -> b
$ case LamCaseVariant
variant of
    LamCaseVariant
LamCase -> Text
"\\case"
    LamCaseVariant
LamCases -> Text
"\\cases"
  R ()
breakpoint
  IsApplicand -> R () -> R ()
inciApplicand IsApplicand
isApp (forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
 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 LHsToken "@" GhcPs
_ 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
_ LHsToken "(" GhcPs
_ LPat GhcPs
pat LHsToken ")" GhcPs
_ ->
    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
. 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 [HsConPatTyArg (NoGhcTc GhcPs)]
tys [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 [HsConPatTyArg (NoGhcTc GhcPs)]
tys Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
xs) 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 a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsConPatTyArg GhcPs -> R ()
p_hsConPatTyArg (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat)) forall a b. (a -> b) -> a -> b
$
            (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HsConPatTyArg (NoGhcTc GhcPs)]
tys) forall a. Semigroup a => a -> a -> a
<> (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs]
xs)
      RecCon (HsRecFields [LHsRecField GhcPs (LPat GhcPs)]
fields Maybe (XRec GhcPs RecFieldsDotDot)
dotdot) -> do
        LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
pat
        R ()
breakpoint
        let f :: Maybe
  (GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (Pat GhcPs))))
-> R ()
f = \case
              Maybe
  (GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (Pat GhcPs))))
Nothing -> Text -> R ()
txt Text
".."
              Just GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (Pat GhcPs)))
x -> forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (Pat GhcPs)))
x HsRecField GhcPs (LPat GhcPs) -> R ()
p_pat_hsFieldBind
        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
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (Pat GhcPs))))
-> R ()
f forall a b. (a -> b) -> a -> b
$
          case Maybe (XRec GhcPs RecFieldsDotDot)
dotdot of
            Maybe (XRec GhcPs RecFieldsDotDot)
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
_ (RecFieldsDotDot 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
_ HsUntypedSplice GhcPs
splice -> SpliceDecoration -> HsUntypedSplice GhcPs -> R ()
p_hsUntypedSplice SpliceDecoration
DollarSplice HsUntypedSplice 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_hsPatSigType :: HsPatSigType GhcPs -> R ()
p_hsPatSigType :: HsPatSigType GhcPs -> R ()
p_hsPatSigType (HsPS XHsPS GhcPs
_ LHsType GhcPs
ty) = Text -> R ()
txt Text
"@" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsType GhcPs
ty HsType GhcPs -> R ()
p_hsType

p_hsConPatTyArg :: HsConPatTyArg GhcPs -> R ()
p_hsConPatTyArg :: HsConPatTyArg GhcPs -> R ()
p_hsConPatTyArg (HsConPatTyArg LHsToken "@" GhcPs
_ HsPatSigType GhcPs
patSigTy) = HsPatSigType GhcPs -> R ()
p_hsPatSigType HsPatSigType GhcPs
patSigTy

p_pat_hsFieldBind :: HsRecField GhcPs (LPat GhcPs) -> R ()
p_pat_hsFieldBind :: HsRecField GhcPs (LPat GhcPs) -> R ()
p_pat_hsFieldBind HsFieldBind {Bool
LFieldOcc GhcPs
LPat GhcPs
XHsFieldBind (LFieldOcc GhcPs)
hfbPun :: Bool
hfbRHS :: LPat GhcPs
hfbLHS :: LFieldOcc GhcPs
hfbAnn :: XHsFieldBind (LFieldOcc GhcPs)
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
..} = do
  forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LFieldOcc GhcPs
hfbLHS FieldOcc GhcPs -> R ()
p_fieldOcc
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hfbPun 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
hfbRHS 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_hsUntypedSplice :: SpliceDecoration -> HsUntypedSplice GhcPs -> R ()
p_hsUntypedSplice :: SpliceDecoration -> HsUntypedSplice GhcPs -> R ()
p_hsUntypedSplice SpliceDecoration
deco = \case
  HsUntypedSpliceExpr XUntypedSpliceExpr 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
quoterName XRec GhcPs 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 XRec GhcPs FastString
str
    Text -> R ()
txt Text
"|]"

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_hsQuote :: EpAnn [AddEpAnn] -> HsQuote GhcPs -> R ()
p_hsQuote :: EpAnn [AddEpAnn] -> HsQuote GhcPs -> R ()
p_hsQuote EpAnn [AddEpAnn]
epAnn = \case
  ExpBr XExpBr GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr -> do
    let name :: Text
name
          | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. Maybe a -> Bool
isJust (AnnKeywordId -> AddEpAnn -> Maybe EpaLocation
matchAddEpAnn AnnKeywordId
AnnOpenEQ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
  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
_ LamCaseVariant
_ 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 GhcPs
_ (LPat GhcPs
x : [LPat GhcPs]
xs) GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_)])
      | 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
_ LamCaseVariant
_ 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