{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

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

import Control.Monad
import Data.Bool (bool)
import Data.Data hiding (Infix, Prefix)
import Data.Function (on)
import Data.Functor ((<&>))
import Data.Generics.Schemes (everything)
import Data.List (intersperse, sortBy, unsnoc)
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.Strict qualified as Strict
import GHC.Hs
import GHC.LanguageExtensions.Type (Extension (NegativeLiterals))
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.Config
import Ormolu.Printer.Combinators
import Ormolu.Printer.Internal (sitccIfTrailing)
import Ormolu.Printer.Meat.Common
import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration
import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.OpTree
import Ormolu.Printer.Meat.Declaration.Signature
import Ormolu.Printer.Meat.Declaration.StringLiteral
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
LocatedN RdrName
funId MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
funMatches
  PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
pat HsMultAnn GhcPs
multAnn GRHSs GhcPs (XRec GhcPs (HsExpr GhcPs))
grhss ->
    MatchGroupStyle
-> Bool
-> HsMultAnn GhcPs
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (XRec GhcPs (HsExpr GhcPs))
-> R ()
p_match MatchGroupStyle
PatternBind Bool
False HsMultAnn GhcPs
multAnn SrcStrictness
NoSrcStrict [LPat GhcPs
pat] GRHSs GhcPs (XRec GhcPs (HsExpr GhcPs))
grhss
  VarBind {} -> String -> R ()
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 = (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA (HsExpr GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,
 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)) ~ EpAnnCO,
    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)) ~ EpAnnCO,
 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 {XMG GhcPs (LocatedA body)
XRec GhcPs [LMatch GhcPs (LocatedA body)]
mg_ext :: XMG GhcPs (LocatedA body)
mg_alts :: XRec GhcPs [LMatch GhcPs (LocatedA body)]
mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_ext :: forall p body. MatchGroup p body -> XMG p 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 MatchGroup GhcPs (LocatedA body) -> Bool
forall (p :: Pass) body. MatchGroup (GhcPass p) body -> Bool
isEmptyMatchGroup MatchGroup GhcPs (LocatedA body)
mg then R () -> R ()
useBraces else R () -> R ()
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 <- (R () -> R ()) -> (R () -> R ()) -> Bool -> R () -> R ()
forall a. a -> a -> Bool -> a
bool R () -> R ()
dontUseBraces R () -> R ()
useBraces (Bool -> R () -> R ()) -> R Bool -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Bool
canUseBraces
  R () -> R ()
ob (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body)) -> R ())
-> [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((Match GhcPs (LocatedA body) -> R ())
-> GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body)) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' (R () -> R ()
ub (R () -> R ())
-> (Match GhcPs (LocatedA body) -> R ())
-> Match GhcPs (LocatedA body)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs (LocatedA body) -> R ()
p_Match)) (GenLocated
  (Anno [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))])
  [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))]
-> [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))]
forall l e. GenLocated l e -> e
unLoc XRec GhcPs [LMatch GhcPs (LocatedA body)]
GenLocated
  (Anno [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))])
  [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))]
mg_alts)
  where
    p_Match :: Match GhcPs (LocatedA body) -> R ()
p_Match m :: Match GhcPs (LocatedA body)
m@Match {XCMatch GhcPs (LocatedA body)
XRec GhcPs [LPat GhcPs]
GRHSs GhcPs (LocatedA body)
HsMatchContext (LIdP (NoGhcTc GhcPs))
m_ext :: XCMatch GhcPs (LocatedA body)
m_ctxt :: HsMatchContext (LIdP (NoGhcTc GhcPs))
m_pats :: XRec GhcPs [LPat GhcPs]
m_grhss :: GRHSs GhcPs (LocatedA body)
m_grhss :: forall p body. Match p body -> GRHSs p body
m_pats :: forall p body. Match p body -> XRec p [LPat p]
m_ctxt :: forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
m_ext :: forall p body. Match p body -> XCMatch p body
..} =
      (body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> HsMultAnn GhcPs
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> HsMultAnn GhcPs
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
p_match'
        body -> Placement
placer
        body -> R ()
render
        (Match GhcPs (LocatedA body) -> MatchGroupStyle -> MatchGroupStyle
forall body. Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle Match GhcPs (LocatedA body)
m MatchGroupStyle
style)
        (Match GhcPs (LocatedA body) -> Bool
forall id body. Match id body -> Bool
isInfixMatch Match GhcPs (LocatedA body)
m)
        (XNoMultAnn GhcPs -> HsMultAnn GhcPs
forall pass. XNoMultAnn pass -> HsMultAnn pass
HsNoMultAnn NoExtField
XNoMultAnn GhcPs
NoExtField)
        (Match GhcPs (LocatedA body) -> SrcStrictness
forall id body. Match id body -> SrcStrictness
matchStrictness Match GhcPs (LocatedA body)
m)
        -- We use the spans of the individual patterns.
        (GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall l e. GenLocated l e -> e
unLoc XRec GhcPs [LPat GhcPs]
GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat 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 (LocatedN RdrName -> MatchGroupStyle)
-> (Match GhcPs body -> LocatedN RdrName)
-> Match GhcPs body
-> MatchGroupStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsMatchContext (LocatedN RdrName) -> LocatedN RdrName
forall fn. HsMatchContext fn -> fn
mc_fun (HsMatchContext (LocatedN RdrName) -> LocatedN RdrName)
-> (Match GhcPs body -> HsMatchContext (LocatedN RdrName))
-> Match GhcPs body
-> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs body -> HsMatchContext (LIdP (NoGhcTc GhcPs))
Match GhcPs body -> HsMatchContext (LocatedN RdrName)
forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
m_ctxt) Match GhcPs body
m
  MatchGroupStyle
style -> MatchGroupStyle
style

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

p_match ::
  -- | Style of the group
  MatchGroupStyle ->
  -- | Is this an infix match?
  Bool ->
  -- | Multiplicity annotation
  HsMultAnn GhcPs ->
  -- | Strictness prefix (FunBind)
  SrcStrictness ->
  -- | Argument patterns
  [LPat GhcPs] ->
  -- | Equations
  GRHSs GhcPs (LHsExpr GhcPs) ->
  R ()
p_match :: MatchGroupStyle
-> Bool
-> HsMultAnn GhcPs
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (XRec GhcPs (HsExpr GhcPs))
-> R ()
p_match = (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> MatchGroupStyle
-> Bool
-> HsMultAnn GhcPs
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA (HsExpr GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> HsMultAnn GhcPs
-> 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)) ~ EpAnnCO) =>
  -- | 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 ->
  -- | Multiplicity annotation
  HsMultAnn GhcPs ->
  -- | Strictness prefix (FunBind)
  SrcStrictness ->
  -- | Argument patterns
  [LPat GhcPs] ->
  -- | Equations
  GRHSs GhcPs (LocatedA body) ->
  R ()
p_match' :: forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> HsMultAnn GhcPs
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
p_match' body -> Placement
placer body -> R ()
render MatchGroupStyle
style Bool
isInfix HsMultAnn GhcPs
multAnn SrcStrictness
strictness [LPat GhcPs]
m_pats GRHSs {[LGRHS GhcPs (LocatedA body)]
XCGRHSs GhcPs (LocatedA body)
HsLocalBinds GhcPs
grhssExt :: XCGRHSs GhcPs (LocatedA body)
grhssGRHSs :: [LGRHS GhcPs (LocatedA body)]
grhssLocalBinds :: HsLocalBinds GhcPs
grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssExt :: forall p body. GRHSs p body -> XCGRHSs p 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 HsMultAnn GhcPs
multAnn of
    HsNoMultAnn NoExtField
XNoMultAnn GhcPs
NoExtField -> () -> R ()
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    HsPct1Ann XPct1Ann GhcPs
_ -> Text -> R ()
txt Text
"%1" R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> R ()
space
    HsMultAnn XMultAnn GhcPs
_ LHsType (NoGhcTc GhcPs)
ty -> do
      Text -> R ()
txt Text
"%"
      GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LHsType (NoGhcTc GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
ty HsType GhcPs -> R ()
p_hsType
      R ()
space
  case SrcStrictness
strictness of
    SrcStrictness
NoSrcStrict -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    SrcStrictness
SrcStrict -> Text -> R ()
txt Text
"!"
    SrcStrictness
SrcLazy -> Text -> R ()
txt Text
"~"
  Bool
indentBody <- case [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> Maybe (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats of
    Maybe (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)))
Nothing ->
      Bool
False Bool -> R () -> R Bool
forall a b. a -> R b -> R a
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
_ -> () -> R ()
forall a. a -> R a
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 (LocatedN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LocatedN RdrName
name) SrcSpan
patSpans
            MatchGroupStyle
_ -> SrcSpan
patSpans
          patSpans :: SrcSpan
patSpans = NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan)
-> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> NonEmpty SrcSpan
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 ()
switchLayoutNoLimit [SrcSpan
combinedSpans] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        let stdCase :: R ()
stdCase = R ()
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat 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)
              ((Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats)
          MatchGroupStyle
PatternBind -> R ()
stdCase
          MatchGroupStyle
Case -> R ()
stdCase
          MatchGroupStyle
Lambda -> do
            let needsSpace :: Bool
needsSpace = case GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
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
                  InvisPat XInvisPat GhcPs
_ HsTyPat (NoGhcTc GhcPs)
_ -> Bool
True
                  Pat GhcPs
_ -> Bool
False
            Text -> R ()
txt Text
"\\"
            Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsSpace R ()
space
            R () -> R ()
sitcc R ()
stdCase
          MatchGroupStyle
LambdaCase -> do
            (Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat GenLocated SrcSpanAnnA (Pat GhcPs)
head_pat
            Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (Pat GhcPs)]
tail_pats) (R () -> R ()) -> R () -> R ()
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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [GenLocated SrcSpanAnnA (Pat GhcPs)]
tail_pats
      Bool -> R Bool
forall a. a -> R a
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 [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> Maybe (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats of
        Maybe (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)))
Nothing -> case MatchGroupStyle
style of
          Function LocatedN RdrName
name -> SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (LocatedN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LocatedN RdrName
name)
          MatchGroupStyle
_ -> Maybe SrcSpan
forall a. Maybe a
Nothing
        Just NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
pats -> (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (SrcSpan -> Maybe SrcSpan)
-> (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)) -> SrcSpan)
-> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> Maybe SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan)
-> (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
    -> GenLocated SrcSpanAnnA (Pat GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> GenLocated SrcSpanAnnA (Pat GhcPs)
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 = [LGRHS GhcPs (LocatedA body)] -> Bool
forall body. [LGRHS GhcPs body] -> Bool
withGuards [LGRHS GhcPs (LocatedA body)]
grhssGRHSs
      grhssSpan :: SrcSpan
grhssSpan =
        NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$
          GRHS GhcPs (LocatedA body) -> SrcSpan
forall body. GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan (GRHS GhcPs (LocatedA body) -> SrcSpan)
-> (GenLocated EpAnnCO (GRHS GhcPs (LocatedA body))
    -> GRHS GhcPs (LocatedA body))
-> GenLocated EpAnnCO (GRHS GhcPs (LocatedA body))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated EpAnnCO (GRHS GhcPs (LocatedA body))
-> GRHS GhcPs (LocatedA body)
forall l e. GenLocated l e -> e
unLoc (GenLocated EpAnnCO (GRHS GhcPs (LocatedA body)) -> SrcSpan)
-> NonEmpty (GenLocated EpAnnCO (GRHS GhcPs (LocatedA body)))
-> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated EpAnnCO (GRHS GhcPs (LocatedA body))]
-> NonEmpty (GenLocated EpAnnCO (GRHS GhcPs (LocatedA body)))
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [LGRHS GhcPs (LocatedA body)]
[GenLocated EpAnnCO (GRHS GhcPs (LocatedA body))]
grhssGRHSs
      patGrhssSpan :: SrcSpan
patGrhssSpan =
        SrcSpan -> (SrcSpan -> SrcSpan) -> Maybe SrcSpan -> SrcSpan
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          SrcSpan
grhssSpan
          (SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
grhssSpan (SrcSpan -> SrcSpan) -> (SrcSpan -> SrcSpan) -> SrcSpan -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcLoc -> SrcSpan
srcLocSpan (SrcLoc -> SrcSpan) -> (SrcSpan -> SrcLoc) -> SrcSpan -> SrcSpan
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
            | (GenLocated
   (Anno (GRHS GhcPs (LocatedA body))) (GRHS GhcPs (LocatedA body))
 -> Bool)
-> [GenLocated
      (Anno (GRHS GhcPs (LocatedA body))) (GRHS GhcPs (LocatedA body))]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LGRHS GhcPs (LocatedA body) -> Bool
GenLocated
  (Anno (GRHS GhcPs (LocatedA body))) (GRHS GhcPs (LocatedA body))
-> Bool
forall body. XRec GhcPs (GRHS GhcPs body) -> Bool
guardNeedsLineBreak [LGRHS GhcPs (LocatedA body)]
[GenLocated
   (Anno (GRHS GhcPs (LocatedA body))) (GRHS GhcPs (LocatedA body))]
grhssGRHSs
                Bool -> Bool -> Bool
|| Bool -> Bool
not (SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn SrcSpan
grhssSpan) ->
                Placement
Normal
          Maybe SrcSpan
_ -> (body -> Placement) -> [LGRHS GhcPs (LocatedA body)] -> Placement
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
_ [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
guardLStmts body
_)) = case [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
guardLStmts of
        [] -> Bool
False
        [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))
g] -> Bool -> Bool
not (Bool -> Bool)
-> (LStmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> Bool)
-> LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Bool
isOneLineSpan (SrcSpan -> Bool)
-> (GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
    -> SrcSpan)
-> GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA (LStmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> Bool)
-> LStmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> Bool
forall a b. (a -> b) -> a -> b
$ LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))
g
        [LStmt GhcPs (XRec GhcPs (HsExpr 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
        R ()
-> (GenLocated EpAnnCO (GRHS GhcPs (LocatedA body)) -> R ())
-> [GenLocated EpAnnCO (GRHS GhcPs (LocatedA body))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
          R ()
breakpoint
          ((GRHS GhcPs (LocatedA body) -> R ())
-> GenLocated EpAnnCO (GRHS GhcPs (LocatedA body)) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' (Placement
-> (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA body)
-> R ()
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)]
[GenLocated EpAnnCO (GRHS GhcPs (LocatedA body))]
grhssGRHSs
      p_where :: R ()
p_where = do
        Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HsLocalBinds GhcPs -> Bool
forall a b. HsLocalBindsLR a b -> Bool
eqEmptyLocalBinds HsLocalBinds GhcPs
grhssLocalBinds) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          R ()
breakpoint
          Bool
indentWhere <- (forall (f :: * -> *). PrinterOpts f -> f Bool) -> R Bool
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f Bool
forall (f :: * -> *). PrinterOpts f -> f Bool
poIndentWheres
          (R () -> R ()) -> (R () -> R ()) -> Bool -> R () -> R ()
forall a. a -> a -> Bool -> a
bool (Rational -> R () -> R ()
inciByFrac (-Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
2)) R () -> R ()
forall a. a -> a
id Bool
indentWhere (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ Text -> R ()
txt Text
"where"
          R ()
breakpoint
          Bool -> R () -> R ()
inciIf Bool
indentWhere (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ HsLocalBinds GhcPs -> R ()
p_hsLocalBinds HsLocalBinds GhcPs
grhssLocalBinds
  Bool -> R () -> R ()
inciIf Bool
indentBody (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated EpAnnCO (GRHS GhcPs (LocatedA body))] -> ConTag
forall a. [a] -> ConTag
forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [LGRHS GhcPs (LocatedA body)]
[GenLocated EpAnnCO (GRHS GhcPs (LocatedA body))]
grhssGRHSs ConTag -> ConTag -> Bool
forall a. Ord a => a -> a -> Bool
> ConTag
1) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      case MatchGroupStyle
style of
        Function LocatedN RdrName
_ | Bool
hasGuards -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Function LocatedN RdrName
_ -> R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
equals
        MatchGroupStyle
PatternBind -> R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
equals
        MatchGroupStyle
s | MatchGroupStyle -> Bool
isCase MatchGroupStyle
s Bool -> Bool -> Bool
&& Bool
hasGuards -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        MatchGroupStyle
_ -> R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
token'rarrow
    [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
patGrhssSpan] (R () -> R ()) -> R () -> R ()
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 = Placement
-> (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA (HsExpr GhcPs))
-> R ()
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)
_ [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
guards LocatedA body
body) =
  case [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
guards of
    [] -> R ()
p_body
    [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
xs -> do
      Text -> R ()
txt Text
"|"
      R ()
space
      R () -> R ()
sitccIfTrailing (R ()
-> (GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
    -> R ())
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
    -> R ())
-> GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> R ())
-> GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> R ()
p_stmt) [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
[GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
xs)
      R ()
space
      R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ case GroupStyle
style of
        GroupStyle
EqualSign -> R ()
equals
        GroupStyle
RightArrow -> R ()
token'rarrow
      -- If we have a sequence of guards and it is placed in the normal way,
      -- then we indent one level more for readability. Otherwise (all
      -- guards are on the same line) we do not need to indent, as it would
      -- look like double indentation without a good reason.
      ConTag
indent <- (forall (f :: * -> *). PrinterOpts f -> f ConTag) -> R ConTag
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f ConTag
forall (f :: * -> *). PrinterOpts f -> f ConTag
poIndentation
      Bool -> R () -> R ()
inciIf (ConTag
indent ConTag -> ConTag -> Bool
forall a. Ord a => a -> a -> Bool
<= ConTag
2 Bool -> Bool -> Bool
&& Placement
parentPlacement Placement -> Placement -> Bool
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 (LocatedA body -> body
forall l e. GenLocated l e -> e
unLoc LocatedA body
body)
        Just SrcSpan
spn ->
          if SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn (LocatedA body -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LocatedA body
body)
            then body -> Placement
placer (LocatedA body -> body
forall l e. GenLocated l e -> e
unLoc LocatedA body
body)
            else Placement
Normal
    endOfGuards :: Maybe SrcSpan
endOfGuards =
      case [GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> Maybe
     (NonEmpty
        (GenLocated
           SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
[GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
guards of
        Maybe
  (NonEmpty
     (GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))))
Nothing -> Maybe SrcSpan
forall a. Maybe a
Nothing
        Just NonEmpty
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
gs -> (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (SrcSpan -> Maybe SrcSpan)
-> (NonEmpty
      (GenLocated
         SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
    -> SrcSpan)
-> NonEmpty
     (GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
-> Maybe SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA (GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
 -> SrcSpan)
-> (NonEmpty
      (GenLocated
         SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
    -> GenLocated
         SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
-> NonEmpty
     (GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
forall a. NonEmpty a -> a
NE.last) NonEmpty
  (GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
gs
    p_body :: R ()
p_body = LocatedA body -> (body -> R ()) -> R ()
forall l a. HasLoc 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 (LocatedA (HsExpr GhcPs)
l, LocatedA (HsExpr GhcPs)
r) = if Bool
rightToLeft then (XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
body, XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
input) else (XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
input, XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
body)
    LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA (HsExpr GhcPs)
l ((HsExpr GhcPs -> R ()) -> R ()) -> (HsExpr GhcPs -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' IsApplicand
NotApplicand BracketStyle
s
    R ()
breakpoint
    R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      case (HsArrAppType
arrType, Bool
rightToLeft) of
        (HsArrAppType
HsFirstOrderApp, Bool
True) -> R ()
token'larrowtail
        (HsArrAppType
HsHigherOrderApp, Bool
True) -> R ()
token'Larrowtail
        (HsArrAppType
HsFirstOrderApp, Bool
False) -> R ()
token'rarrowtail
        (HsArrAppType
HsHigherOrderApp, Bool
False) -> R ()
token'Rarrowtail
      Placement -> R () -> R ()
placeHanging (HsExpr GhcPs -> Placement
exprPlacement (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
input)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
        LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA (HsExpr GhcPs)
r HsExpr GhcPs -> R ()
p_hsExpr
  HsCmdArrForm XCmdArrForm GhcPs
_ XRec GhcPs (HsExpr GhcPs)
form LexicalFixity
Prefix [LHsCmdTop GhcPs]
cmds -> BracketStyle -> R () -> R ()
banana BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
form HsExpr GhcPs -> R ()
p_hsExpr
    Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated EpAnnCO (HsCmdTop GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsCmdTop GhcPs]
[GenLocated EpAnnCO (HsCmdTop GhcPs)]
cmds) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      R ()
breakpoint
      R () -> R ()
inci ([R ()] -> R ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (R () -> [R ()] -> [R ()]
forall a. a -> [a] -> [a]
intersperse R ()
breakpoint ((HsCmdTop GhcPs -> R ())
-> GenLocated EpAnnCO (HsCmdTop GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' (BracketStyle -> HsCmdTop GhcPs -> R ()
p_hsCmdTop BracketStyle
N) (GenLocated EpAnnCO (HsCmdTop GhcPs) -> R ())
-> [GenLocated EpAnnCO (HsCmdTop GhcPs)] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsCmdTop GhcPs]
[GenLocated EpAnnCO (HsCmdTop GhcPs)]
cmds)))
  HsCmdArrForm XCmdArrForm GhcPs
_ XRec GhcPs (HsExpr GhcPs)
form LexicalFixity
Infix [LHsCmdTop GhcPs
left, LHsCmdTop GhcPs
right] -> do
    ModuleFixityMap
modFixityMap <- R ModuleFixityMap
askModuleFixityMap
    Choice "debug"
debug <- R (Choice "debug")
askDebug
    let opTree :: OpTree
  (GenLocated EpAnnCO (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
opTree = OpTree
  (GenLocated EpAnnCO (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
-> LocatedA (HsExpr GhcPs)
-> OpTree
     (GenLocated EpAnnCO (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
-> OpTree
     (GenLocated EpAnnCO (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
BinaryOpBranches (LHsCmdTop GhcPs
-> OpTree (LHsCmdTop GhcPs) (XRec GhcPs (HsExpr GhcPs))
cmdOpTree LHsCmdTop GhcPs
left) XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
form (LHsCmdTop GhcPs
-> OpTree (LHsCmdTop GhcPs) (XRec GhcPs (HsExpr GhcPs))
cmdOpTree LHsCmdTop GhcPs
right)
    BracketStyle
-> OpTree (LHsCmdTop GhcPs) (OpInfo (XRec GhcPs (HsExpr GhcPs)))
-> R ()
p_cmdOpTree
      BracketStyle
s
      (Choice "debug"
-> (LocatedA (HsExpr GhcPs) -> Maybe RdrName)
-> ModuleFixityMap
-> OpTree
     (GenLocated EpAnnCO (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
-> OpTree
     (GenLocated EpAnnCO (HsCmdTop GhcPs))
     (OpInfo (LocatedA (HsExpr GhcPs)))
forall op ty.
Choice "debug"
-> (op -> Maybe RdrName)
-> ModuleFixityMap
-> OpTree ty op
-> OpTree ty (OpInfo op)
reassociateOpTree Choice "debug"
debug (HsExpr GhcPs -> Maybe RdrName
getOpName (HsExpr GhcPs -> Maybe RdrName)
-> (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs)
-> LocatedA (HsExpr GhcPs)
-> Maybe RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc) ModuleFixityMap
modFixityMap OpTree
  (GenLocated EpAnnCO (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
opTree)
  HsCmdArrForm XCmdArrForm GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ LexicalFixity
Infix [LHsCmdTop GhcPs]
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsCmdArrForm"
  HsCmdApp XCmdApp GhcPs
_ XRec GhcPs (HsCmd GhcPs)
cmd XRec GhcPs (HsExpr GhcPs)
expr -> do
    LocatedA (HsCmd GhcPs) -> (HsCmd GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsCmd GhcPs)
LocatedA (HsCmd GhcPs)
cmd (IsApplicand -> BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' IsApplicand
Applicand BracketStyle
s)
    R ()
breakpoint
    R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
  HsCmdLam XCmdLamCase GhcPs
_ HsLamVariant
variant MatchGroup GhcPs (XRec GhcPs (HsCmd GhcPs))
mgroup -> IsApplicand
-> HsLamVariant
-> (HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
IsApplicand
-> HsLamVariant
-> (body -> Placement)
-> (body -> R ())
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_lam IsApplicand
isApp HsLamVariant
variant HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd MatchGroup GhcPs (XRec GhcPs (HsCmd GhcPs))
MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
mgroup
  HsCmdPar XCmdPar GhcPs
_ XRec GhcPs (HsCmd GhcPs)
c -> BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LocatedA (HsCmd GhcPs) -> (HsCmd GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsCmd GhcPs)
LocatedA (HsCmd GhcPs)
c HsCmd GhcPs -> R ()
p_hsCmd
  HsCmdCase XCmdCase GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (XRec GhcPs (HsCmd GhcPs))
mgroup ->
    IsApplicand
-> (HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,
 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 (XRec GhcPs (HsCmd GhcPs))
MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
mgroup
  HsCmdIf XCmdIf GhcPs
anns SyntaxExpr GhcPs
_ XRec GhcPs (HsExpr GhcPs)
if' XRec GhcPs (HsCmd GhcPs)
then' XRec GhcPs (HsCmd GhcPs)
else' ->
    (HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> AnnsIf
-> XRec GhcPs (HsExpr GhcPs)
-> LocatedA (HsCmd GhcPs)
-> LocatedA (HsCmd GhcPs)
-> R ()
forall body.
(body -> Placement)
-> (body -> R ())
-> AnnsIf
-> XRec GhcPs (HsExpr GhcPs)
-> LocatedA body
-> LocatedA body
-> R ()
p_if HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd XCmdIf GhcPs
AnnsIf
anns XRec GhcPs (HsExpr GhcPs)
if' XRec GhcPs (HsCmd GhcPs)
LocatedA (HsCmd GhcPs)
then' XRec GhcPs (HsCmd GhcPs)
LocatedA (HsCmd GhcPs)
else'
  HsCmdLet (EpToken "let"
letToken, EpToken "in"
_) HsLocalBinds GhcPs
localBinds XRec GhcPs (HsCmd GhcPs)
c ->
    Bool
-> (HsCmd GhcPs -> R ())
-> EpToken "let"
-> HsLocalBinds GhcPs
-> LocatedA (HsCmd GhcPs)
-> R ()
forall body.
Bool
-> (body -> R ())
-> EpToken "let"
-> HsLocalBinds GhcPs
-> LocatedA body
-> R ()
p_let (BracketStyle
s BracketStyle -> BracketStyle -> Bool
forall a. Eq a => a -> a -> Bool
== BracketStyle
S) HsCmd GhcPs -> R ()
p_hsCmd EpToken "let"
letToken HsLocalBinds GhcPs
localBinds XRec GhcPs (HsCmd GhcPs)
LocatedA (HsCmd GhcPs)
c
  HsCmdDo XCmdDo GhcPs
_ XRec GhcPs [LStmt GhcPs (XRec GhcPs (HsCmd GhcPs))]
es -> do
    Text -> R ()
txt Text
"do"
    BracketStyle
-> IsApplicand
-> (HsCmd GhcPs -> Placement)
-> (BracketStyle -> HsCmd GhcPs -> R ())
-> XRec GhcPs [LStmt GhcPs (XRec GhcPs (HsCmd GhcPs))]
-> R ()
forall body.
(Anno [LStmt GhcPs (XRec GhcPs body)] ~ SrcSpanAnnLW,
 Anno (Stmt GhcPs (XRec GhcPs body)) ~ SrcSpanAnnA,
 Anno body ~ SrcSpanAnnA) =>
BracketStyle
-> IsApplicand
-> (body -> Placement)
-> (BracketStyle -> body -> R ())
-> XRec GhcPs [LStmt GhcPs (XRec GhcPs body)]
-> R ()
p_stmts BracketStyle
S IsApplicand
isApp HsCmd GhcPs -> Placement
cmdPlacement (IsApplicand -> BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' IsApplicand
NotApplicand) XRec GhcPs [LStmt GhcPs (XRec GhcPs (HsCmd 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
_ XRec GhcPs (HsCmd GhcPs)
cmd) = LocatedA (HsCmd GhcPs) -> (HsCmd GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsCmd GhcPs)
LocatedA (HsCmd 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 = LocatedAn ann a -> (a -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedAn ann a
l ((a -> R ()) -> R ()) -> (a -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
  case LocatedAn ann a -> SrcSpan
forall a e. HasLoc a => GenLocated 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 R (Maybe SpanMark) -> (Maybe SpanMark -> R ()) -> R ()
forall a b. R a -> (a -> R b) -> R b
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 ConTag -> ConTag -> Bool
forall a. Ord a => a -> a -> Bool
> RealSrcSpan -> ConTag
srcSpanEndLine RealSrcSpan
lastSpn ConTag -> ConTag -> ConTag
forall a. Num a => a -> a -> a
+ ConTag
1
            then R ()
newline
            else () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Maybe SpanMark
_ -> () -> R ()
forall a. a -> R a
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 R (Maybe SpanMark) -> (Maybe SpanMark -> R ()) -> R ()
forall a b. R a -> (a -> R b) -> R b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just (HaddockSpan HaddockStyle
_ RealSrcSpan
_) -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (CommentSpan RealSrcSpan
_) -> () -> R ()
forall a. a -> R a
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 = BracketStyle
-> (HsExpr GhcPs -> Placement)
-> (BracketStyle -> HsExpr GhcPs -> R ())
-> Stmt GhcPs (XRec GhcPs (HsExpr GhcPs))
-> R ()
forall body.
(Anno [LStmt GhcPs (XRec GhcPs body)] ~ SrcSpanAnnLW,
 Anno (Stmt GhcPs (XRec GhcPs body)) ~ SrcSpanAnnA,
 Anno body ~ SrcSpanAnnA) =>
BracketStyle
-> (body -> Placement)
-> (BracketStyle -> body -> R ())
-> Stmt GhcPs (XRec GhcPs body)
-> R ()
p_stmt' BracketStyle
N HsExpr GhcPs -> Placement
exprPlacement (IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' IsApplicand
NotApplicand)

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

p_stmts ::
  ( Anno [LStmt GhcPs (XRec GhcPs body)] ~ SrcSpanAnnLW,
    Anno (Stmt GhcPs (XRec GhcPs body)) ~ SrcSpanAnnA,
    Anno body ~ SrcSpanAnnA
  ) =>
  BracketStyle ->
  IsApplicand ->
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (BracketStyle -> body -> R ()) ->
  -- | Statements to render
  XRec GhcPs [LStmt GhcPs (XRec GhcPs body)] ->
  R ()
p_stmts :: forall body.
(Anno [LStmt GhcPs (XRec GhcPs body)] ~ SrcSpanAnnLW,
 Anno (Stmt GhcPs (XRec GhcPs body)) ~ SrcSpanAnnA,
 Anno body ~ SrcSpanAnnA) =>
BracketStyle
-> IsApplicand
-> (body -> Placement)
-> (BracketStyle -> body -> R ())
-> XRec GhcPs [LStmt GhcPs (XRec GhcPs body)]
-> R ()
p_stmts BracketStyle
s IsApplicand
isApp body -> Placement
placer BracketStyle -> body -> R ()
render XRec GhcPs [LStmt GhcPs (XRec GhcPs body)]
es = do
  R ()
breakpoint
  R () -> R ()
ub <- Layout -> R () -> R ()
layoutToBraces (Layout -> R () -> R ()) -> R Layout -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Layout
getLayout
  let p_stmtExt :: (RelativePos,
 GenLocated SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body)))
-> R ()
p_stmtExt (RelativePos
relPos, GenLocated SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body))
stmt) =
        R () -> R ()
ub' (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ (Stmt GhcPs (GenLocated SrcSpanAnnA body) -> R ())
-> GenLocated
     SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body))
-> R ()
forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing (BracketStyle
-> (body -> Placement)
-> (BracketStyle -> body -> R ())
-> Stmt GhcPs (XRec GhcPs body)
-> R ()
forall body.
(Anno [LStmt GhcPs (XRec GhcPs body)] ~ SrcSpanAnnLW,
 Anno (Stmt GhcPs (XRec GhcPs body)) ~ SrcSpanAnnA,
 Anno body ~ SrcSpanAnnA) =>
BracketStyle
-> (body -> Placement)
-> (BracketStyle -> body -> R ())
-> Stmt GhcPs (XRec GhcPs body)
-> R ()
p_stmt' BracketStyle
s body -> Placement
placer BracketStyle -> body -> R ()
render) GenLocated SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body))
stmt
        where
          -- We need to set brace usage information for all but the last
          -- statement (e.g.in the case of nested do blocks).
          ub' :: R () -> R ()
ub' = case RelativePos
relPos of
            RelativePos
FirstPos -> R () -> R ()
ub
            RelativePos
MiddlePos -> R () -> R ()
ub
            RelativePos
LastPos -> R () -> R ()
forall a. a -> a
id
            RelativePos
SinglePos -> R () -> R ()
forall a. a -> a
id
  IsApplicand -> R () -> R ()
inciApplicand IsApplicand
isApp (R () -> R ())
-> (([GenLocated
        SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body))]
     -> R ())
    -> R ())
-> ([GenLocated
       SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body))]
    -> R ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnLW
  [GenLocated SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body))]
-> ([GenLocated
       SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body))]
    -> R ())
-> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs [LStmt GhcPs (XRec GhcPs body)]
GenLocated
  SrcSpanAnnLW
  [GenLocated SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body))]
es (([GenLocated
     SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body))]
  -> R ())
 -> R ())
-> ([GenLocated
       SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body))]
    -> R ())
-> R ()
forall a b. (a -> b) -> a -> b
$
    ((RelativePos,
  GenLocated SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body)))
 -> R ())
-> [(RelativePos,
     GenLocated SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body)))]
-> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi (RelativePos,
 GenLocated SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body)))
-> R ()
p_stmtExt ([(RelativePos,
   GenLocated SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body)))]
 -> R ())
-> ([GenLocated
       SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body))]
    -> [(RelativePos,
         GenLocated
           SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body)))])
-> [GenLocated
      SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body))]
-> [(RelativePos,
     GenLocated SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA body)))]
forall a. [a] -> [(RelativePos, a)]
attachRelativePos

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
binds [LSig GhcPs]
lsigs) -> SrcSpanAnnLW -> R () -> R ()
forall {a}. EpAnn (AnnList a) -> R () -> R ()
pseudoLocated XHsValBinds GhcPs GhcPs
SrcSpanAnnLW
epAnn (R () -> R ()) -> R () -> R ()
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 (Layout -> R () -> R ()) -> R Layout -> R (R () -> R ())
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) = l -> Either a b -> GenLocated l (Either a b)
forall l e. l -> e -> GenLocated l e
L l
l (a -> Either a b
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) = l -> Either a b -> GenLocated l (Either a b)
forall l e. l -> e -> GenLocated l e
L l
l (b -> Either a b
forall a b. b -> Either a b
Right b
x)
           in (GenLocated SrcSpanAnnA (HsBind GhcPs)
-> GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
forall {l} {a} {b}. GenLocated l a -> GenLocated l (Either a b)
injectLeft (GenLocated SrcSpanAnnA (HsBind GhcPs)
 -> GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs)))
-> [GenLocated SrcSpanAnnA (HsBind GhcPs)]
-> [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsBindsLR GhcPs GhcPs
[GenLocated SrcSpanAnnA (HsBind GhcPs)]
binds) [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
-> [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
-> [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
forall a. [a] -> [a] -> [a]
++ (GenLocated SrcSpanAnnA (Sig GhcPs)
-> GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
forall {l} {b} {a}. GenLocated l b -> GenLocated l (Either a b)
injectRight (GenLocated SrcSpanAnnA (Sig GhcPs)
 -> GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs)))
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
-> [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
lsigs)
        positionToBracing :: RelativePos -> R () -> R ()
positionToBracing = \case
          RelativePos
SinglePos -> R () -> R ()
forall a. a -> a
id
          RelativePos
FirstPos -> R () -> R ()
br
          RelativePos
MiddlePos -> R () -> R ()
br
          RelativePos
LastPos -> R () -> R ()
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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
            (Either (HsBind GhcPs) (Sig GhcPs) -> R ())
-> GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
-> R ()
forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing ((HsBind GhcPs -> R ())
-> (Sig GhcPs -> R ()) -> Either (HsBind GhcPs) (Sig GhcPs) -> R ()
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
        items' :: [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
items' = (GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
 -> GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
 -> Ordering)
-> [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
-> [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
    -> SrcSpan)
-> GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
-> GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
-> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA) [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
items
    R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ ((RelativePos,
  GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs)))
 -> R ())
-> [(RelativePos,
     GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs)))]
-> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi (RelativePos,
 GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs)))
-> R ()
p_item' ([GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
-> [(RelativePos,
     GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs)))]
forall a. [a] -> [(RelativePos, a)]
attachRelativePos [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
items')
  HsValBinds XHsValBinds GhcPs GhcPs
_ HsValBindsLR GhcPs GhcPs
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsValBinds"
  HsIPBinds XHsIPBinds GhcPs GhcPs
epAnn (IPBinds XIPBinds GhcPs
_ [LIPBind GhcPs]
xs) -> SrcSpanAnnLW -> R () -> R ()
forall {a}. EpAnn (AnnList a) -> R () -> R ()
pseudoLocated XHsIPBinds GhcPs GhcPs
SrcSpanAnnLW
epAnn (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    let p_ipBind :: IPBind GhcPs -> R ()
p_ipBind (IPBind XCIPBind GhcPs
_ (L EpAnnCO
_ 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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
    (GenLocated SrcSpanAnnA (IPBind GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (IPBind GhcPs)] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((IPBind GhcPs -> R ())
-> GenLocated SrcSpanAnnA (IPBind GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' IPBind GhcPs -> R ()
p_ipBind) [LIPBind GhcPs]
[GenLocated SrcSpanAnnA (IPBind GhcPs)]
xs
  EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_ -> () -> R ()
forall a. a -> R a
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 a) -> R () -> R ()
pseudoLocated = \case
      EpAnn {anns :: forall ann. EpAnn ann -> ann
anns = AnnList {Maybe EpaLocation
al_anchor :: Maybe EpaLocation
al_anchor :: forall a. AnnList a -> Maybe EpaLocation
al_anchor}}
        | -- excluding cases where there are no bindings
          Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Bool
isZeroWidthSpan (Maybe EpaLocation -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA Maybe EpaLocation
al_anchor) ->
            GenLocated (Maybe EpaLocation) () -> (() -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located (Maybe EpaLocation -> () -> GenLocated (Maybe EpaLocation) ()
forall l e. l -> e -> GenLocated l e
L Maybe EpaLocation
al_anchor ()) ((() -> R ()) -> R ()) -> (R () -> () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> () -> R ()
forall a b. a -> b -> a
const
      EpAnn (AnnList a)
_ -> R () -> R ()
forall a. a -> a
id

p_dotFieldOcc :: DotFieldOcc GhcPs -> R ()
p_dotFieldOcc :: DotFieldOcc GhcPs -> R ()
p_dotFieldOcc =
  LocatedN RdrName -> R ()
p_rdrName (LocatedN RdrName -> R ())
-> (DotFieldOcc GhcPs -> LocatedN RdrName)
-> DotFieldOcc GhcPs
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldLabelString -> RdrName)
-> GenLocated SrcSpanAnnN FieldLabelString -> LocatedN RdrName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FastString -> RdrName
mkVarUnqual (FastString -> RdrName)
-> (FieldLabelString -> FastString) -> FieldLabelString -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabelString -> FastString
field_label) (GenLocated SrcSpanAnnN FieldLabelString -> LocatedN RdrName)
-> (DotFieldOcc GhcPs -> GenLocated SrcSpanAnnN FieldLabelString)
-> DotFieldOcc GhcPs
-> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotFieldOcc GhcPs -> XRec GhcPs FieldLabelString
DotFieldOcc GhcPs -> GenLocated SrcSpanAnnN FieldLabelString
forall p. DotFieldOcc p -> XRec p FieldLabelString
dfoLabel

p_dotFieldOccs :: [DotFieldOcc GhcPs] -> R ()
p_dotFieldOccs :: [DotFieldOcc GhcPs] -> R ()
p_dotFieldOccs = R () -> (DotFieldOcc GhcPs -> R ()) -> [DotFieldOcc GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt Text
".") DotFieldOcc GhcPs -> R ()
p_dotFieldOcc

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

p_hsFieldBind ::
  (lhs ~ GenLocated l a, HasLoc l) =>
  (lhs -> R ()) ->
  HsFieldBind lhs (LHsExpr GhcPs) ->
  R ()
p_hsFieldBind :: forall lhs l a.
(lhs ~ GenLocated l a, HasLoc l) =>
(lhs -> R ())
-> HsFieldBind lhs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_hsFieldBind lhs -> R ()
p_lhs HsFieldBind {lhs
Bool
XHsFieldBind lhs
XRec GhcPs (HsExpr GhcPs)
hfbAnn :: XHsFieldBind lhs
hfbLHS :: lhs
hfbRHS :: XRec GhcPs (HsExpr GhcPs)
hfbPun :: Bool
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
..} = do
  lhs -> R ()
p_lhs lhs
hfbLHS
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hfbPun (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    R ()
space
    R ()
equals
    let placement :: Placement
placement =
          if SrcSpan -> SrcSpan -> Bool
onTheSameLine (GenLocated l a -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA lhs
GenLocated l a
hfbLHS) (LocatedA (HsExpr GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
hfbRHS)
            then HsExpr GhcPs -> Placement
exprPlacement (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
hfbRHS)
            else Placement
Normal
    Placement -> R () -> R ()
placeHanging Placement
placement (LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (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 (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
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
LocatedN RdrName
name
  HsUnboundVar XUnboundVar GhcPs
_ RdrName
occ -> RdrName -> R ()
forall a. Outputable a => a -> R ()
atom RdrName
occ
  HsOverLabel XOverLabel GhcPs
sourceText FastString
_ -> do
    Text -> R ()
txt Text
"#"
    SourceText -> R ()
p_sourceText XOverLabel GhcPs
SourceText
sourceText
  HsIPVar XIPVar GhcPs
_ (HsIPName FastString
name) -> do
    Text -> R ()
txt Text
"?"
    FastString -> R ()
forall a. Outputable a => a -> R ()
atom FastString
name
  HsOverLit XOverLitE GhcPs
_ HsOverLit GhcPs
v -> OverLitVal -> R ()
forall a. Outputable a => a -> R ()
atom (HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit GhcPs
v)
  HsLit XLitE GhcPs
_ HsLit GhcPs
lit ->
    case HsLit GhcPs
lit of
      HsString (SourceText FastString
stxt) FastString
_ -> FastString -> R ()
p_stringLit FastString
stxt
      HsStringPrim (SourceText FastString
stxt) ByteString
_ -> FastString -> R ()
p_stringLit FastString
stxt
      HsMultilineString (SourceText FastString
stxt) FastString
_ -> FastString -> R ()
p_stringLit FastString
stxt
      HsLit GhcPs
r -> HsLit GhcPs -> R ()
forall a. Outputable a => a -> R ()
atom HsLit GhcPs
r
  HsLam XLam GhcPs
_ HsLamVariant
variant MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup ->
    IsApplicand
-> HsLamVariant
-> (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> MatchGroup GhcPs (LocatedA (HsExpr GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
IsApplicand
-> HsLamVariant
-> (body -> Placement)
-> (body -> R ())
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_lam IsApplicand
isApp HsLamVariant
variant HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
MatchGroup GhcPs (LocatedA (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 (GenLocated l (HsExpr p))
-> (GenLocated l (HsExpr p), NonEmpty (GenLocated l (HsExpr p)))
gatherArgs GenLocated l (HsExpr p)
f' NonEmpty (GenLocated l (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 (GenLocated l (HsExpr p))
-> (GenLocated l (HsExpr p), NonEmpty (GenLocated l (HsExpr p)))
gatherArgs XRec p (HsExpr p)
GenLocated l (HsExpr p)
l (XRec p (HsExpr p)
GenLocated l (HsExpr p)
r GenLocated l (HsExpr p)
-> NonEmpty (GenLocated l (HsExpr p))
-> NonEmpty (GenLocated l (HsExpr p))
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty (GenLocated l (HsExpr p))
knownArgs)
            GenLocated l (HsExpr p)
_ -> (GenLocated l (HsExpr p)
f', NonEmpty (GenLocated l (HsExpr p))
knownArgs)
        (LocatedA (HsExpr GhcPs)
func, NonEmpty (LocatedA (HsExpr GhcPs))
args) = LocatedA (HsExpr GhcPs)
-> NonEmpty (LocatedA (HsExpr GhcPs))
-> (LocatedA (HsExpr GhcPs), NonEmpty (LocatedA (HsExpr GhcPs)))
forall {p} {l}.
(XRec p (HsExpr p) ~ GenLocated l (HsExpr p)) =>
GenLocated l (HsExpr p)
-> NonEmpty (GenLocated l (HsExpr p))
-> (GenLocated l (HsExpr p), NonEmpty (GenLocated l (HsExpr p)))
gatherArgs XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
f (XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
x LocatedA (HsExpr GhcPs)
-> [LocatedA (HsExpr GhcPs)] -> NonEmpty (LocatedA (HsExpr GhcPs))
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.
        ([LocatedA (HsExpr GhcPs)]
initp, LocatedA (HsExpr GhcPs)
lastp) = (NonEmpty (LocatedA (HsExpr GhcPs)) -> [LocatedA (HsExpr GhcPs)]
forall a. NonEmpty a -> [a]
NE.init NonEmpty (LocatedA (HsExpr GhcPs))
args, NonEmpty (LocatedA (HsExpr GhcPs)) -> LocatedA (HsExpr GhcPs)
forall a. NonEmpty a -> a
NE.last NonEmpty (LocatedA (HsExpr GhcPs))
args)
        initSpan :: SrcSpan
initSpan =
          NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$
            LocatedA (HsExpr GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
f SrcSpan -> [SrcSpan] -> NonEmpty SrcSpan
forall a. a -> [a] -> NonEmpty a
:| [(SrcLoc -> SrcSpan
srcLocSpan (SrcLoc -> SrcSpan)
-> (LocatedA (HsExpr GhcPs) -> SrcLoc)
-> LocatedA (HsExpr GhcPs)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc)
-> (LocatedA (HsExpr GhcPs) -> SrcSpan)
-> LocatedA (HsExpr GhcPs)
-> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA (HsExpr GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA) LocatedA (HsExpr GhcPs)
lastp]
    -- Hang the last argument only if the initial arguments span one line.
    Placement
placement <-
      [SrcSpan] -> R Layout
spansLayout [SrcSpan
initSpan] R Layout -> (Layout -> Placement) -> R Placement
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Layout
SingleLine -> HsExpr GhcPs -> Placement
exprPlacement (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LocatedA (HsExpr GhcPs)
lastp)
        Layout
MultiLine -> Placement
Normal
    -- If the last argument is not hanging, just separate every argument as
    -- usual. If it is hanging, print the initial arguments and hang the
    -- last one. Also, use braces around the every argument except the last
    -- one.
    case Placement
placement of
      Placement
Normal -> do
        let indentArg :: R () -> R ()
indentArg =
              -- Normally, inciApplicand handles the case of multiline
              -- function application in a do-block, but in the specific
              -- case of:
              --
              --   do f
              --     a
              --
              -- we need to indent by exactly 2 spaces, to avoid going past
              -- the start of the statement.
              case LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LocatedA (HsExpr GhcPs)
func of
                HsDo {} | SrcSpan -> Bool
isOneLineSpan (LocatedA (HsExpr GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LocatedA (HsExpr GhcPs)
func) -> ConTag -> R () -> R ()
inciBy ConTag
2
                HsExpr GhcPs
_ -> R () -> R ()
inci
        R () -> R ()
ub <-
          R Layout
getLayout R Layout -> (Layout -> R () -> R ()) -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            Layout
SingleLine -> R () -> R ()
useBraces
            Layout
MultiLine -> R () -> R ()
forall a. a -> a
id
        R () -> R ()
ub (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA (HsExpr GhcPs)
func (IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' IsApplicand
Applicand BracketStyle
s)
          R ()
breakpoint
          R () -> R ()
indentArg (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (LocatedA (HsExpr GhcPs) -> R ())
-> [LocatedA (HsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((HsExpr GhcPs -> R ()) -> LocatedA (HsExpr GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LocatedA (HsExpr GhcPs)]
initp
        R () -> R ()
indentArg (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LocatedA (HsExpr GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LocatedA (HsExpr GhcPs)]
initp) R ()
breakpoint
          LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA (HsExpr GhcPs)
lastp HsExpr GhcPs -> R ()
p_hsExpr
      Placement
Hanging -> do
        R () -> R ()
useBraces (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
initSpan] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA (HsExpr GhcPs)
func (IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' IsApplicand
Applicand BracketStyle
s)
          R ()
breakpoint
          R ()
-> (LocatedA (HsExpr GhcPs) -> R ())
-> [LocatedA (HsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((HsExpr GhcPs -> R ()) -> LocatedA (HsExpr GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LocatedA (HsExpr GhcPs)]
initp
        Placement -> R () -> R ()
placeHanging Placement
placement (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
          LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA (HsExpr GhcPs)
lastp HsExpr GhcPs -> R ()
p_hsExpr
  HsAppType XAppTypeE GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e LHsWcType (NoGhcTc GhcPs)
a -> do
    LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
    R ()
breakpoint
    R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> R ()
txt Text
"@"
      GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsWcType (NoGhcTc GhcPs)
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType 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
    Choice "debug"
debug <- R (Choice "debug")
askDebug
    let opTree :: OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
opTree = OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
-> LocatedA (HsExpr GhcPs)
-> OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
-> OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
BinaryOpBranches (XRec GhcPs (HsExpr GhcPs)
-> OpTree (XRec GhcPs (HsExpr GhcPs)) (XRec GhcPs (HsExpr GhcPs))
exprOpTree XRec GhcPs (HsExpr GhcPs)
x) XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
op (XRec GhcPs (HsExpr GhcPs)
-> OpTree (XRec GhcPs (HsExpr GhcPs)) (XRec GhcPs (HsExpr GhcPs))
exprOpTree XRec GhcPs (HsExpr GhcPs)
y)
    BracketStyle
-> OpTree
     (XRec GhcPs (HsExpr GhcPs)) (OpInfo (XRec GhcPs (HsExpr GhcPs)))
-> R ()
p_exprOpTree
      BracketStyle
s
      (Choice "debug"
-> (LocatedA (HsExpr GhcPs) -> Maybe RdrName)
-> ModuleFixityMap
-> OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
-> OpTree
     (LocatedA (HsExpr GhcPs)) (OpInfo (LocatedA (HsExpr GhcPs)))
forall op ty.
Choice "debug"
-> (op -> Maybe RdrName)
-> ModuleFixityMap
-> OpTree ty op
-> OpTree ty (OpInfo op)
reassociateOpTree Choice "debug"
debug (HsExpr GhcPs -> Maybe RdrName
getOpName (HsExpr GhcPs -> Maybe RdrName)
-> (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs)
-> LocatedA (HsExpr GhcPs)
-> Maybe RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc) ModuleFixityMap
modFixityMap OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (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 LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
LocatedA (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.
    Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
negativeLiterals Bool -> Bool -> Bool
&& Bool
isLiteral) R ()
space
    LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
  HsPar XPar GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e -> do
    [SrcSpan]
csSpans <-
      (GenLocated RealSrcSpan Comment -> SrcSpan)
-> [GenLocated RealSrcSpan Comment] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RealSrcSpan -> Maybe BufSpan -> SrcSpan)
-> Maybe BufSpan -> RealSrcSpan -> SrcSpan
forall a b c. (a -> b -> c) -> b -> a -> c
flip RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan Maybe BufSpan
forall a. Maybe a
Strict.Nothing (RealSrcSpan -> SrcSpan)
-> (GenLocated RealSrcSpan Comment -> RealSrcSpan)
-> GenLocated RealSrcSpan Comment
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated RealSrcSpan Comment -> RealSrcSpan
forall l e. GenLocated l e -> l
getLoc) ([GenLocated RealSrcSpan Comment] -> [SrcSpan])
-> R [GenLocated RealSrcSpan Comment] -> R [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R [GenLocated RealSrcSpan Comment]
getEnclosingComments
    [SrcSpan] -> R () -> R ()
switchLayout (LocatedA (HsExpr GhcPs) -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
e SrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
: [SrcSpan]
csSpans) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      BracketStyle -> R () -> R ()
parens BracketStyle
s (R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
e (R () -> R ()
dontUseBraces (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
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
    LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr
    R ()
breakpoint
    R () -> R ()
inci (LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
op HsExpr GhcPs -> R ()
p_hsExpr)
  SectionR XSectionR GhcPs
_ XRec GhcPs (HsExpr GhcPs)
op XRec GhcPs (HsExpr GhcPs)
x -> do
    LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
op HsExpr GhcPs -> R ()
p_hsExpr
    R ()
breakpoint
    R () -> R ()
inci (LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr)
  ExplicitTuple XExplicitTuple GhcPs
_ [HsTupArg GhcPs]
args Boxity
boxity -> do
    let isSection :: Bool
isSection = (HsTupArg GhcPs -> Bool) -> [HsTupArg GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any HsTupArg GhcPs -> Bool
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 (R () -> R ())
-> (HsTupArg GhcPs -> R ()) -> HsTupArg GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
            Present XPresent GhcPs
_ XRec GhcPs (HsExpr GhcPs)
x -> LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExprListItem
            Missing XMissing GhcPs
_ -> () -> R ()
forall a. a -> R a
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 <-
      (RealSrcSpan -> SrcSpan) -> [RealSrcSpan] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RealSrcSpan -> Maybe BufSpan -> SrcSpan)
-> Maybe BufSpan -> RealSrcSpan -> SrcSpan
forall a b c. (a -> b -> c) -> b -> a -> c
flip RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan Maybe BufSpan
forall a. Maybe a
Strict.Nothing) ([RealSrcSpan] -> [SrcSpan])
-> (Maybe RealSrcSpan -> [RealSrcSpan])
-> Maybe RealSrcSpan
-> [SrcSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe RealSrcSpan -> [RealSrcSpan]
forall a. Maybe a -> [a]
maybeToList
        (Maybe RealSrcSpan -> [SrcSpan])
-> R (Maybe RealSrcSpan) -> R [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R (Maybe RealSrcSpan)
getEnclosingSpan
    if Bool
isSection
      then
        [SrcSpan] -> R () -> R ()
switchLayout [] (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
          R () -> (HsTupArg GhcPs -> R ()) -> [HsTupArg GhcPs] -> R ()
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 (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
          R () -> (HsTupArg GhcPs -> R ()) -> [HsTupArg GhcPs] -> R ()
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 (LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr)
  HsCase XCase GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup ->
    IsApplicand
-> (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> MatchGroup GhcPs (LocatedA (HsExpr GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,
 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))
MatchGroup GhcPs (LocatedA (HsExpr GhcPs))
mgroup
  HsIf XIf GhcPs
anns XRec GhcPs (HsExpr GhcPs)
if' XRec GhcPs (HsExpr GhcPs)
then' XRec GhcPs (HsExpr GhcPs)
else' ->
    (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> AnnsIf
-> XRec GhcPs (HsExpr GhcPs)
-> LocatedA (HsExpr GhcPs)
-> LocatedA (HsExpr GhcPs)
-> R ()
forall body.
(body -> Placement)
-> (body -> R ())
-> AnnsIf
-> XRec GhcPs (HsExpr GhcPs)
-> LocatedA body
-> LocatedA body
-> R ()
p_if HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr XIf GhcPs
AnnsIf
anns XRec GhcPs (HsExpr GhcPs)
if' XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
then' XRec GhcPs (HsExpr GhcPs)
LocatedA (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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated EpAnnCO (GRHS GhcPs (LocatedA (HsExpr GhcPs)))
    -> R ())
-> [GenLocated EpAnnCO (GRHS GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((GRHS GhcPs (LocatedA (HsExpr GhcPs)) -> R ())
-> GenLocated EpAnnCO (GRHS GhcPs (LocatedA (HsExpr GhcPs)))
-> R ()
forall l a. HasLoc 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))]
[GenLocated EpAnnCO (GRHS GhcPs (LocatedA (HsExpr GhcPs)))]
guards
  HsLet (EpToken "let"
letToken, EpToken "in"
_) HsLocalBinds GhcPs
localBinds XRec GhcPs (HsExpr GhcPs)
e ->
    Bool
-> (HsExpr GhcPs -> R ())
-> EpToken "let"
-> HsLocalBinds GhcPs
-> LocatedA (HsExpr GhcPs)
-> R ()
forall body.
Bool
-> (body -> R ())
-> EpToken "let"
-> HsLocalBinds GhcPs
-> LocatedA body
-> R ()
p_let (BracketStyle
s BracketStyle -> BracketStyle -> Bool
forall a. Eq a => a -> a -> Bool
== BracketStyle
S) HsExpr GhcPs -> R ()
p_hsExpr EpToken "let"
letToken HsLocalBinds GhcPs
localBinds XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
e
  HsDo XDo GhcPs
_ HsDoFlavour
doFlavor XRec GhcPs [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
es -> do
    let doBody :: Maybe ModuleName -> Text -> R ()
doBody Maybe ModuleName
moduleName Text
header = do
          Maybe ModuleName -> (ModuleName -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ModuleName
moduleName ((ModuleName -> R ()) -> R ()) -> (ModuleName -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \ModuleName
m -> ModuleName -> R ()
forall a. Outputable a => a -> R ()
atom ModuleName
m R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> R ()
txt Text
"."
          Text -> R ()
txt Text
header
          BracketStyle
-> IsApplicand
-> (HsExpr GhcPs -> Placement)
-> (BracketStyle -> HsExpr GhcPs -> R ())
-> XRec GhcPs [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
-> R ()
forall body.
(Anno [LStmt GhcPs (XRec GhcPs body)] ~ SrcSpanAnnLW,
 Anno (Stmt GhcPs (XRec GhcPs body)) ~ SrcSpanAnnA,
 Anno body ~ SrcSpanAnnA) =>
BracketStyle
-> IsApplicand
-> (body -> Placement)
-> (BracketStyle -> body -> R ())
-> XRec GhcPs [LStmt GhcPs (XRec GhcPs body)]
-> R ()
p_stmts BracketStyle
S IsApplicand
isApp HsExpr GhcPs -> Placement
exprPlacement (IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' IsApplicand
NotApplicand) XRec GhcPs [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
es
    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 -> BracketStyle
-> XRec GhcPs [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))] -> R ()
p_listComp BracketStyle
s XRec GhcPs [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
es
      HsDoFlavour
MonadComp -> BracketStyle
-> XRec GhcPs [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))] -> R ()
p_listComp BracketStyle
s XRec GhcPs [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
es
      HsDoFlavour
GhciStmtCtxt -> String -> R ()
forall a. String -> a
notImplemented String
"GhciStmtCtxt"
  ExplicitList XExplicitList GhcPs
_ [XRec GhcPs (HsExpr GhcPs)]
xs ->
    BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      R ()
-> (LocatedA (HsExpr GhcPs) -> R ())
-> [LocatedA (HsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (LocatedA (HsExpr GhcPs) -> R ())
-> LocatedA (HsExpr GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsExpr GhcPs -> R ()) -> LocatedA (HsExpr GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExprListItem) [XRec GhcPs (HsExpr GhcPs)]
[LocatedA (HsExpr GhcPs)]
xs
  RecordCon {XRecordCon GhcPs
XRec GhcPs (ConLikeP GhcPs)
HsRecordBinds GhcPs
rcon_ext :: XRecordCon GhcPs
rcon_con :: XRec GhcPs (ConLikeP GhcPs)
rcon_flds :: HsRecordBinds GhcPs
rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_con :: forall p. HsExpr p -> XRec p (ConLikeP p)
rcon_ext :: forall p. HsExpr p -> XRecordCon p
..} -> do
    LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
rcon_con
    R ()
breakpointPreRecordBrace
    let HsRecFields {[LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
Maybe (XRec GhcPs RecFieldsDotDot)
XHsRecFields GhcPs
rec_ext :: XHsRecFields GhcPs
rec_flds :: [LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
rec_dotdot :: Maybe (XRec GhcPs RecFieldsDotDot)
rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_ext :: forall p arg. HsRecFields p arg -> XHsRecFields p
..} = HsRecordBinds GhcPs
rcon_flds
        p_lhs :: GenLocated SrcSpanAnnA (FieldOcc GhcPs) -> R ()
p_lhs = (FieldOcc GhcPs -> R ())
-> GenLocated SrcSpanAnnA (FieldOcc GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' ((FieldOcc GhcPs -> R ())
 -> GenLocated SrcSpanAnnA (FieldOcc GhcPs) -> R ())
-> (FieldOcc GhcPs -> R ())
-> GenLocated SrcSpanAnnA (FieldOcc GhcPs)
-> R ()
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> R ()
p_rdrName (LocatedN RdrName -> R ())
-> (FieldOcc GhcPs -> LocatedN RdrName) -> FieldOcc GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc GhcPs -> LIdP GhcPs
FieldOcc GhcPs -> LocatedN RdrName
forall pass. FieldOcc pass -> LIdP pass
foLabel
        fields :: [R ()]
fields = (HsFieldBind
   (GenLocated SrcSpanAnnA (FieldOcc GhcPs)) (LocatedA (HsExpr GhcPs))
 -> R ())
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
        (LocatedA (HsExpr GhcPs)))
-> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' ((GenLocated SrcSpanAnnA (FieldOcc GhcPs) -> R ())
-> HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
     (XRec GhcPs (HsExpr GhcPs))
-> R ()
forall lhs l a.
(lhs ~ GenLocated l a, HasLoc l) =>
(lhs -> R ())
-> HsFieldBind lhs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_hsFieldBind GenLocated SrcSpanAnnA (FieldOcc GhcPs) -> R ()
p_lhs) (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
      (LocatedA (HsExpr GhcPs)))
 -> R ())
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
         (LocatedA (HsExpr GhcPs)))]
-> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
      (LocatedA (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 (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      R () -> (R () -> R ()) -> [R ()] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel R () -> R ()
sitcc ([R ()]
fields [R ()] -> [R ()] -> [R ()]
forall a. Semigroup a => a -> a -> a
<> [R ()]
dotdot)
  RecordUpd {XRecordUpd GhcPs
XRec GhcPs (HsExpr GhcPs)
LHsRecUpdFields GhcPs
rupd_ext :: XRecordUpd GhcPs
rupd_expr :: XRec GhcPs (HsExpr GhcPs)
rupd_flds :: LHsRecUpdFields GhcPs
rupd_flds :: forall p. HsExpr p -> LHsRecUpdFields p
rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_ext :: forall p. HsExpr p -> XRecordUpd p
..} -> do
    LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
rupd_expr HsExpr GhcPs -> R ()
p_hsExpr
    R ()
breakpointPreRecordBrace
    let p_recFields :: (GenLocated l a -> R ())
-> [GenLocated
      l (HsFieldBind (GenLocated l a) (LocatedA (HsExpr GhcPs)))]
-> R ()
p_recFields GenLocated l a -> R ()
p_lbl =
          R ()
-> (GenLocated
      l (HsFieldBind (GenLocated l a) (LocatedA (HsExpr GhcPs)))
    -> R ())
-> [GenLocated
      l (HsFieldBind (GenLocated l a) (LocatedA (HsExpr GhcPs)))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated
      l (HsFieldBind (GenLocated l a) (LocatedA (HsExpr GhcPs)))
    -> R ())
-> GenLocated
     l (HsFieldBind (GenLocated l a) (LocatedA (HsExpr GhcPs)))
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsFieldBind (GenLocated l a) (LocatedA (HsExpr GhcPs)) -> R ())
-> GenLocated
     l (HsFieldBind (GenLocated l a) (LocatedA (HsExpr GhcPs)))
-> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' ((GenLocated l a -> R ())
-> HsFieldBind (GenLocated l a) (XRec GhcPs (HsExpr GhcPs)) -> R ()
forall lhs l a.
(lhs ~ GenLocated l a, HasLoc l) =>
(lhs -> R ())
-> HsFieldBind lhs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_hsFieldBind GenLocated l a -> R ()
p_lbl))
        p_fieldLabelStrings :: FieldLabelStrings GhcPs -> R ()
p_fieldLabelStrings (FieldLabelStrings [XRec GhcPs (DotFieldOcc GhcPs)]
flss) =
          [DotFieldOcc GhcPs] -> R ()
p_dotFieldOccs ([DotFieldOcc GhcPs] -> R ()) -> [DotFieldOcc GhcPs] -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated EpAnnCO (DotFieldOcc GhcPs) -> DotFieldOcc GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated EpAnnCO (DotFieldOcc GhcPs) -> DotFieldOcc GhcPs)
-> [GenLocated EpAnnCO (DotFieldOcc GhcPs)] -> [DotFieldOcc GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [XRec GhcPs (DotFieldOcc GhcPs)]
[GenLocated EpAnnCO (DotFieldOcc GhcPs)]
flss
    R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ case LHsRecUpdFields GhcPs
rupd_flds of
      RegularRecUpdFields {[LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
XLHsRecUpdLabels GhcPs
xRecUpdFields :: XLHsRecUpdLabels GhcPs
recUpdFields :: [LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
recUpdFields :: forall p. LHsRecUpdFields p -> [LHsRecUpdField p p]
xRecUpdFields :: forall p. LHsRecUpdFields p -> XLHsRecUpdLabels p
..} ->
        (GenLocated SrcSpanAnnA (FieldOcc GhcPs) -> R ())
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
         (LocatedA (HsExpr GhcPs)))]
-> R ()
forall {l} {l} {a}.
(HasLoc l, HasLoc l) =>
(GenLocated l a -> R ())
-> [GenLocated
      l (HsFieldBind (GenLocated l a) (LocatedA (HsExpr GhcPs)))]
-> R ()
p_recFields ((FieldOcc GhcPs -> R ())
-> GenLocated SrcSpanAnnA (FieldOcc GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' FieldOcc GhcPs -> R ()
p_fieldOcc) [LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
      (LocatedA (HsExpr GhcPs)))]
recUpdFields
      OverloadedRecUpdFields {[LHsRecUpdProj GhcPs]
XLHsOLRecUpdLabels GhcPs
xOLRecUpdFields :: XLHsOLRecUpdLabels GhcPs
olRecUpdFields :: [LHsRecUpdProj GhcPs]
olRecUpdFields :: forall p. LHsRecUpdFields p -> [LHsRecUpdProj p]
xOLRecUpdFields :: forall p. LHsRecUpdFields p -> XLHsOLRecUpdLabels p
..} ->
        (GenLocated EpAnnCO (FieldLabelStrings GhcPs) -> R ())
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated EpAnnCO (FieldLabelStrings GhcPs))
         (LocatedA (HsExpr GhcPs)))]
-> R ()
forall {l} {l} {a}.
(HasLoc l, HasLoc l) =>
(GenLocated l a -> R ())
-> [GenLocated
      l (HsFieldBind (GenLocated l a) (LocatedA (HsExpr GhcPs)))]
-> R ()
p_recFields ((FieldLabelStrings GhcPs -> R ())
-> GenLocated EpAnnCO (FieldLabelStrings GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' FieldLabelStrings GhcPs -> R ()
p_fieldLabelStrings) [LHsRecUpdProj GhcPs]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated EpAnnCO (FieldLabelStrings GhcPs))
      (LocatedA (HsExpr GhcPs)))]
olRecUpdFields
  HsGetField {XGetField GhcPs
XRec GhcPs (HsExpr GhcPs)
XRec GhcPs (DotFieldOcc GhcPs)
gf_ext :: XGetField GhcPs
gf_expr :: XRec GhcPs (HsExpr GhcPs)
gf_field :: XRec GhcPs (DotFieldOcc GhcPs)
gf_field :: forall p. HsExpr p -> XRec p (DotFieldOcc p)
gf_expr :: forall p. HsExpr p -> LHsExpr p
gf_ext :: forall p. HsExpr p -> XGetField p
..} -> do
    LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
gf_expr HsExpr GhcPs -> R ()
p_hsExpr
    Text -> R ()
txt Text
"."
    GenLocated EpAnnCO (DotFieldOcc GhcPs)
-> (DotFieldOcc GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (DotFieldOcc GhcPs)
GenLocated EpAnnCO (DotFieldOcc GhcPs)
gf_field DotFieldOcc GhcPs -> R ()
p_dotFieldOcc
  HsProjection {NonEmpty (DotFieldOcc GhcPs)
XProjection GhcPs
proj_ext :: XProjection GhcPs
proj_flds :: NonEmpty (DotFieldOcc GhcPs)
proj_flds :: forall p. HsExpr p -> NonEmpty (DotFieldOcc p)
proj_ext :: forall p. HsExpr p -> XProjection p
..} -> BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> R ()
txt Text
"."
    [DotFieldOcc GhcPs] -> R ()
p_dotFieldOccs (NonEmpty (DotFieldOcc GhcPs) -> [DotFieldOcc GhcPs]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (DotFieldOcc GhcPs)
proj_flds)
  ExprWithTySig XExprWithTySig GhcPs
_ XRec GhcPs (HsExpr GhcPs)
x HsWC {LHsSigType (NoGhcTc GhcPs)
hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body :: LHsSigType (NoGhcTc GhcPs)
hswc_body} -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr
    R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> R ()
p_hsTypeAnnotation (HsSigType GhcPs -> HsType GhcPs
hsSigTypeToType (HsSigType GhcPs -> HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsSigType (NoGhcTc GhcPs)
GenLocated SrcSpanAnnA (HsSigType GhcPs)
hswc_body)
  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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        R ()
-> (LocatedA (HsExpr GhcPs) -> R ())
-> [LocatedA (HsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((HsExpr GhcPs -> R ()) -> LocatedA (HsExpr GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
from, XRec GhcPs (HsExpr GhcPs)
LocatedA (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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
from HsExpr GhcPs -> R ()
p_hsExpr
        R ()
breakpoint
        Text -> R ()
txt Text
".."
        R ()
space
        LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        R ()
-> (LocatedA (HsExpr GhcPs) -> R ())
-> [LocatedA (HsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((HsExpr GhcPs -> R ()) -> LocatedA (HsExpr GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
from, XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
next]
        R ()
breakpoint
        Text -> R ()
txt Text
".."
        R ()
space
        LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
to HsExpr GhcPs -> R ()
p_hsExpr
  HsTypedBracket XTypedBracket GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr -> do
    Text -> R ()
txt Text
"[||"
    R ()
breakpoint'
    LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
    R ()
breakpoint'
    Text -> R ()
txt Text
"||]"
  HsUntypedBracket XUntypedBracket GhcPs
_ HsQuote GhcPs
x -> HsQuote GhcPs -> R ()
p_hsQuote 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"
    GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p ((Pat GhcPs -> R ()) -> R ()) -> (Pat GhcPs -> R ()) -> R ()
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
    R ()
token'rarrow
    Placement -> R () -> R ()
placeHanging (HsCmdTop GhcPs -> Placement
cmdTopPlacement (GenLocated EpAnnCO (HsCmdTop GhcPs) -> HsCmdTop GhcPs
forall l e. GenLocated l e -> e
unLoc LHsCmdTop GhcPs
GenLocated EpAnnCO (HsCmdTop GhcPs)
e)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      GenLocated EpAnnCO (HsCmdTop GhcPs)
-> (HsCmdTop GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
GenLocated EpAnnCO (HsCmdTop 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 (LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (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 "
      StringLiteral -> R ()
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 -> R () -> R ()
forall a. a -> a
id; BracketStyle
S -> R () -> R ()
inci
      R () -> R ()
inciIfS (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr
  HsEmbTy XEmbTy GhcPs
_ HsWC {LHsType (NoGhcTc GhcPs)
hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body :: LHsType (NoGhcTc GhcPs)
hswc_body} -> do
    Text -> R ()
txt Text
"type"
    R ()
space
    GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LHsType (NoGhcTc GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
hswc_body HsType GhcPs -> R ()
p_hsType
  -- similar to HsForAllTy
  expr :: HsExpr GhcPs
expr@HsForAll {} ->
    HsExpr GhcPs -> R ()
forall a. FunRepr a => a -> R ()
p_hsFun HsExpr GhcPs
expr
  -- similar to HsQualTy
  expr :: HsExpr GhcPs
expr@HsQual {} ->
    HsExpr GhcPs -> R ()
forall a. FunRepr a => a -> R ()
p_hsFun HsExpr GhcPs
expr
  -- similar to HsFunTy
  expr :: HsExpr GhcPs
expr@HsFunArr {} ->
    HsExpr GhcPs -> R ()
forall a. FunRepr a => a -> R ()
p_hsFun HsExpr GhcPs
expr

-- | Print a list comprehension.
--
-- BracketStyle should be N except in a do-block, which must be S or else it's a parse error.
p_listComp :: BracketStyle -> XRec GhcPs [ExprLStmt GhcPs] -> R ()
p_listComp :: BracketStyle
-> XRec GhcPs [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))] -> R ()
p_listComp BracketStyle
s XRec GhcPs [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
es = R () -> R ()
sitcc (R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout R ()
singleLine R ()
multiLine)
  where
    singleLine :: R ()
singleLine = do
      Text -> R ()
txt Text
"["
      R ()
body
      Text -> R ()
txt Text
"]"
    multiLine :: R ()
multiLine = do
      Text -> R ()
txt Text
"[" R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space
      (if BracketStyle
s BracketStyle -> BracketStyle -> Bool
forall a. Eq a => a -> a -> Bool
== BracketStyle
S then R () -> R ()
sitcc else R () -> R ()
forall a. a -> a
id) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        R ()
body
        R ()
newline
        Text -> R ()
txt Text
"]"

    body :: R ()
body = GenLocated
  SrcSpanAnnLW
  [GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> ([GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
    -> R ())
-> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
GenLocated
  SrcSpanAnnLW
  [GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
es [GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ()
p_body
    p_body :: [GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ()
p_body [GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
xs = do
      let ([GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
stmts, GenLocated
  SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
yield) =
            case [GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> Maybe
     ([GenLocated
         SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))],
      GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
forall a. [a] -> Maybe ([a], a)
unsnoc [GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
xs of
              Maybe
  ([GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))],
   GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
Nothing -> String
-> ([GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))],
    GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
forall a. HasCallStack => String -> a
error (String
 -> ([GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))],
     GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))))
-> String
-> ([GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))],
    GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
forall a b. (a -> b) -> a -> b
$ String
"list comprehension unexpectedly had no expressions"
              Just ([GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
ys, GenLocated
  SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
y) -> ([GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
ys, GenLocated
  SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
y)
      R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated
  SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated
  SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
yield Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> R ()
p_stmt
      R ()
breakpoint
      Text -> R ()
txt Text
"|"
      R ()
space
      [[GenLocated
    SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> R ()
p_bodyParallels ([LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
-> [[LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]]
gatherStmts [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
[GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
stmts)

    -- print the list of list comprehension sections, e.g.
    -- [ "| x <- xs, y <- ys, let z = x <> y", "| a <- f z" ]
    p_bodyParallels :: [[GenLocated
    SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> R ()
p_bodyParallels = R ()
-> ([GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
    -> R ())
-> [[GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
breakpoint R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|" R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space) (R () -> R ()
sitccIfTrailing (R () -> R ())
-> ([GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
    -> R ())
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ()
p_bodyParallelStmts)

    -- print a list comprehension section within a pipe, e.g.
    -- [ "x <- xs", "y <- ys", "let z = x <> y" ]
    p_bodyParallelStmts :: [GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ()
p_bodyParallelStmts = R ()
-> (GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
    -> R ())
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> R ())
-> GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' (R () -> R ()
sitcc (R () -> R ())
-> (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> R ())
-> StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> R ()
p_stmt))

-- | Gather the set of statements in a list comprehension.
--
-- For example, this code:
--
-- @
-- [ a + b + c + d
-- | a <- as, let b = a + a
-- | c <- cs
-- | d <- ds, then sort by f
-- ]
-- @
--
-- is parsed as roughly:
--
-- @
-- [ ParStmt
--     [ ParStmtBlock
--         [ BindStmt [| a <- as |]
--         , LetStmt  [| let b = a + a |]
--         ]
--     , ParStmtBlock
--         [ BindStmt [| c <- cs |]
--         ]
--     , ParStmtBlock
--         [ TransStmt
--             [ BindStmt [| d <- ds |]
--             ]
--             [| then sort by f |]
--         ]
--     ]
-- , LastStmt [| a + b + c + d |]
-- ]
-- @
--
-- The final expression is parsed out in p_body, and the rest is passed
-- to this function. This function takes the above tree as input and
-- normalizes it into:
--
-- @
-- [ [ BindStmt [| a <- as |]
--   , LetStmt  [| let b = a + a |]
--   ]
-- , [ BindStmt [| c <- cs |]
--   ]
-- , [ BindStmt [| d <- ds |]
--   , TransStmt [] [| then sortWith by f |]
--   ]
-- ]
-- @
--
-- Notes:
--   * The number of elements in the outer list is the number of pipes in
--     the comprehension; i.e. 1 unless -XParallelListComp is enabled
gatherStmts :: [ExprLStmt GhcPs] -> [[ExprLStmt GhcPs]]
gatherStmts :: [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
-> [[LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]]
gatherStmts = \case
  -- When -XParallelListComp is enabled + list comprehension has
  -- multiple pipes, input will have exactly 1 element, and it
  -- will be ParStmt.
  [L SrcSpanAnnA
_ (ParStmt XParStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
_ [ParStmtBlock GhcPs GhcPs]
blocks HsExpr GhcPs
_ SyntaxExpr GhcPs
_)] ->
    [ (GenLocated SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))
 -> [GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))])
-> [GenLocated
      SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))
-> [GenLocated
      SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))]
GenLocated SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
collectNonParStmts [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
[GenLocated SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))]
stmts
    | ParStmtBlock XParStmtBlock GhcPs GhcPs
_ [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
stmts [IdP GhcPs]
_ SyntaxExpr GhcPs
_ <- [ParStmtBlock GhcPs GhcPs]
blocks
    ]
  -- Otherwise, list will not contain any ParStmt
  [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
stmts ->
    [ (GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
 -> [GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))])
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))
-> [GenLocated
      SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))]
GenLocated
  SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
collectNonParStmts [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
[GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
stmts
    ]
  where
    collectNonParStmts :: GenLocated SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))
-> [GenLocated
      SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))]
collectNonParStmts = \case
      L SrcSpanAnnA
_ ParStmt {} -> String
-> [GenLocated
      SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))]
forall a. String -> a
unexpected String
"ParStmt"
      stmt :: GenLocated SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))
stmt@(L SrcSpanAnnA
_ TransStmt {[LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_stmts :: [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
trS_stmts}) -> (GenLocated SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))
 -> [GenLocated
       SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))])
-> [GenLocated
      SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))
-> [GenLocated
      SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))]
collectNonParStmts [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
[GenLocated SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))]
trS_stmts [GenLocated SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))
stmt]
      GenLocated SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))
stmt -> [GenLocated SrcSpanAnnA (Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)))
stmt]

    unexpected :: String -> a
unexpected String
label = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Unexpected " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
label String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"! Please file a bug."

p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PSB {XPSB GhcPs GhcPs
LIdP GhcPs
LPat GhcPs
HsPatSynDetails GhcPs
HsPatSynDir GhcPs
psb_ext :: XPSB GhcPs GhcPs
psb_id :: LIdP GhcPs
psb_args :: HsPatSynDetails GhcPs
psb_def :: LPat GhcPs
psb_dir :: HsPatSynDir GhcPs
psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
..} = do
  let rhs :: [SrcSpan] -> R ()
rhs [SrcSpan]
conSpans = do
        R ()
space
        let pattern_def_spans :: [SrcSpan]
pattern_def_spans = [LocatedN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LIdP GhcPs
LocatedN RdrName
psb_id, GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
psb_def] [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ [SrcSpan]
conSpans
        case HsPatSynDir GhcPs
psb_dir of
          HsPatSynDir GhcPs
Unidirectional ->
            [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
pattern_def_spans (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
              R ()
token'larrow
              R ()
breakpoint
              GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
psb_def Pat GhcPs -> R ()
p_pat
          HsPatSynDir GhcPs
ImplicitBidirectional ->
            [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
pattern_def_spans (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
              R ()
equals
              R ()
breakpoint
              GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat 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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
              R ()
token'larrow
              R ()
breakpoint
              GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat 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
LocatedN RdrName
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
LocatedN RdrName
psb_id
      R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        let conSpans :: [SrcSpan]
conSpans = LocatedN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA (LocatedN RdrName -> SrcSpan) -> [LocatedN RdrName] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LIdP GhcPs]
[LocatedN RdrName]
xs
        [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conSpans (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LocatedN RdrName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIdP GhcPs]
[LocatedN RdrName]
xs) R ()
breakpoint
          R () -> R ()
sitcc (R () -> (LocatedN RdrName -> R ()) -> [LocatedN RdrName] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint LocatedN RdrName -> R ()
p_rdrName [LIdP GhcPs]
[LocatedN RdrName]
xs)
        [SrcSpan] -> R ()
rhs [SrcSpan]
conSpans
    PrefixCon (Void
v : [Void]
_) [LIdP GhcPs]
_ -> Void -> R ()
forall a. Void -> a
absurd Void
v
    RecCon [RecordPatSynField GhcPs]
xs -> do
      R ()
space
      LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
psb_id
      R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        let conSpans :: [SrcSpan]
conSpans = LocatedN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA (LocatedN RdrName -> SrcSpan)
-> (RecordPatSynField GhcPs -> LocatedN RdrName)
-> RecordPatSynField GhcPs
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField GhcPs -> LIdP GhcPs
RecordPatSynField GhcPs -> LocatedN RdrName
forall pass. RecordPatSynField pass -> LIdP pass
recordPatSynPatVar (RecordPatSynField GhcPs -> SrcSpan)
-> [RecordPatSynField GhcPs] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RecordPatSynField GhcPs]
xs
        [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conSpans (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([RecordPatSynField GhcPs] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RecordPatSynField GhcPs]
xs) R ()
breakpointPreRecordBrace
          BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
            R ()
-> (RecordPatSynField GhcPs -> R ())
-> [RecordPatSynField GhcPs]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (LocatedN RdrName -> R ()
p_rdrName (LocatedN RdrName -> R ())
-> (RecordPatSynField GhcPs -> LocatedN RdrName)
-> RecordPatSynField GhcPs
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField GhcPs -> LIdP GhcPs
RecordPatSynField GhcPs -> LocatedN RdrName
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 = [LocatedN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LIdP GhcPs
LocatedN RdrName
l, LocatedN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LIdP GhcPs
LocatedN RdrName
r]
      [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conSpans (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        R ()
space
        LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
l
        R ()
breakpoint
        R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
psb_id
          R ()
space
          LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
r
      R () -> R ()
inci ([SrcSpan] -> R ()
rhs [SrcSpan]
conSpans)

p_case ::
  ( Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,
    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)) ~ EpAnnCO,
 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
  LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
  R ()
space
  Text -> R ()
txt Text
"of"
  R ()
breakpoint
  IsApplicand -> R () -> R ()
inciApplicand IsApplicand
isApp ((body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,
 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_lam ::
  ( Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,
    Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
  ) =>
  IsApplicand ->
  -- | Variant (@\\@ or @\\case@ or @\\cases@)
  HsLamVariant ->
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (body -> R ()) ->
  -- | Expression
  MatchGroup GhcPs (LocatedA body) ->
  R ()
p_lam :: forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
IsApplicand
-> HsLamVariant
-> (body -> Placement)
-> (body -> R ())
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_lam IsApplicand
isApp HsLamVariant
variant body -> Placement
placer body -> R ()
render MatchGroup GhcPs (LocatedA body)
mgroup = do
  let mCaseTxt :: Maybe Text
mCaseTxt = case HsLamVariant
variant of
        HsLamVariant
LamSingle -> Maybe Text
forall a. Maybe a
Nothing
        HsLamVariant
LamCase -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"\\case"
        HsLamVariant
LamCases -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"\\cases"
      mgs :: MatchGroupStyle
mgs = if Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
mCaseTxt then MatchGroupStyle
LambdaCase else MatchGroupStyle
Lambda
      pMatchGroup :: R ()
pMatchGroup = (body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,
 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
mgs MatchGroup GhcPs (LocatedA body)
mgroup
  case Maybe Text
mCaseTxt of
    Maybe Text
Nothing -> R ()
pMatchGroup
    Just Text
caseTxt -> do
      Text -> R ()
txt Text
caseTxt
      R ()
breakpoint
      IsApplicand -> R () -> R ()
inciApplicand IsApplicand
isApp R ()
pMatchGroup

p_if ::
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (body -> R ()) ->
  -- | Annotations
  AnnsIf ->
  -- | If
  LHsExpr GhcPs ->
  -- | Then
  LocatedA body ->
  -- | Else
  LocatedA body ->
  R ()
p_if :: forall body.
(body -> Placement)
-> (body -> R ())
-> AnnsIf
-> XRec GhcPs (HsExpr GhcPs)
-> LocatedA body
-> LocatedA body
-> R ()
p_if body -> Placement
placer body -> R ()
render AnnsIf
anns XRec GhcPs (HsExpr GhcPs)
if' LocatedA body
then' LocatedA body
else' = do
  IfStyle
ifStyle <- (forall (f :: * -> *). PrinterOpts f -> f IfStyle) -> R IfStyle
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f IfStyle
forall (f :: * -> *). PrinterOpts f -> f IfStyle
poIfStyle

  Text -> R ()
txt Text
"if"
  R ()
space
  LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
if' HsExpr GhcPs -> R ()
p_hsExpr
  [RealSrcSpan]
commentSpans <- (GenLocated RealSrcSpan Comment -> RealSrcSpan)
-> [GenLocated RealSrcSpan Comment] -> [RealSrcSpan]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated RealSrcSpan Comment -> RealSrcSpan
forall l e. GenLocated l e -> l
getLoc ([GenLocated RealSrcSpan Comment] -> [RealSrcSpan])
-> R [GenLocated RealSrcSpan Comment] -> R [RealSrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R [GenLocated RealSrcSpan Comment]
getEnclosingComments
  let (SrcSpan
thenSpan, SrcSpan
elseSpan) = (EpToken "then" -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA EpToken "then"
aiThen, EpToken "else" -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA EpToken "else"
aiElse)
        where
          AnnsIf {EpToken "then"
aiThen :: EpToken "then"
aiThen :: AnnsIf -> EpToken "then"
aiThen, EpToken "else"
aiElse :: EpToken "else"
aiElse :: AnnsIf -> EpToken "else"
aiElse} = AnnsIf
anns

      locatedToken :: l -> Text -> R ()
locatedToken l
tokenSpan Text
token =
        GenLocated l () -> (() -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located (l -> () -> GenLocated l ()
forall l e. l -> e -> GenLocated l e
L l
tokenSpan ()) ((() -> R ()) -> R ()) -> (() -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \()
_ -> Text -> R ()
txt Text
token

      betweenSpans :: a -> a -> a -> Bool
betweenSpans a
spanA a
spanB a
s = a
spanA a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
s Bool -> Bool -> Bool
&& a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
spanB

      placeHangingLocated :: SrcSpan -> LocatedA body -> R ()
placeHangingLocated SrcSpan
tokenSpan bodyLoc :: LocatedA body
bodyLoc@(L SrcSpanAnnA
_ body
body) = do
        let bodySpan :: SrcSpan
bodySpan = LocatedA body -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LocatedA body
bodyLoc
            hasComments :: Bool
hasComments = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
              RealSrcSpan
tokenRealSpan <- SrcSpan -> Maybe RealSrcSpan
srcSpanToRealSrcSpan SrcSpan
tokenSpan
              RealSrcSpan
bodyRealSpan <- SrcSpan -> Maybe RealSrcSpan
srcSpanToRealSrcSpan SrcSpan
bodySpan
              Bool -> Maybe Bool
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ (RealSrcSpan -> Bool) -> [RealSrcSpan] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (RealSrcSpan -> RealSrcSpan -> RealSrcSpan -> Bool
forall {a}. Ord a => a -> a -> a -> Bool
betweenSpans RealSrcSpan
tokenRealSpan RealSrcSpan
bodyRealSpan) [RealSrcSpan]
commentSpans
            placement :: Placement
placement = if Bool
hasComments then Placement
Normal else body -> Placement
placer body
body
        [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
tokenSpan, SrcSpan
bodySpan] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
          Placement -> R () -> R ()
placeHanging Placement
placement (LocatedA body -> (body -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
bodyLoc body -> R ()
render)

      placeBranch :: SrcSpan -> LocatedA body -> R ()
placeBranch SrcSpan
tokenSpan LocatedA body
body =
        case IfStyle
ifStyle of
          IfStyle
IfHanging
            | SrcSpan -> Bool
isOneLineSpan (LocatedA body -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LocatedA body
body) ->
                Placement -> R () -> R ()
placeHanging Placement
Normal (LocatedA body -> (body -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
body body -> R ()
render)
          IfStyle
_ ->
            SrcSpan -> LocatedA body -> R ()
placeHangingLocated SrcSpan
tokenSpan LocatedA body
body

      hangIf :: R () -> R ()
hangIf R ()
m =
        case IfStyle
ifStyle of
          IfStyle
IfIndented -> R ()
breakpoint R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
m
          IfStyle
IfHanging -> [SrcSpan] -> R () -> R ()
switchLayout [LocatedA (HsExpr GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
if'] R ()
breakpoint R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
m

  R () -> R ()
hangIf (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    SrcSpan -> Text -> R ()
forall {l}. HasLoc l => l -> Text -> R ()
locatedToken SrcSpan
thenSpan Text
"then"
    R ()
space
    SrcSpan -> LocatedA body -> R ()
placeBranch SrcSpan
thenSpan LocatedA body
then'
    R ()
breakpoint
    SrcSpan -> Text -> R ()
forall {l}. HasLoc l => l -> Text -> R ()
locatedToken SrcSpan
elseSpan Text
"else"
    R ()
space
    SrcSpan -> LocatedA body -> R ()
placeBranch SrcSpan
elseSpan LocatedA body
else'

p_let ::
  -- | True if in do-block
  Bool ->
  -- | Render
  (body -> R ()) ->
  -- | Annotation for the `let` block
  EpToken "let" ->
  HsLocalBinds GhcPs ->
  LocatedA body ->
  R ()
p_let :: forall body.
Bool
-> (body -> R ())
-> EpToken "let"
-> HsLocalBinds GhcPs
-> LocatedA body
-> R ()
p_let Bool
inDo body -> R ()
render EpToken "let"
letToken HsLocalBinds GhcPs
localBinds LocatedA body
e = Bool -> EpToken "let" -> HsLocalBinds GhcPs -> Maybe (R ()) -> R ()
p_let' Bool
inDo EpToken "let"
letToken HsLocalBinds GhcPs
localBinds (Maybe (R ()) -> R ()) -> Maybe (R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> Maybe (R ())
forall a. a -> Maybe a
Just (LocatedA body -> (body -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
e body -> R ()
render)

p_let' ::
  -- | True if in do-block
  Bool ->
  -- | Annotation for the `let` block
  EpToken "let" ->
  -- | Let bindings
  HsLocalBinds GhcPs ->
  -- | Optional 'in' body
  Maybe (R ()) ->
  R ()
p_let' :: Bool -> EpToken "let" -> HsLocalBinds GhcPs -> Maybe (R ()) -> R ()
p_let' Bool
inDo EpToken "let"
letLoc HsLocalBinds GhcPs
localBinds Maybe (R ())
mBody = do
  LetStyle
letStyle <- (forall (f :: * -> *). PrinterOpts f -> f LetStyle) -> R LetStyle
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f LetStyle
forall (f :: * -> *). PrinterOpts f -> f LetStyle
poLetStyle
  InStyle
inStyle <- (forall (f :: * -> *). PrinterOpts f -> f InStyle) -> R InStyle
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f InStyle
forall (f :: * -> *). PrinterOpts f -> f InStyle
poInStyle
  Layout
layout <- R Layout
getLayout
  -- isAllInline = True if whole "let ... in ..." should be one line
  let isAllInline :: Bool
isAllInline = Layout
layout Layout -> Layout -> Bool
forall a. Eq a => a -> a -> Bool
== Layout
SingleLine Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
inDo Bool -> Bool -> Bool
|| Maybe (R ()) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (R ())
mBody)
  -- isBlockInline = True if each "let ..." + "in ..." block should be one line
  let isBlockInline :: Bool
isBlockInline =
        case LetStyle
letStyle of
          LetStyle
_ | Bool
isAllInline -> Bool
True
          LetStyle
LetAuto ->
            -- check if local binds are on the same line as the "let" keyword;
            -- if we can't figure out the positions, just fallback to `inline` style
            Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
              ConTag
letStartLine <-
                case EpToken "let"
letLoc of
                  EpTok EpaLocation
loc -> ConTag -> Maybe ConTag
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConTag -> Maybe ConTag)
-> (EpaLocation -> ConTag) -> EpaLocation -> Maybe ConTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcSpan -> ConTag
srcSpanStartLine (RealSrcSpan -> ConTag)
-> (EpaLocation -> RealSrcSpan) -> EpaLocation -> ConTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpaLocation -> RealSrcSpan
forall a. EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan (EpaLocation -> Maybe ConTag) -> EpaLocation -> Maybe ConTag
forall a b. (a -> b) -> a -> b
$ EpaLocation
loc
                  EpToken "let"
NoEpTok -> Maybe ConTag
forall a. Maybe a
Nothing
              ConTag
localBindsStartLine <- HsLocalBinds GhcPs -> Maybe (XHsValBinds GhcPs GhcPs)
localBindsEpAnns HsLocalBinds GhcPs
localBinds Maybe SrcSpanAnnLW
-> (SrcSpanAnnLW -> Maybe ConTag) -> Maybe ConTag
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SrcSpanAnnLW -> Maybe ConTag
forall {ann}. EpAnn ann -> Maybe ConTag
epAnnsStartLine
              Bool -> Maybe Bool
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$
                -- special case when let has zero local binds
                if ConTag
localBindsStartLine ConTag -> ConTag -> Bool
forall a. Eq a => a -> a -> Bool
== -ConTag
1
                  then Bool
True
                  else ConTag
letStartLine ConTag -> ConTag -> Bool
forall a. Eq a => a -> a -> Bool
== ConTag
localBindsStartLine
          LetStyle
LetInline -> Bool
True
          LetStyle
LetNewline -> Bool
False
          LetStyle
LetMixed -> ConTag
numLocalBinds ConTag -> ConTag -> Bool
forall a. Ord a => a -> a -> Bool
<= ConTag
1
  let inString :: Text
inString =
        case InStyle
inStyle of
          InStyle
_ | Bool
inDo -> Text
" in"
          InStyle
InRightAlign -> Text
" in"
          InStyle
InLeftAlign
            | Bool
isBlockInline -> Text
"in "
            | Bool
otherwise -> Text
"in"
          InStyle
InNoSpace -> Text
"in"

  -- helpers
  let block :: Text -> R () -> R ()
block Text
keyword R ()
body = do
        Text -> R ()
txt Text
keyword
        if Bool
isBlockInline
          then R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
sitcc R ()
body
          else R ()
newline R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
body

  R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> R () -> R ()
block Text
"let" (HsLocalBinds GhcPs -> R ()
p_hsLocalBinds HsLocalBinds GhcPs
localBinds)

    case Maybe (R ())
mBody of
      Just R ()
body
        | Bool
isAllInline -> do
            R ()
space
            Text -> R () -> R ()
block Text
"in" R ()
body
        | Bool
otherwise -> do
            R ()
newline
            Text -> R () -> R ()
block Text
inString R ()
body
      Maybe (R ())
Nothing -> () -> R ()
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    numLocalBinds :: ConTag
numLocalBinds =
      case HsLocalBinds GhcPs
localBinds of
        HsValBinds XHsValBinds GhcPs GhcPs
_ (ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
binds [LSig GhcPs]
sigs) -> [GenLocated SrcSpanAnnA (HsBind GhcPs)] -> ConTag
forall a. [a] -> ConTag
forall (t :: * -> *) a. Foldable t => t a -> ConTag
length LHsBindsLR GhcPs GhcPs
[GenLocated SrcSpanAnnA (HsBind GhcPs)]
binds ConTag -> ConTag -> ConTag
forall a. Num a => a -> a -> a
+ [GenLocated SrcSpanAnnA (Sig GhcPs)] -> ConTag
forall a. [a] -> ConTag
forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs
        HsValBinds XHsValBinds GhcPs GhcPs
_ (XValBindsLR (NValBinds [(RecFlag, LHsBindsLR GhcPs GhcPs)]
binds [LSig GhcRn]
sigs)) -> [(RecFlag, [GenLocated SrcSpanAnnA (HsBind GhcPs)])] -> ConTag
forall a. [a] -> ConTag
forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [(RecFlag, LHsBindsLR GhcPs GhcPs)]
[(RecFlag, [GenLocated SrcSpanAnnA (HsBind GhcPs)])]
binds ConTag -> ConTag -> ConTag
forall a. Num a => a -> a -> a
+ [GenLocated SrcSpanAnnA (Sig GhcRn)] -> ConTag
forall a. [a] -> ConTag
forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [LSig GhcRn]
[GenLocated SrcSpanAnnA (Sig GhcRn)]
sigs
        HsIPBinds XHsIPBinds GhcPs GhcPs
_ (IPBinds XIPBinds GhcPs
_ [LIPBind GhcPs]
binds) -> [GenLocated SrcSpanAnnA (IPBind GhcPs)] -> ConTag
forall a. [a] -> ConTag
forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [LIPBind GhcPs]
[GenLocated SrcSpanAnnA (IPBind GhcPs)]
binds
        EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_ -> ConTag
0

    localBindsEpAnns :: HsLocalBinds GhcPs -> Maybe (XHsValBinds GhcPs GhcPs)
localBindsEpAnns = \case
      HsValBinds XHsValBinds GhcPs GhcPs
epanns HsValBindsLR GhcPs GhcPs
_ -> XHsValBinds GhcPs GhcPs -> Maybe (XHsValBinds GhcPs GhcPs)
forall a. a -> Maybe a
Just XHsValBinds GhcPs GhcPs
epanns
      HsIPBinds XHsIPBinds GhcPs GhcPs
epanns HsIPBinds GhcPs
_ -> XHsValBinds GhcPs GhcPs -> Maybe (XHsValBinds GhcPs GhcPs)
forall a. a -> Maybe a
Just XHsIPBinds GhcPs GhcPs
XHsValBinds GhcPs GhcPs
epanns
      EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_ -> Maybe (XHsValBinds GhcPs GhcPs)
forall a. Maybe a
Nothing
    epAnnsStartLine :: EpAnn ann -> Maybe ConTag
epAnnsStartLine EpAnn ann
epAnn =
      case EpAnn ann -> EpaLocation
forall ann. EpAnn ann -> EpaLocation
entry EpAnn ann
epAnn of
        EpaSpan (RealSrcSpan RealSrcSpan
r Maybe BufSpan
_) -> ConTag -> Maybe ConTag
forall a. a -> Maybe a
Just (ConTag -> Maybe ConTag) -> ConTag -> Maybe ConTag
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> ConTag
srcSpanStartLine RealSrcSpan
r
        EpaLocation
_ -> Maybe ConTag
forall a. Maybe a
Nothing

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
LocatedN RdrName
name
  LazyPat XLazyPat GhcPs
_ LPat GhcPs
pat -> do
    Text -> R ()
txt Text
"~"
    GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
  AsPat XAsPat GhcPs
_ LIdP GhcPs
name LPat GhcPs
pat -> do
    LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
name
    Text -> R ()
txt Text
"@"
    GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
  ParPat XParPat GhcPs
_ LPat GhcPs
pat ->
    GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat (BracketStyle -> R () -> R ()
parens BracketStyle
S (R () -> R ()) -> (Pat GhcPs -> R ()) -> Pat GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> (Pat GhcPs -> R ()) -> Pat GhcPs -> R ()
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
"!"
    GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
  ListPat XListPat GhcPs
_ [LPat GhcPs]
pats ->
    BracketStyle -> R () -> R ()
brackets BracketStyle
S (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat 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' (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> GenLocated SrcSpanAnnA (Pat GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
  OrPat XOrPat GhcPs
_ NonEmpty (LPat GhcPs)
pats ->
    (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LPat GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (Pat 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 (GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat 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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
pat
        Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([HsConPatTyArg GhcPs] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsConPatTyArg (NoGhcTc GhcPs)]
[HsConPatTyArg GhcPs]
tys Bool -> Bool -> Bool
&& [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
xs) R ()
breakpoint
        R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
          R ()
-> (Either
      (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
    -> R ())
-> [Either
      (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc (R () -> R ())
-> (Either
      (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
    -> R ())
-> Either
     (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsConPatTyArg GhcPs -> R ())
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> Either
     (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
-> R ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsConPatTyArg GhcPs -> R ()
p_hsConPatTyArg ((Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat)) ([Either
    (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))]
 -> R ())
-> [Either
      (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))]
-> R ()
forall a b. (a -> b) -> a -> b
$
            (HsConPatTyArg GhcPs
-> Either
     (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a b. a -> Either a b
Left (HsConPatTyArg GhcPs
 -> Either
      (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> [HsConPatTyArg GhcPs]
-> [Either
      (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HsConPatTyArg (NoGhcTc GhcPs)]
[HsConPatTyArg GhcPs]
tys) [Either (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))]
-> [Either
      (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))]
-> [Either
      (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))]
forall a. Semigroup a => a -> a -> a
<> (GenLocated SrcSpanAnnA (Pat GhcPs)
-> Either
     (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a b. b -> Either a b
Right (GenLocated SrcSpanAnnA (Pat GhcPs)
 -> Either
      (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [Either
      (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
xs)
      RecCon (HsRecFields XHsRecFields GhcPs
_ [LHsRecField GhcPs (LPat GhcPs)]
fields Maybe (XRec GhcPs RecFieldsDotDot)
dotdot) -> do
        LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
pat
        R ()
breakpointPreRecordBrace
        let f :: Maybe
  (GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (Pat GhcPs))))
-> R ()
f = \case
              Maybe
  (GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (Pat GhcPs))))
Nothing -> Text -> R ()
txt Text
".."
              Just GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (Pat GhcPs)))
x -> GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (Pat GhcPs))
    -> R ())
-> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (Pat GhcPs)))
x HsRecField GhcPs (LPat GhcPs) -> R ()
HsFieldBind
  (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
  (GenLocated SrcSpanAnnA (Pat GhcPs))
-> R ()
p_pat_hsFieldBind
        R () -> R ()
inci (R () -> R ())
-> ([Maybe
       (GenLocated
          SrcSpanAnnA
          (HsFieldBind
             (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
             (GenLocated SrcSpanAnnA (Pat GhcPs))))]
    -> R ())
-> [Maybe
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
            (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ())
-> ([Maybe
       (GenLocated
          SrcSpanAnnA
          (HsFieldBind
             (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
             (GenLocated SrcSpanAnnA (Pat GhcPs))))]
    -> R ())
-> [Maybe
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
            (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R ()
-> (Maybe
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
            (GenLocated SrcSpanAnnA (Pat GhcPs))))
    -> R ())
-> [Maybe
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
            (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel Maybe
  (GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (Pat GhcPs))))
-> R ()
f ([Maybe
    (GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
          (GenLocated SrcSpanAnnA (Pat GhcPs))))]
 -> R ())
-> [Maybe
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
            (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ()
forall a b. (a -> b) -> a -> b
$
          case Maybe (XRec GhcPs RecFieldsDotDot)
dotdot of
            Maybe (XRec GhcPs RecFieldsDotDot)
Nothing -> GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Maybe
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
           (GenLocated SrcSpanAnnA (Pat GhcPs))))
forall a. a -> Maybe a
Just (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (Pat GhcPs)))
 -> Maybe
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
            (GenLocated SrcSpanAnnA (Pat GhcPs)))))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> [Maybe
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
            (GenLocated SrcSpanAnnA (Pat GhcPs))))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (LPat GhcPs)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (Pat GhcPs)))]
fields
            Just (L EpaLocation
_ (RecFieldsDotDot ConTag
n)) -> (GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Maybe
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
           (GenLocated SrcSpanAnnA (Pat GhcPs))))
forall a. a -> Maybe a
Just (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (Pat GhcPs)))
 -> Maybe
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
            (GenLocated SrcSpanAnnA (Pat GhcPs)))))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> [Maybe
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
            (GenLocated SrcSpanAnnA (Pat GhcPs))))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConTag
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (Pat GhcPs)))]
forall a. ConTag -> [a] -> [a]
take ConTag
n [LHsRecField GhcPs (LPat GhcPs)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (Pat GhcPs)))]
fields) [Maybe
   (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> [Maybe
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
            (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> [Maybe
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
            (GenLocated SrcSpanAnnA (Pat GhcPs))))]
forall a. [a] -> [a] -> [a]
++ [Maybe
  (GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (FieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (Pat GhcPs))))
forall a. Maybe a
Nothing]
      InfixCon LPat GhcPs
l LPat GhcPs
r -> do
        [SrcSpan] -> R () -> R ()
switchLayout [GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
l, GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
r] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
l Pat GhcPs -> R ()
p_pat
          R ()
breakpoint
          R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
            LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
pat
            R ()
space
            GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
r Pat GhcPs -> R ()
p_pat
  ViewPat XViewPat GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr LPat GhcPs
pat -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
    R ()
space
    R ()
token'rarrow
    R ()
breakpoint
    R () -> R ()
inci (GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat 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 -> HsLit GhcPs -> R ()
forall a. Outputable a => a -> R ()
atom HsLit GhcPs
p
  NPat XNPat GhcPs
_ XRec GhcPs (HsOverLit GhcPs)
v (Maybe NoExtField -> Bool
Maybe (SyntaxExpr GhcPs) -> Bool
forall a. Maybe a -> Bool
isJust -> Bool
isNegated) SyntaxExpr GhcPs
_ -> do
    Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isNegated (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> R ()
txt Text
"-"
      Bool
negativeLiterals <- Extension -> R Bool
isExtensionEnabled Extension
NegativeLiterals
      Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
negativeLiterals R ()
space
    GenLocated EpAnnCO (HsOverLit GhcPs)
-> (HsOverLit GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsOverLit GhcPs)
GenLocated EpAnnCO (HsOverLit GhcPs)
v (OverLitVal -> R ()
forall a. Outputable a => a -> R ()
atom (OverLitVal -> R ())
-> (HsOverLit GhcPs -> OverLitVal) -> HsOverLit GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsOverLit GhcPs -> OverLitVal
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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
n
    R ()
breakpoint
    R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> R ()
txt Text
"+"
      R ()
space
      GenLocated EpAnnCO (HsOverLit GhcPs)
-> (HsOverLit GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsOverLit GhcPs)
GenLocated EpAnnCO (HsOverLit GhcPs)
k (OverLitVal -> R ()
forall a. Outputable a => a -> R ()
atom (OverLitVal -> R ())
-> (HsOverLit GhcPs -> OverLitVal) -> HsOverLit GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val)
  SigPat XSigPat GhcPs
_ LPat GhcPs
pat HsPS {XHsPS (NoGhcTc GhcPs)
LHsType (NoGhcTc GhcPs)
hsps_ext :: XHsPS (NoGhcTc GhcPs)
hsps_body :: LHsType (NoGhcTc GhcPs)
hsps_body :: forall pass. HsPatSigType pass -> LHsType pass
hsps_ext :: forall pass. HsPatSigType pass -> XHsPS pass
..} -> do
    GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
    LHsSigType GhcPs -> R ()
p_typeAscription (LHsType GhcPs -> LHsSigType GhcPs
lhsTypeToSigType LHsType (NoGhcTc GhcPs)
LHsType GhcPs
hsps_body)
  EmbTyPat XEmbTyPat GhcPs
_ (HsTP XHsTP (NoGhcTc GhcPs)
_ LHsType (NoGhcTc GhcPs)
ty) -> do
    Text -> R ()
txt Text
"type"
    R ()
space
    GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LHsType (NoGhcTc GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
ty HsType GhcPs -> R ()
p_hsType
  InvisPat XInvisPat GhcPs
_ HsTyPat (NoGhcTc GhcPs)
tyPat -> HsTyPat GhcPs -> R ()
p_tyPat HsTyPat (NoGhcTc GhcPs)
HsTyPat GhcPs
tyPat

p_tyPat :: HsTyPat GhcPs -> R ()
p_tyPat :: HsTyPat GhcPs -> R ()
p_tyPat (HsTP XHsTP GhcPs
_ LHsType GhcPs
ty) = Text -> R ()
txt Text
"@" R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty HsType GhcPs -> R ()
p_hsType

p_hsConPatTyArg :: HsConPatTyArg GhcPs -> R ()
p_hsConPatTyArg :: HsConPatTyArg GhcPs -> R ()
p_hsConPatTyArg (HsConPatTyArg XConPatTyArg GhcPs
_ HsTyPat GhcPs
patSigTy) = HsTyPat GhcPs -> R ()
p_tyPat HsTyPat GhcPs
patSigTy

p_pat_hsFieldBind :: HsRecField GhcPs (LPat GhcPs) -> R ()
p_pat_hsFieldBind :: HsRecField GhcPs (LPat GhcPs) -> R ()
p_pat_hsFieldBind HsFieldBind {Bool
XHsFieldBind (LFieldOcc GhcPs)
LPat GhcPs
LFieldOcc GhcPs
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
hfbAnn :: XHsFieldBind (LFieldOcc GhcPs)
hfbLHS :: LFieldOcc GhcPs
hfbRHS :: LPat GhcPs
hfbPun :: Bool
..} = do
  GenLocated SrcSpanAnnA (FieldOcc GhcPs)
-> (FieldOcc GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LFieldOcc GhcPs
GenLocated SrcSpanAnnA (FieldOcc GhcPs)
hfbLHS FieldOcc GhcPs -> R ()
p_fieldOcc
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hfbPun (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    R ()
space
    R ()
equals
    R ()
breakpoint
    R () -> R ()
inci (GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat 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 ConTag -> ConTag -> ConTag
forall a. Num a => a -> a -> a
- ConTag
1
      after :: ConTag
after = ConTag
arity ConTag -> ConTag -> ConTag
forall a. Num a => a -> a -> a
- ConTag
before ConTag -> ConTag -> ConTag
forall a. Num a => a -> a -> a
- ConTag
1
      args :: [Maybe (R ())]
args = ConTag -> Maybe (R ()) -> [Maybe (R ())]
forall a. ConTag -> a -> [a]
replicate ConTag
before Maybe (R ())
forall a. Maybe a
Nothing [Maybe (R ())] -> [Maybe (R ())] -> [Maybe (R ())]
forall a. Semigroup a => a -> a -> a
<> [R () -> Maybe (R ())
forall a. a -> Maybe a
Just R ()
m] [Maybe (R ())] -> [Maybe (R ())] -> [Maybe (R ())]
forall a. Semigroup a => a -> a -> a
<> ConTag -> Maybe (R ()) -> [Maybe (R ())]
forall a. ConTag -> a -> [a]
replicate ConTag
after Maybe (R ())
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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (Maybe (R ()) -> R ()) -> [Maybe (R ())] -> R ()
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 (RdrName -> LocatedN RdrName
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA IdP GhcPs
RdrName
quoterName)
    Text -> R ()
txt Text
"|"
    -- QuasiQuoters often rely on precise custom strings. We cannot do any
    -- formatting here without potentially breaking someone's code.
    GenLocated EpAnnCO FastString -> R ()
forall a. Outputable a => a -> R ()
atom XRec GhcPs FastString
GenLocated EpAnnCO 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
    LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
expr (R () -> R ()
sitcc (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
  SpliceDecoration
BareSplice ->
    LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
expr (R () -> R ()
sitcc (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
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 :: HsQuote GhcPs -> R ()
p_hsQuote :: HsQuote GhcPs -> R ()
p_hsQuote = \case
  ExpBr (BracketAnn (EpUniToken "[|" "\10214") (EpToken "[e|")
bracketAnn, EpUniToken "|]" "\10215"
_) XRec GhcPs (HsExpr GhcPs)
expr -> do
    let name :: Text
name = case BracketAnn (EpUniToken "[|" "\10214") (EpToken "[e|")
bracketAnn of
          BracketNoE {} -> Text
""
          BracketHasE {} -> Text
"e"
    Text -> R () -> R ()
quote Text
name (LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr)
  PatBr XPatBr GhcPs
_ LPat GhcPs
pat -> GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat (Text -> R () -> R ()
quote Text
"p" (R () -> R ()) -> (Pat GhcPs -> R ()) -> Pat GhcPs -> R ()
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" ([GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> R () -> R ()
forall a. Data a => a -> R () -> R ()
handleStarIsType [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls (FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDecls FamilyStyle
Free [LHsDecl GhcPs]
decls))
  DecBrG XDecBrG GhcPs
_ HsGroup GhcPs
_ -> String -> R ()
forall a. String -> a
notImplemented String
"DecBrG" -- result of renamer
  TypBr XTypBr GhcPs
_ LHsType GhcPs
ty -> Text -> R () -> R ()
quote Text
"t" (GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty (GenLocated SrcSpanAnnA (HsType GhcPs) -> R () -> R ()
forall a. Data a => a -> R () -> R ()
handleStarIsType LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty (R () -> R ()) -> (HsType GhcPs -> R ()) -> HsType GhcPs -> R ()
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 (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"''" Text
"'" Bool
isSingleQuote)
    LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
name
  where
    quote :: Text -> R () -> R ()
    quote :: Text -> R () -> R ()
quote Text
name R ()
body = do
      let (R ()
startQuote, R ()
endQuote) =
            if Text -> Bool
Text.null Text
name
              then (R ()
token'openExpQuote, R ()
token'closeQuote)
              else (Text -> R ()
txt Text
"[" R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
name R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|", Text -> R ()
txt Text
"|]")
      R ()
startQuote
      R ()
breakpoint'
      R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        R () -> R ()
dontUseBraces R ()
body
        R ()
breakpoint'
        R ()
endQuote
    -- 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 R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> R ()
p R () -> R () -> R ()
forall a b. R a -> R b -> R a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* R ()
space
      | Bool
otherwise = R ()
p
      where
        containsHsStarTy :: a -> Bool
containsHsStarTy = (Bool -> Bool -> Bool) -> GenericQ Bool -> GenericQ Bool
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything Bool -> Bool -> Bool
(||) (GenericQ Bool -> GenericQ Bool) -> GenericQ Bool -> GenericQ 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

-- | Function types in expressions, e.g. with -XRequiredTypeArguments
instance FunRepr (HsExpr GhcPs) where
  renderFunItem :: HsExpr GhcPs -> R ()
renderFunItem = HsExpr GhcPs -> R ()
p_hsExpr
  parseFunRepr :: LocatedA (HsExpr GhcPs) -> ParsedFunRepr (HsExpr GhcPs)
parseFunRepr = \case
    -- `forall a. _`
    L SrcSpanAnnA
ann (HsForAll XForAll GhcPs
_ HsForAllTelescope GhcPs
tele XRec GhcPs (HsExpr GhcPs)
expr) ->
      LocatedA (HsForAllTelescope GhcPs)
-> ParsedFunRepr (HsExpr GhcPs) -> ParsedFunRepr (HsExpr GhcPs)
forall a.
LocatedA (HsForAllTelescope GhcPs)
-> ParsedFunRepr a -> ParsedFunRepr a
ParsedFunForall (SrcSpanAnnA
-> HsForAllTelescope GhcPs -> LocatedA (HsForAllTelescope GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
ann HsForAllTelescope GhcPs
tele) (LocatedA (HsExpr GhcPs) -> ParsedFunRepr (HsExpr GhcPs)
forall a. FunRepr a => LocatedA a -> ParsedFunRepr a
parseFunRepr XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
expr)
    -- `HasCallStack => _`
    expr :: LocatedA (HsExpr GhcPs)
expr@(L SrcSpanAnnA
_ HsQual {}) ->
      let ([GenLocated SrcSpanAnnA (XRec GhcPs [XRec GhcPs (HsExpr GhcPs)])]
ctxs, LocatedA (HsExpr GhcPs)
rest) = LocatedA (HsExpr GhcPs)
-> ([GenLocated
       SrcSpanAnnA (XRec GhcPs [XRec GhcPs (HsExpr GhcPs)])],
    LocatedA (HsExpr GhcPs))
getContexts LocatedA (HsExpr GhcPs)
expr
       in [LocatedA (LocatedC [LocatedA (HsExpr GhcPs)])]
-> ParsedFunRepr (HsExpr GhcPs) -> ParsedFunRepr (HsExpr GhcPs)
forall a.
[LocatedA (LocatedC [LocatedA a])]
-> ParsedFunRepr a -> ParsedFunRepr a
ParsedFunQuals [GenLocated SrcSpanAnnA (XRec GhcPs [XRec GhcPs (HsExpr GhcPs)])]
[LocatedA (LocatedC [LocatedA (HsExpr GhcPs)])]
ctxs (LocatedA (HsExpr GhcPs) -> ParsedFunRepr (HsExpr GhcPs)
forall a. FunRepr a => LocatedA a -> ParsedFunRepr a
parseFunRepr LocatedA (HsExpr GhcPs)
rest)
    -- `Int -> _`
    expr :: LocatedA (HsExpr GhcPs)
expr@(L SrcSpanAnnA
_ HsFunArr {}) ->
      let ([GenLocated
   SrcSpanAnnA
   (XRec GhcPs (HsExpr GhcPs), Maybe (LHsDoc GhcPs),
    HsArrowOf (XRec GhcPs (HsExpr GhcPs)) GhcPs)]
args, LocatedA (HsExpr GhcPs)
ret) = LocatedA (HsExpr GhcPs)
-> ([GenLocated
       SrcSpanAnnA
       (XRec GhcPs (HsExpr GhcPs), Maybe (LHsDoc GhcPs),
        HsArrowOf (XRec GhcPs (HsExpr GhcPs)) GhcPs)],
    LocatedA (HsExpr GhcPs))
forall {a}.
LocatedA (HsExpr GhcPs)
-> ([GenLocated
       SrcSpanAnnA
       (XRec GhcPs (HsExpr GhcPs), Maybe a,
        HsArrowOf (XRec GhcPs (HsExpr GhcPs)) GhcPs)],
    LocatedA (HsExpr GhcPs))
getArgsAndReturn LocatedA (HsExpr GhcPs)
expr
       in [LocatedA
   (LocatedA (HsExpr GhcPs), Maybe (LHsDoc GhcPs),
    HsArrowOf (LocatedA (HsExpr GhcPs)) GhcPs)]
-> ParsedFunRepr (HsExpr GhcPs) -> ParsedFunRepr (HsExpr GhcPs)
forall a.
[LocatedA
   (LocatedA a, Maybe (LHsDoc GhcPs), HsArrowOf (LocatedA a) GhcPs)]
-> ParsedFunRepr a -> ParsedFunRepr a
ParsedFunArgs [GenLocated
   SrcSpanAnnA
   (XRec GhcPs (HsExpr GhcPs), Maybe (LHsDoc GhcPs),
    HsArrowOf (XRec GhcPs (HsExpr GhcPs)) GhcPs)]
[LocatedA
   (LocatedA (HsExpr GhcPs), Maybe (LHsDoc GhcPs),
    HsArrowOf (LocatedA (HsExpr GhcPs)) GhcPs)]
args (LocatedA (HsExpr GhcPs) -> ParsedFunRepr (HsExpr GhcPs)
forall a. FunRepr a => LocatedA a -> ParsedFunRepr a
parseFunRepr LocatedA (HsExpr GhcPs)
ret)
    -- `_ -> Int`
    LocatedA (HsExpr GhcPs)
expr -> (LocatedA (HsExpr GhcPs), Maybe (LHsDoc GhcPs))
-> ParsedFunRepr (HsExpr GhcPs)
forall a. (LocatedA a, Maybe (LHsDoc GhcPs)) -> ParsedFunRepr a
ParsedFunReturn (LocatedA (HsExpr GhcPs)
expr, Maybe (LHsDoc GhcPs)
forall a. Maybe a
Nothing)
    where
      getContexts :: LocatedA (HsExpr GhcPs)
-> ([GenLocated
       SrcSpanAnnA (XRec GhcPs [XRec GhcPs (HsExpr GhcPs)])],
    LocatedA (HsExpr GhcPs))
getContexts =
        let go :: [GenLocated l (XRec p [XRec p (HsExpr p)])]
-> GenLocated l (HsExpr p)
-> ([GenLocated l (XRec p [XRec p (HsExpr p)])],
    GenLocated l (HsExpr p))
go [GenLocated l (XRec p [XRec p (HsExpr p)])]
ctxs = \case
              L l
ann (HsQual XQual p
_ XRec p [XRec p (HsExpr p)]
ctx XRec p (HsExpr p)
expr) ->
                [GenLocated l (XRec p [XRec p (HsExpr p)])]
-> GenLocated l (HsExpr p)
-> ([GenLocated l (XRec p [XRec p (HsExpr p)])],
    GenLocated l (HsExpr p))
go (l
-> XRec p [XRec p (HsExpr p)]
-> GenLocated l (XRec p [XRec p (HsExpr p)])
forall l e. l -> e -> GenLocated l e
L l
ann XRec p [XRec p (HsExpr p)]
ctx GenLocated l (XRec p [XRec p (HsExpr p)])
-> [GenLocated l (XRec p [XRec p (HsExpr p)])]
-> [GenLocated l (XRec p [XRec p (HsExpr p)])]
forall a. a -> [a] -> [a]
: [GenLocated l (XRec p [XRec p (HsExpr p)])]
ctxs) XRec p (HsExpr p)
GenLocated l (HsExpr p)
expr
              GenLocated l (HsExpr p)
expr ->
                ([GenLocated l (XRec p [XRec p (HsExpr p)])]
-> [GenLocated l (XRec p [XRec p (HsExpr p)])]
forall a. [a] -> [a]
reverse [GenLocated l (XRec p [XRec p (HsExpr p)])]
ctxs, GenLocated l (HsExpr p)
expr)
         in [GenLocated SrcSpanAnnA (XRec GhcPs [XRec GhcPs (HsExpr GhcPs)])]
-> LocatedA (HsExpr GhcPs)
-> ([GenLocated
       SrcSpanAnnA (XRec GhcPs [XRec GhcPs (HsExpr GhcPs)])],
    LocatedA (HsExpr GhcPs))
forall {p} {l}.
(XRec p (HsExpr p) ~ GenLocated l (HsExpr p)) =>
[GenLocated l (XRec p [XRec p (HsExpr p)])]
-> GenLocated l (HsExpr p)
-> ([GenLocated l (XRec p [XRec p (HsExpr p)])],
    GenLocated l (HsExpr p))
go []
      getArgsAndReturn :: LocatedA (HsExpr GhcPs)
-> ([GenLocated
       SrcSpanAnnA
       (XRec GhcPs (HsExpr GhcPs), Maybe a,
        HsArrowOf (XRec GhcPs (HsExpr GhcPs)) GhcPs)],
    LocatedA (HsExpr GhcPs))
getArgsAndReturn =
        let go :: [GenLocated
   l (XRec p (HsExpr p), Maybe a, HsArrowOf (XRec p (HsExpr p)) p)]
-> GenLocated l (HsExpr p)
-> ([GenLocated
       l (XRec p (HsExpr p), Maybe a, HsArrowOf (XRec p (HsExpr p)) p)],
    GenLocated l (HsExpr p))
go [GenLocated
   l (XRec p (HsExpr p), Maybe a, HsArrowOf (XRec p (HsExpr p)) p)]
args = \case
              L l
ann (HsFunArr XFunArr p
_ HsArrowOf (XRec p (HsExpr p)) p
arrow XRec p (HsExpr p)
l XRec p (HsExpr p)
r) ->
                [GenLocated
   l (XRec p (HsExpr p), Maybe a, HsArrowOf (XRec p (HsExpr p)) p)]
-> GenLocated l (HsExpr p)
-> ([GenLocated
       l (XRec p (HsExpr p), Maybe a, HsArrowOf (XRec p (HsExpr p)) p)],
    GenLocated l (HsExpr p))
go (l
-> (XRec p (HsExpr p), Maybe a, HsArrowOf (XRec p (HsExpr p)) p)
-> GenLocated
     l (XRec p (HsExpr p), Maybe a, HsArrowOf (XRec p (HsExpr p)) p)
forall l e. l -> e -> GenLocated l e
L l
ann (XRec p (HsExpr p)
l, Maybe a
forall a. Maybe a
Nothing, HsArrowOf (XRec p (HsExpr p)) p
arrow) GenLocated
  l (XRec p (HsExpr p), Maybe a, HsArrowOf (XRec p (HsExpr p)) p)
-> [GenLocated
      l (XRec p (HsExpr p), Maybe a, HsArrowOf (XRec p (HsExpr p)) p)]
-> [GenLocated
      l (XRec p (HsExpr p), Maybe a, HsArrowOf (XRec p (HsExpr p)) p)]
forall a. a -> [a] -> [a]
: [GenLocated
   l (XRec p (HsExpr p), Maybe a, HsArrowOf (XRec p (HsExpr p)) p)]
args) XRec p (HsExpr p)
GenLocated l (HsExpr p)
r
              GenLocated l (HsExpr p)
expr ->
                ([GenLocated
   l (XRec p (HsExpr p), Maybe a, HsArrowOf (XRec p (HsExpr p)) p)]
-> [GenLocated
      l (XRec p (HsExpr p), Maybe a, HsArrowOf (XRec p (HsExpr p)) p)]
forall a. [a] -> [a]
reverse [GenLocated
   l (XRec p (HsExpr p), Maybe a, HsArrowOf (XRec p (HsExpr p)) p)]
args, GenLocated l (HsExpr p)
expr)
         in [GenLocated
   SrcSpanAnnA
   (XRec GhcPs (HsExpr GhcPs), Maybe a,
    HsArrowOf (XRec GhcPs (HsExpr GhcPs)) GhcPs)]
-> LocatedA (HsExpr GhcPs)
-> ([GenLocated
       SrcSpanAnnA
       (XRec GhcPs (HsExpr GhcPs), Maybe a,
        HsArrowOf (XRec GhcPs (HsExpr GhcPs)) GhcPs)],
    LocatedA (HsExpr GhcPs))
forall {p} {l} {a}.
(XRec p (HsExpr p) ~ GenLocated l (HsExpr p)) =>
[GenLocated
   l (XRec p (HsExpr p), Maybe a, HsArrowOf (XRec p (HsExpr p)) p)]
-> GenLocated l (HsExpr p)
-> ([GenLocated
       l (XRec p (HsExpr p), Maybe a, HsArrowOf (XRec p (HsExpr p)) p)],
    GenLocated l (HsExpr p))
go []

----------------------------------------------------------------------------
-- 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 -> R () -> R ()
forall a. a -> a
id

getGRHSSpan :: GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan :: forall body. GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan (GRHS XCGRHS GhcPs (LocatedA body)
_ [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
guards LocatedA body
body) =
  NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ LocatedA body -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LocatedA body
body SrcSpan -> [SrcSpan] -> NonEmpty SrcSpan
forall a. a -> [a] -> NonEmpty a
:| (GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
 -> SrcSpan)
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
[GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr 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)
_ [LStmt GhcPs (XRec GhcPs (HsExpr 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 {} -> Placement
Hanging
  HsCmdCase {} -> Placement
Hanging
  HsCmdDo {} -> 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
_ HsLamVariant
variant MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mg -> case HsLamVariant
variant of
    HsLamVariant
LamSingle -> case MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mg of
      MG XMG GhcPs (XRec GhcPs (HsExpr GhcPs))
_ (L SrcSpanAnnLW
_ [L SrcSpanAnnA
_ (Match XCMatch GhcPs (LocatedA (HsExpr GhcPs))
_ HsMatchContext (LIdP (NoGhcTc GhcPs))
_ (L EpaLocation
_ (GenLocated SrcSpanAnnA (Pat GhcPs)
x : [GenLocated SrcSpanAnnA (Pat GhcPs)]
xs)) GRHSs GhcPs (LocatedA (HsExpr GhcPs))
_)])
        | SrcSpan -> Bool
isOneLineSpan (NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan)
-> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> NonEmpty SrcSpan
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (Pat GhcPs)
x GenLocated SrcSpanAnnA (Pat GhcPs)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. a -> [a] -> NonEmpty a
:| [GenLocated SrcSpanAnnA (Pat GhcPs)]
xs)) ->
            Placement
Hanging
      MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
_ -> Placement
Normal
    HsLamVariant
LamCase -> Placement
Hanging
    HsLamVariant
LamCases -> 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 [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
_ -> Placement
Hanging
  HsDo XDo GhcPs
_ (MDoExpr Maybe ModuleName
_) XRec GhcPs [LStmt GhcPs (XRec GhcPs (HsExpr GhcPs))]
_ -> Placement
Hanging
  OpApp XOpApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ XRec GhcPs (HsExpr GhcPs)
op XRec GhcPs (HsExpr GhcPs)
y ->
    case ((RdrName -> String) -> Maybe RdrName -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> String
getOpNameStr (Maybe RdrName -> Maybe String)
-> (LocatedA (HsExpr GhcPs) -> Maybe RdrName)
-> LocatedA (HsExpr GhcPs)
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> Maybe RdrName
getOpName (HsExpr GhcPs -> Maybe RdrName)
-> (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs)
-> LocatedA (HsExpr GhcPs)
-> Maybe RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc) XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
op of
      Just String
"$" -> HsExpr GhcPs -> Placement
exprPlacement (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
LocatedA (HsExpr GhcPs)
y)
      Maybe String
_ -> Placement
Normal
  HsApp XApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ XRec GhcPs (HsExpr GhcPs)
y -> HsExpr GhcPs -> Placement
exprPlacement (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
LocatedA (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 (GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LPat GhcPs
GenLocated SrcSpanAnnA (Pat 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 = (GenLocated (Anno (GRHS GhcPs body)) (GRHS GhcPs body) -> Bool)
-> [GenLocated (Anno (GRHS GhcPs body)) (GRHS GhcPs body)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GRHS GhcPs body -> Bool
forall {p} {body}. GRHS p body -> Bool
checkOne (GRHS GhcPs body -> Bool)
-> (GenLocated (Anno (GRHS GhcPs body)) (GRHS GhcPs body)
    -> GRHS GhcPs body)
-> GenLocated (Anno (GRHS GhcPs body)) (GRHS GhcPs body)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (Anno (GRHS GhcPs body)) (GRHS GhcPs body)
-> GRHS GhcPs body
forall l e. GenLocated l e -> e
unLoc)
  where
    checkOne :: GRHS p body -> Bool
checkOne (GRHS XCGRHS p body
_ [] body
_) = Bool
False
    checkOne GRHS p body
_ = Bool
True

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

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