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

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

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

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

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

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

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

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

p_matchGroup' ::
  ( Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
    Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
  ) =>
  -- | How to get body placement
  (body -> Placement) ->
  -- | How to print body
  (body -> R ()) ->
  -- | Style of this group of equations
  MatchGroupStyle ->
  -- | Match group
  MatchGroup GhcPs (LocatedA body) ->
  R ()
p_matchGroup' :: (body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
style mg :: MatchGroup GhcPs (LocatedA body)
mg@MG {XRec GhcPs [LMatch GhcPs (LocatedA body)]
XMG GhcPs (LocatedA body)
Origin
mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_origin :: forall p body. MatchGroup p body -> Origin
mg_origin :: Origin
mg_alts :: XRec GhcPs [LMatch GhcPs (LocatedA body)]
mg_ext :: XMG GhcPs (LocatedA body)
..} = do
  let ob :: R () -> R ()
ob = case MatchGroupStyle
style of
        MatchGroupStyle
Case -> R () -> R ()
bracesIfEmpty
        MatchGroupStyle
LambdaCase -> R () -> R ()
bracesIfEmpty
        MatchGroupStyle
_ -> R () -> R ()
dontUseBraces
        where
          bracesIfEmpty :: R () -> R ()
bracesIfEmpty = if 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. HasSrcSpan 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 {[LPat GhcPs]
HsMatchContext (NoGhcTc GhcPs)
GRHSs GhcPs (LocatedA body)
XCMatch GhcPs (LocatedA body)
m_ext :: forall p body. Match p body -> XCMatch p body
m_ctxt :: forall p body. Match p body -> HsMatchContext (NoGhcTc p)
m_pats :: forall p body. Match p body -> [LPat p]
m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss :: GRHSs GhcPs (LocatedA body)
m_pats :: [LPat GhcPs]
m_ctxt :: HsMatchContext (NoGhcTc GhcPs)
m_ext :: XCMatch GhcPs (LocatedA body)
..} =
      (body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
p_match'
        body -> Placement
placer
        body -> R ()
render
        (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)
        (Match GhcPs (LocatedA body) -> SrcStrictness
forall id body. Match id body -> SrcStrictness
matchStrictness Match GhcPs (LocatedA body)
m)
        [LPat GhcPs]
m_pats
        GRHSs GhcPs (LocatedA body)
m_grhss

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

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

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

p_match' ::
  (Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan) =>
  -- | How to get body placement
  (body -> Placement) ->
  -- | How to print body
  (body -> R ()) ->
  -- | Style of this group of equations
  MatchGroupStyle ->
  -- | Is this an infix match?
  Bool ->
  -- | Strictness prefix (FunBind)
  SrcStrictness ->
  -- | Argument patterns
  [LPat GhcPs] ->
  -- | Equations
  GRHSs GhcPs (LocatedA body) ->
  R ()
p_match' :: (body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
p_match' body -> Placement
placer body -> R ()
render MatchGroupStyle
style Bool
isInfix SrcStrictness
strictness [LPat GhcPs]
m_pats GRHSs {[LGRHS GhcPs (LocatedA body)]
HsLocalBinds GhcPs
XCGRHSs GhcPs (LocatedA body)
grhssExt :: forall p body. GRHSs p body -> XCGRHSs p body
grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
grhssLocalBinds :: HsLocalBinds GhcPs
grhssGRHSs :: [LGRHS GhcPs (LocatedA body)]
grhssExt :: XCGRHSs GhcPs (LocatedA body)
..} = do
  -- Normally, since patterns may be placed in a multi-line layout, it is
  -- necessary to bump indentation for the pattern group so it's more
  -- indented than function name. This in turn means that indentation for
  -- the body should also be bumped. Normally this would mean that bodies
  -- would start with two indentation steps applied, which is ugly, so we
  -- need to be a bit more clever here and bump indentation level only when
  -- pattern group is multiline.
  case SrcStrictness
strictness of
    SrcStrictness
NoSrcStrict -> () -> R ()
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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()
    Just NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
ne_pats -> do
      let combinedSpans :: SrcSpan
combinedSpans = case MatchGroupStyle
style of
            Function LocatedN RdrName
name -> SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' 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. GenLocated (SrcSpanAnn' 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 ()
switchLayout [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. HasSrcSpan 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. HasSrcSpan 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 (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a. NonEmpty a -> a
NE.head NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
ne_pats) of
                  LazyPat XLazyPat GhcPs
_ LPat GhcPs
_ -> Bool
True
                  BangPat XBangPat GhcPs
_ LPat GhcPs
_ -> Bool
True
                  SplicePat XSplicePat GhcPs
_ HsSplice GhcPs
_ -> Bool
True
                  Pat GhcPs
_ -> Bool
False
            Text -> R ()
txt Text
"\\"
            Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsSpace R ()
space
            R () -> R ()
sitcc R ()
stdCase
          MatchGroupStyle
LambdaCase -> R ()
stdCase
      Bool -> R Bool
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. GenLocated (SrcSpanAnn' 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. GenLocated (SrcSpanAnn' 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 SrcSpan (GRHS GhcPs (LocatedA body))
    -> GRHS GhcPs (LocatedA body))
-> GenLocated SrcSpan (GRHS GhcPs (LocatedA body))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (GRHS GhcPs (LocatedA body))
-> GRHS GhcPs (LocatedA body)
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (GRHS GhcPs (LocatedA body)) -> SrcSpan)
-> NonEmpty (GenLocated SrcSpan (GRHS GhcPs (LocatedA body)))
-> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated SrcSpan (GRHS GhcPs (LocatedA body))]
-> NonEmpty (GenLocated SrcSpan (GRHS GhcPs (LocatedA body)))
forall a. [a] -> NonEmpty a
NE.fromList [LGRHS GhcPs (LocatedA body)]
[GenLocated SrcSpan (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 SrcSpan (GRHS GhcPs (LocatedA body)) -> Bool)
-> [GenLocated SrcSpan (GRHS GhcPs (LocatedA body))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any GenLocated SrcSpan (GRHS GhcPs (LocatedA body)) -> Bool
forall body. Located (GRHS GhcPs body) -> Bool
guardNeedsLineBreak [LGRHS GhcPs (LocatedA body)]
[GenLocated SrcSpan (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 :: Located (GRHS GhcPs body) -> Bool
      guardNeedsLineBreak :: Located (GRHS GhcPs body) -> Bool
guardNeedsLineBreak (L SrcSpan
_ (GRHS XCGRHS GhcPs body
_ [GuardLStmt GhcPs]
guardLStmts body
_)) = case [GuardLStmt GhcPs]
guardLStmts of
        [] -> Bool
False
        [GuardLStmt GhcPs
g] -> Bool -> Bool
not (Bool -> Bool)
-> (GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
    -> Bool)
-> GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (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. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
 -> Bool)
-> GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> Bool
forall a b. (a -> b) -> a -> b
$ GuardLStmt GhcPs
GenLocated
  SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
g
        [GuardLStmt GhcPs]
_ -> Bool
True
      p_body :: R ()
p_body = do
        let groupStyle :: GroupStyle
groupStyle =
              if MatchGroupStyle -> Bool
isCase MatchGroupStyle
style Bool -> Bool -> Bool
&& Bool
hasGuards
                then GroupStyle
RightArrow
                else GroupStyle
EqualSign
        R ()
-> (GenLocated SrcSpan (GRHS GhcPs (LocatedA body)) -> R ())
-> [GenLocated SrcSpan (GRHS GhcPs (LocatedA body))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
          R ()
breakpoint
          ((GRHS GhcPs (LocatedA body) -> R ())
-> GenLocated (SrcAnn Any) (GRHS GhcPs (LocatedA body)) -> R ()
forall l a. HasSrcSpan 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) (GenLocated (SrcAnn Any) (GRHS GhcPs (LocatedA body)) -> R ())
-> (GenLocated SrcSpan (GRHS GhcPs (LocatedA body))
    -> GenLocated (SrcAnn Any) (GRHS GhcPs (LocatedA body)))
-> GenLocated SrcSpan (GRHS GhcPs (LocatedA body))
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (GRHS GhcPs (LocatedA body))
-> GenLocated (SrcAnn Any) (GRHS GhcPs (LocatedA body))
forall e ann. Located e -> LocatedAn ann e
reLocA)
          [LGRHS GhcPs (LocatedA body)]
[GenLocated SrcSpan (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
          Text -> R ()
txt Text
"where"
          R ()
breakpoint
          R () -> R ()
inci (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 SrcSpan (GRHS GhcPs (LocatedA body))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LGRHS GhcPs (LocatedA body)]
[GenLocated SrcSpan (GRHS GhcPs (LocatedA body))]
grhssGRHSs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      case MatchGroupStyle
style of
        Function LocatedN RdrName
_ | Bool
hasGuards -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Function LocatedN RdrName
_ -> R ()
space R () -> R () -> R ()
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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()
        MatchGroupStyle
_ -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"->"
    [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 (LHsExpr 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' :: Placement
-> (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA body)
-> R ()
p_grhs' Placement
parentPlacement body -> Placement
placer body -> R ()
render GroupStyle
style (GRHS XCGRHS GhcPs (LocatedA body)
_ [GuardLStmt GhcPs]
guards LocatedA body
body) =
  case [GuardLStmt GhcPs]
guards of
    [] -> R ()
p_body
    [GuardLStmt GhcPs]
xs -> do
      Text -> R ()
txt Text
"|"
      R ()
space
      R () -> R ()
sitcc (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. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Stmt GhcPs (LHsExpr GhcPs) -> R ()
StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> R ()
p_stmt) [GuardLStmt 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 -> Text -> R ()
txt Text
"->"
      -- If we have a sequence of guards and it is placed in the normal way,
      -- then we indent one level more for readability. Otherwise (all
      -- guards are on the same line) we do not need to indent, as it would
      -- look like double indentation without a good reason.
      Bool -> R () -> R ()
inciIf (Placement
parentPlacement 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. GenLocated (SrcSpanAnn' 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 [GuardLStmt 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. GenLocated (SrcSpanAnn' 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. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
body body -> R ()
render

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

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

-- | Render an expression preserving blank lines between such consecutive
-- expressions found in the original source code.
withSpacing ::
  -- | Rendering function
  (a -> R ()) ->
  -- | Entity to render
  LocatedAn ann a ->
  R ()
withSpacing :: (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing a -> R ()
f LocatedAn ann a
l = LocatedAn ann a -> (a -> R ()) -> R ()
forall l a. HasSrcSpan 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. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedAn ann a
l of
    UnhelpfulSpan UnhelpfulSpanReason
_ -> a -> R ()
f a
x
    RealSrcSpan RealSrcSpan
currentSpn Maybe BufSpan
_ -> do
      R (Maybe SpanMark)
getSpanMark R (Maybe SpanMark) -> (Maybe SpanMark -> R ()) -> R ()
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 -> Int
srcSpanStartLine RealSrcSpan
currentSpn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
lastSpn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            then R ()
newline
            else () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Maybe SpanMark
_ -> () -> R ()
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just (HaddockSpan HaddockStyle
_ RealSrcSpan
_) -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (CommentSpan RealSrcSpan
_) -> () -> R ()
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 (LHsExpr GhcPs) -> R ()
p_stmt = (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))
-> R ()
forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
 Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
p_stmt' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr

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

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

gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]
gatherStmt :: GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt (L _ (ParStmt _ block _ _)) =
  (ParStmtBlock GhcPs 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)))]]
-> [ParStmtBlock GhcPs GhcPs]
-> [[GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[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 a. Semigroup a => a -> a -> a
(<>) ([[GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
 -> [[GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
 -> [[GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]])
-> (ParStmtBlock GhcPs GhcPs
    -> [[GenLocated
           SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]])
-> ParStmtBlock GhcPs GhcPs
-> [[GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]]
ParStmtBlock GhcPs GhcPs
-> [[GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
gatherStmtBlock) [] [ParStmtBlock GhcPs GhcPs]
block
gatherStmt (L s stmt@TransStmt {..}) =
  ([[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)))]]
-> [[[GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]]
-> [[GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [[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 a. Semigroup a => [a] -> [a] -> [a]
liftAppend [] ((GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
GenLocated
  SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> [[GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
gatherStmt (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuardLStmt GhcPs]
[GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
trS_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)))]]]
forall a. Semigroup a => a -> a -> a
<> [[GenLocated
    SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[[GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[SrcSpanAnnA
-> StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
s StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))
stmt]])
gatherStmt GuardLStmt GhcPs
stmt = [[GuardLStmt GhcPs
stmt]]

gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[ExprLStmt GhcPs]]
gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]]
gatherStmtBlock (ParStmtBlock XParStmtBlock GhcPs GhcPs
_ [GuardLStmt GhcPs]
stmts [IdP GhcPs]
_ SyntaxExpr GhcPs
_) =
  (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)))]]
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> [[GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[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 a. Semigroup a => [a] -> [a] -> [a]
liftAppend ([[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)))
    -> [[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 b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
GenLocated
  SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> [[GenLocated
       SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
gatherStmt) [] [GuardLStmt GhcPs]
[GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
stmts

p_hsLocalBinds :: HsLocalBinds GhcPs -> R ()
p_hsLocalBinds :: HsLocalBinds GhcPs -> R ()
p_hsLocalBinds = \case
  HsValBinds XHsValBinds GhcPs GhcPs
epAnn (ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
bag [LSig GhcPs]
lsigs) -> EpAnn AnnList -> R () -> R ()
pseudoLocated XHsValBinds GhcPs GhcPs
EpAnn AnnList
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 (HsBindLR GhcPs 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 (HsBindLR GhcPs GhcPs)
-> GenLocated
     SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
forall l a b. GenLocated l a -> GenLocated l (Either a b)
injectLeft (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
 -> GenLocated
      SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
-> [GenLocated
      SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
bag) [GenLocated
   SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [GenLocated
      SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [GenLocated
      SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall a. [a] -> [a] -> [a]
++ (GenLocated SrcSpanAnnA (Sig GhcPs)
-> GenLocated
     SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
forall l b a. GenLocated l b -> GenLocated l (Either a b)
injectRight (GenLocated SrcSpanAnnA (Sig GhcPs)
 -> GenLocated
      SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
-> [GenLocated
      SrcSpanAnnA (Either (HsBindLR GhcPs 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 (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> R ()
p_item' (RelativePos
p, GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
item) =
          RelativePos -> R () -> R ()
positionToBracing RelativePos
p (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
            (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs) -> R ())
-> GenLocated
     SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> R ()
forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing ((HsBindLR GhcPs GhcPs -> R ())
-> (Sig GhcPs -> R ())
-> Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)
-> R ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsBindLR GhcPs GhcPs -> R ()
p_valDecl Sig GhcPs -> R ()
p_sigDecl) GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
item
        binds :: [GenLocated
   SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
binds = (GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
 -> GenLocated
      SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
 -> Ordering)
-> [GenLocated
      SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [GenLocated
      SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (GenLocated
      SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
    -> SrcSpan)
-> GenLocated
     SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> GenLocated
     SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) [GenLocated
   SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
items
    R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ ((RelativePos,
  GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
 -> R ())
-> [(RelativePos,
     GenLocated
       SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))]
-> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi (RelativePos,
 GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> R ()
p_item' ([GenLocated
   SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [(RelativePos,
     GenLocated
       SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))]
forall a. [a] -> [(RelativePos, a)]
attachRelativePos [GenLocated
   SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
binds)
  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) -> EpAnn AnnList -> R () -> R ()
pseudoLocated XHsIPBinds GhcPs GhcPs
EpAnn AnnList
epAnn (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    -- Second argument of IPBind is always Left before type-checking.
    let p_ipBind :: IPBind GhcPs -> R ()
p_ipBind (IPBind XCIPBind GhcPs
_ (Left XRec GhcPs HsIPName
name) LHsExpr GhcPs
expr) = do
          GenLocated SrcSpan HsIPName -> R ()
forall a. Outputable a => a -> R ()
atom XRec GhcPs HsIPName
GenLocated SrcSpan 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. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
        p_ipBind (IPBind XCIPBind GhcPs
_ (Right IdP GhcPs
_) LHsExpr GhcPs
_) =
          -- Should only occur after the type checker
          String -> R ()
forall a. String -> a
notImplemented String
"IPBind _ (Right _) _"
    (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. HasSrcSpan 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 (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    -- HsLocalBinds is no longer wrapped in a Located (see call sites
    -- of p_hsLocalBinds). Hence, we introduce a manual Located as we
    -- depend on the layout being correctly set.
    pseudoLocated :: EpAnn AnnList -> R () -> R ()
pseudoLocated = \case
      EpAnn {anns :: forall ann. EpAnn ann -> ann
anns = AnnList {al_anchor :: AnnList -> Maybe Anchor
al_anchor = Just Anchor {RealSrcSpan
anchor :: Anchor -> RealSrcSpan
anchor :: RealSrcSpan
anchor}}} ->
        GenLocated SrcSpan () -> (() -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (SrcSpan -> () -> GenLocated SrcSpan ()
forall l e. l -> e -> GenLocated l e
L (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
anchor Maybe BufSpan
forall a. Maybe a
Nothing) ()) ((() -> 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
_ -> R () -> R ()
forall a. a -> a
id

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

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

p_hsRecField ::
  (id -> R ()) ->
  HsRecField' id (LHsExpr GhcPs) ->
  R ()
p_hsRecField :: (id -> R ()) -> HsRecField' id (LHsExpr GhcPs) -> R ()
p_hsRecField id -> R ()
p_lbl HsRecField {Bool
LHsExpr GhcPs
XHsRecField id
Located id
hsRecFieldAnn :: forall id arg. HsRecField' id arg -> XHsRecField id
hsRecFieldLbl :: forall id arg. HsRecField' id arg -> Located id
hsRecFieldArg :: forall id arg. HsRecField' id arg -> arg
hsRecPun :: forall id arg. HsRecField' id arg -> Bool
hsRecPun :: Bool
hsRecFieldArg :: LHsExpr GhcPs
hsRecFieldLbl :: Located id
hsRecFieldAnn :: XHsRecField id
..} = do
  Located id -> (id -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located Located id
hsRecFieldLbl id -> R ()
p_lbl
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hsRecPun (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 (Located id -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located id
hsRecFieldLbl) (LocatedA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
hsRecFieldArg)
            then HsExpr GhcPs -> Placement
exprPlacement (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
hsRecFieldArg)
            else Placement
Normal
    Placement -> R () -> R ()
placeHanging Placement
placement (LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
hsRecFieldArg HsExpr GhcPs -> R ()
p_hsExpr)

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

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

p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PSB {HsPatSynDir GhcPs
HsPatSynDetails GhcPs
LPat GhcPs
LIdP GhcPs
XPSB GhcPs GhcPs
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_dir :: HsPatSynDir GhcPs
psb_def :: LPat GhcPs
psb_args :: HsPatSynDetails GhcPs
psb_id :: LIdP GhcPs
psb_ext :: XPSB GhcPs GhcPs
..} = do
  let rhs :: [SrcSpan] -> R ()
rhs [SrcSpan]
conSpans = do
        R ()
space
        let pattern_def_spans :: [SrcSpan]
pattern_def_spans = [LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
LocatedN RdrName
psb_id, GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' 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
              Text -> R ()
txt Text
"<-"
              R ()
breakpoint
              GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan 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. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
psb_def Pat GhcPs -> R ()
p_pat
          ExplicitBidirectional MatchGroup GhcPs (LHsExpr GhcPs)
mgroup -> do
            [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
pattern_def_spans (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
              Text -> R ()
txt Text
"<-"
              R ()
breakpoint
              GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan 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 (LHsExpr GhcPs) -> R ()
p_matchGroup (LocatedN RdrName -> MatchGroupStyle
Function LIdP GhcPs
LocatedN RdrName
psb_id) MatchGroup GhcPs (LHsExpr 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. GenLocated (SrcSpanAnn' 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 (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. GenLocated (SrcSpanAnn' 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 -> 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 (t :: * -> *) a. Foldable t => t a -> Bool
null [RecordPatSynField GhcPs]
xs) R ()
breakpoint
          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 -> 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. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
LocatedN RdrName
l, LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' 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)) ~ SrcSpan,
    Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
  ) =>
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (body -> R ()) ->
  -- | Expression
  LHsExpr GhcPs ->
  -- | Match group
  MatchGroup GhcPs (LocatedA body) ->
  R ()
p_case :: (body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_case body -> Placement
placer body -> R ()
render LHsExpr 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. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
  R ()
space
  Text -> R ()
txt Text
"of"
  R ()
breakpoint
  R () -> R ()
inci ((body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
 Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
Case MatchGroup GhcPs (LocatedA body)
mgroup)

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

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

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

p_pat :: Pat GhcPs -> R ()
p_pat :: Pat GhcPs -> R ()
p_pat = \case
  WildPat XWildPat GhcPs
_ -> Text -> R ()
txt Text
"_"
  VarPat XVarPat GhcPs
_ LIdP GhcPs
name -> LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
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. HasSrcSpan 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. HasSrcSpan 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. HasSrcSpan 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
. 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. HasSrcSpan 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. HasSrcSpan 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. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
  SumPat XSumPat GhcPs
_ LPat GhcPs
pat Int
tag Int
arity ->
    BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum BracketStyle
S Int
tag Int
arity (GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan 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 [] [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 ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
xs) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          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 ()
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (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. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
xs
      -- The first field of PrefixCon is filled in later stages
      PrefixCon {} -> String -> R ()
forall a. String -> a
notImplemented String
"Unexpected types in constructor pattern"
      RecCon (HsRecFields [LHsRecField GhcPs (LPat GhcPs)]
fields Maybe (Located Int)
dotdot) -> do
        LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
pat
        R ()
breakpoint
        let f :: Maybe
  (GenLocated
     SrcSpanAnnA
     (HsRecField'
        (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
-> R ()
f = \case
              Maybe
  (GenLocated
     SrcSpanAnnA
     (HsRecField'
        (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
Nothing -> Text -> R ()
txt Text
".."
              Just GenLocated
  SrcSpanAnnA
  (HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
x -> GenLocated
  SrcSpanAnnA
  (HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> (HsRecField'
      (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
    -> R ())
-> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated
  SrcSpanAnnA
  (HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
x HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
-> R ()
p_pat_hsRecField
        R () -> R ()
inci (R () -> R ())
-> ([Maybe
       (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
    -> R ())
-> [Maybe
      (GenLocated
         SrcSpanAnnA
         (HsRecField'
            (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
          (HsRecField'
             (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
    -> R ())
-> [Maybe
      (GenLocated
         SrcSpanAnnA
         (HsRecField'
            (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R ()
-> (Maybe
      (GenLocated
         SrcSpanAnnA
         (HsRecField'
            (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
    -> R ())
-> [Maybe
      (GenLocated
         SrcSpanAnnA
         (HsRecField'
            (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel Maybe
  (GenLocated
     SrcSpanAnnA
     (HsRecField'
        (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
-> R ()
f ([Maybe
    (GenLocated
       SrcSpanAnnA
       (HsRecField'
          (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
 -> R ())
-> [Maybe
      (GenLocated
         SrcSpanAnnA
         (HsRecField'
            (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ()
forall a b. (a -> b) -> a -> b
$
          case Maybe (Located Int)
dotdot of
            Maybe (Located Int)
Nothing -> GenLocated
  SrcSpanAnnA
  (HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Maybe
     (GenLocated
        SrcSpanAnnA
        (HsRecField'
           (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
forall a. a -> Maybe a
Just (GenLocated
   SrcSpanAnnA
   (HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
 -> Maybe
      (GenLocated
         SrcSpanAnnA
         (HsRecField'
            (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))))
-> [GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> [Maybe
      (GenLocated
         SrcSpanAnnA
         (HsRecField'
            (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (LPat GhcPs)]
[GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))]
fields
            Just (L SrcSpan
_ Int
n) -> (GenLocated
  SrcSpanAnnA
  (HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Maybe
     (GenLocated
        SrcSpanAnnA
        (HsRecField'
           (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
forall a. a -> Maybe a
Just (GenLocated
   SrcSpanAnnA
   (HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
 -> Maybe
      (GenLocated
         SrcSpanAnnA
         (HsRecField'
            (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))))
-> [GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> [Maybe
      (GenLocated
         SrcSpanAnnA
         (HsRecField'
            (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> [GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> [GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))]
forall a. Int -> [a] -> [a]
take Int
n [LHsRecField GhcPs (LPat GhcPs)]
[GenLocated
   SrcSpanAnnA
   (HsRecField'
      (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))]
fields) [Maybe
   (GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> [Maybe
      (GenLocated
         SrcSpanAnnA
         (HsRecField'
            (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> [Maybe
      (GenLocated
         SrcSpanAnnA
         (HsRecField'
            (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
forall a. [a] -> [a] -> [a]
++ [Maybe
  (GenLocated
     SrcSpanAnnA
     (HsRecField'
        (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. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
l, GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' 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. HasSrcSpan 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. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
r Pat GhcPs -> R ()
p_pat
  ViewPat XViewPat GhcPs
_ LHsExpr 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. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
    R ()
space
    Text -> R ()
txt Text
"->"
    R ()
breakpoint
    R () -> R ()
inci (GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat)
  SplicePat XSplicePat GhcPs
_ HsSplice GhcPs
splice -> HsSplice GhcPs -> R ()
p_hsSplice HsSplice GhcPs
splice
  LitPat XLitPat GhcPs
_ HsLit GhcPs
p -> HsLit GhcPs -> R ()
forall a. Outputable a => a -> R ()
atom HsLit GhcPs
p
  NPat XNPat GhcPs
_ XRec GhcPs (HsOverLit GhcPs)
v (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 SrcSpan (HsOverLit GhcPs)
-> (HsOverLit GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsOverLit GhcPs)
GenLocated SrcSpan (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 SrcSpan (HsOverLit GhcPs)
-> (HsOverLit GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsOverLit GhcPs)
GenLocated SrcSpan (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 {LHsType (NoGhcTc GhcPs)
XHsPS (NoGhcTc GhcPs)
hsps_ext :: forall pass. HsPatSigType pass -> XHsPS pass
hsps_body :: forall pass. HsPatSigType pass -> LHsType pass
hsps_body :: LHsType (NoGhcTc GhcPs)
hsps_ext :: XHsPS (NoGhcTc GhcPs)
..} -> do
    GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan 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 GhcPs
LHsType (NoGhcTc GhcPs)
hsps_body)

p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
p_pat_hsRecField HsRecField {Bool
LPat GhcPs
XHsRecField (FieldOcc GhcPs)
Located (FieldOcc GhcPs)
hsRecPun :: Bool
hsRecFieldArg :: LPat GhcPs
hsRecFieldLbl :: Located (FieldOcc GhcPs)
hsRecFieldAnn :: XHsRecField (FieldOcc GhcPs)
hsRecFieldAnn :: forall id arg. HsRecField' id arg -> XHsRecField id
hsRecFieldLbl :: forall id arg. HsRecField' id arg -> Located id
hsRecFieldArg :: forall id arg. HsRecField' id arg -> arg
hsRecPun :: forall id arg. HsRecField' id arg -> Bool
..} = do
  Located (FieldOcc GhcPs) -> (FieldOcc GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located Located (FieldOcc GhcPs)
hsRecFieldLbl ((FieldOcc GhcPs -> R ()) -> R ())
-> (FieldOcc GhcPs -> R ()) -> 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 -> LocatedN RdrName
forall pass. FieldOcc pass -> LocatedN RdrName
rdrNameFieldOcc
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hsRecPun (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. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
hsRecFieldArg Pat GhcPs -> R ()
p_pat)

p_unboxedSum :: BracketStyle -> ConTag -> Arity -> R () -> R ()
p_unboxedSum :: BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum BracketStyle
s Int
tag Int
arity R ()
m = do
  let before :: Int
before = Int
tag Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      after :: Int
after = Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
before Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      args :: [Maybe (R ())]
args = Int -> Maybe (R ()) -> [Maybe (R ())]
forall a. Int -> a -> [a]
replicate Int
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
<> Int -> Maybe (R ()) -> [Maybe (R ())]
forall a. Int -> a -> [a]
replicate Int
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_hsSplice :: HsSplice GhcPs -> R ()
p_hsSplice :: HsSplice GhcPs -> R ()
p_hsSplice = \case
  HsTypedSplice XTypedSplice GhcPs
_ SpliceDecoration
deco IdP GhcPs
_ LHsExpr GhcPs
expr -> Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
True LHsExpr GhcPs
expr SpliceDecoration
deco
  HsUntypedSplice XUntypedSplice GhcPs
_ SpliceDecoration
deco IdP GhcPs
_ LHsExpr GhcPs
expr -> Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
False LHsExpr GhcPs
expr SpliceDecoration
deco
  HsQuasiQuote XQuasiQuote GhcPs
_ IdP GhcPs
_ IdP GhcPs
quoterName SrcSpan
_ FastString
str -> do
    Text -> R ()
txt Text
"["
    LocatedN RdrName -> R ()
p_rdrName (RdrName -> LocatedN RdrName
forall a an. a -> LocatedAn an 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.
    FastString -> R ()
forall a. Outputable a => a -> R ()
atom FastString
str
    Text -> R ()
txt Text
"|]"
  HsSpliced {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsSpliced"

p_hsSpliceTH ::
  -- | Typed splice?
  Bool ->
  -- | Splice expression
  LHsExpr GhcPs ->
  -- | Splice decoration
  SpliceDecoration ->
  R ()
p_hsSpliceTH :: Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
isTyped LHsExpr GhcPs
expr = \case
  SpliceDecoration
DollarSplice -> do
    Text -> R ()
txt Text
decoSymbol
    LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr 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. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr 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_hsBracket :: EpAnn [AddEpAnn] -> HsBracket GhcPs -> R ()
p_hsBracket :: EpAnn [AddEpAnn] -> HsBracket GhcPs -> R ()
p_hsBracket EpAnn [AddEpAnn]
epAnn = \case
  ExpBr XExpBr GhcPs
_ LHsExpr GhcPs
expr -> do
    let name :: Text
name
          | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool
True | AddEpAnn AnnKeywordId
AnnOpenEQ EpaLocation
_ <- EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns EpAnn [AddEpAnn]
epAnn] = Text
""
          | Bool
otherwise = Text
"e"
    Text -> R () -> R ()
quote Text
name (LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr 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. HasSrcSpan 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. HasSrcSpan 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
  TExpBr XTExpBr GhcPs
_ LHsExpr GhcPs
expr -> do
    Text -> R ()
txt Text
"[||"
    R ()
breakpoint'
    LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
    R ()
breakpoint'
    Text -> R ()
txt Text
"||]"
  where
    quote :: Text -> R () -> R ()
    quote :: Text -> R () -> R ()
quote Text
name R ()
body = do
      Text -> R ()
txt Text
"["
      Text -> R ()
txt Text
name
      Text -> R ()
txt Text
"|"
      R ()
breakpoint'
      R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        R () -> R ()
dontUseBraces R ()
body
        R ()
breakpoint'
        Text -> R ()
txt Text
"|]"
    -- With StarIsType, type and declaration brackets might end with a *,
    -- so we have to insert a space in the end to prevent the (mis)parsing
    -- of an (*|) operator.
    -- The detection is a bit overcautious, as it adds the spaces as soon as
    -- HsStarTy is anywhere in the type/declaration.
    handleStarIsType :: Data a => a -> R () -> R ()
    handleStarIsType :: a -> R () -> R ()
handleStarIsType a
a R ()
p
      | a -> Bool
containsHsStarTy a
a = R ()
space R () -> R () -> R ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> R ()
p R () -> R () -> R ()
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 a -> Maybe (HsType GhcPs)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast @_ @(HsType GhcPs) a
b of
          Just HsStarTy {} -> Bool
True
          Maybe (HsType GhcPs)
_ -> Bool
False

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

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

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

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

getGRHSSpan :: GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan :: GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan (GRHS XCGRHS GhcPs (LocatedA body)
_ [GuardLStmt 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. GenLocated (SrcSpanAnn' 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. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA [GuardLStmt 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 :: (body -> Placement) -> [LGRHS GhcPs (LocatedA body)] -> Placement
blockPlacement body -> Placement
placer [L _ (GRHS _ _ (L _ x))] = body -> Placement
placer body
x
blockPlacement body -> Placement
_ [LGRHS GhcPs (LocatedA body)]
_ = Placement
Normal

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

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

-- | Check if given expression has a hanging form.
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement = \case
  -- Only hang lambdas with single line parameter lists
  HsLam XLam GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
mg -> case MatchGroup GhcPs (LHsExpr GhcPs)
mg of
    MG XMG GhcPs (LHsExpr GhcPs)
_ (L _ [L _ (Match _ _ (x : xs) _)]) Origin
_
      | 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
x GenLocated SrcSpanAnnA (Pat GhcPs)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. a -> [a] -> NonEmpty a
:| [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
xs)) ->
          Placement
Hanging
    MatchGroup GhcPs (LHsExpr GhcPs)
_ -> Placement
Normal
  HsLamCase XLamCase GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
_ -> Placement
Hanging
  HsCase XCase GhcPs
_ LHsExpr GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
_ -> Placement
Hanging
  HsDo XDo GhcPs
_ (DoExpr Maybe ModuleName
_) XRec GhcPs [GuardLStmt GhcPs]
_ -> Placement
Hanging
  HsDo XDo GhcPs
_ (MDoExpr Maybe ModuleName
_) XRec GhcPs [GuardLStmt GhcPs]
_ -> Placement
Hanging
  OpApp XOpApp GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
op LHsExpr GhcPs
y ->
    case ((RdrName -> String) -> Maybe RdrName -> Maybe String
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) LHsExpr 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 LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
y)
      Maybe String
_ -> Placement
Normal
  HsApp XApp GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
y -> HsExpr GhcPs -> Placement
exprPlacement (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr 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. GenLocated (SrcSpanAnn' 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 :: [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