{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Ormolu.Printer.Meat.Declaration.Value
( p_valDecl,
p_pat,
p_hsExpr,
p_hsUntypedSplice,
p_stringLit,
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 (find, intersperse, sortBy)
import Data.List.NonEmpty (NonEmpty (..), (<|))
import Data.List.NonEmpty qualified as NE
import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Void
import GHC.Data.Bag (bagToList)
import GHC.Data.Strict qualified as Strict
import GHC.Hs
import GHC.LanguageExtensions.Type (Extension (NegativeLiterals))
import GHC.Parser.CharClass (is_space)
import GHC.Types.Basic
import GHC.Types.Fixity
import GHC.Types.Name.Reader
import GHC.Types.SourceText
import GHC.Types.SrcLoc
import Language.Haskell.Syntax.Basic
import Ormolu.Config
import Ormolu.Printer.Combinators
import Ormolu.Printer.Internal (sitccIfTrailing)
import Ormolu.Printer.Meat.Common
import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration
import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.OpTree
import Ormolu.Printer.Meat.Declaration.Signature
import Ormolu.Printer.Meat.Type
import Ormolu.Printer.Operators
import Ormolu.Utils
data MatchGroupStyle
= Function (LocatedN RdrName)
| PatternBind
| Case
| Lambda
| LambdaCase
data GroupStyle
= EqualSign
| RightArrow
p_valDecl :: HsBind GhcPs -> R ()
p_valDecl :: HsBind GhcPs -> R ()
p_valDecl = \case
FunBind XFunBind GhcPs GhcPs
_ LIdP GhcPs
funId MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
funMatches -> LocatedN RdrName
-> MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_funBind LIdP GhcPs
funId MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
funMatches
PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
pat GRHSs GhcPs (XRec GhcPs (HsExpr GhcPs))
grhss -> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (XRec GhcPs (HsExpr GhcPs))
-> R ()
p_match MatchGroupStyle
PatternBind Bool
False SrcStrictness
NoSrcStrict [LPat GhcPs
pat] GRHSs GhcPs (XRec GhcPs (HsExpr GhcPs))
grhss
VarBind {} -> forall a. String -> a
notImplemented String
"VarBinds"
PatSynBind XPatSynBind GhcPs GhcPs
_ PatSynBind GhcPs GhcPs
psb -> PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PatSynBind GhcPs GhcPs
psb
p_funBind ::
LocatedN RdrName ->
MatchGroup GhcPs (LHsExpr GhcPs) ->
R ()
p_funBind :: LocatedN RdrName
-> MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_funBind LocatedN RdrName
name = MatchGroupStyle
-> MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_matchGroup (LocatedN RdrName -> MatchGroupStyle
Function LocatedN RdrName
name)
p_matchGroup ::
MatchGroupStyle ->
MatchGroup GhcPs (LHsExpr GhcPs) ->
R ()
p_matchGroup :: MatchGroupStyle
-> MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_matchGroup = forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_matchGroup' ::
( Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
) =>
(body -> Placement) ->
(body -> R ()) ->
MatchGroupStyle ->
MatchGroup GhcPs (LocatedA body) ->
R ()
p_matchGroup' :: forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
style mg :: MatchGroup GhcPs (LocatedA body)
mg@MG {XRec GhcPs [LMatch GhcPs (LocatedA body)]
XMG GhcPs (LocatedA body)
mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts :: XRec GhcPs [LMatch GhcPs (LocatedA body)]
mg_ext :: XMG GhcPs (LocatedA body)
..} = do
let ob :: R () -> R ()
ob = case MatchGroupStyle
style of
MatchGroupStyle
Case -> R () -> R ()
bracesIfEmpty
MatchGroupStyle
LambdaCase -> R () -> R ()
bracesIfEmpty
MatchGroupStyle
_ -> R () -> R ()
dontUseBraces
where
bracesIfEmpty :: R () -> R ()
bracesIfEmpty = if forall (p :: Pass) body. MatchGroup (GhcPass p) body -> Bool
isEmptyMatchGroup MatchGroup GhcPs (LocatedA body)
mg then R () -> R ()
useBraces else forall a. a -> a
id
R () -> R ()
ub <- forall a. a -> a -> Bool -> a
bool R () -> R ()
dontUseBraces R () -> R ()
useBraces forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Bool
canUseBraces
R () -> R ()
ob forall a b. (a -> b) -> a -> b
$ forall a. (a -> R ()) -> [a] -> R ()
sepSemi (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (R () -> R ()
ub forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs (LocatedA body) -> R ()
p_Match)) (forall l e. GenLocated l e -> e
unLoc XRec GhcPs [LMatch GhcPs (LocatedA body)]
mg_alts)
where
p_Match :: Match GhcPs (LocatedA body) -> R ()
p_Match m :: Match GhcPs (LocatedA body)
m@Match {[LPat GhcPs]
HsMatchContext GhcPs
GRHSs GhcPs (LocatedA body)
XCMatch GhcPs (LocatedA body)
m_ext :: forall p body. Match p body -> XCMatch p body
m_ctxt :: forall p body. Match p body -> HsMatchContext p
m_pats :: forall p body. Match p body -> [LPat p]
m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss :: GRHSs GhcPs (LocatedA body)
m_pats :: [LPat GhcPs]
m_ctxt :: HsMatchContext GhcPs
m_ext :: XCMatch GhcPs (LocatedA body)
..} =
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
p_match'
body -> Placement
placer
body -> R ()
render
(forall body. Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle Match GhcPs (LocatedA body)
m MatchGroupStyle
style)
(forall id body. Match id body -> Bool
isInfixMatch Match GhcPs (LocatedA body)
m)
(forall id body. Match id body -> SrcStrictness
matchStrictness Match GhcPs (LocatedA body)
m)
[LPat GhcPs]
m_pats
GRHSs GhcPs (LocatedA body)
m_grhss
adjustMatchGroupStyle ::
Match GhcPs body ->
MatchGroupStyle ->
MatchGroupStyle
adjustMatchGroupStyle :: forall body. Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle Match GhcPs body
m = \case
Function LocatedN RdrName
_ -> (LocatedN RdrName -> MatchGroupStyle
Function forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. HsMatchContext p -> LIdP (NoGhcTc p)
mc_fun forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p body. Match p body -> HsMatchContext p
m_ctxt) Match GhcPs body
m
MatchGroupStyle
style -> MatchGroupStyle
style
matchStrictness :: Match id body -> SrcStrictness
matchStrictness :: forall id body. Match id body -> SrcStrictness
matchStrictness Match id body
match =
case forall p body. Match p body -> HsMatchContext p
m_ctxt Match id body
match of
FunRhs {mc_strictness :: forall p. HsMatchContext p -> SrcStrictness
mc_strictness = SrcStrictness
s} -> SrcStrictness
s
HsMatchContext id
_ -> SrcStrictness
NoSrcStrict
p_match ::
MatchGroupStyle ->
Bool ->
SrcStrictness ->
[LPat GhcPs] ->
GRHSs GhcPs (LHsExpr GhcPs) ->
R ()
p_match :: MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (XRec GhcPs (HsExpr GhcPs))
-> R ()
p_match = forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
p_match' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_match' ::
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns) =>
(body -> Placement) ->
(body -> R ()) ->
MatchGroupStyle ->
Bool ->
SrcStrictness ->
[LPat GhcPs] ->
GRHSs GhcPs (LocatedA body) ->
R ()
p_match' :: forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
p_match' body -> Placement
placer body -> R ()
render MatchGroupStyle
style Bool
isInfix SrcStrictness
strictness [LPat GhcPs]
m_pats GRHSs {[LGRHS GhcPs (LocatedA body)]
HsLocalBinds GhcPs
XCGRHSs GhcPs (LocatedA body)
grhssExt :: forall p body. GRHSs p body -> XCGRHSs p body
grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
grhssLocalBinds :: HsLocalBinds GhcPs
grhssGRHSs :: [LGRHS GhcPs (LocatedA body)]
grhssExt :: XCGRHSs GhcPs (LocatedA body)
..} = do
case SrcStrictness
strictness of
SrcStrictness
NoSrcStrict -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
SrcStrictness
SrcStrict -> Text -> R ()
txt Text
"!"
SrcStrictness
SrcLazy -> Text -> R ()
txt Text
"~"
Bool
indentBody <- case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
m_pats of
Maybe (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)))
Nothing ->
Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ case MatchGroupStyle
style of
Function LocatedN RdrName
name -> LocatedN RdrName -> R ()
p_rdrName LocatedN RdrName
name
MatchGroupStyle
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
ne_pats -> do
let combinedSpans :: SrcSpan
combinedSpans = case MatchGroupStyle
style of
Function LocatedN RdrName
name -> SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedN RdrName
name) SrcSpan
patSpans
MatchGroupStyle
_ -> SrcSpan
patSpans
patSpans :: SrcSpan
patSpans = NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
ne_pats)
indentBody :: Bool
indentBody = Bool -> Bool
not (SrcSpan -> Bool
isOneLineSpan SrcSpan
combinedSpans)
[SrcSpan] -> R () -> R ()
switchLayoutNoLimit [SrcSpan
combinedSpans] forall a b. (a -> b) -> a -> b
$ do
let stdCase :: R ()
stdCase = forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
m_pats
case MatchGroupStyle
style of
Function LocatedN RdrName
name ->
Bool -> Bool -> R () -> [R ()] -> R ()
p_infixDefHelper
Bool
isInfix
Bool
indentBody
(LocatedN RdrName -> R ()
p_rdrName LocatedN RdrName
name)
(forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs]
m_pats)
MatchGroupStyle
PatternBind -> R ()
stdCase
MatchGroupStyle
Case -> R ()
stdCase
MatchGroupStyle
Lambda -> do
let needsSpace :: Bool
needsSpace = case forall l e. GenLocated l e -> e
unLoc (forall a. NonEmpty a -> a
NE.head NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
ne_pats) of
LazyPat XLazyPat GhcPs
_ LPat GhcPs
_ -> Bool
True
BangPat XBangPat GhcPs
_ LPat GhcPs
_ -> Bool
True
SplicePat XSplicePat GhcPs
_ HsUntypedSplice GhcPs
_ -> Bool
True
Pat GhcPs
_ -> Bool
False
Text -> R ()
txt Text
"\\"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsSpace R ()
space
R () -> R ()
sitcc R ()
stdCase
MatchGroupStyle
LambdaCase -> R ()
stdCase
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
indentBody
let
endOfPats :: Maybe SrcSpan
endOfPats = case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
m_pats of
Maybe (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)))
Nothing -> case MatchGroupStyle
style of
Function LocatedN RdrName
name -> forall a. a -> Maybe a
Just (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedN RdrName
name)
MatchGroupStyle
_ -> forall a. Maybe a
Nothing
Just NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
pats -> (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.last) NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
pats
isCase :: MatchGroupStyle -> Bool
isCase = \case
MatchGroupStyle
Case -> Bool
True
MatchGroupStyle
LambdaCase -> Bool
True
MatchGroupStyle
_ -> Bool
False
hasGuards :: Bool
hasGuards = forall body. [LGRHS GhcPs body] -> Bool
withGuards [LGRHS GhcPs (LocatedA body)]
grhssGRHSs
grhssSpan :: SrcSpan
grhssSpan =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' forall a b. (a -> b) -> a -> b
$
forall body. GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> NonEmpty a
NE.fromList [LGRHS GhcPs (LocatedA body)]
grhssGRHSs
patGrhssSpan :: SrcSpan
patGrhssSpan =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
SrcSpan
grhssSpan
(SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
grhssSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcLoc -> SrcSpan
srcLocSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanEnd)
Maybe SrcSpan
endOfPats
placement :: Placement
placement =
case Maybe SrcSpan
endOfPats of
Just SrcSpan
spn
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall body. XRec GhcPs (GRHS GhcPs body) -> Bool
guardNeedsLineBreak [LGRHS GhcPs (LocatedA body)]
grhssGRHSs
Bool -> Bool -> Bool
|| Bool -> Bool
not (SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn SrcSpan
grhssSpan) ->
Placement
Normal
Maybe SrcSpan
_ -> forall body.
(body -> Placement) -> [LGRHS GhcPs (LocatedA body)] -> Placement
blockPlacement body -> Placement
placer [LGRHS GhcPs (LocatedA body)]
grhssGRHSs
guardNeedsLineBreak :: XRec GhcPs (GRHS GhcPs body) -> Bool
guardNeedsLineBreak :: forall body. XRec GhcPs (GRHS GhcPs body) -> Bool
guardNeedsLineBreak (L Anno (GRHS GhcPs body)
_ (GRHS XCGRHS GhcPs body
_ [GuardLStmt GhcPs]
guardLStmts body
_)) = case [GuardLStmt GhcPs]
guardLStmts of
[] -> Bool
False
[GuardLStmt GhcPs
g] -> Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Bool
isOneLineSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall a b. (a -> b) -> a -> b
$ GuardLStmt GhcPs
g
[GuardLStmt GhcPs]
_ -> Bool
True
p_body :: R ()
p_body = do
let groupStyle :: GroupStyle
groupStyle =
if MatchGroupStyle -> Bool
isCase MatchGroupStyle
style Bool -> Bool -> Bool
&& Bool
hasGuards
then GroupStyle
RightArrow
else GroupStyle
EqualSign
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
R ()
breakpoint
(forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (forall body.
Placement
-> (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA body)
-> R ()
p_grhs' Placement
placement body -> Placement
placer body -> R ()
render GroupStyle
groupStyle))
[LGRHS GhcPs (LocatedA body)]
grhssGRHSs
p_where :: R ()
p_where = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a b. HsLocalBindsLR a b -> Bool
eqEmptyLocalBinds HsLocalBinds GhcPs
grhssLocalBinds) forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
Bool
indentWhere <- forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f Bool
poIndentWheres
forall a. a -> a -> Bool -> a
bool (ConTag -> R () -> R ()
inciByFrac forall a b. (a -> b) -> a -> b
$ -ConTag
2) forall a. a -> a
id Bool
indentWhere forall a b. (a -> b) -> a -> b
$ Text -> R ()
txt Text
"where"
R ()
breakpoint
Bool -> R () -> R ()
inciIf Bool
indentWhere forall a b. (a -> b) -> a -> b
$ HsLocalBinds GhcPs -> R ()
p_hsLocalBinds HsLocalBinds GhcPs
grhssLocalBinds
Bool -> R () -> R ()
inciIf Bool
indentBody forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [LGRHS GhcPs (LocatedA body)]
grhssGRHSs forall a. Ord a => a -> a -> Bool
> ConTag
1) forall a b. (a -> b) -> a -> b
$
case MatchGroupStyle
style of
Function LocatedN RdrName
_ | Bool
hasGuards -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Function LocatedN RdrName
_ -> R ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
equals
MatchGroupStyle
PatternBind -> R ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
equals
MatchGroupStyle
s | MatchGroupStyle -> Bool
isCase MatchGroupStyle
s Bool -> Bool -> Bool
&& Bool
hasGuards -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
MatchGroupStyle
_ -> R ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
token'rarrow
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
patGrhssSpan] forall a b. (a -> b) -> a -> b
$
Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body
R () -> R ()
inci R ()
p_where
p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
p_grhs :: GroupStyle -> GRHS GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_grhs = forall body.
Placement
-> (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA body)
-> R ()
p_grhs' Placement
Normal HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_grhs' ::
Placement ->
(body -> Placement) ->
(body -> R ()) ->
GroupStyle ->
GRHS GhcPs (LocatedA body) ->
R ()
p_grhs' :: forall body.
Placement
-> (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA body)
-> R ()
p_grhs' Placement
parentPlacement body -> Placement
placer body -> R ()
render GroupStyle
style (GRHS XCGRHS GhcPs (LocatedA body)
_ [GuardLStmt GhcPs]
guards LocatedA body
body) =
case [GuardLStmt GhcPs]
guards of
[] -> R ()
p_body
[GuardLStmt GhcPs]
xs -> do
Text -> R ()
txt Text
"|"
R ()
space
R () -> R ()
sitccIfTrailing (forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_stmt) [GuardLStmt GhcPs]
xs)
R ()
space
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ case GroupStyle
style of
GroupStyle
EqualSign -> R ()
equals
GroupStyle
RightArrow -> R ()
token'rarrow
ConTag
indent <- forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f ConTag
poIndentation
Bool -> R () -> R ()
inciIf (ConTag
indent forall a. Ord a => a -> a -> Bool
<= ConTag
2 Bool -> Bool -> Bool
&& Placement
parentPlacement forall a. Eq a => a -> a -> Bool
== Placement
Normal) (Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body)
where
placement :: Placement
placement =
case Maybe SrcSpan
endOfGuards of
Maybe SrcSpan
Nothing -> body -> Placement
placer (forall l e. GenLocated l e -> e
unLoc LocatedA body
body)
Just SrcSpan
spn ->
if SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedA body
body)
then body -> Placement
placer (forall l e. GenLocated l e -> e
unLoc LocatedA body
body)
else Placement
Normal
endOfGuards :: Maybe SrcSpan
endOfGuards =
case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [GuardLStmt GhcPs]
guards of
Maybe
(NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
Nothing -> forall a. Maybe a
Nothing
Just NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
gs -> (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.last) NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
gs
p_body :: R ()
p_body = forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
body body -> R ()
render
p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd = BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
N
p_hsCmd' :: BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' :: BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
s = \case
HsCmdArrApp XCmdArrApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
body XRec GhcPs (HsExpr GhcPs)
input HsArrAppType
arrType Bool
rightToLeft -> do
let (GenLocated SrcSpanAnnA (HsExpr GhcPs)
l, GenLocated SrcSpanAnnA (HsExpr GhcPs)
r) = if Bool
rightToLeft then (XRec GhcPs (HsExpr GhcPs)
body, XRec GhcPs (HsExpr GhcPs)
input) else (XRec GhcPs (HsExpr GhcPs)
input, XRec GhcPs (HsExpr GhcPs)
body)
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
l HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
case (HsArrAppType
arrType, Bool
rightToLeft) of
(HsArrAppType
HsFirstOrderApp, Bool
True) -> R ()
token'larrowtail
(HsArrAppType
HsHigherOrderApp, Bool
True) -> R ()
token'Larrowtail
(HsArrAppType
HsFirstOrderApp, Bool
False) -> R ()
token'rarrowtail
(HsArrAppType
HsHigherOrderApp, Bool
False) -> R ()
token'Rarrowtail
Placement -> R () -> R ()
placeHanging (HsExpr GhcPs -> Placement
exprPlacement (forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
input)) forall a b. (a -> b) -> a -> b
$
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
r HsExpr GhcPs -> R ()
p_hsExpr
HsCmdArrForm XCmdArrForm GhcPs
_ XRec GhcPs (HsExpr GhcPs)
form LexicalFixity
Prefix Maybe Fixity
_ [LHsCmdTop GhcPs]
cmds -> BracketStyle -> R () -> R ()
banana BracketStyle
s forall a b. (a -> b) -> a -> b
$ do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
form HsExpr GhcPs -> R ()
p_hsExpr
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsCmdTop GhcPs]
cmds) forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
R () -> R ()
inci (forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (forall a. a -> [a] -> [a]
intersperse R ()
breakpoint (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (BracketStyle -> HsCmdTop GhcPs -> R ()
p_hsCmdTop BracketStyle
N) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsCmdTop GhcPs]
cmds)))
HsCmdArrForm XCmdArrForm GhcPs
_ XRec GhcPs (HsExpr GhcPs)
form LexicalFixity
Infix Maybe Fixity
_ [LHsCmdTop GhcPs
left, LHsCmdTop GhcPs
right] -> do
FixityMap
fixityOverrides <- R FixityMap
askFixityOverrides
LazyFixityMap
fixityMap <- R LazyFixityMap
askFixityMap
let opTree :: OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
opTree = forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches [LHsCmdTop GhcPs
-> OpTree (LHsCmdTop GhcPs) (XRec GhcPs (HsExpr GhcPs))
cmdOpTree LHsCmdTop GhcPs
left, LHsCmdTop GhcPs
-> OpTree (LHsCmdTop GhcPs) (XRec GhcPs (HsExpr GhcPs))
cmdOpTree LHsCmdTop GhcPs
right] [XRec GhcPs (HsExpr GhcPs)
form]
BracketStyle
-> OpTree (LHsCmdTop GhcPs) (OpInfo (XRec GhcPs (HsExpr GhcPs)))
-> R ()
p_cmdOpTree
BracketStyle
s
(forall op ty.
(op -> Maybe RdrName)
-> FixityMap
-> LazyFixityMap
-> OpTree ty op
-> OpTree ty (OpInfo op)
reassociateOpTree (HsExpr GhcPs -> Maybe RdrName
getOpName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) FixityMap
fixityOverrides LazyFixityMap
fixityMap OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
opTree)
HsCmdArrForm XCmdArrForm GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ LexicalFixity
Infix Maybe Fixity
_ [LHsCmdTop GhcPs]
_ -> forall a. String -> a
notImplemented String
"HsCmdArrForm"
HsCmdApp XCmdApp GhcPs
_ LHsCmd GhcPs
cmd XRec GhcPs (HsExpr GhcPs)
expr -> do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
cmd (BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
s)
R ()
space
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
HsCmdLam XCmdLam GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
mgroup -> forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd MatchGroupStyle
Lambda MatchGroup GhcPs (LHsCmd GhcPs)
mgroup
HsCmdPar XCmdPar GhcPs
_ LHsToken "(" GhcPs
_ LHsCmd GhcPs
c LHsToken ")" GhcPs
_ -> BracketStyle -> R () -> R ()
parens BracketStyle
N forall a b. (a -> b) -> a -> b
$ R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
c HsCmd GhcPs -> R ()
p_hsCmd
HsCmdCase XCmdCase GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (LHsCmd GhcPs)
mgroup ->
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_case HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (LHsCmd GhcPs)
mgroup
HsCmdLamCase XCmdLamCase GhcPs
_ LamCaseVariant
variant MatchGroup GhcPs (LHsCmd GhcPs)
mgroup ->
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
LamCaseVariant
-> (body -> Placement)
-> (body -> R ())
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_lamcase LamCaseVariant
variant HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd MatchGroup GhcPs (LHsCmd GhcPs)
mgroup
HsCmdIf XCmdIf GhcPs
_ SyntaxExpr GhcPs
_ XRec GhcPs (HsExpr GhcPs)
if' LHsCmd GhcPs
then' LHsCmd GhcPs
else' ->
forall body.
(body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> LocatedA body
-> LocatedA body
-> R ()
p_if HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd XRec GhcPs (HsExpr GhcPs)
if' LHsCmd GhcPs
then' LHsCmd GhcPs
else'
HsCmdLet XCmdLet GhcPs
_ LHsToken "let" GhcPs
letToken HsLocalBinds GhcPs
localBinds LHsToken "in" GhcPs
_ LHsCmd GhcPs
c ->
forall body.
Bool
-> (body -> R ())
-> LHsToken "let" GhcPs
-> HsLocalBinds GhcPs
-> LocatedA body
-> R ()
p_let (BracketStyle
s forall a. Eq a => a -> a -> Bool
== BracketStyle
S) HsCmd GhcPs -> R ()
p_hsCmd LHsToken "let" GhcPs
letToken HsLocalBinds GhcPs
localBinds LHsCmd GhcPs
c
HsCmdDo XCmdDo GhcPs
_ XRec GhcPs [CmdLStmt GhcPs]
es -> do
Text -> R ()
txt Text
"do"
forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ())
-> LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> R ()
p_stmts HsCmd GhcPs -> Placement
cmdPlacement (BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
S) XRec GhcPs [CmdLStmt GhcPs]
es
p_hsCmdTop :: BracketStyle -> HsCmdTop GhcPs -> R ()
p_hsCmdTop :: BracketStyle -> HsCmdTop GhcPs -> R ()
p_hsCmdTop BracketStyle
s (HsCmdTop XCmdTop GhcPs
_ LHsCmd GhcPs
cmd) = forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
cmd (BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
s)
withSpacing ::
(a -> R ()) ->
LocatedAn ann a ->
R ()
withSpacing :: forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing a -> R ()
f LocatedAn ann a
l = forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedAn ann a
l forall a b. (a -> b) -> a -> b
$ \a
x -> do
case forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedAn ann a
l of
UnhelpfulSpan UnhelpfulSpanReason
_ -> a -> R ()
f a
x
RealSrcSpan RealSrcSpan
currentSpn Maybe BufSpan
_ -> do
R (Maybe SpanMark)
getSpanMark forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (StatementSpan RealSrcSpan
lastSpn) ->
if RealSrcSpan -> ConTag
srcSpanStartLine RealSrcSpan
currentSpn forall a. Ord a => a -> a -> Bool
> RealSrcSpan -> ConTag
srcSpanEndLine RealSrcSpan
lastSpn forall a. Num a => a -> a -> a
+ ConTag
1
then R ()
newline
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe SpanMark
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
a -> R ()
f a
x
R (Maybe SpanMark)
getSpanMark forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (HaddockSpan HaddockStyle
_ RealSrcSpan
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (CommentSpan RealSrcSpan
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe SpanMark
_ -> SpanMark -> R ()
setSpanMark (RealSrcSpan -> SpanMark
StatementSpan RealSrcSpan
currentSpn)
p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt :: Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_stmt = forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
p_stmt' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_stmt' ::
( Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL
) =>
(body -> Placement) ->
(body -> R ()) ->
Stmt GhcPs (LocatedA body) ->
R ()
p_stmt' :: forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render = \case
LastStmt XLastStmt GhcPs GhcPs (LocatedA body)
_ LocatedA body
body Maybe Bool
_ SyntaxExpr GhcPs
_ -> forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
body body -> R ()
render
BindStmt XBindStmt GhcPs GhcPs (LocatedA body)
_ LPat GhcPs
p f :: LocatedA body
f@(forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA -> SrcSpan
l) -> do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
p Pat GhcPs -> R ()
p_pat
R ()
space
R ()
token'larrow
let loc :: SrcSpan
loc = forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
p
placement :: Placement
placement
| SrcSpan -> Bool
isOneLineSpan (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (SrcSpan -> SrcLoc
srcSpanEnd SrcSpan
loc) (SrcSpan -> SrcLoc
srcSpanStart SrcSpan
l)) = body -> Placement
placer (forall l e. GenLocated l e -> e
unLoc LocatedA body
f)
| Bool
otherwise = Placement
Normal
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
loc, SrcSpan
l] forall a b. (a -> b) -> a -> b
$
Placement -> R () -> R ()
placeHanging Placement
placement (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
f body -> R ()
render)
ApplicativeStmt {} -> forall a. String -> a
notImplemented String
"ApplicativeStmt"
BodyStmt XBodyStmt GhcPs GhcPs (LocatedA body)
_ LocatedA body
body SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ -> forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
body body -> R ()
render
LetStmt XLetStmt GhcPs GhcPs (LocatedA body)
epAnnLet HsLocalBinds GhcPs
binds -> do
let letLoc :: Maybe EpaLocation
letLoc =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(AddEpAnn AnnKeywordId
_ EpaLocation
loc) -> EpaLocation
loc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(AddEpAnn AnnKeywordId
ann EpaLocation
_) -> AnnKeywordId
ann forall a. Eq a => a -> a -> Bool
== AnnKeywordId
AnnLet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns
forall a b. (a -> b) -> a -> b
$ XLetStmt GhcPs GhcPs (LocatedA body)
epAnnLet
Bool
-> Maybe EpaLocation -> HsLocalBinds GhcPs -> Maybe (R ()) -> R ()
p_let' Bool
True Maybe EpaLocation
letLoc HsLocalBinds GhcPs
binds forall a. Maybe a
Nothing
ParStmt {} ->
forall a. String -> a
notImplemented String
"ParStmt"
TransStmt {[(IdP GhcPs, IdP GhcPs)]
[GuardLStmt GhcPs]
Maybe (XRec GhcPs (HsExpr GhcPs))
TransForm
HsExpr GhcPs
SyntaxExpr GhcPs
XRec GhcPs (HsExpr GhcPs)
XTransStmt GhcPs GhcPs (LocatedA body)
trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
trS_fmap :: HsExpr GhcPs
trS_bind :: SyntaxExpr GhcPs
trS_ret :: SyntaxExpr GhcPs
trS_by :: Maybe (XRec GhcPs (HsExpr GhcPs))
trS_using :: XRec GhcPs (HsExpr GhcPs)
trS_bndrs :: [(IdP GhcPs, IdP GhcPs)]
trS_stmts :: [GuardLStmt GhcPs]
trS_form :: TransForm
trS_ext :: XTransStmt GhcPs GhcPs (LocatedA body)
..} ->
case (TransForm
trS_form, Maybe (XRec GhcPs (HsExpr GhcPs))
trS_by) of
(TransForm
ThenForm, Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
Nothing) -> do
Text -> R ()
txt Text
"then"
R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
trS_using HsExpr GhcPs -> R ()
p_hsExpr
(TransForm
ThenForm, Just GenLocated SrcSpanAnnA (HsExpr GhcPs)
e) -> do
Text -> R ()
txt Text
"then"
R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
trS_using HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt Text
"by"
R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
(TransForm
GroupForm, Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
Nothing) -> do
Text -> R ()
txt Text
"then group using"
R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
trS_using HsExpr GhcPs -> R ()
p_hsExpr
(TransForm
GroupForm, Just GenLocated SrcSpanAnnA (HsExpr GhcPs)
e) -> do
Text -> R ()
txt Text
"then group by"
R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt Text
"using"
R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
trS_using HsExpr GhcPs -> R ()
p_hsExpr
RecStmt {[IdP GhcPs]
SyntaxExpr GhcPs
XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA body)]
XRecStmt GhcPs GhcPs (LocatedA body)
recS_ext :: forall idL idR body. StmtLR idL idR body -> XRecStmt idL idR body
recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_bind_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_ret_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_mfix_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_mfix_fn :: SyntaxExpr GhcPs
recS_ret_fn :: SyntaxExpr GhcPs
recS_bind_fn :: SyntaxExpr GhcPs
recS_rec_ids :: [IdP GhcPs]
recS_later_ids :: [IdP GhcPs]
recS_stmts :: XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA body)]
recS_ext :: XRecStmt GhcPs GhcPs (LocatedA body)
..} -> do
Text -> R ()
txt Text
"rec"
R ()
space
R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA body)]
recS_stmts forall a b. (a -> b) -> a -> b
$ forall a. (a -> R ()) -> [a] -> R ()
sepSemi (forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing (forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render))
p_stmts ::
( Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL
) =>
(body -> Placement) ->
(body -> R ()) ->
LocatedL [LocatedA (Stmt GhcPs (LocatedA body))] ->
R ()
p_stmts :: forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ())
-> LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> R ()
p_stmts body -> Placement
placer body -> R ()
render LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
es = do
R ()
breakpoint
R () -> R ()
ub <- Layout -> R () -> R ()
layoutToBraces forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Layout
getLayout
R () -> R ()
inci forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
es forall a b. (a -> b) -> a -> b
$
forall a. (a -> R ()) -> [a] -> R ()
sepSemi
(R () -> R ()
ub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing (forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render))
gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]
gatherStmt :: GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt (L SrcSpanAnnA
_ (ParStmt XParStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [ParStmtBlock GhcPs GhcPs]
block HsExpr GhcPs
_ SyntaxExpr GhcPs
_)) =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]]
gatherStmtBlock) [] [ParStmtBlock GhcPs GhcPs]
block
gatherStmt (L SrcSpanAnnA
s stmt :: StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
stmt@TransStmt {[(IdP GhcPs, IdP GhcPs)]
[GuardLStmt GhcPs]
Maybe (XRec GhcPs (HsExpr GhcPs))
TransForm
HsExpr GhcPs
SyntaxExpr GhcPs
XRec GhcPs (HsExpr GhcPs)
XTransStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
trS_fmap :: HsExpr GhcPs
trS_bind :: SyntaxExpr GhcPs
trS_ret :: SyntaxExpr GhcPs
trS_by :: Maybe (XRec GhcPs (HsExpr GhcPs))
trS_using :: XRec GhcPs (HsExpr GhcPs)
trS_bndrs :: [(IdP GhcPs, IdP GhcPs)]
trS_stmts :: [GuardLStmt GhcPs]
trS_form :: TransForm
trS_ext :: XTransStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
..}) =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend [] ((GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuardLStmt GhcPs]
trS_stmts) forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Applicative f => a -> f a
pure [[forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
s StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
stmt]])
gatherStmt GuardLStmt GhcPs
stmt = [[GuardLStmt GhcPs
stmt]]
gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[ExprLStmt GhcPs]]
gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]]
gatherStmtBlock (ParStmtBlock XParStmtBlock GhcPs GhcPs
_ [GuardLStmt GhcPs]
stmts [IdP GhcPs]
_ SyntaxExpr GhcPs
_) =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt) [] [GuardLStmt GhcPs]
stmts
p_hsLocalBinds :: HsLocalBinds GhcPs -> R ()
p_hsLocalBinds :: HsLocalBinds GhcPs -> R ()
p_hsLocalBinds = \case
HsValBinds XHsValBinds GhcPs GhcPs
epAnn (ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
bag [LSig GhcPs]
lsigs) -> EpAnn AnnList -> R () -> R ()
pseudoLocated XHsValBinds GhcPs GhcPs
epAnn forall a b. (a -> b) -> a -> b
$ do
R () -> R ()
br <- Layout -> R () -> R ()
layoutToBraces forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Layout
getLayout
let items :: [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
items =
let injectLeft :: GenLocated l a -> GenLocated l (Either a b)
injectLeft (L l
l a
x) = forall l e. l -> e -> GenLocated l e
L l
l (forall a b. a -> Either a b
Left a
x)
injectRight :: GenLocated l b -> GenLocated l (Either a b)
injectRight (L l
l b
x) = forall l e. l -> e -> GenLocated l e
L l
l (forall a b. b -> Either a b
Right b
x)
in (forall {l} {a} {b}. GenLocated l a -> GenLocated l (Either a b)
injectLeft forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
bag) forall a. [a] -> [a] -> [a]
++ (forall {l} {b} {a}. GenLocated l b -> GenLocated l (Either a b)
injectRight forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LSig GhcPs]
lsigs)
positionToBracing :: RelativePos -> R () -> R ()
positionToBracing = \case
RelativePos
SinglePos -> forall a. a -> a
id
RelativePos
FirstPos -> R () -> R ()
br
RelativePos
MiddlePos -> R () -> R ()
br
RelativePos
LastPos -> forall a. a -> a
id
RelativePos
FirstAfterDocPos -> R () -> R ()
br
p_item' :: (RelativePos,
GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs)))
-> R ()
p_item' (RelativePos
p, GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
item) =
RelativePos -> R () -> R ()
positionToBracing RelativePos
p forall a b. (a -> b) -> a -> b
$
forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsBind GhcPs -> R ()
p_valDecl Sig GhcPs -> R ()
p_sigDecl) GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
item
binds :: [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
binds = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
leftmost_smallest forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
items
R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ forall a. (a -> R ()) -> [a] -> R ()
sepSemi (RelativePos,
GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs)))
-> R ()
p_item' (forall a. [a] -> [(RelativePos, a)]
attachRelativePos [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
binds)
HsValBinds XHsValBinds GhcPs GhcPs
_ HsValBindsLR GhcPs GhcPs
_ -> forall a. String -> a
notImplemented String
"HsValBinds"
HsIPBinds XHsIPBinds GhcPs GhcPs
epAnn (IPBinds XIPBinds GhcPs
_ [LIPBind GhcPs]
xs) -> EpAnn AnnList -> R () -> R ()
pseudoLocated XHsIPBinds GhcPs GhcPs
epAnn forall a b. (a -> b) -> a -> b
$ do
let p_ipBind :: IPBind GhcPs -> R ()
p_ipBind (IPBind XCIPBind GhcPs
_ (L SrcAnn NoEpAnns
_ HsIPName
name) XRec GhcPs (HsExpr GhcPs)
expr) = do
forall a. Outputable a => a -> R ()
atom @HsIPName HsIPName
name
R ()
space
R ()
equals
R ()
breakpoint
R () -> R ()
useBraces forall a b. (a -> b) -> a -> b
$ R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
forall a. (a -> R ()) -> [a] -> R ()
sepSemi (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' IPBind GhcPs -> R ()
p_ipBind) [LIPBind GhcPs]
xs
EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
pseudoLocated :: EpAnn AnnList -> R () -> R ()
pseudoLocated = \case
EpAnn {anns :: forall ann. EpAnn ann -> ann
anns = AnnList {al_anchor :: AnnList -> Maybe Anchor
al_anchor = Just Anchor {RealSrcSpan
anchor :: Anchor -> RealSrcSpan
anchor :: RealSrcSpan
anchor}}}
| let sp :: SrcSpan
sp = RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
anchor forall a. Maybe a
Strict.Nothing,
Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ SrcSpan -> Bool
isZeroWidthSpan SrcSpan
sp ->
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (forall l e. l -> e -> GenLocated l e
L SrcSpan
sp ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
EpAnn AnnList
_ -> forall a. a -> a
id
p_ldotFieldOcc :: XRec GhcPs (DotFieldOcc GhcPs) -> R ()
p_ldotFieldOcc :: XRec GhcPs (DotFieldOcc GhcPs) -> R ()
p_ldotFieldOcc =
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> R ()
p_rdrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FastString -> RdrName
mkVarUnqual forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabelString -> FastString
field_label) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. DotFieldOcc p -> XRec p FieldLabelString
dfoLabel
p_ldotFieldOccs :: [XRec GhcPs (DotFieldOcc GhcPs)] -> R ()
p_ldotFieldOccs :: [XRec GhcPs (DotFieldOcc GhcPs)] -> R ()
p_ldotFieldOccs = forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt Text
".") XRec GhcPs (DotFieldOcc GhcPs) -> R ()
p_ldotFieldOcc
p_fieldOcc :: FieldOcc GhcPs -> R ()
p_fieldOcc :: FieldOcc GhcPs -> R ()
p_fieldOcc FieldOcc {XRec GhcPs RdrName
XCFieldOcc GhcPs
foExt :: forall pass. FieldOcc pass -> XCFieldOcc pass
foLabel :: forall pass. FieldOcc pass -> XRec pass RdrName
foLabel :: XRec GhcPs RdrName
foExt :: XCFieldOcc GhcPs
..} = LocatedN RdrName -> R ()
p_rdrName XRec GhcPs RdrName
foLabel
p_hsFieldBind ::
(lhs ~ GenLocated l a, HasSrcSpan l) =>
(lhs -> R ()) ->
HsFieldBind lhs (LHsExpr GhcPs) ->
R ()
p_hsFieldBind :: forall lhs l a.
(lhs ~ GenLocated l a, HasSrcSpan l) =>
(lhs -> R ())
-> HsFieldBind lhs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_hsFieldBind lhs -> R ()
p_lhs HsFieldBind {lhs
Bool
XRec GhcPs (HsExpr GhcPs)
XHsFieldBind lhs
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbPun :: Bool
hfbRHS :: XRec GhcPs (HsExpr GhcPs)
hfbLHS :: lhs
hfbAnn :: XHsFieldBind lhs
..} = do
lhs -> R ()
p_lhs lhs
hfbLHS
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hfbPun forall a b. (a -> b) -> a -> b
$ do
R ()
space
R ()
equals
let placement :: Placement
placement =
if SrcSpan -> SrcSpan -> Bool
onTheSameLine (forall l a. HasSrcSpan l => GenLocated l a -> SrcSpan
getLoc' lhs
hfbLHS) (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA XRec GhcPs (HsExpr GhcPs)
hfbRHS)
then HsExpr GhcPs -> Placement
exprPlacement (forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
hfbRHS)
else Placement
Normal
Placement -> R () -> R ()
placeHanging Placement
placement (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
hfbRHS HsExpr GhcPs -> R ()
p_hsExpr)
p_hsExpr :: HsExpr GhcPs -> R ()
p_hsExpr :: HsExpr GhcPs -> R ()
p_hsExpr = BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
N
p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s = \case
HsVar XVar GhcPs
_ LIdP GhcPs
name -> LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
name
HsUnboundVar XUnboundVar GhcPs
_ RdrName
occ -> forall a. Outputable a => a -> R ()
atom RdrName
occ
HsRecSel XRecSel GhcPs
_ FieldOcc GhcPs
fldOcc -> FieldOcc GhcPs -> R ()
p_fieldOcc FieldOcc GhcPs
fldOcc
HsOverLabel XOverLabel GhcPs
_ SourceText
sourceText FastString
_ -> do
Text -> R ()
txt Text
"#"
SourceText -> R ()
p_sourceText SourceText
sourceText
HsIPVar XIPVar GhcPs
_ (HsIPName FastString
name) -> do
Text -> R ()
txt Text
"?"
forall a. Outputable a => a -> R ()
atom FastString
name
HsOverLit XOverLitE GhcPs
_ HsOverLit GhcPs
v -> forall a. Outputable a => a -> R ()
atom (forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit GhcPs
v)
HsLit XLitE GhcPs
_ HsLit GhcPs
lit ->
case HsLit GhcPs
lit of
HsString (SourceText String
stxt) FastString
_ -> String -> R ()
p_stringLit String
stxt
HsStringPrim (SourceText String
stxt) ByteString
_ -> String -> R ()
p_stringLit String
stxt
HsLit GhcPs
r -> forall a. Outputable a => a -> R ()
atom HsLit GhcPs
r
HsLam XLam GhcPs
_ MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup ->
MatchGroupStyle
-> MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_matchGroup MatchGroupStyle
Lambda MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup
HsLamCase XLamCase GhcPs
_ LamCaseVariant
variant MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup ->
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
LamCaseVariant
-> (body -> Placement)
-> (body -> R ())
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_lamcase LamCaseVariant
variant HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup
HsApp XApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
f XRec GhcPs (HsExpr GhcPs)
x -> do
let
gatherArgs :: GenLocated l (HsExpr p)
-> NonEmpty (XRec p (HsExpr p))
-> (GenLocated l (HsExpr p), NonEmpty (XRec p (HsExpr p)))
gatherArgs GenLocated l (HsExpr p)
f' NonEmpty (XRec p (HsExpr p))
knownArgs =
case GenLocated l (HsExpr p)
f' of
L l
_ (HsApp XApp p
_ XRec p (HsExpr p)
l XRec p (HsExpr p)
r) -> GenLocated l (HsExpr p)
-> NonEmpty (XRec p (HsExpr p))
-> (GenLocated l (HsExpr p), NonEmpty (XRec p (HsExpr p)))
gatherArgs XRec p (HsExpr p)
l (XRec p (HsExpr p)
r forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty (XRec p (HsExpr p))
knownArgs)
GenLocated l (HsExpr p)
_ -> (GenLocated l (HsExpr p)
f', NonEmpty (XRec p (HsExpr p))
knownArgs)
(GenLocated SrcSpanAnnA (HsExpr GhcPs)
func, NonEmpty (XRec GhcPs (HsExpr GhcPs))
args) = forall {p} {l}.
(XRec p (HsExpr p) ~ GenLocated l (HsExpr p)) =>
GenLocated l (HsExpr p)
-> NonEmpty (XRec p (HsExpr p))
-> (GenLocated l (HsExpr p), NonEmpty (XRec p (HsExpr p)))
gatherArgs XRec GhcPs (HsExpr GhcPs)
f (XRec GhcPs (HsExpr GhcPs)
x forall a. a -> [a] -> NonEmpty a
:| [])
([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
initp, GenLocated SrcSpanAnnA (HsExpr GhcPs)
lastp) = (forall a. NonEmpty a -> [a]
NE.init NonEmpty (XRec GhcPs (HsExpr GhcPs))
args, forall a. NonEmpty a -> a
NE.last NonEmpty (XRec GhcPs (HsExpr GhcPs))
args)
initSpan :: SrcSpan
initSpan =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' forall a b. (a -> b) -> a -> b
$
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA XRec GhcPs (HsExpr GhcPs)
f forall a. a -> [a] -> NonEmpty a
:| [(SrcLoc -> SrcSpan
srcLocSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) GenLocated SrcSpanAnnA (HsExpr GhcPs)
lastp]
placement :: Placement
placement =
if SrcSpan -> Bool
isOneLineSpan SrcSpan
initSpan
then HsExpr GhcPs -> Placement
exprPlacement (forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
lastp)
else Placement
Normal
case Placement
placement of
Placement
Normal -> do
let
indentArg :: R () -> R ()
indentArg
| SrcSpan -> Bool
isOneLineSpan (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (HsExpr GhcPs)
func) = case forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
func of
HsDo {} -> ConTag -> R () -> R ()
inciBy ConTag
2
HsExpr GhcPs
_ -> R () -> R ()
inci
| Bool
otherwise = case forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
func of
HsDo {} -> R () -> R ()
inciHalf
HsCase {} -> R () -> R ()
inciHalf
HsLamCase {} -> R () -> R ()
inciHalf
HsExpr GhcPs
_ -> R () -> R ()
inci
R () -> R ()
ub <-
R Layout
getLayout forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Layout
SingleLine -> R () -> R ()
useBraces
Layout
MultiLine -> forall a. a -> a
id
R () -> R ()
ub forall a b. (a -> b) -> a -> b
$ do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
func (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
R ()
breakpoint
R () -> R ()
indentArg forall a b. (a -> b) -> a -> b
$ forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
initp
R () -> R ()
indentArg forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
initp) R ()
breakpoint
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
lastp HsExpr GhcPs -> R ()
p_hsExpr
Placement
Hanging -> do
R () -> R ()
useBraces forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
initSpan] forall a b. (a -> b) -> a -> b
$ do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
func (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
R ()
breakpoint
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
initp
Placement -> R () -> R ()
placeHanging Placement
placement forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
dontUseBraces forall a b. (a -> b) -> a -> b
$
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
lastp HsExpr GhcPs -> R ()
p_hsExpr
HsAppType XAppTypeE GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e LHsToken "@" GhcPs
_ LHsWcType (NoGhcTc GhcPs)
a -> do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"@"
case forall l e. GenLocated l e -> e
unLoc (forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsWcType (NoGhcTc GhcPs)
a) of
HsSpliceTy {} -> R ()
space
HsType GhcPs
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsWcType (NoGhcTc GhcPs)
a) HsType GhcPs -> R ()
p_hsType
OpApp XOpApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
x XRec GhcPs (HsExpr GhcPs)
op XRec GhcPs (HsExpr GhcPs)
y -> do
FixityMap
fixityOverrides <- R FixityMap
askFixityOverrides
LazyFixityMap
fixityMap <- R LazyFixityMap
askFixityMap
let opTree :: OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
opTree = forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches [XRec GhcPs (HsExpr GhcPs)
-> OpTree (XRec GhcPs (HsExpr GhcPs)) (XRec GhcPs (HsExpr GhcPs))
exprOpTree XRec GhcPs (HsExpr GhcPs)
x, XRec GhcPs (HsExpr GhcPs)
-> OpTree (XRec GhcPs (HsExpr GhcPs)) (XRec GhcPs (HsExpr GhcPs))
exprOpTree XRec GhcPs (HsExpr GhcPs)
y] [XRec GhcPs (HsExpr GhcPs)
op]
BracketStyle
-> OpTree
(XRec GhcPs (HsExpr GhcPs)) (OpInfo (XRec GhcPs (HsExpr GhcPs)))
-> R ()
p_exprOpTree
BracketStyle
s
(forall op ty.
(op -> Maybe RdrName)
-> FixityMap
-> LazyFixityMap
-> OpTree ty op
-> OpTree ty (OpInfo op)
reassociateOpTree (HsExpr GhcPs -> Maybe RdrName
getOpName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) FixityMap
fixityOverrides LazyFixityMap
fixityMap OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
opTree)
NegApp XNegApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e SyntaxExpr GhcPs
_ -> do
Bool
negativeLiterals <- Extension -> R Bool
isExtensionEnabled Extension
NegativeLiterals
let isLiteral :: Bool
isLiteral = case forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
e of
HsLit {} -> Bool
True
HsOverLit {} -> Bool
True
HsExpr GhcPs
_ -> Bool
False
Text -> R ()
txt Text
"-"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
negativeLiterals Bool -> Bool -> Bool
&& Bool
isLiteral) R ()
space
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
HsPar XPar GhcPs
_ LHsToken "(" GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e LHsToken ")" GhcPs
_ ->
BracketStyle -> R () -> R ()
parens BracketStyle
s forall a b. (a -> b) -> a -> b
$ R () -> R ()
sitcc (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
e (R () -> R ()
dontUseBraces forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr))
SectionL XSectionL GhcPs
_ XRec GhcPs (HsExpr GhcPs)
x XRec GhcPs (HsExpr GhcPs)
op -> do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
op HsExpr GhcPs -> R ()
p_hsExpr)
SectionR XSectionR GhcPs
_ XRec GhcPs (HsExpr GhcPs)
op XRec GhcPs (HsExpr GhcPs)
x -> do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
op HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr)
ExplicitTuple XExplicitTuple GhcPs
_ [HsTupArg GhcPs]
args Boxity
boxity -> do
let isSection :: Bool
isSection = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall {id}. HsTupArg id -> Bool
isMissing [HsTupArg GhcPs]
args
isMissing :: HsTupArg id -> Bool
isMissing = \case
Missing XMissing id
_ -> Bool
True
HsTupArg id
_ -> Bool
False
p_arg :: HsTupArg GhcPs -> R ()
p_arg =
R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Present XPresent GhcPs
_ XRec GhcPs (HsExpr GhcPs)
x -> forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExprListItem
Missing XMissing GhcPs
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
parens' :: BracketStyle -> R () -> R ()
parens' =
case Boxity
boxity of
Boxity
Boxed -> BracketStyle -> R () -> R ()
parens
Boxity
Unboxed -> BracketStyle -> R () -> R ()
parensHash
[SrcSpan]
enclSpan <-
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan forall a. Maybe a
Strict.Nothing) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> [a]
maybeToList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RealSrcSpan -> Bool) -> R (Maybe RealSrcSpan)
getEnclosingSpan (forall a b. a -> b -> a
const Bool
True)
if Bool
isSection
then
[SrcSpan] -> R () -> R ()
switchLayout [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s forall a b. (a -> b) -> a -> b
$
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
comma HsTupArg GhcPs -> R ()
p_arg [HsTupArg GhcPs]
args
else
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
enclSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s forall a b. (a -> b) -> a -> b
$
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel HsTupArg GhcPs -> R ()
p_arg [HsTupArg GhcPs]
args
ExplicitSum XExplicitSum GhcPs
_ ConTag
tag ConTag
arity XRec GhcPs (HsExpr GhcPs)
e ->
BracketStyle -> ConTag -> ConTag -> R () -> R ()
p_unboxedSum BracketStyle
N ConTag
tag ConTag
arity (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr)
HsCase XCase GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup ->
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_case HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup
HsIf XIf GhcPs
_ XRec GhcPs (HsExpr GhcPs)
if' XRec GhcPs (HsExpr GhcPs)
then' XRec GhcPs (HsExpr GhcPs)
else' ->
forall body.
(body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> LocatedA body
-> LocatedA body
-> R ()
p_if HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr XRec GhcPs (HsExpr GhcPs)
if' XRec GhcPs (HsExpr GhcPs)
then' XRec GhcPs (HsExpr GhcPs)
else'
HsMultiIf XMultiIf GhcPs
_ [LGRHS GhcPs (XRec GhcPs (HsExpr GhcPs))]
guards -> do
Text -> R ()
txt Text
"if"
R ()
breakpoint
R () -> R ()
inci forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (GroupStyle -> GRHS GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_grhs GroupStyle
RightArrow)) [LGRHS GhcPs (XRec GhcPs (HsExpr GhcPs))]
guards
HsLet XLet GhcPs
_ LHsToken "let" GhcPs
letToken HsLocalBinds GhcPs
localBinds LHsToken "in" GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e ->
forall body.
Bool
-> (body -> R ())
-> LHsToken "let" GhcPs
-> HsLocalBinds GhcPs
-> LocatedA body
-> R ()
p_let (BracketStyle
s forall a. Eq a => a -> a -> Bool
== BracketStyle
S) HsExpr GhcPs -> R ()
p_hsExpr LHsToken "let" GhcPs
letToken HsLocalBinds GhcPs
localBinds XRec GhcPs (HsExpr GhcPs)
e
HsDo XDo GhcPs
_ HsDoFlavour
doFlavor XRec GhcPs [GuardLStmt GhcPs]
es -> do
let doBody :: Maybe ModuleName -> Text -> R ()
doBody Maybe ModuleName
moduleName Text
header = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ModuleName
moduleName forall a b. (a -> b) -> a -> b
$ \ModuleName
m -> forall a. Outputable a => a -> R ()
atom ModuleName
m forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> R ()
txt Text
"."
Text -> R ()
txt Text
header
forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ())
-> LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> R ()
p_stmts HsExpr GhcPs -> Placement
exprPlacement (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
S) XRec GhcPs [GuardLStmt GhcPs]
es
compBody :: R ()
compBody = BracketStyle -> R () -> R ()
brackets BracketStyle
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs [GuardLStmt GhcPs]
es forall a b. (a -> b) -> a -> b
$ \[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs -> do
let p_parBody :: [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> R ()
p_parBody =
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
(R ()
breakpoint forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space)
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
p_seqBody
p_seqBody :: [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
p_seqBody =
R () -> R ()
sitccIfTrailing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
R ()
commaDel
(forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_stmt))
stmts :: [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts = forall a. [a] -> [a]
init [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
yield :: GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
yield = forall a. [a] -> a
last [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
lists :: [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
lists = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt) [] [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
yield Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_stmt
R ()
breakpoint
Text -> R ()
txt Text
"|"
R ()
space
[[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> R ()
p_parBody [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
lists
case HsDoFlavour
doFlavor of
DoExpr Maybe ModuleName
moduleName -> Maybe ModuleName -> Text -> R ()
doBody Maybe ModuleName
moduleName Text
"do"
MDoExpr Maybe ModuleName
moduleName -> Maybe ModuleName -> Text -> R ()
doBody Maybe ModuleName
moduleName Text
"mdo"
HsDoFlavour
ListComp -> R ()
compBody
HsDoFlavour
MonadComp -> R ()
compBody
HsDoFlavour
GhciStmtCtxt -> forall a. String -> a
notImplemented String
"GhciStmtCtxt"
ExplicitList XExplicitList GhcPs
_ [XRec GhcPs (HsExpr GhcPs)]
xs ->
BracketStyle -> R () -> R ()
brackets BracketStyle
s forall a b. (a -> b) -> a -> b
$
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExprListItem) [XRec GhcPs (HsExpr GhcPs)]
xs
RecordCon {HsRecordBinds GhcPs
XRec GhcPs (ConLikeP GhcPs)
XRecordCon GhcPs
rcon_ext :: forall p. HsExpr p -> XRecordCon p
rcon_con :: forall p. HsExpr p -> XRec p (ConLikeP p)
rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_flds :: HsRecordBinds GhcPs
rcon_con :: XRec GhcPs (ConLikeP GhcPs)
rcon_ext :: XRecordCon GhcPs
..} -> do
LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
rcon_con
R ()
breakpointPreRecordBrace
let HsRecFields {[LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
Maybe (XRec GhcPs RecFieldsDotDot)
rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_dotdot :: Maybe (XRec GhcPs RecFieldsDotDot)
rec_flds :: [LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
..} = HsRecordBinds GhcPs
rcon_flds
p_lhs :: GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> R ()
p_lhs = forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> R ()
p_rdrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. FieldOcc pass -> XRec pass RdrName
foLabel
fields :: [R ()]
fields = forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (forall lhs l a.
(lhs ~ GenLocated l a, HasSrcSpan l) =>
(lhs -> R ())
-> HsFieldBind lhs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_hsFieldBind GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> R ()
p_lhs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
rec_flds
dotdot :: [R ()]
dotdot = case Maybe (XRec GhcPs RecFieldsDotDot)
rec_dotdot of
Just {} -> [Text -> R ()
txt Text
".."]
Maybe (XRec GhcPs RecFieldsDotDot)
Nothing -> []
R () -> R ()
inci forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N forall a b. (a -> b) -> a -> b
$
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel R () -> R ()
sitcc ([R ()]
fields forall a. Semigroup a => a -> a -> a
<> [R ()]
dotdot)
RecordUpd {Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
XRec GhcPs (HsExpr GhcPs)
XRecordUpd GhcPs
rupd_ext :: forall p. HsExpr p -> XRecordUpd p
rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_flds :: forall p. HsExpr p -> Either [LHsRecUpdField p] [LHsRecUpdProj p]
rupd_flds :: Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
rupd_expr :: XRec GhcPs (HsExpr GhcPs)
rupd_ext :: XRecordUpd GhcPs
..} -> do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
rupd_expr HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpointPreRecordBrace
let p_updLbl :: GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs) -> R ()
p_updLbl =
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' forall a b. (a -> b) -> a -> b
$
LocatedN RdrName -> R ()
p_rdrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
(Unambiguous NoExtField
XUnambiguous GhcPs
NoExtField XRec GhcPs RdrName
n :: AmbiguousFieldOcc GhcPs) -> XRec GhcPs RdrName
n
Ambiguous NoExtField
XAmbiguous GhcPs
NoExtField XRec GhcPs RdrName
n -> XRec GhcPs RdrName
n
p_recFields :: (GenLocated l a -> R ())
-> [GenLocated
l
(HsFieldBind
(GenLocated l a) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
p_recFields GenLocated l a -> R ()
p_lbl =
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (forall lhs l a.
(lhs ~ GenLocated l a, HasSrcSpan l) =>
(lhs -> R ())
-> HsFieldBind lhs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_hsFieldBind GenLocated l a -> R ()
p_lbl))
R () -> R ()
inci forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N forall a b. (a -> b) -> a -> b
$
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(forall {l} {l} {a}.
(HasSrcSpan l, HasSrcSpan l) =>
(GenLocated l a -> R ())
-> [GenLocated
l
(HsFieldBind
(GenLocated l a) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
p_recFields GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs) -> R ()
p_updLbl)
(forall {l} {l} {a}.
(HasSrcSpan l, HasSrcSpan l) =>
(GenLocated l a -> R ())
-> [GenLocated
l
(HsFieldBind
(GenLocated l a) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
p_recFields forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce [XRec GhcPs (DotFieldOcc GhcPs)] -> R ()
p_ldotFieldOccs)
Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
rupd_flds
HsGetField {XRec GhcPs (DotFieldOcc GhcPs)
XRec GhcPs (HsExpr GhcPs)
XGetField GhcPs
gf_ext :: forall p. HsExpr p -> XGetField p
gf_expr :: forall p. HsExpr p -> LHsExpr p
gf_field :: forall p. HsExpr p -> XRec p (DotFieldOcc p)
gf_field :: XRec GhcPs (DotFieldOcc GhcPs)
gf_expr :: XRec GhcPs (HsExpr GhcPs)
gf_ext :: XGetField GhcPs
..} -> do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
gf_expr HsExpr GhcPs -> R ()
p_hsExpr
Text -> R ()
txt Text
"."
XRec GhcPs (DotFieldOcc GhcPs) -> R ()
p_ldotFieldOcc XRec GhcPs (DotFieldOcc GhcPs)
gf_field
HsProjection {NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
XProjection GhcPs
proj_ext :: forall p. HsExpr p -> XProjection p
proj_flds :: forall p. HsExpr p -> NonEmpty (XRec p (DotFieldOcc p))
proj_flds :: NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
proj_ext :: XProjection GhcPs
..} -> BracketStyle -> R () -> R ()
parens BracketStyle
N forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"."
[XRec GhcPs (DotFieldOcc GhcPs)] -> R ()
p_ldotFieldOccs (forall a. NonEmpty a -> [a]
NE.toList NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
proj_flds)
ExprWithTySig XExprWithTySig GhcPs
_ XRec GhcPs (HsExpr GhcPs)
x HsWC {LHsSigType (NoGhcTc GhcPs)
hswc_body :: LHsSigType (NoGhcTc GhcPs)
hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body} -> R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
startTypeAnnotation LHsSigType (NoGhcTc GhcPs)
hswc_body HsSigType GhcPs -> R ()
p_hsSigType
ArithSeq XArithSeq GhcPs
_ Maybe (SyntaxExpr GhcPs)
_ ArithSeqInfo GhcPs
x ->
case ArithSeqInfo GhcPs
x of
From XRec GhcPs (HsExpr GhcPs)
from -> BracketStyle -> R () -> R ()
brackets BracketStyle
s forall a b. (a -> b) -> a -> b
$ do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
from HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt Text
".."
FromThen XRec GhcPs (HsExpr GhcPs)
from XRec GhcPs (HsExpr GhcPs)
next -> BracketStyle -> R () -> R ()
brackets BracketStyle
s forall a b. (a -> b) -> a -> b
$ do
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [XRec GhcPs (HsExpr GhcPs)
from, XRec GhcPs (HsExpr GhcPs)
next]
R ()
breakpoint
Text -> R ()
txt Text
".."
FromTo XRec GhcPs (HsExpr GhcPs)
from XRec GhcPs (HsExpr GhcPs)
to -> BracketStyle -> R () -> R ()
brackets BracketStyle
s forall a b. (a -> b) -> a -> b
$ do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
from HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt Text
".."
R ()
space
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
to HsExpr GhcPs -> R ()
p_hsExpr
FromThenTo XRec GhcPs (HsExpr GhcPs)
from XRec GhcPs (HsExpr GhcPs)
next XRec GhcPs (HsExpr GhcPs)
to -> BracketStyle -> R () -> R ()
brackets BracketStyle
s forall a b. (a -> b) -> a -> b
$ do
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [XRec GhcPs (HsExpr GhcPs)
from, XRec GhcPs (HsExpr GhcPs)
next]
R ()
breakpoint
Text -> R ()
txt Text
".."
R ()
space
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
to HsExpr GhcPs -> R ()
p_hsExpr
HsTypedBracket XTypedBracket GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr -> do
Text -> R ()
txt Text
"[||"
R ()
breakpoint'
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint'
Text -> R ()
txt Text
"||]"
HsUntypedBracket XUntypedBracket GhcPs
epAnn HsQuote GhcPs
x -> EpAnn [AddEpAnn] -> HsQuote GhcPs -> R ()
p_hsQuote XUntypedBracket GhcPs
epAnn HsQuote GhcPs
x
HsTypedSplice XTypedSplice GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr -> Bool -> XRec GhcPs (HsExpr GhcPs) -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
True XRec GhcPs (HsExpr GhcPs)
expr SpliceDecoration
DollarSplice
HsUntypedSplice XUntypedSplice GhcPs
_ HsUntypedSplice GhcPs
untySplice -> SpliceDecoration -> HsUntypedSplice GhcPs -> R ()
p_hsUntypedSplice SpliceDecoration
DollarSplice HsUntypedSplice GhcPs
untySplice
HsProc XProc GhcPs
_ LPat GhcPs
p LHsCmdTop GhcPs
e -> do
Text -> R ()
txt Text
"proc"
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
p forall a b. (a -> b) -> a -> b
$ \Pat GhcPs
x -> do
R ()
breakpoint
R () -> R ()
inci (Pat GhcPs -> R ()
p_pat Pat GhcPs
x)
R ()
breakpoint
R ()
token'rarrow
Placement -> R () -> R ()
placeHanging (HsCmdTop GhcPs -> Placement
cmdTopPlacement (forall l e. GenLocated l e -> e
unLoc LHsCmdTop GhcPs
e)) forall a b. (a -> b) -> a -> b
$
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
e (BracketStyle -> HsCmdTop GhcPs -> R ()
p_hsCmdTop BracketStyle
N)
HsStatic XStatic GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e -> do
Text -> R ()
txt Text
"static"
R ()
breakpoint
R () -> R ()
inci (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr)
HsPragE XPragE GhcPs
_ HsPragE GhcPs
prag XRec GhcPs (HsExpr GhcPs)
x -> case HsPragE GhcPs
prag of
HsPragSCC XSCC GhcPs
_ StringLiteral
name -> do
Text -> R ()
txt Text
"{-# SCC "
forall a. Outputable a => a -> R ()
atom StringLiteral
name
Text -> R ()
txt Text
" #-}"
R ()
breakpoint
let inciIfS :: R () -> R ()
inciIfS = case BracketStyle
s of BracketStyle
N -> forall a. a -> a
id; BracketStyle
S -> R () -> R ()
inci
R () -> R ()
inciIfS forall a b. (a -> b) -> a -> b
$ forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PSB {HsPatSynDir GhcPs
HsPatSynDetails GhcPs
LPat GhcPs
LIdP GhcPs
XPSB GhcPs GhcPs
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_dir :: HsPatSynDir GhcPs
psb_def :: LPat GhcPs
psb_args :: HsPatSynDetails GhcPs
psb_id :: LIdP GhcPs
psb_ext :: XPSB GhcPs GhcPs
..} = do
let rhs :: [SrcSpan] -> R ()
rhs [SrcSpan]
conSpans = do
R ()
space
let pattern_def_spans :: [SrcSpan]
pattern_def_spans = [forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
psb_id, forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
psb_def] forall a. [a] -> [a] -> [a]
++ [SrcSpan]
conSpans
case HsPatSynDir GhcPs
psb_dir of
HsPatSynDir GhcPs
Unidirectional ->
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
pattern_def_spans forall a b. (a -> b) -> a -> b
$ do
R ()
token'larrow
R ()
breakpoint
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
psb_def Pat GhcPs -> R ()
p_pat
HsPatSynDir GhcPs
ImplicitBidirectional ->
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
pattern_def_spans forall a b. (a -> b) -> a -> b
$ do
R ()
equals
R ()
breakpoint
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
psb_def Pat GhcPs -> R ()
p_pat
ExplicitBidirectional MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup -> do
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
pattern_def_spans forall a b. (a -> b) -> a -> b
$ do
R ()
token'larrow
R ()
breakpoint
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
psb_def Pat GhcPs -> R ()
p_pat
R ()
breakpoint
Text -> R ()
txt Text
"where"
R ()
breakpoint
R () -> R ()
inci (MatchGroupStyle
-> MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_matchGroup (LocatedN RdrName -> MatchGroupStyle
Function LIdP GhcPs
psb_id) MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup)
Text -> R ()
txt Text
"pattern"
case HsPatSynDetails GhcPs
psb_args of
PrefixCon [] [LIdP GhcPs]
xs -> do
R ()
space
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
psb_id
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
let conSpans :: [SrcSpan]
conSpans = forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LIdP GhcPs]
xs
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conSpans forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIdP GhcPs]
xs) R ()
breakpoint
R () -> R ()
sitcc (forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint LocatedN RdrName -> R ()
p_rdrName [LIdP GhcPs]
xs)
[SrcSpan] -> R ()
rhs [SrcSpan]
conSpans
PrefixCon (Void
v : [Void]
_) [LIdP GhcPs]
_ -> forall a. Void -> a
absurd Void
v
RecCon [RecordPatSynField GhcPs]
xs -> do
R ()
space
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
psb_id
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
let conSpans :: [SrcSpan]
conSpans = forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. RecordPatSynField pass -> LIdP pass
recordPatSynPatVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RecordPatSynField GhcPs]
xs
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conSpans forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RecordPatSynField GhcPs]
xs) R ()
breakpointPreRecordBrace
BracketStyle -> R () -> R ()
braces BracketStyle
N forall a b. (a -> b) -> a -> b
$
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (LocatedN RdrName -> R ()
p_rdrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. RecordPatSynField pass -> LIdP pass
recordPatSynPatVar) [RecordPatSynField GhcPs]
xs
[SrcSpan] -> R ()
rhs [SrcSpan]
conSpans
InfixCon LIdP GhcPs
l LIdP GhcPs
r -> do
let conSpans :: [SrcSpan]
conSpans = [forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
l, forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
r]
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conSpans forall a b. (a -> b) -> a -> b
$ do
R ()
space
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
l
R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
psb_id
R ()
space
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
r
R () -> R ()
inci ([SrcSpan] -> R ()
rhs [SrcSpan]
conSpans)
p_case ::
( Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
) =>
(body -> Placement) ->
(body -> R ()) ->
LHsExpr GhcPs ->
MatchGroup GhcPs (LocatedA body) ->
R ()
p_case :: forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_case body -> Placement
placer body -> R ()
render XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (LocatedA body)
mgroup = do
Text -> R ()
txt Text
"case"
R ()
space
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
Text -> R ()
txt Text
"of"
R ()
breakpoint
R () -> R ()
inci (forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
Case MatchGroup GhcPs (LocatedA body)
mgroup)
p_lamcase ::
( Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
) =>
LamCaseVariant ->
(body -> Placement) ->
(body -> R ()) ->
MatchGroup GhcPs (LocatedA body) ->
R ()
p_lamcase :: forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
LamCaseVariant
-> (body -> Placement)
-> (body -> R ())
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_lamcase LamCaseVariant
variant body -> Placement
placer body -> R ()
render MatchGroup GhcPs (LocatedA body)
mgroup = do
Text -> R ()
txt forall a b. (a -> b) -> a -> b
$ case LamCaseVariant
variant of
LamCaseVariant
LamCase -> Text
"\\case"
LamCaseVariant
LamCases -> Text
"\\cases"
R ()
breakpoint
R () -> R ()
inci (forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
LambdaCase MatchGroup GhcPs (LocatedA body)
mgroup)
p_if ::
(body -> Placement) ->
(body -> R ()) ->
LHsExpr GhcPs ->
LocatedA body ->
LocatedA body ->
R ()
p_if :: forall body.
(body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> LocatedA body
-> LocatedA body
-> R ()
p_if body -> Placement
placer body -> R ()
render XRec GhcPs (HsExpr GhcPs)
if' LocatedA body
then' LocatedA body
else' = do
Text -> R ()
txt Text
"if"
R ()
space
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
if' HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"then"
R ()
space
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
then' forall a b. (a -> b) -> a -> b
$ \body
x ->
Placement -> R () -> R ()
placeHanging (body -> Placement
placer body
x) (body -> R ()
render body
x)
R ()
breakpoint
Text -> R ()
txt Text
"else"
R ()
space
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
else' forall a b. (a -> b) -> a -> b
$ \body
x ->
Placement -> R () -> R ()
placeHanging (body -> Placement
placer body
x) (body -> R ()
render body
x)
p_let ::
Bool ->
(body -> R ()) ->
LHsToken "let" GhcPs ->
HsLocalBinds GhcPs ->
LocatedA body ->
R ()
p_let :: forall body.
Bool
-> (body -> R ())
-> LHsToken "let" GhcPs
-> HsLocalBinds GhcPs
-> LocatedA body
-> R ()
p_let Bool
inDo body -> R ()
render LHsToken "let" GhcPs
letToken HsLocalBinds GhcPs
localBinds LocatedA body
e = Bool
-> Maybe EpaLocation -> HsLocalBinds GhcPs -> Maybe (R ()) -> R ()
p_let' Bool
inDo Maybe EpaLocation
letLoc HsLocalBinds GhcPs
localBinds forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
e body -> R ()
render)
where
letLoc :: Maybe EpaLocation
letLoc =
case forall l e. GenLocated l e -> l
getLoc LHsToken "let" GhcPs
letToken of
TokenLoc EpaLocation
loc -> forall a. a -> Maybe a
Just EpaLocation
loc
TokenLocation
NoTokenLoc -> forall a. Maybe a
Nothing
p_let' ::
Bool ->
Maybe EpaLocation ->
HsLocalBinds GhcPs ->
Maybe (R ()) ->
R ()
p_let' :: Bool
-> Maybe EpaLocation -> HsLocalBinds GhcPs -> Maybe (R ()) -> R ()
p_let' Bool
inDo Maybe EpaLocation
letLoc HsLocalBinds GhcPs
localBinds Maybe (R ())
mBody = do
LetStyle
letStyle <- forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f LetStyle
poLetStyle
InStyle
inStyle <- forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f InStyle
poInStyle
Layout
layout <- R Layout
getLayout
let isAllInline :: Bool
isAllInline = Layout
layout forall a. Eq a => a -> a -> Bool
== Layout
SingleLine Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
inDo Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe (R ())
mBody)
let isBlockInline :: Bool
isBlockInline =
case LetStyle
letStyle of
LetStyle
_ | Bool
isAllInline -> Bool
True
LetStyle
LetAuto ->
forall a. a -> Maybe a -> a
fromMaybe Bool
True forall a b. (a -> b) -> a -> b
$ do
ConTag
letStartLine <- RealSrcSpan -> ConTag
srcSpanStartLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpaLocation -> RealSrcSpan
epaLocationRealSrcSpan forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe EpaLocation
letLoc
ConTag
localBindsStartLine <- HsLocalBinds GhcPs -> Maybe (XHsValBinds GhcPs GhcPs)
localBindsEpAnns HsLocalBinds GhcPs
localBinds forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {ann}. EpAnn ann -> Maybe ConTag
epAnnsStartLine
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
if ConTag
localBindsStartLine forall a. Eq a => a -> a -> Bool
== -ConTag
1
then Bool
True
else ConTag
letStartLine forall a. Eq a => a -> a -> Bool
== ConTag
localBindsStartLine
LetStyle
LetInline -> Bool
True
LetStyle
LetNewline -> Bool
False
LetStyle
LetMixed -> ConTag
numLocalBinds forall a. Ord a => a -> a -> Bool
<= ConTag
1
let inString :: Text
inString =
case InStyle
inStyle of
InStyle
_ | Bool
inDo -> Text
" in"
InStyle
InRightAlign -> Text
" in"
InStyle
InLeftAlign
| Bool
isBlockInline -> Text
"in "
| Bool
otherwise -> Text
"in"
InStyle
InNoSpace -> Text
"in"
let block :: Text -> R () -> R ()
block Text
keyword R ()
body = do
Text -> R ()
txt Text
keyword
if Bool
isBlockInline
then R ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
sitcc R ()
body
else R ()
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
body
R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ do
Text -> R () -> R ()
block Text
"let" (HsLocalBinds GhcPs -> R ()
p_hsLocalBinds HsLocalBinds GhcPs
localBinds)
case Maybe (R ())
mBody of
Just R ()
body
| Bool
isAllInline -> do
R ()
space
Text -> R () -> R ()
block Text
"in" R ()
body
| Bool
otherwise -> do
R ()
newline
Text -> R () -> R ()
block Text
inString R ()
body
Maybe (R ())
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
numLocalBinds :: ConTag
numLocalBinds =
case HsLocalBinds GhcPs
localBinds of
HsValBinds XHsValBinds GhcPs GhcPs
_ (ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
binds [LSig GhcPs]
sigs) -> forall (t :: * -> *) a. Foldable t => t a -> ConTag
length LHsBindsLR GhcPs GhcPs
binds forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [LSig GhcPs]
sigs
HsValBinds XHsValBinds GhcPs GhcPs
_ (XValBindsLR (NValBinds [(RecFlag, LHsBindsLR GhcPs GhcPs)]
binds [LSig GhcRn]
sigs)) -> forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [(RecFlag, LHsBindsLR GhcPs GhcPs)]
binds forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [LSig GhcRn]
sigs
HsIPBinds XHsIPBinds GhcPs GhcPs
_ (IPBinds XIPBinds GhcPs
_ [LIPBind GhcPs]
binds) -> forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [LIPBind GhcPs]
binds
EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_ -> ConTag
0
localBindsEpAnns :: HsLocalBinds GhcPs -> Maybe (XHsValBinds GhcPs GhcPs)
localBindsEpAnns = \case
HsValBinds XHsValBinds GhcPs GhcPs
epanns HsValBindsLR GhcPs GhcPs
_ -> forall a. a -> Maybe a
Just XHsValBinds GhcPs GhcPs
epanns
HsIPBinds XHsIPBinds GhcPs GhcPs
epanns HsIPBinds GhcPs
_ -> forall a. a -> Maybe a
Just XHsIPBinds GhcPs GhcPs
epanns
EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_ -> forall a. Maybe a
Nothing
epAnnsStartLine :: EpAnn ann -> Maybe ConTag
epAnnsStartLine = \case
EpAnn {Anchor
entry :: forall ann. EpAnn ann -> Anchor
entry :: Anchor
entry} -> forall a. a -> Maybe a
Just (RealSrcSpan -> ConTag
srcSpanStartLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. Anchor -> RealSrcSpan
anchor forall a b. (a -> b) -> a -> b
$ Anchor
entry)
EpAnn ann
EpAnnNotUsed -> forall a. Maybe a
Nothing
p_pat :: Pat GhcPs -> R ()
p_pat :: Pat GhcPs -> R ()
p_pat = \case
WildPat XWildPat GhcPs
_ -> Text -> R ()
txt Text
"_"
VarPat XVarPat GhcPs
_ LIdP GhcPs
name -> LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
name
LazyPat XLazyPat GhcPs
_ LPat GhcPs
pat -> do
Text -> R ()
txt Text
"~"
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
pat Pat GhcPs -> R ()
p_pat
AsPat XAsPat GhcPs
_ LIdP GhcPs
name LHsToken "@" GhcPs
_ LPat GhcPs
pat -> do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
name
Text -> R ()
txt Text
"@"
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
pat Pat GhcPs -> R ()
p_pat
ParPat XParPat GhcPs
_ LHsToken "(" GhcPs
_ LPat GhcPs
pat LHsToken ")" GhcPs
_ ->
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
pat (BracketStyle -> R () -> R ()
parens BracketStyle
S forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat GhcPs -> R ()
p_pat)
BangPat XBangPat GhcPs
_ LPat GhcPs
pat -> do
Text -> R ()
txt Text
"!"
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
pat Pat GhcPs -> R ()
p_pat
ListPat XListPat GhcPs
_ [LPat GhcPs]
pats ->
BracketStyle -> R () -> R ()
brackets BracketStyle
S forall a b. (a -> b) -> a -> b
$ forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
pats
TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
pats Boxity
boxing -> do
let parens' :: R () -> R ()
parens' =
case Boxity
boxing of
Boxity
Boxed -> BracketStyle -> R () -> R ()
parens BracketStyle
S
Boxity
Unboxed -> BracketStyle -> R () -> R ()
parensHash BracketStyle
S
R () -> R ()
parens' forall a b. (a -> b) -> a -> b
$ forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
pats
SumPat XSumPat GhcPs
_ LPat GhcPs
pat ConTag
tag ConTag
arity ->
BracketStyle -> ConTag -> ConTag -> R () -> R ()
p_unboxedSum BracketStyle
S ConTag
tag ConTag
arity (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
pat Pat GhcPs -> R ()
p_pat)
ConPat XConPat GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
pat HsConPatDetails GhcPs
details ->
case HsConPatDetails GhcPs
details of
PrefixCon [HsConPatTyArg (NoGhcTc GhcPs)]
tys [LPat GhcPs]
xs -> R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ do
LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
pat
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsConPatTyArg (NoGhcTc GhcPs)]
tys Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
xs) R ()
breakpoint
R () -> R ()
inci forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsConPatTyArg GhcPs -> R ()
p_hsConPatTyArg (forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat)) forall a b. (a -> b) -> a -> b
$
(forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HsConPatTyArg (NoGhcTc GhcPs)]
tys) forall a. Semigroup a => a -> a -> a
<> (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs]
xs)
RecCon (HsRecFields [LHsRecField GhcPs (LPat GhcPs)]
fields Maybe (XRec GhcPs RecFieldsDotDot)
dotdot) -> do
LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
pat
R ()
breakpointPreRecordBrace
let f :: Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
-> R ()
f = \case
Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
Nothing -> Text -> R ()
txt Text
".."
Just GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
x -> forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
x HsRecField GhcPs (LPat GhcPs) -> R ()
p_pat_hsFieldBind
R () -> R ()
inci forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
-> R ()
f forall a b. (a -> b) -> a -> b
$
case Maybe (XRec GhcPs RecFieldsDotDot)
dotdot of
Maybe (XRec GhcPs RecFieldsDotDot)
Nothing -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (LPat GhcPs)]
fields
Just (L SrcSpan
_ (RecFieldsDotDot ConTag
n)) -> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ConTag -> [a] -> [a]
take ConTag
n [LHsRecField GhcPs (LPat GhcPs)]
fields) forall a. [a] -> [a] -> [a]
++ [forall a. Maybe a
Nothing]
InfixCon LPat GhcPs
l LPat GhcPs
r -> do
[SrcSpan] -> R () -> R ()
switchLayout [forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
l, forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
r] forall a b. (a -> b) -> a -> b
$ do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
l Pat GhcPs -> R ()
p_pat
R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
pat
R ()
space
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
r Pat GhcPs -> R ()
p_pat
ViewPat XViewPat GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr LPat GhcPs
pat -> R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
R ()
token'rarrow
R ()
breakpoint
R () -> R ()
inci (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
pat Pat GhcPs -> R ()
p_pat)
SplicePat XSplicePat GhcPs
_ HsUntypedSplice GhcPs
splice -> SpliceDecoration -> HsUntypedSplice GhcPs -> R ()
p_hsUntypedSplice SpliceDecoration
DollarSplice HsUntypedSplice GhcPs
splice
LitPat XLitPat GhcPs
_ HsLit GhcPs
p -> forall a. Outputable a => a -> R ()
atom HsLit GhcPs
p
NPat XNPat GhcPs
_ XRec GhcPs (HsOverLit GhcPs)
v (forall a. Maybe a -> Bool
isJust -> Bool
isNegated) SyntaxExpr GhcPs
_ -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isNegated forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"-"
Bool
negativeLiterals <- Extension -> R Bool
isExtensionEnabled Extension
NegativeLiterals
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
negativeLiterals R ()
space
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsOverLit GhcPs)
v (forall a. Outputable a => a -> R ()
atom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. HsOverLit p -> OverLitVal
ol_val)
NPlusKPat XNPlusKPat GhcPs
_ LIdP GhcPs
n XRec GhcPs (HsOverLit GhcPs)
k HsOverLit GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ -> R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
n
R ()
breakpoint
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"+"
R ()
space
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsOverLit GhcPs)
k (forall a. Outputable a => a -> R ()
atom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. HsOverLit p -> OverLitVal
ol_val)
SigPat XSigPat GhcPs
_ LPat GhcPs
pat HsPS {LHsType (NoGhcTc GhcPs)
XHsPS (NoGhcTc GhcPs)
hsps_ext :: forall pass. HsPatSigType pass -> XHsPS pass
hsps_body :: forall pass. HsPatSigType pass -> LHsType pass
hsps_body :: LHsType (NoGhcTc GhcPs)
hsps_ext :: XHsPS (NoGhcTc GhcPs)
..} -> do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
pat Pat GhcPs -> R ()
p_pat
LHsSigType GhcPs -> R ()
p_typeAscription (LHsType GhcPs -> LHsSigType GhcPs
lhsTypeToSigType LHsType (NoGhcTc GhcPs)
hsps_body)
p_hsPatSigType :: HsPatSigType GhcPs -> R ()
p_hsPatSigType :: HsPatSigType GhcPs -> R ()
p_hsPatSigType (HsPS XHsPS GhcPs
_ LHsType GhcPs
ty) = Text -> R ()
txt Text
"@" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsType GhcPs
ty HsType GhcPs -> R ()
p_hsType
p_hsConPatTyArg :: HsConPatTyArg GhcPs -> R ()
p_hsConPatTyArg :: HsConPatTyArg GhcPs -> R ()
p_hsConPatTyArg (HsConPatTyArg LHsToken "@" GhcPs
_ HsPatSigType GhcPs
patSigTy) = HsPatSigType GhcPs -> R ()
p_hsPatSigType HsPatSigType GhcPs
patSigTy
p_pat_hsFieldBind :: HsRecField GhcPs (LPat GhcPs) -> R ()
p_pat_hsFieldBind :: HsRecField GhcPs (LPat GhcPs) -> R ()
p_pat_hsFieldBind HsFieldBind {Bool
LFieldOcc GhcPs
LPat GhcPs
XHsFieldBind (LFieldOcc GhcPs)
hfbPun :: Bool
hfbRHS :: LPat GhcPs
hfbLHS :: LFieldOcc GhcPs
hfbAnn :: XHsFieldBind (LFieldOcc GhcPs)
hfbAnn :: forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
..} = do
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LFieldOcc GhcPs
hfbLHS FieldOcc GhcPs -> R ()
p_fieldOcc
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hfbPun forall a b. (a -> b) -> a -> b
$ do
R ()
space
R ()
equals
R ()
breakpoint
R () -> R ()
inci (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
hfbRHS Pat GhcPs -> R ()
p_pat)
p_unboxedSum :: BracketStyle -> ConTag -> Arity -> R () -> R ()
p_unboxedSum :: BracketStyle -> ConTag -> ConTag -> R () -> R ()
p_unboxedSum BracketStyle
s ConTag
tag ConTag
arity R ()
m = do
let before :: ConTag
before = ConTag
tag forall a. Num a => a -> a -> a
- ConTag
1
after :: ConTag
after = ConTag
arity forall a. Num a => a -> a -> a
- ConTag
before forall a. Num a => a -> a -> a
- ConTag
1
args :: [Maybe (R ())]
args = forall a. ConTag -> a -> [a]
replicate ConTag
before forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> [forall a. a -> Maybe a
Just R ()
m] forall a. Semigroup a => a -> a -> a
<> forall a. ConTag -> a -> [a]
replicate ConTag
after forall a. Maybe a
Nothing
f :: Maybe (R ()) -> R ()
f Maybe (R ())
x =
case Maybe (R ())
x :: Maybe (R ()) of
Maybe (R ())
Nothing ->
R ()
space
Just R ()
m' -> do
R ()
space
R ()
m'
R ()
space
BracketStyle -> R () -> R ()
parensHash BracketStyle
s forall a b. (a -> b) -> a -> b
$ forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt Text
"|") Maybe (R ()) -> R ()
f [Maybe (R ())]
args
p_hsUntypedSplice :: SpliceDecoration -> HsUntypedSplice GhcPs -> R ()
p_hsUntypedSplice :: SpliceDecoration -> HsUntypedSplice GhcPs -> R ()
p_hsUntypedSplice SpliceDecoration
deco = \case
HsUntypedSpliceExpr XUntypedSpliceExpr GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr -> Bool -> XRec GhcPs (HsExpr GhcPs) -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
False XRec GhcPs (HsExpr GhcPs)
expr SpliceDecoration
deco
HsQuasiQuote XQuasiQuote GhcPs
_ IdP GhcPs
quoterName XRec GhcPs FastString
str -> do
Text -> R ()
txt Text
"["
LocatedN RdrName -> R ()
p_rdrName (forall a an. a -> LocatedAn an a
noLocA IdP GhcPs
quoterName)
Text -> R ()
txt Text
"|"
forall a. Outputable a => a -> R ()
atom XRec GhcPs FastString
str
Text -> R ()
txt Text
"|]"
p_hsSpliceTH ::
Bool ->
LHsExpr GhcPs ->
SpliceDecoration ->
R ()
p_hsSpliceTH :: Bool -> XRec GhcPs (HsExpr GhcPs) -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
isTyped XRec GhcPs (HsExpr GhcPs)
expr = \case
SpliceDecoration
DollarSplice -> do
Text -> R ()
txt Text
decoSymbol
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
expr (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
SpliceDecoration
BareSplice ->
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
expr (R () -> R ()
sitcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
where
decoSymbol :: Text
decoSymbol = if Bool
isTyped then Text
"$$" else Text
"$"
p_hsQuote :: EpAnn [AddEpAnn] -> HsQuote GhcPs -> R ()
p_hsQuote :: EpAnn [AddEpAnn] -> HsQuote GhcPs -> R ()
p_hsQuote EpAnn [AddEpAnn]
epAnn = \case
ExpBr XExpBr GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr -> do
let name :: Text
name
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. Maybe a -> Bool
isJust (AnnKeywordId -> AddEpAnn -> Maybe EpaLocation
matchAddEpAnn AnnKeywordId
AnnOpenEQ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns EpAnn [AddEpAnn]
epAnn) = Text
""
| Bool
otherwise = Text
"e"
Text -> R () -> R ()
quote Text
name (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr)
PatBr XPatBr GhcPs
_ LPat GhcPs
pat -> forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
pat (Text -> R () -> R ()
quote Text
"p" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat GhcPs -> R ()
p_pat)
DecBrL XDecBrL GhcPs
_ [LHsDecl GhcPs]
decls -> Text -> R () -> R ()
quote Text
"d" (forall a. Data a => a -> R () -> R ()
handleStarIsType [LHsDecl GhcPs]
decls (FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDecls FamilyStyle
Free [LHsDecl GhcPs]
decls))
DecBrG XDecBrG GhcPs
_ HsGroup GhcPs
_ -> forall a. String -> a
notImplemented String
"DecBrG"
TypBr XTypBr GhcPs
_ LHsType GhcPs
ty -> Text -> R () -> R ()
quote Text
"t" (forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsType GhcPs
ty (forall a. Data a => a -> R () -> R ()
handleStarIsType LHsType GhcPs
ty forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType GhcPs -> R ()
p_hsType))
VarBr XVarBr GhcPs
_ Bool
isSingleQuote LIdP GhcPs
name -> do
Text -> R ()
txt (forall a. a -> a -> Bool -> a
bool Text
"''" Text
"'" Bool
isSingleQuote)
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
name
where
quote :: Text -> R () -> R ()
quote :: Text -> R () -> R ()
quote Text
name R ()
body = do
let (R ()
startQuote, R ()
endQuote) =
if Text -> Bool
Text.null Text
name
then (R ()
token'openExpQuote, R ()
token'closeQuote)
else (Text -> R ()
txt Text
"[" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
name forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|", Text -> R ()
txt Text
"|]")
R ()
startQuote
R ()
breakpoint'
R () -> R ()
inci forall a b. (a -> b) -> a -> b
$ do
R () -> R ()
dontUseBraces R ()
body
R ()
breakpoint'
R ()
endQuote
handleStarIsType :: (Data a) => a -> R () -> R ()
handleStarIsType :: forall a. Data a => a -> R () -> R ()
handleStarIsType a
a R ()
p
| a -> Bool
containsHsStarTy a
a = R ()
space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> R ()
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* R ()
space
| Bool
otherwise = R ()
p
where
containsHsStarTy :: a -> Bool
containsHsStarTy = forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything Bool -> Bool -> Bool
(||) forall a b. (a -> b) -> a -> b
$ \a
b -> case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast @_ @(HsType GhcPs) a
b of
Just HsStarTy {} -> Bool
True
Maybe (HsType GhcPs)
_ -> Bool
False
p_stringLit :: String -> R ()
p_stringLit :: String -> R ()
p_stringLit String
src =
let s :: [String]
s = String -> [String]
splitGaps String
src
singleLine :: R ()
singleLine =
Text -> R ()
txt forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (forall a. Monoid a => [a] -> a
mconcat [String]
s)
multiLine :: R ()
multiLine =
R () -> R ()
sitcc forall a b. (a -> b) -> a -> b
$ forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (Text -> R ()
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) ([String] -> [String]
backslashes [String]
s)
in forall a. R a -> R a -> R a
vlayout R ()
singleLine R ()
multiLine
where
splitGaps :: String -> [String]
splitGaps :: String -> [String]
splitGaps String
"" = []
splitGaps String
s =
let
p :: (Maybe Char, Char, Maybe Char) -> Bool
p (Just Char
'\\', Char
_, Maybe Char
_) = Bool
True
p (Maybe Char
_, Char
'\\', Just Char
c) | Char -> Bool
ghcSpace Char
c = Bool
False
p (Maybe Char, Char, Maybe Char)
_ = Bool
True
in case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Maybe Char, Char, Maybe Char) -> Bool
p (forall a. [a] -> [(Maybe a, a, Maybe a)]
zipPrevNext String
s) of
([(Maybe Char, Char, Maybe Char)]
l, [(Maybe Char, Char, Maybe Char)]
r) ->
let
r' :: String
r' = forall a. ConTag -> [a] -> [a]
drop ConTag
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
ghcSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ConTag -> [a] -> [a]
drop ConTag
1 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {c}. (a, b, c) -> b
orig [(Maybe Char, Char, Maybe Char)]
r
in forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {c}. (a, b, c) -> b
orig [(Maybe Char, Char, Maybe Char)]
l forall a. a -> [a] -> [a]
: String -> [String]
splitGaps String
r'
ghcSpace :: Char -> Bool
ghcSpace :: Char -> Bool
ghcSpace Char
c = Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x7f' Bool -> Bool -> Bool
&& Char -> Bool
is_space Char
c
backslashes :: [String] -> [String]
backslashes :: [String] -> [String]
backslashes (String
x : String
y : [String]
xs) = (String
x forall a. [a] -> [a] -> [a]
++ String
"\\") forall a. a -> [a] -> [a]
: [String] -> [String]
backslashes ((Char
'\\' forall a. a -> [a] -> [a]
: String
y) forall a. a -> [a] -> [a]
: [String]
xs)
backslashes [String]
xs = [String]
xs
zipPrevNext :: [a] -> [(Maybe a, a, Maybe a)]
zipPrevNext :: forall a. [a] -> [(Maybe a, a, Maybe a)]
zipPrevNext [a]
xs =
let z :: [((Maybe a, a), Maybe a)]
z =
forall a b. [a] -> [b] -> [(a, b)]
zip
(forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Maybe a
Nothing forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just [a]
xs) [a]
xs)
(forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just (forall a. [a] -> [a]
tail [a]
xs) forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat forall a. Maybe a
Nothing)
in forall a b. (a -> b) -> [a] -> [b]
map (\((Maybe a
p, a
x), Maybe a
n) -> (Maybe a
p, a
x, Maybe a
n)) [((Maybe a, a), Maybe a)]
z
orig :: (a, b, c) -> b
orig (a
_, b
x, c
_) = b
x
layoutToBraces :: Layout -> R () -> R ()
layoutToBraces :: Layout -> R () -> R ()
layoutToBraces = \case
Layout
SingleLine -> R () -> R ()
useBraces
Layout
MultiLine -> forall a. a -> a
id
liftAppend :: (Semigroup a) => [a] -> [a] -> [a]
liftAppend :: forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend [] [] = []
liftAppend [] (a
y : [a]
ys) = a
y forall a. a -> [a] -> [a]
: [a]
ys
liftAppend (a
x : [a]
xs) [] = a
x forall a. a -> [a] -> [a]
: [a]
xs
liftAppend (a
x : [a]
xs) (a
y : [a]
ys) = a
x forall a. Semigroup a => a -> a -> a
<> a
y forall a. a -> [a] -> [a]
: forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend [a]
xs [a]
ys
getGRHSSpan :: GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan :: forall body. GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan (GRHS XCGRHS GhcPs (LocatedA body)
_ [GuardLStmt GhcPs]
guards LocatedA body
body) =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' forall a b. (a -> b) -> a -> b
$ forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedA body
body forall a. a -> [a] -> NonEmpty a
:| forall a b. (a -> b) -> [a] -> [b]
map forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA [GuardLStmt GhcPs]
guards
blockPlacement ::
(body -> Placement) ->
[LGRHS GhcPs (LocatedA body)] ->
Placement
blockPlacement :: forall body.
(body -> Placement) -> [LGRHS GhcPs (LocatedA body)] -> Placement
blockPlacement body -> Placement
placer [L Anno (GRHS GhcPs (LocatedA body))
_ (GRHS XCGRHS GhcPs (LocatedA body)
_ [GuardLStmt GhcPs]
_ (L SrcSpanAnnA
_ body
x))] = body -> Placement
placer body
x
blockPlacement body -> Placement
_ [LGRHS GhcPs (LocatedA body)]
_ = Placement
Normal
cmdPlacement :: HsCmd GhcPs -> Placement
cmdPlacement :: HsCmd GhcPs -> Placement
cmdPlacement = \case
HsCmdLam XCmdLam GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
_ -> Placement
Hanging
HsCmdCase XCmdCase GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ MatchGroup GhcPs (LHsCmd GhcPs)
_ -> Placement
Hanging
HsCmdLamCase XCmdLamCase GhcPs
_ LamCaseVariant
_ MatchGroup GhcPs (LHsCmd GhcPs)
_ -> Placement
Hanging
HsCmdDo XCmdDo GhcPs
_ XRec GhcPs [CmdLStmt GhcPs]
_ -> Placement
Hanging
HsCmd GhcPs
_ -> Placement
Normal
cmdTopPlacement :: HsCmdTop GhcPs -> Placement
cmdTopPlacement :: HsCmdTop GhcPs -> Placement
cmdTopPlacement (HsCmdTop XCmdTop GhcPs
_ (L SrcSpanAnnA
_ HsCmd GhcPs
x)) = HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs
x
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement = \case
HsLam XLam GhcPs
_ MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mg -> case MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mg of
MG XMG GhcPs (XRec GhcPs (HsExpr GhcPs))
_ (L SrcSpanAnnL
_ [L SrcSpanAnnA
_ (Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ HsMatchContext GhcPs
_ (LPat GhcPs
x : [LPat GhcPs]
xs) GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_)])
| SrcSpan -> Bool
isOneLineSpan (NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (LPat GhcPs
x forall a. a -> [a] -> NonEmpty a
:| [LPat GhcPs]
xs)) ->
Placement
Hanging
MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
_ -> Placement
Normal
HsLamCase XLamCase GhcPs
_ LamCaseVariant
_ MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
_ -> Placement
Hanging
HsCase XCase GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
_ -> Placement
Hanging
HsDo XDo GhcPs
_ (DoExpr Maybe ModuleName
_) XRec GhcPs [GuardLStmt GhcPs]
_ -> Placement
Hanging
HsDo XDo GhcPs
_ (MDoExpr Maybe ModuleName
_) XRec GhcPs [GuardLStmt GhcPs]
_ -> Placement
Hanging
OpApp XOpApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ XRec GhcPs (HsExpr GhcPs)
op XRec GhcPs (HsExpr GhcPs)
y ->
case (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> String
getOpNameStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> Maybe RdrName
getOpName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) XRec GhcPs (HsExpr GhcPs)
op of
Just String
"$" -> HsExpr GhcPs -> Placement
exprPlacement (forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
y)
Maybe String
_ -> Placement
Normal
HsApp XApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ XRec GhcPs (HsExpr GhcPs)
y -> HsExpr GhcPs -> Placement
exprPlacement (forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
y)
HsProc XProc GhcPs
_ LPat GhcPs
p LHsCmdTop GhcPs
_ ->
if SrcSpan -> Bool
isOneLineSpan (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
p)
then Placement
Hanging
else Placement
Normal
HsExpr GhcPs
_ -> Placement
Normal
withGuards :: [LGRHS GhcPs body] -> Bool
withGuards :: forall body. [LGRHS GhcPs body] -> Bool
withGuards = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall {p} {body}. GRHS p body -> Bool
checkOne forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc)
where
checkOne :: GRHS p body -> Bool
checkOne (GRHS XCGRHS p body
_ [] body
_) = Bool
False
checkOne GRHS p body
_ = Bool
True
breakpointPreRecordBrace :: R ()
breakpointPreRecordBrace :: R ()
breakpointPreRecordBrace = do
Bool
useSpace <- forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f Bool
poRecordBraceSpace
if Bool
useSpace
then R ()
breakpoint
else R ()
breakpoint'
p_hsExprListItem :: HsExpr GhcPs -> R ()
p_hsExprListItem :: HsExpr GhcPs -> R ()
p_hsExprListItem HsExpr GhcPs
e = do
ConTag
indent <- forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f ConTag
poIndentation
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {p}. HsExpr p -> Bool
listLike HsExpr GhcPs
e) forall a b. (a -> b) -> a -> b
$ do
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f CommaStyle
poCommaStyle forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
CommaStyle
Leading -> R ()
breakpoint'
CommaStyle
Trailing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall a. R a -> R a -> R a
vlayout (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (ConTag -> R ()
spaces forall a b. (a -> b) -> a -> b
$ ConTag
indent forall a. Num a => a -> a -> a
- ConTag
2)
HsExpr GhcPs -> R ()
p_hsExpr HsExpr GhcPs
e
where
spaces :: ConTag -> R ()
spaces ConTag
n = Text -> R ()
txt forall a b. (a -> b) -> a -> b
$ ConTag -> Text -> Text
Text.replicate ConTag
n Text
" "
listLike :: HsExpr p -> Bool
listLike = \case
ExplicitList {} -> Bool
True
ExplicitTuple {} -> Bool
True
HsExpr p
_ -> Bool
False