{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Ormolu.Printer.Meat.Declaration.Value
( p_valDecl,
p_pat,
p_hsExpr,
p_hsUntypedSplice,
p_stringLit,
IsApplicand (..),
p_hsExpr',
p_hsCmdTop,
exprPlacement,
cmdTopPlacement,
)
where
import Control.Monad
import Data.Bool (bool)
import Data.Coerce (coerce)
import Data.Data hiding (Infix, Prefix)
import Data.Function (on)
import Data.Functor ((<&>))
import Data.Generics.Schemes (everything)
import Data.List (intersperse, sortBy)
import Data.List.NonEmpty (NonEmpty (..), (<|))
import Data.List.NonEmpty qualified as NE
import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Void
import GHC.Data.Bag (bagToList)
import GHC.Data.FastString
import GHC.Data.Strict qualified as Strict
import GHC.Hs
import GHC.LanguageExtensions.Type (Extension (NegativeLiterals))
import GHC.Parser.CharClass (is_space)
import GHC.Types.Basic
import GHC.Types.Fixity
import GHC.Types.Name.Reader
import GHC.Types.SourceText
import GHC.Types.SrcLoc
import Language.Haskell.Syntax.Basic
import Ormolu.Printer.Combinators
import Ormolu.Printer.Meat.Common
import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration
import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.OpTree
import Ormolu.Printer.Meat.Declaration.Signature
import Ormolu.Printer.Meat.Type
import Ormolu.Printer.Operators
import Ormolu.Utils
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
LocatedN RdrName
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 {} -> String -> R ()
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 = (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> R ()
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 {XMG GhcPs (LocatedA body)
XRec GhcPs [LMatch GhcPs (LocatedA body)]
mg_ext :: XMG GhcPs (LocatedA body)
mg_alts :: XRec GhcPs [LMatch GhcPs (LocatedA body)]
mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
..} = do
let ob :: R () -> R ()
ob = case MatchGroupStyle
style of
MatchGroupStyle
Case -> R () -> R ()
bracesIfEmpty
MatchGroupStyle
LambdaCase -> R () -> R ()
bracesIfEmpty
MatchGroupStyle
_ -> R () -> R ()
dontUseBraces
where
bracesIfEmpty :: R () -> R ()
bracesIfEmpty = if MatchGroup GhcPs (LocatedA body) -> Bool
forall (p :: Pass) body. MatchGroup (GhcPass p) body -> Bool
isEmptyMatchGroup MatchGroup GhcPs (LocatedA body)
mg then R () -> R ()
useBraces else R () -> R ()
forall a. a -> a
id
R () -> R ()
ub <- (R () -> R ()) -> (R () -> R ()) -> Bool -> R () -> R ()
forall a. a -> a -> Bool -> a
bool R () -> R ()
dontUseBraces R () -> R ()
useBraces (Bool -> R () -> R ()) -> R Bool -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Bool
canUseBraces
R () -> R ()
ob (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body)) -> R ())
-> [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((Match GhcPs (LocatedA body) -> R ())
-> GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body)) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (R () -> R ()
ub (R () -> R ())
-> (Match GhcPs (LocatedA body) -> R ())
-> Match GhcPs (LocatedA body)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs (LocatedA body) -> R ()
p_Match)) (GenLocated
(Anno [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))])
[GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))]
-> [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))]
forall l e. GenLocated l e -> e
unLoc XRec GhcPs [LMatch GhcPs (LocatedA body)]
GenLocated
(Anno [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))])
[GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))]
mg_alts)
where
p_Match :: Match GhcPs (LocatedA body) -> R ()
p_Match m :: Match GhcPs (LocatedA body)
m@Match {[LPat GhcPs]
XCMatch GhcPs (LocatedA body)
GRHSs GhcPs (LocatedA body)
HsMatchContext GhcPs
m_ext :: XCMatch GhcPs (LocatedA body)
m_ctxt :: HsMatchContext GhcPs
m_pats :: [LPat GhcPs]
m_grhss :: GRHSs 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
..} =
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
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
(Match GhcPs (LocatedA body) -> MatchGroupStyle -> MatchGroupStyle
forall body. Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle Match GhcPs (LocatedA body)
m MatchGroupStyle
style)
(Match GhcPs (LocatedA body) -> Bool
forall id body. Match id body -> Bool
isInfixMatch Match GhcPs (LocatedA body)
m)
(Match GhcPs (LocatedA body) -> SrcStrictness
forall id body. Match id body -> SrcStrictness
matchStrictness Match GhcPs (LocatedA body)
m)
[LPat GhcPs]
m_pats
GRHSs GhcPs (LocatedA body)
m_grhss
adjustMatchGroupStyle ::
Match GhcPs body ->
MatchGroupStyle ->
MatchGroupStyle
adjustMatchGroupStyle :: forall body. Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle Match GhcPs body
m = \case
Function LocatedN RdrName
_ -> (LocatedN RdrName -> MatchGroupStyle
Function (LocatedN RdrName -> MatchGroupStyle)
-> (Match GhcPs body -> LocatedN RdrName)
-> Match GhcPs body
-> MatchGroupStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsMatchContext GhcPs -> LIdP (NoGhcTc GhcPs)
HsMatchContext GhcPs -> LocatedN RdrName
forall p. HsMatchContext p -> LIdP (NoGhcTc p)
mc_fun (HsMatchContext GhcPs -> LocatedN RdrName)
-> (Match GhcPs body -> HsMatchContext GhcPs)
-> Match GhcPs body
-> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs body -> HsMatchContext GhcPs
forall p body. Match p body -> HsMatchContext p
m_ctxt) Match GhcPs body
m
MatchGroupStyle
style -> MatchGroupStyle
style
matchStrictness :: Match id body -> SrcStrictness
matchStrictness :: forall id body. Match id body -> SrcStrictness
matchStrictness Match id body
match =
case Match id body -> HsMatchContext id
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 = (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> R ()
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)]
XCGRHSs GhcPs (LocatedA body)
HsLocalBinds GhcPs
grhssExt :: XCGRHSs GhcPs (LocatedA body)
grhssGRHSs :: [LGRHS GhcPs (LocatedA body)]
grhssLocalBinds :: HsLocalBinds GhcPs
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
..} = do
case SrcStrictness
strictness of
SrcStrictness
NoSrcStrict -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
SrcStrictness
SrcStrict -> Text -> R ()
txt Text
"!"
SrcStrictness
SrcLazy -> Text -> R ()
txt Text
"~"
Bool
indentBody <- case [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> Maybe (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats of
Maybe (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)))
Nothing ->
Bool
False Bool -> R () -> R Bool
forall a b. a -> R b -> R a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ case MatchGroupStyle
style of
Function LocatedN RdrName
name -> LocatedN RdrName -> R ()
p_rdrName LocatedN RdrName
name
MatchGroupStyle
_ -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ne_pats :: NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
ne_pats@(GenLocated SrcSpanAnnA (Pat GhcPs)
head_pat :| [GenLocated SrcSpanAnnA (Pat GhcPs)]
tail_pats) -> do
let combinedSpans :: SrcSpan
combinedSpans = case MatchGroupStyle
style of
Function LocatedN RdrName
name -> SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedN RdrName
name) SrcSpan
patSpans
MatchGroupStyle
_ -> SrcSpan
patSpans
patSpans :: SrcSpan
patSpans = NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan)
-> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
ne_pats)
indentBody :: Bool
indentBody = Bool -> Bool
not (SrcSpan -> Bool
isOneLineSpan SrcSpan
combinedSpans)
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
combinedSpans] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
let stdCase :: R ()
stdCase = R ()
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats
case MatchGroupStyle
style of
Function LocatedN RdrName
name ->
Bool -> Bool -> R () -> [R ()] -> R ()
p_infixDefHelper
Bool
isInfix
Bool
indentBody
(LocatedN RdrName -> R ()
p_rdrName LocatedN RdrName
name)
((Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats)
MatchGroupStyle
PatternBind -> R ()
stdCase
MatchGroupStyle
Case -> R ()
stdCase
MatchGroupStyle
Lambda -> do
let needsSpace :: Bool
needsSpace = case GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (Pat GhcPs)
head_pat of
LazyPat XLazyPat GhcPs
_ LPat GhcPs
_ -> Bool
True
BangPat XBangPat GhcPs
_ LPat GhcPs
_ -> Bool
True
SplicePat XSplicePat GhcPs
_ HsUntypedSplice GhcPs
_ -> Bool
True
Pat GhcPs
_ -> Bool
False
Text -> R ()
txt Text
"\\"
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsSpace R ()
space
R () -> R ()
sitcc R ()
stdCase
MatchGroupStyle
LambdaCase -> do
(Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat GenLocated SrcSpanAnnA (Pat GhcPs)
head_pat
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (Pat GhcPs)]
tail_pats) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [GenLocated SrcSpanAnnA (Pat GhcPs)]
tail_pats
Bool -> R Bool
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
indentBody
let
endOfPats :: Maybe SrcSpan
endOfPats = case [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> Maybe (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats of
Maybe (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)))
Nothing -> case MatchGroupStyle
style of
Function LocatedN RdrName
name -> SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedN RdrName
name)
MatchGroupStyle
_ -> Maybe SrcSpan
forall a. Maybe a
Nothing
Just NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
pats -> (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (SrcSpan -> Maybe SrcSpan)
-> (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)) -> SrcSpan)
-> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> Maybe SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan)
-> (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> GenLocated SrcSpanAnnA (Pat GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a. NonEmpty a -> a
NE.last) NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
pats
isCase :: MatchGroupStyle -> Bool
isCase = \case
MatchGroupStyle
Case -> Bool
True
MatchGroupStyle
LambdaCase -> Bool
True
MatchGroupStyle
_ -> Bool
False
hasGuards :: Bool
hasGuards = [LGRHS GhcPs (LocatedA body)] -> Bool
forall body. [LGRHS GhcPs body] -> Bool
withGuards [LGRHS GhcPs (LocatedA body)]
grhssGRHSs
grhssSpan :: SrcSpan
grhssSpan =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$
GRHS GhcPs (LocatedA body) -> SrcSpan
forall body. GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan (GRHS GhcPs (LocatedA body) -> SrcSpan)
-> (GenLocated (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA body))
-> GRHS GhcPs (LocatedA body))
-> GenLocated (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA body))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA body))
-> GRHS GhcPs (LocatedA body)
forall l e. GenLocated l e -> e
unLoc (GenLocated (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA body))
-> SrcSpan)
-> NonEmpty
(GenLocated (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA body)))
-> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA body))]
-> NonEmpty
(GenLocated (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA body)))
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [LGRHS GhcPs (LocatedA body)]
[GenLocated (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA body))]
grhssGRHSs
patGrhssSpan :: SrcSpan
patGrhssSpan =
SrcSpan -> (SrcSpan -> SrcSpan) -> Maybe SrcSpan -> SrcSpan
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
SrcSpan
grhssSpan
(SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
grhssSpan (SrcSpan -> SrcSpan) -> (SrcSpan -> SrcSpan) -> SrcSpan -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcLoc -> SrcSpan
srcLocSpan (SrcLoc -> SrcSpan) -> (SrcSpan -> SrcLoc) -> SrcSpan -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanEnd)
Maybe SrcSpan
endOfPats
placement :: Placement
placement =
case Maybe SrcSpan
endOfPats of
Just SrcSpan
spn
| (GenLocated
(Anno (GRHS GhcPs (LocatedA body))) (GRHS GhcPs (LocatedA body))
-> Bool)
-> [GenLocated
(Anno (GRHS GhcPs (LocatedA body))) (GRHS GhcPs (LocatedA body))]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LGRHS GhcPs (LocatedA body) -> Bool
GenLocated
(Anno (GRHS GhcPs (LocatedA body))) (GRHS GhcPs (LocatedA body))
-> Bool
forall body. XRec GhcPs (GRHS GhcPs body) -> Bool
guardNeedsLineBreak [LGRHS GhcPs (LocatedA body)]
[GenLocated
(Anno (GRHS GhcPs (LocatedA body))) (GRHS GhcPs (LocatedA body))]
grhssGRHSs
Bool -> Bool -> Bool
|| Bool -> Bool
not (SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn SrcSpan
grhssSpan) ->
Placement
Normal
Maybe SrcSpan
_ -> (body -> Placement) -> [LGRHS GhcPs (LocatedA body)] -> Placement
forall body.
(body -> Placement) -> [LGRHS GhcPs (LocatedA body)] -> Placement
blockPlacement body -> Placement
placer [LGRHS GhcPs (LocatedA body)]
grhssGRHSs
guardNeedsLineBreak :: XRec GhcPs (GRHS GhcPs body) -> Bool
guardNeedsLineBreak :: forall body. XRec GhcPs (GRHS GhcPs body) -> Bool
guardNeedsLineBreak (L Anno (GRHS GhcPs body)
_ (GRHS XCGRHS GhcPs body
_ [GuardLStmt GhcPs]
guardLStmts body
_)) = case [GuardLStmt GhcPs]
guardLStmts of
[] -> Bool
False
[GuardLStmt GhcPs
g] -> Bool -> Bool
not (Bool -> Bool)
-> (GuardLStmt GhcPs -> Bool) -> GuardLStmt GhcPs -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Bool
isOneLineSpan (SrcSpan -> Bool)
-> (GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan)
-> GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GuardLStmt GhcPs -> Bool) -> GuardLStmt GhcPs -> Bool
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
R ()
-> (GenLocated (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA body))
-> R ())
-> [GenLocated (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA body))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
R ()
breakpoint
((GRHS GhcPs (LocatedA body) -> R ())
-> GenLocated (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA body))
-> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (Placement
-> (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA body)
-> R ()
forall body.
Placement
-> (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA body)
-> R ()
p_grhs' Placement
placement body -> Placement
placer body -> R ()
render GroupStyle
groupStyle))
[LGRHS GhcPs (LocatedA body)]
[GenLocated (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA body))]
grhssGRHSs
p_where :: R ()
p_where = do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HsLocalBinds GhcPs -> Bool
forall a b. HsLocalBindsLR a b -> Bool
eqEmptyLocalBinds HsLocalBinds GhcPs
grhssLocalBinds) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
Text -> R ()
txt Text
"where"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ HsLocalBinds GhcPs -> R ()
p_hsLocalBinds HsLocalBinds GhcPs
grhssLocalBinds
Bool -> R () -> R ()
inciIf Bool
indentBody (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA body))]
-> ConTag
forall a. [a] -> ConTag
forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [LGRHS GhcPs (LocatedA body)]
[GenLocated (SrcAnn NoEpAnns) (GRHS GhcPs (LocatedA body))]
grhssGRHSs ConTag -> ConTag -> Bool
forall a. Ord a => a -> a -> Bool
> ConTag
1) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
case MatchGroupStyle
style of
Function LocatedN RdrName
_ | Bool
hasGuards -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Function LocatedN RdrName
_ -> R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
equals
MatchGroupStyle
PatternBind -> R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
equals
MatchGroupStyle
s | MatchGroupStyle -> Bool
isCase MatchGroupStyle
s Bool -> Bool -> Bool
&& Bool
hasGuards -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MatchGroupStyle
_ -> R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"->"
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
patGrhssSpan] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body
R () -> R ()
inci R ()
p_where
p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
p_grhs :: GroupStyle -> GRHS GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_grhs = Placement
-> (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> GroupStyle
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> R ()
forall body.
Placement
-> (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA body)
-> R ()
p_grhs' Placement
Normal HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_grhs' ::
Placement ->
(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 ()
sitcc (R ()
-> (GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> R ())
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> R ())
-> GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> R ())
-> GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> R ()
p_stmt) [GuardLStmt GhcPs]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs)
R ()
space
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ case GroupStyle
style of
GroupStyle
EqualSign -> R ()
equals
GroupStyle
RightArrow -> Text -> R ()
txt Text
"->"
Bool -> R () -> R ()
inciIf (Placement
parentPlacement Placement -> Placement -> Bool
forall a. Eq a => a -> a -> Bool
== Placement
Normal) (Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body)
where
placement :: Placement
placement =
case Maybe SrcSpan
endOfGuards of
Maybe SrcSpan
Nothing -> body -> Placement
placer (LocatedA body -> body
forall l e. GenLocated l e -> e
unLoc LocatedA body
body)
Just SrcSpan
spn ->
if SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn (LocatedA body -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedA body
body)
then body -> Placement
placer (LocatedA body -> body
forall l e. GenLocated l e -> e
unLoc LocatedA body
body)
else Placement
Normal
endOfGuards :: Maybe SrcSpan
endOfGuards =
case [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Maybe
(NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [GuardLStmt GhcPs]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
guards of
Maybe
(NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
Nothing -> Maybe SrcSpan
forall a. Maybe a
Nothing
Just NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
gs -> (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (SrcSpan -> Maybe SrcSpan)
-> (NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> SrcSpan)
-> NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> Maybe SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan)
-> (NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. NonEmpty a -> a
NE.last) NonEmpty
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
gs
p_body :: R ()
p_body = LocatedA body -> (body -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
body body -> R ()
render
p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd = IsApplicand -> BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' IsApplicand
NotApplicand BracketStyle
N
p_hsCmd' :: IsApplicand -> BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' :: IsApplicand -> BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' IsApplicand
isApp BracketStyle
s = \case
HsCmdArrApp XCmdArrApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
body XRec GhcPs (HsExpr GhcPs)
input HsArrAppType
arrType Bool
rightToLeft -> do
let (GenLocated SrcSpanAnnA (HsExpr GhcPs)
l, GenLocated SrcSpanAnnA (HsExpr GhcPs)
r) = if Bool
rightToLeft then (XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
body, XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
input) else (XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
input, XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
body)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
case (HsArrAppType
arrType, Bool
rightToLeft) of
(HsArrAppType
HsFirstOrderApp, Bool
True) -> Text -> R ()
txt Text
"-<"
(HsArrAppType
HsHigherOrderApp, Bool
True) -> Text -> R ()
txt Text
"-<<"
(HsArrAppType
HsFirstOrderApp, Bool
False) -> Text -> R ()
txt Text
">-"
(HsArrAppType
HsHigherOrderApp, Bool
False) -> Text -> R ()
txt Text
">>-"
Placement -> R () -> R ()
placeHanging (HsExpr GhcPs -> Placement
exprPlacement (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
input)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
form HsExpr GhcPs -> R ()
p_hsExpr
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsCmdTop GhcPs]
[GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs)]
cmds) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
R () -> R ()
inci ([R ()] -> R ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (R () -> [R ()] -> [R ()]
forall a. a -> [a] -> [a]
intersperse R ()
breakpoint ((HsCmdTop GhcPs -> R ())
-> GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (BracketStyle -> HsCmdTop GhcPs -> R ()
p_hsCmdTop BracketStyle
N) (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs) -> R ())
-> [GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs)] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsCmdTop GhcPs]
[GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs)]
cmds)))
HsCmdArrForm XCmdArrForm GhcPs
_ XRec GhcPs (HsExpr GhcPs)
form LexicalFixity
Infix Maybe Fixity
_ [LHsCmdTop GhcPs
left, LHsCmdTop GhcPs
right] -> do
ModuleFixityMap
modFixityMap <- R ModuleFixityMap
askModuleFixityMap
Bool
debug <- R Bool
askDebug
let opTree :: OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
opTree = OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
BinaryOpBranches (LHsCmdTop GhcPs
-> OpTree (LHsCmdTop GhcPs) (XRec GhcPs (HsExpr GhcPs))
cmdOpTree LHsCmdTop GhcPs
left) XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
form (LHsCmdTop GhcPs
-> OpTree (LHsCmdTop GhcPs) (XRec GhcPs (HsExpr GhcPs))
cmdOpTree LHsCmdTop GhcPs
right)
BracketStyle
-> OpTree (LHsCmdTop GhcPs) (OpInfo (XRec GhcPs (HsExpr GhcPs)))
-> R ()
p_cmdOpTree
BracketStyle
s
(Bool
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Maybe RdrName)
-> ModuleFixityMap
-> OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall op ty.
Bool
-> (op -> Maybe RdrName)
-> ModuleFixityMap
-> OpTree ty op
-> OpTree ty (OpInfo op)
reassociateOpTree Bool
debug (HsExpr GhcPs -> Maybe RdrName
getOpName (HsExpr GhcPs -> Maybe RdrName)
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc) ModuleFixityMap
modFixityMap OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
opTree)
HsCmdArrForm XCmdArrForm GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ LexicalFixity
Infix Maybe Fixity
_ [LHsCmdTop GhcPs]
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsCmdArrForm"
HsCmdApp XCmdApp GhcPs
_ LHsCmd GhcPs
cmd XRec GhcPs (HsExpr GhcPs)
expr -> do
LocatedA (HsCmd GhcPs) -> (HsCmd GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
LocatedA (HsCmd GhcPs)
cmd (IsApplicand -> BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' IsApplicand
Applicand BracketStyle
s)
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
HsCmdLam XCmdLam GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
mgroup -> (HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
-> R ()
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)
MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
mgroup
HsCmdPar XCmdPar GhcPs
_ LHsToken "(" GhcPs
_ LHsCmd GhcPs
c LHsToken ")" GhcPs
_ -> BracketStyle -> R () -> R ()
parens BracketStyle
N (LocatedA (HsCmd GhcPs) -> (HsCmd GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
LocatedA (HsCmd GhcPs)
c HsCmd GhcPs -> R ()
p_hsCmd)
HsCmdCase XCmdCase GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (LHsCmd GhcPs)
mgroup ->
IsApplicand
-> (HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
IsApplicand
-> (body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_case IsApplicand
isApp HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (LHsCmd GhcPs)
MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
mgroup
HsCmdLamCase XCmdLamCase GhcPs
_ LamCaseVariant
variant MatchGroup GhcPs (LHsCmd GhcPs)
mgroup ->
IsApplicand
-> LamCaseVariant
-> (HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
IsApplicand
-> LamCaseVariant
-> (body -> Placement)
-> (body -> R ())
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_lamcase IsApplicand
isApp LamCaseVariant
variant HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd MatchGroup GhcPs (LHsCmd GhcPs)
MatchGroup GhcPs (LocatedA (HsCmd GhcPs))
mgroup
HsCmdIf XCmdIf GhcPs
anns SyntaxExpr GhcPs
_ XRec GhcPs (HsExpr GhcPs)
if' LHsCmd GhcPs
then' LHsCmd GhcPs
else' ->
(HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> EpAnn AnnsIf
-> XRec GhcPs (HsExpr GhcPs)
-> LocatedA (HsCmd GhcPs)
-> LocatedA (HsCmd GhcPs)
-> R ()
forall body.
(body -> Placement)
-> (body -> R ())
-> EpAnn AnnsIf
-> XRec GhcPs (HsExpr GhcPs)
-> LocatedA body
-> LocatedA body
-> R ()
p_if HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd XCmdIf GhcPs
EpAnn AnnsIf
anns XRec GhcPs (HsExpr GhcPs)
if' LHsCmd GhcPs
LocatedA (HsCmd GhcPs)
then' LHsCmd GhcPs
LocatedA (HsCmd GhcPs)
else'
HsCmdLet XCmdLet GhcPs
_ LHsToken "let" GhcPs
_ HsLocalBinds GhcPs
localBinds LHsToken "in" GhcPs
_ LHsCmd GhcPs
c ->
(HsCmd GhcPs -> R ())
-> HsLocalBinds GhcPs -> LocatedA (HsCmd GhcPs) -> R ()
forall body.
(body -> R ()) -> HsLocalBinds GhcPs -> LocatedA body -> R ()
p_let HsCmd GhcPs -> R ()
p_hsCmd HsLocalBinds GhcPs
localBinds LHsCmd GhcPs
LocatedA (HsCmd GhcPs)
c
HsCmdDo XCmdDo GhcPs
_ XRec GhcPs [CmdLStmt GhcPs]
es -> do
Text -> R ()
txt Text
"do"
IsApplicand
-> (HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> LocatedL [LocatedA (Stmt GhcPs (LocatedA (HsCmd GhcPs)))]
-> R ()
forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
IsApplicand
-> (body -> Placement)
-> (body -> R ())
-> LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> R ()
p_stmts IsApplicand
isApp HsCmd GhcPs -> Placement
cmdPlacement (IsApplicand -> BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' IsApplicand
NotApplicand BracketStyle
S) XRec GhcPs [CmdLStmt GhcPs]
LocatedL [LocatedA (Stmt GhcPs (LocatedA (HsCmd GhcPs)))]
es
p_hsCmdTop :: BracketStyle -> HsCmdTop GhcPs -> R ()
p_hsCmdTop :: BracketStyle -> HsCmdTop GhcPs -> R ()
p_hsCmdTop BracketStyle
s (HsCmdTop XCmdTop GhcPs
_ LHsCmd GhcPs
cmd) = LocatedA (HsCmd GhcPs) -> (HsCmd GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
LocatedA (HsCmd GhcPs)
cmd (IsApplicand -> BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' IsApplicand
NotApplicand 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 = LocatedAn ann a -> (a -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedAn ann a
l ((a -> R ()) -> R ()) -> (a -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
case LocatedAn ann a -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedAn ann a
l of
UnhelpfulSpan UnhelpfulSpanReason
_ -> a -> R ()
f a
x
RealSrcSpan RealSrcSpan
currentSpn Maybe BufSpan
_ -> do
R (Maybe SpanMark)
getSpanMark R (Maybe SpanMark) -> (Maybe SpanMark -> R ()) -> R ()
forall a b. R a -> (a -> R b) -> R b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (StatementSpan RealSrcSpan
lastSpn) ->
if RealSrcSpan -> ConTag
srcSpanStartLine RealSrcSpan
currentSpn ConTag -> ConTag -> Bool
forall a. Ord a => a -> a -> Bool
> RealSrcSpan -> ConTag
srcSpanEndLine RealSrcSpan
lastSpn ConTag -> ConTag -> ConTag
forall a. Num a => a -> a -> a
+ ConTag
1
then R ()
newline
else () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe SpanMark
_ -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
a -> R ()
f a
x
R (Maybe SpanMark)
getSpanMark R (Maybe SpanMark) -> (Maybe SpanMark -> R ()) -> R ()
forall a b. R a -> (a -> R b) -> R b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (HaddockSpan HaddockStyle
_ RealSrcSpan
_) -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (CommentSpan RealSrcSpan
_) -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe SpanMark
_ -> SpanMark -> R ()
setSpanMark (RealSrcSpan -> SpanMark
StatementSpan RealSrcSpan
currentSpn)
p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt :: Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_stmt = (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> R ()
forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
p_stmt' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_stmt' ::
( Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL
) =>
(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
_ -> LocatedA body -> (body -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
body body -> R ()
render
BindStmt XBindStmt GhcPs GhcPs (LocatedA body)
_ LPat GhcPs
p f :: LocatedA body
f@(LocatedA body -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA -> SrcSpan
l) -> do
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p Pat GhcPs -> R ()
p_pat
R ()
space
Text -> R ()
txt Text
"<-"
let loc :: SrcSpan
loc = GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p
placement :: Placement
placement
| SrcSpan -> Bool
isOneLineSpan (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (SrcSpan -> SrcLoc
srcSpanEnd SrcSpan
loc) (SrcSpan -> SrcLoc
srcSpanStart SrcSpan
l)) = body -> Placement
placer (LocatedA body -> body
forall l e. GenLocated l e -> e
unLoc LocatedA body
f)
| Bool
otherwise = Placement
Normal
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
loc, SrcSpan
l] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
Placement -> R () -> R ()
placeHanging Placement
placement (LocatedA body -> (body -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
f body -> R ()
render)
ApplicativeStmt {} -> String -> R ()
forall a. String -> a
notImplemented String
"ApplicativeStmt"
BodyStmt XBodyStmt GhcPs GhcPs (LocatedA body)
_ LocatedA body
body SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ -> LocatedA body -> (body -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
body body -> R ()
render
LetStmt XLetStmt GhcPs GhcPs (LocatedA body)
_ HsLocalBinds GhcPs
binds -> do
Text -> R ()
txt Text
"let"
R ()
space
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ HsLocalBinds GhcPs -> R ()
p_hsLocalBinds HsLocalBinds GhcPs
binds
ParStmt {} ->
String -> R ()
forall a. String -> a
notImplemented String
"ParStmt"
TransStmt {[(IdP GhcPs, IdP GhcPs)]
[GuardLStmt GhcPs]
Maybe (XRec GhcPs (HsExpr GhcPs))
XTransStmt GhcPs GhcPs (LocatedA body)
XRec GhcPs (HsExpr GhcPs)
SyntaxExpr GhcPs
HsExpr GhcPs
TransForm
trS_ext :: XTransStmt GhcPs GhcPs (LocatedA body)
trS_form :: TransForm
trS_stmts :: [GuardLStmt GhcPs]
trS_bndrs :: [(IdP GhcPs, IdP GhcPs)]
trS_using :: XRec GhcPs (HsExpr GhcPs)
trS_by :: Maybe (XRec GhcPs (HsExpr GhcPs))
trS_ret :: SyntaxExpr GhcPs
trS_bind :: SyntaxExpr GhcPs
trS_fmap :: HsExpr GhcPs
trS_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
..} ->
case (TransForm
trS_form, Maybe (XRec GhcPs (HsExpr GhcPs))
Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
trS_by) of
(TransForm
ThenForm, Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
Nothing) -> do
Text -> R ()
txt Text
"then"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
trS_using HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt Text
"by"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
trS_using HsExpr GhcPs -> R ()
p_hsExpr
RecStmt {[IdP GhcPs]
XRecStmt GhcPs GhcPs (LocatedA body)
XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA body)]
SyntaxExpr GhcPs
recS_ext :: XRecStmt GhcPs GhcPs (LocatedA body)
recS_stmts :: XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA body)]
recS_later_ids :: [IdP GhcPs]
recS_rec_ids :: [IdP GhcPs]
recS_bind_fn :: SyntaxExpr GhcPs
recS_ret_fn :: SyntaxExpr GhcPs
recS_mfix_fn :: SyntaxExpr GhcPs
recS_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
..} -> do
Text -> R ()
txt Text
"rec"
R ()
space
R () -> R ()
sitcc (R () -> R ())
-> (([LocatedA (Stmt GhcPs (LocatedA body))] -> R ()) -> R ())
-> ([LocatedA (Stmt GhcPs (LocatedA body))] -> R ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnL [LocatedA (Stmt GhcPs (LocatedA body))]
-> ([LocatedA (Stmt GhcPs (LocatedA body))] -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA body)]
GenLocated SrcSpanAnnL [LocatedA (Stmt GhcPs (LocatedA body))]
recS_stmts (([LocatedA (Stmt GhcPs (LocatedA body))] -> R ()) -> R ())
-> ([LocatedA (Stmt GhcPs (LocatedA body))] -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ (LocatedA (Stmt GhcPs (LocatedA body)) -> R ())
-> [LocatedA (Stmt GhcPs (LocatedA body))] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((Stmt GhcPs (LocatedA body) -> R ())
-> LocatedA (Stmt GhcPs (LocatedA body)) -> R ()
forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing ((body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render))
p_stmts ::
( Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL
) =>
IsApplicand ->
(body -> Placement) ->
(body -> R ()) ->
LocatedL [LocatedA (Stmt GhcPs (LocatedA body))] ->
R ()
p_stmts :: forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
IsApplicand
-> (body -> Placement)
-> (body -> R ())
-> LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> R ()
p_stmts IsApplicand
isApp body -> Placement
placer body -> R ()
render LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
es = do
R ()
breakpoint
R () -> R ()
ub <- Layout -> R () -> R ()
layoutToBraces (Layout -> R () -> R ()) -> R Layout -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Layout
getLayout
let p_stmtExt :: (RelativePos, LocatedA (Stmt GhcPs (LocatedA body))) -> R ()
p_stmtExt (RelativePos
relPos, LocatedA (Stmt GhcPs (LocatedA body))
stmt) =
R () -> R ()
ub' (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ (Stmt GhcPs (LocatedA body) -> R ())
-> LocatedA (Stmt GhcPs (LocatedA body)) -> R ()
forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing ((body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render) LocatedA (Stmt GhcPs (LocatedA body))
stmt
where
ub' :: R () -> R ()
ub' = case RelativePos
relPos of
RelativePos
FirstPos -> R () -> R ()
ub
RelativePos
MiddlePos -> R () -> R ()
ub
RelativePos
LastPos -> R () -> R ()
forall a. a -> a
id
RelativePos
SinglePos -> R () -> R ()
forall a. a -> a
id
IsApplicand -> R () -> R ()
inciApplicand IsApplicand
isApp (R () -> R ())
-> (([LocatedA (Stmt GhcPs (LocatedA body))] -> R ()) -> R ())
-> ([LocatedA (Stmt GhcPs (LocatedA body))] -> R ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> ([LocatedA (Stmt GhcPs (LocatedA body))] -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
es (([LocatedA (Stmt GhcPs (LocatedA body))] -> R ()) -> R ())
-> ([LocatedA (Stmt GhcPs (LocatedA body))] -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$
((RelativePos, LocatedA (Stmt GhcPs (LocatedA body))) -> R ())
-> [(RelativePos, LocatedA (Stmt GhcPs (LocatedA body)))] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi (RelativePos, LocatedA (Stmt GhcPs (LocatedA body))) -> R ()
p_stmtExt ([(RelativePos, LocatedA (Stmt GhcPs (LocatedA body)))] -> R ())
-> ([LocatedA (Stmt GhcPs (LocatedA body))]
-> [(RelativePos, LocatedA (Stmt GhcPs (LocatedA body)))])
-> [LocatedA (Stmt GhcPs (LocatedA body))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LocatedA (Stmt GhcPs (LocatedA body))]
-> [(RelativePos, LocatedA (Stmt GhcPs (LocatedA body)))]
forall a. [a] -> [(RelativePos, a)]
attachRelativePos
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
_)) =
(ParStmtBlock GhcPs GhcPs
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]])
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [ParStmtBlock GhcPs GhcPs]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
forall a. Semigroup a => a -> a -> a
(<>) ([[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]])
-> (ParStmtBlock GhcPs GhcPs
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]])
-> ParStmtBlock GhcPs GhcPs
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]]
ParStmtBlock GhcPs GhcPs
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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))
XTransStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
XRec GhcPs (HsExpr GhcPs)
SyntaxExpr GhcPs
HsExpr GhcPs
TransForm
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_ext :: XTransStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
trS_form :: TransForm
trS_stmts :: [GuardLStmt GhcPs]
trS_bndrs :: [(IdP GhcPs, IdP GhcPs)]
trS_using :: XRec GhcPs (HsExpr GhcPs)
trS_by :: Maybe (XRec GhcPs (HsExpr GhcPs))
trS_ret :: SyntaxExpr GhcPs
trS_bind :: SyntaxExpr GhcPs
trS_fmap :: HsExpr GhcPs
..}) =
([[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]])
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend [] ((GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
gatherStmt (GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]])
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [[[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuardLStmt GhcPs]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
trS_stmts) [[[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]]
-> [[[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]]
-> [[[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]]
forall a. Semigroup a => a -> a -> a
<> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[SrcSpanAnnA
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
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
_) =
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]])
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend ([[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]])
-> (GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]])
-> GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
gatherStmt) [] [GuardLStmt GhcPs]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts
p_hsLocalBinds :: HsLocalBinds GhcPs -> R ()
p_hsLocalBinds :: HsLocalBinds GhcPs -> R ()
p_hsLocalBinds = \case
HsValBinds XHsValBinds GhcPs GhcPs
epAnn (ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
bag [LSig GhcPs]
lsigs) -> EpAnn AnnList -> R () -> R ()
pseudoLocated XHsValBinds GhcPs GhcPs
EpAnn AnnList
epAnn (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R () -> R ()
br <- Layout -> R () -> R ()
layoutToBraces (Layout -> R () -> R ()) -> R Layout -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Layout
getLayout
let items :: [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
items =
let injectLeft :: GenLocated l a -> GenLocated l (Either a b)
injectLeft (L l
l a
x) = l -> Either a b -> GenLocated l (Either a b)
forall l e. l -> e -> GenLocated l e
L l
l (a -> Either a b
forall a b. a -> Either a b
Left a
x)
injectRight :: GenLocated l b -> GenLocated l (Either a b)
injectRight (L l
l b
x) = l -> Either a b -> GenLocated l (Either a b)
forall l e. l -> e -> GenLocated l e
L l
l (b -> Either a b
forall a b. b -> Either a b
Right b
x)
in (GenLocated SrcSpanAnnA (HsBind GhcPs)
-> GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
forall {l} {a} {b}. GenLocated l a -> GenLocated l (Either a b)
injectLeft (GenLocated SrcSpanAnnA (HsBind GhcPs)
-> GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs)))
-> [GenLocated SrcSpanAnnA (HsBind GhcPs)]
-> [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
-> [GenLocated SrcSpanAnnA (HsBind GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
bag) [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
-> [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
-> [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
forall a. [a] -> [a] -> [a]
++ (GenLocated SrcSpanAnnA (Sig GhcPs)
-> GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
forall {l} {b} {a}. GenLocated l b -> GenLocated l (Either a b)
injectRight (GenLocated SrcSpanAnnA (Sig GhcPs)
-> GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs)))
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
-> [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
lsigs)
positionToBracing :: RelativePos -> R () -> R ()
positionToBracing = \case
RelativePos
SinglePos -> R () -> R ()
forall a. a -> a
id
RelativePos
FirstPos -> R () -> R ()
br
RelativePos
MiddlePos -> R () -> R ()
br
RelativePos
LastPos -> R () -> R ()
forall a. a -> a
id
p_item' :: (RelativePos,
GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs)))
-> R ()
p_item' (RelativePos
p, GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
item) =
RelativePos -> R () -> R ()
positionToBracing RelativePos
p (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
(Either (HsBind GhcPs) (Sig GhcPs) -> R ())
-> GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
-> R ()
forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing ((HsBind GhcPs -> R ())
-> (Sig GhcPs -> R ()) -> Either (HsBind GhcPs) (Sig GhcPs) -> R ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsBind GhcPs -> R ()
p_valDecl Sig GhcPs -> R ()
p_sigDecl) GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
item
binds :: [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
binds = (GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
-> GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
-> Ordering)
-> [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
-> [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
-> SrcSpan)
-> GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
-> GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
items
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ ((RelativePos,
GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs)))
-> R ())
-> [(RelativePos,
GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs)))]
-> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi (RelativePos,
GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs)))
-> R ()
p_item' ([GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
-> [(RelativePos,
GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs)))]
forall a. [a] -> [(RelativePos, a)]
attachRelativePos [GenLocated SrcSpanAnnA (Either (HsBind GhcPs) (Sig GhcPs))]
binds)
HsValBinds XHsValBinds GhcPs GhcPs
_ HsValBindsLR GhcPs GhcPs
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsValBinds"
HsIPBinds XHsIPBinds GhcPs GhcPs
epAnn (IPBinds XIPBinds GhcPs
_ [LIPBind GhcPs]
xs) -> EpAnn AnnList -> R () -> R ()
pseudoLocated XHsIPBinds GhcPs GhcPs
EpAnn AnnList
epAnn (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
(GenLocated SrcSpanAnnA (IPBind GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (IPBind GhcPs)] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((IPBind GhcPs -> R ())
-> GenLocated SrcSpanAnnA (IPBind GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' IPBind GhcPs -> R ()
p_ipBind) [LIPBind GhcPs]
[GenLocated SrcSpanAnnA (IPBind GhcPs)]
xs
EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_ -> () -> R ()
forall a. a -> R a
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 :: RealSrcSpan
anchor :: Anchor -> RealSrcSpan
anchor}}}
| let sp :: SrcSpan
sp = RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
anchor Maybe BufSpan
forall a. Maybe a
Strict.Nothing,
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Bool
isZeroWidthSpan SrcSpan
sp ->
GenLocated SrcSpan () -> (() -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (SrcSpan -> () -> GenLocated SrcSpan ()
forall l e. l -> e -> GenLocated l e
L SrcSpan
sp ()) ((() -> R ()) -> R ()) -> (R () -> () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> () -> R ()
forall a b. a -> b -> a
const
EpAnn AnnList
_ -> R () -> R ()
forall a. a -> a
id
p_ldotFieldOcc :: XRec GhcPs (DotFieldOcc GhcPs) -> R ()
p_ldotFieldOcc :: XRec GhcPs (DotFieldOcc GhcPs) -> R ()
p_ldotFieldOcc =
(DotFieldOcc GhcPs -> R ())
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' ((DotFieldOcc GhcPs -> R ())
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs) -> R ())
-> (DotFieldOcc GhcPs -> R ())
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)
-> R ()
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> R ()
p_rdrName (LocatedN RdrName -> R ())
-> (DotFieldOcc GhcPs -> LocatedN RdrName)
-> DotFieldOcc GhcPs
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldLabelString -> RdrName)
-> GenLocated SrcSpanAnnN FieldLabelString -> LocatedN RdrName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FastString -> RdrName
mkVarUnqual (FastString -> RdrName)
-> (FieldLabelString -> FastString) -> FieldLabelString -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabelString -> FastString
field_label) (GenLocated SrcSpanAnnN FieldLabelString -> LocatedN RdrName)
-> (DotFieldOcc GhcPs -> GenLocated SrcSpanAnnN FieldLabelString)
-> DotFieldOcc GhcPs
-> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotFieldOcc GhcPs -> XRec GhcPs FieldLabelString
DotFieldOcc GhcPs -> GenLocated SrcSpanAnnN FieldLabelString
forall p. DotFieldOcc p -> XRec p FieldLabelString
dfoLabel
p_ldotFieldOccs :: [XRec GhcPs (DotFieldOcc GhcPs)] -> R ()
p_ldotFieldOccs :: [XRec GhcPs (DotFieldOcc GhcPs)] -> R ()
p_ldotFieldOccs = R ()
-> (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs) -> R ())
-> [GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt Text
".") XRec GhcPs (DotFieldOcc GhcPs) -> R ()
GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs) -> R ()
p_ldotFieldOcc
p_fieldOcc :: FieldOcc GhcPs -> R ()
p_fieldOcc :: FieldOcc GhcPs -> R ()
p_fieldOcc FieldOcc {XCFieldOcc GhcPs
XRec GhcPs RdrName
foExt :: XCFieldOcc GhcPs
foLabel :: XRec GhcPs RdrName
foExt :: forall pass. FieldOcc pass -> XCFieldOcc pass
foLabel :: forall pass. FieldOcc pass -> XRec pass RdrName
..} = LocatedN RdrName -> R ()
p_rdrName XRec GhcPs RdrName
LocatedN 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
XHsFieldBind lhs
XRec GhcPs (HsExpr GhcPs)
hfbAnn :: XHsFieldBind lhs
hfbLHS :: lhs
hfbRHS :: XRec GhcPs (HsExpr GhcPs)
hfbPun :: Bool
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
lhs -> R ()
p_lhs lhs
hfbLHS
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hfbPun (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
space
R ()
equals
let placement :: Placement
placement =
if SrcSpan -> SrcSpan -> Bool
onTheSameLine (GenLocated l a -> SrcSpan
forall l a. HasSrcSpan l => GenLocated l a -> SrcSpan
getLoc' lhs
GenLocated l a
hfbLHS) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
hfbRHS)
then HsExpr GhcPs -> Placement
exprPlacement (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
hfbRHS)
else Placement
Normal
Placement -> R () -> R ()
placeHanging Placement
placement (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
hfbRHS HsExpr GhcPs -> R ()
p_hsExpr)
p_hsExpr :: HsExpr GhcPs -> R ()
p_hsExpr :: HsExpr GhcPs -> R ()
p_hsExpr = IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' IsApplicand
NotApplicand BracketStyle
N
data IsApplicand = Applicand | NotApplicand
inciApplicand :: IsApplicand -> R () -> R ()
inciApplicand :: IsApplicand -> R () -> R ()
inciApplicand = \case
IsApplicand
Applicand -> R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
inci
IsApplicand
NotApplicand -> R () -> R ()
inci
p_hsExpr' :: IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' :: IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' IsApplicand
isApp BracketStyle
s = \case
HsVar XVar GhcPs
_ LIdP GhcPs
name -> LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
name
HsUnboundVar XUnboundVar GhcPs
_ RdrName
occ -> RdrName -> R ()
forall a. Outputable a => a -> R ()
atom RdrName
occ
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
"?"
FastString -> R ()
forall a. Outputable a => a -> R ()
atom FastString
name
HsOverLit XOverLitE GhcPs
_ HsOverLit GhcPs
v -> OverLitVal -> R ()
forall a. Outputable a => a -> R ()
atom (HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit GhcPs
v)
HsLit XLitE GhcPs
_ HsLit GhcPs
lit ->
case HsLit GhcPs
lit of
HsString (SourceText FastString
stxt) FastString
_ -> FastString -> R ()
p_stringLit FastString
stxt
HsStringPrim (SourceText FastString
stxt) ByteString
_ -> FastString -> R ()
p_stringLit FastString
stxt
HsLit GhcPs
r -> 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 ->
IsApplicand
-> LamCaseVariant
-> (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
IsApplicand
-> LamCaseVariant
-> (body -> Placement)
-> (body -> R ())
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_lamcase IsApplicand
isApp LamCaseVariant
variant HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mgroup
HsApp XApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
f XRec GhcPs (HsExpr GhcPs)
x -> do
let
gatherArgs :: GenLocated l (HsExpr p)
-> NonEmpty (GenLocated l (HsExpr p))
-> (GenLocated l (HsExpr p), NonEmpty (GenLocated l (HsExpr p)))
gatherArgs GenLocated l (HsExpr p)
f' NonEmpty (GenLocated l (HsExpr p))
knownArgs =
case GenLocated l (HsExpr p)
f' of
L l
_ (HsApp XApp p
_ XRec p (HsExpr p)
l XRec p (HsExpr p)
r) -> GenLocated l (HsExpr p)
-> NonEmpty (GenLocated l (HsExpr p))
-> (GenLocated l (HsExpr p), NonEmpty (GenLocated l (HsExpr p)))
gatherArgs XRec p (HsExpr p)
GenLocated l (HsExpr p)
l (XRec p (HsExpr p)
GenLocated l (HsExpr p)
r GenLocated l (HsExpr p)
-> NonEmpty (GenLocated l (HsExpr p))
-> NonEmpty (GenLocated l (HsExpr p))
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty (GenLocated l (HsExpr p))
knownArgs)
GenLocated l (HsExpr p)
_ -> (GenLocated l (HsExpr p)
f', NonEmpty (GenLocated l (HsExpr p))
knownArgs)
(GenLocated SrcSpanAnnA (HsExpr GhcPs)
func, NonEmpty (GenLocated SrcSpanAnnA (HsExpr GhcPs))
args) = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> NonEmpty (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs),
NonEmpty (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall {p} {l}.
(XRec p (HsExpr p) ~ GenLocated l (HsExpr p)) =>
GenLocated l (HsExpr p)
-> NonEmpty (GenLocated l (HsExpr p))
-> (GenLocated l (HsExpr p), NonEmpty (GenLocated l (HsExpr p)))
gatherArgs XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
f (XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> [a] -> NonEmpty a
:| [])
([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
initp, GenLocated SrcSpanAnnA (HsExpr GhcPs)
lastp) = (NonEmpty (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. NonEmpty a -> [a]
NE.init NonEmpty (GenLocated SrcSpanAnnA (HsExpr GhcPs))
args, NonEmpty (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a. NonEmpty a -> a
NE.last NonEmpty (GenLocated SrcSpanAnnA (HsExpr GhcPs))
args)
initSpan :: SrcSpan
initSpan =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
f SrcSpan -> [SrcSpan] -> NonEmpty SrcSpan
forall a. a -> [a] -> NonEmpty a
:| [(SrcLoc -> SrcSpan
srcLocSpan (SrcLoc -> SrcSpan)
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcLoc)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc)
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
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 (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
lastp)
else Placement
Normal
case Placement
placement of
Placement
Normal -> do
R () -> R ()
ub <-
R Layout
getLayout R Layout -> (Layout -> R () -> R ()) -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Layout
SingleLine -> R () -> R ()
useBraces
Layout
MultiLine -> R () -> R ()
forall a. a -> a
id
R () -> R ()
ub (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
func (IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' IsApplicand
Applicand BracketStyle
s)
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((HsExpr GhcPs -> R ())
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
initp
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
initp) R ()
breakpoint
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
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 (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
initSpan] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsExpr GhcPs)
func (IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' IsApplicand
Applicand BracketStyle
s)
R ()
breakpoint
R ()
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((HsExpr GhcPs -> R ())
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> R ()
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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
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
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"@"
case GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsWcType (NoGhcTc GhcPs)
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
a) of
HsSpliceTy {} -> R ()
space
HsType GhcPs
_ -> () -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsWcType (NoGhcTc GhcPs)
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
a) HsType GhcPs -> R ()
p_hsType
OpApp XOpApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
x XRec GhcPs (HsExpr GhcPs)
op XRec GhcPs (HsExpr GhcPs)
y -> do
ModuleFixityMap
modFixityMap <- R ModuleFixityMap
askModuleFixityMap
Bool
debug <- R Bool
askDebug
let opTree :: OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
opTree = OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
BinaryOpBranches (XRec GhcPs (HsExpr GhcPs)
-> OpTree (XRec GhcPs (HsExpr GhcPs)) (XRec GhcPs (HsExpr GhcPs))
exprOpTree XRec GhcPs (HsExpr GhcPs)
x) XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op (XRec GhcPs (HsExpr GhcPs)
-> OpTree (XRec GhcPs (HsExpr GhcPs)) (XRec GhcPs (HsExpr GhcPs))
exprOpTree XRec GhcPs (HsExpr GhcPs)
y)
BracketStyle
-> OpTree
(XRec GhcPs (HsExpr GhcPs)) (OpInfo (XRec GhcPs (HsExpr GhcPs)))
-> R ()
p_exprOpTree
BracketStyle
s
(Bool
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Maybe RdrName)
-> ModuleFixityMap
-> OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall op ty.
Bool
-> (op -> Maybe RdrName)
-> ModuleFixityMap
-> OpTree ty op
-> OpTree ty (OpInfo op)
reassociateOpTree Bool
debug (HsExpr GhcPs -> Maybe RdrName
getOpName (HsExpr GhcPs -> Maybe RdrName)
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc) ModuleFixityMap
modFixityMap OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
opTree)
NegApp XNegApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e SyntaxExpr GhcPs
_ -> do
Bool
negativeLiterals <- Extension -> R Bool
isExtensionEnabled Extension
NegativeLiterals
let isLiteral :: Bool
isLiteral = case GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e of
HsLit {} -> Bool
True
HsOverLit {} -> Bool
True
HsExpr GhcPs
_ -> Bool
False
Text -> R ()
txt Text
"-"
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
negativeLiterals Bool -> Bool -> Bool
&& Bool
isLiteral) R ()
space
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (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 (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e (R () -> R ()
dontUseBraces (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr))
SectionL XSectionL GhcPs
_ XRec GhcPs (HsExpr GhcPs)
x XRec GhcPs (HsExpr GhcPs)
op -> do
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op HsExpr GhcPs -> R ()
p_hsExpr)
SectionR XSectionR GhcPs
_ XRec GhcPs (HsExpr GhcPs)
op XRec GhcPs (HsExpr GhcPs)
x -> do
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr)
ExplicitTuple XExplicitTuple GhcPs
_ [HsTupArg GhcPs]
args Boxity
boxity -> do
let isSection :: Bool
isSection = (HsTupArg GhcPs -> Bool) -> [HsTupArg GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any HsTupArg GhcPs -> Bool
forall {id}. HsTupArg id -> Bool
isMissing [HsTupArg GhcPs]
args
isMissing :: HsTupArg id -> Bool
isMissing = \case
Missing XMissing id
_ -> Bool
True
HsTupArg id
_ -> Bool
False
p_arg :: HsTupArg GhcPs -> R ()
p_arg =
R () -> R ()
sitcc (R () -> R ())
-> (HsTupArg GhcPs -> R ()) -> HsTupArg GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Present XPresent GhcPs
_ XRec GhcPs (HsExpr GhcPs)
x -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr
Missing XMissing GhcPs
_ -> () -> R ()
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
parens' :: BracketStyle -> R () -> R ()
parens' =
case Boxity
boxity of
Boxity
Boxed -> BracketStyle -> R () -> R ()
parens
Boxity
Unboxed -> BracketStyle -> R () -> R ()
parensHash
[SrcSpan]
enclSpan <-
(RealSrcSpan -> SrcSpan) -> [RealSrcSpan] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RealSrcSpan -> Maybe BufSpan -> SrcSpan)
-> Maybe BufSpan -> RealSrcSpan -> SrcSpan
forall a b c. (a -> b -> c) -> b -> a -> c
flip RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan Maybe BufSpan
forall a. Maybe a
Strict.Nothing) ([RealSrcSpan] -> [SrcSpan])
-> (Maybe RealSrcSpan -> [RealSrcSpan])
-> Maybe RealSrcSpan
-> [SrcSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe RealSrcSpan -> [RealSrcSpan]
forall a. Maybe a -> [a]
maybeToList
(Maybe RealSrcSpan -> [SrcSpan])
-> R (Maybe RealSrcSpan) -> R [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R (Maybe RealSrcSpan)
getEnclosingSpan
if Bool
isSection
then
[SrcSpan] -> R () -> R ()
switchLayout [] (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> (HsTupArg GhcPs -> R ()) -> [HsTupArg GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
comma HsTupArg GhcPs -> R ()
p_arg [HsTupArg GhcPs]
args
else
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
enclSpan (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> (HsTupArg GhcPs -> R ()) -> [HsTupArg GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel HsTupArg GhcPs -> R ()
p_arg [HsTupArg GhcPs]
args
ExplicitSum XExplicitSum GhcPs
_ ConTag
tag ConTag
arity XRec GhcPs (HsExpr GhcPs)
e ->
BracketStyle -> ConTag -> ConTag -> R () -> R ()
p_unboxedSum BracketStyle
N ConTag
tag ConTag
arity (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr)
HsCase XCase GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup ->
IsApplicand
-> (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
IsApplicand
-> (body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_case IsApplicand
isApp HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
mgroup
HsIf XIf GhcPs
anns XRec GhcPs (HsExpr GhcPs)
if' XRec GhcPs (HsExpr GhcPs)
then' XRec GhcPs (HsExpr GhcPs)
else' ->
(HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> EpAnn AnnsIf
-> XRec GhcPs (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> R ()
forall body.
(body -> Placement)
-> (body -> R ())
-> EpAnn AnnsIf
-> XRec GhcPs (HsExpr GhcPs)
-> LocatedA body
-> LocatedA body
-> R ()
p_if HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr XIf GhcPs
EpAnn AnnsIf
anns XRec GhcPs (HsExpr GhcPs)
if' XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
then' XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
else'
HsMultiIf XMultiIf GhcPs
_ [LGRHS GhcPs (XRec GhcPs (HsExpr GhcPs))]
guards -> do
Text -> R ()
txt Text
"if"
R ()
breakpoint
IsApplicand -> R () -> R ()
inciApplicand IsApplicand
isApp (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> R ())
-> [GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline ((GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> R ())
-> GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> R ()
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))]
[GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
guards
HsLet XLet GhcPs
_ LHsToken "let" GhcPs
_ HsLocalBinds GhcPs
localBinds LHsToken "in" GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e ->
(HsExpr GhcPs -> R ())
-> HsLocalBinds GhcPs
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> R ()
forall body.
(body -> R ()) -> HsLocalBinds GhcPs -> LocatedA body -> R ()
p_let HsExpr GhcPs -> R ()
p_hsExpr HsLocalBinds GhcPs
localBinds XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (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
Maybe ModuleName -> (ModuleName -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ModuleName
moduleName ((ModuleName -> R ()) -> R ()) -> (ModuleName -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \ModuleName
m -> ModuleName -> R ()
forall a. Outputable a => a -> R ()
atom ModuleName
m R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> R ()
txt Text
"."
Text -> R ()
txt Text
header
IsApplicand
-> (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> LocatedL
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
IsApplicand
-> (body -> Placement)
-> (body -> R ())
-> LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> R ()
p_stmts IsApplicand
isApp HsExpr GhcPs -> Placement
exprPlacement (IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' IsApplicand
NotApplicand BracketStyle
S) XRec GhcPs [GuardLStmt GhcPs]
LocatedL
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
es
compBody :: R ()
compBody = BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ())
-> (([GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ())
-> R ())
-> ([GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedL
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> ([GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ())
-> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs [GuardLStmt GhcPs]
LocatedL
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
es (([GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ())
-> R ())
-> ([GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ())
-> R ()
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 =
R ()
-> ([GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ())
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
(R ()
breakpoint R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|" R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space)
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
p_seqBody
p_seqBody :: [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
p_seqBody =
R () -> R ()
sitcc
(R () -> R ())
-> ([GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ())
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R ()
-> (GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> R ())
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
R ()
commaDel
((StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> R ())
-> GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (R () -> R ()
sitcc (R () -> R ())
-> (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> R ())
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stmt GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> R ()
p_stmt))
stmts :: [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts = [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. HasCallStack => [a] -> [a]
init [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
yield :: GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
yield = [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. HasCallStack => [a] -> a
last [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
lists :: [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
lists = (GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]])
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend ([[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]])
-> (GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]])
-> GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]]
gatherStmt) [] [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts
GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> R ())
-> R ()
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 ()
StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (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 -> String -> R ()
forall a. String -> a
notImplemented String
"GhciStmtCtxt"
ExplicitList XExplicitList GhcPs
_ [XRec GhcPs (HsExpr GhcPs)]
xs ->
BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R ()
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> R ())
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsExpr GhcPs -> R ())
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [XRec GhcPs (HsExpr GhcPs)]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
xs
RecordCon {XRecordCon GhcPs
XRec GhcPs (ConLikeP GhcPs)
HsRecordBinds GhcPs
rcon_ext :: XRecordCon GhcPs
rcon_con :: XRec GhcPs (ConLikeP GhcPs)
rcon_flds :: HsRecordBinds GhcPs
rcon_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
..} -> do
LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
rcon_con
R ()
breakpoint
let HsRecFields {[LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
Maybe (XRec GhcPs RecFieldsDotDot)
rec_flds :: [LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
rec_dotdot :: 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)
..} = HsRecordBinds GhcPs
rcon_flds
p_lhs :: GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> R ()
p_lhs = (FieldOcc GhcPs -> R ())
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' ((FieldOcc GhcPs -> R ())
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> R ())
-> (FieldOcc GhcPs -> R ())
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
-> R ()
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> R ()
p_rdrName (LocatedN RdrName -> R ())
-> (FieldOcc GhcPs -> LocatedN RdrName) -> FieldOcc GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc GhcPs -> XRec GhcPs RdrName
FieldOcc GhcPs -> LocatedN RdrName
forall pass. FieldOcc pass -> XRec pass RdrName
foLabel
fields :: [R ()]
fields = (HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> R ())
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' ((GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> R ())
-> HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(XRec GhcPs (HsExpr GhcPs))
-> R ()
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) (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> R ())
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (XRec GhcPs (HsExpr GhcPs))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
rec_flds
dotdot :: [R ()]
dotdot = case Maybe (XRec GhcPs RecFieldsDotDot)
rec_dotdot of
Just {} -> [Text -> R ()
txt Text
".."]
Maybe (XRec GhcPs RecFieldsDotDot)
Nothing -> []
R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> (R () -> R ()) -> [R ()] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel R () -> R ()
sitcc ([R ()]
fields [R ()] -> [R ()] -> [R ()]
forall a. Semigroup a => a -> a -> a
<> [R ()]
dotdot)
RecordUpd {XRecordUpd GhcPs
XRec GhcPs (HsExpr GhcPs)
LHsRecUpdFields GhcPs
rupd_ext :: XRecordUpd GhcPs
rupd_expr :: XRec GhcPs (HsExpr GhcPs)
rupd_flds :: LHsRecUpdFields GhcPs
rupd_ext :: forall p. HsExpr p -> XRecordUpd p
rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_flds :: forall p. HsExpr p -> LHsRecUpdFields p
..} -> do
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rupd_expr HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
let p_updLbl :: GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs) -> R ()
p_updLbl =
(AmbiguousFieldOcc GhcPs -> R ())
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' ((AmbiguousFieldOcc GhcPs -> R ())
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs) -> R ())
-> (AmbiguousFieldOcc GhcPs -> R ())
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs)
-> R ()
forall a b. (a -> b) -> a -> b
$
LocatedN RdrName -> R ()
p_rdrName (LocatedN RdrName -> R ())
-> (AmbiguousFieldOcc GhcPs -> LocatedN RdrName)
-> AmbiguousFieldOcc GhcPs
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
(Unambiguous XUnambiguous GhcPs
NoExtField
NoExtField XRec GhcPs RdrName
n :: AmbiguousFieldOcc GhcPs) -> XRec GhcPs RdrName
LocatedN RdrName
n
Ambiguous XAmbiguous GhcPs
NoExtField
NoExtField XRec GhcPs RdrName
n -> XRec GhcPs RdrName
LocatedN 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 =
R ()
-> (GenLocated
l
(HsFieldBind
(GenLocated l a) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> R ())
-> [GenLocated
l
(HsFieldBind
(GenLocated l a) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated
l
(HsFieldBind
(GenLocated l a) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> R ())
-> GenLocated
l
(HsFieldBind
(GenLocated l a) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsFieldBind
(GenLocated l a) (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> R ())
-> GenLocated
l
(HsFieldBind
(GenLocated l a) (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' ((GenLocated l a -> R ())
-> HsFieldBind (GenLocated l a) (XRec GhcPs (HsExpr GhcPs)) -> R ()
forall lhs l a.
(lhs ~ GenLocated l a, HasSrcSpan l) =>
(lhs -> R ())
-> HsFieldBind lhs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_hsFieldBind GenLocated l a -> R ()
p_lbl))
R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ case LHsRecUpdFields GhcPs
rupd_flds of
RegularRecUpdFields {[LHsRecUpdField GhcPs GhcPs]
XLHsRecUpdLabels GhcPs
xRecUpdFields :: XLHsRecUpdLabels GhcPs
recUpdFields :: [LHsRecUpdField GhcPs GhcPs]
xRecUpdFields :: forall p. LHsRecUpdFields p -> XLHsRecUpdLabels p
recUpdFields :: forall p. LHsRecUpdFields p -> [LHsRecUpdField p p]
..} ->
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs) -> R ())
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
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 [LHsRecUpdField GhcPs GhcPs]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
recUpdFields
OverloadedRecUpdFields {[LHsRecUpdProj GhcPs]
XLHsOLRecUpdLabels GhcPs
xOLRecUpdFields :: XLHsOLRecUpdLabels GhcPs
olRecUpdFields :: [LHsRecUpdProj GhcPs]
xOLRecUpdFields :: forall p. LHsRecUpdFields p -> XLHsOLRecUpdLabels p
olRecUpdFields :: forall p. LHsRecUpdFields p -> [LHsRecUpdProj p]
..} ->
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs) -> R ())
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
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 ((FieldLabelStrings GhcPs -> R ())
-> GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (([GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)] -> R ())
-> FieldLabelStrings GhcPs -> R ()
forall a b. Coercible a b => a -> b
coerce [XRec GhcPs (DotFieldOcc GhcPs)] -> R ()
[GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)] -> R ()
p_ldotFieldOccs)) [LHsRecUpdProj GhcPs]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
olRecUpdFields
HsGetField {XGetField GhcPs
XRec GhcPs (HsExpr GhcPs)
XRec GhcPs (DotFieldOcc GhcPs)
gf_ext :: XGetField GhcPs
gf_expr :: XRec GhcPs (HsExpr GhcPs)
gf_field :: XRec GhcPs (DotFieldOcc GhcPs)
gf_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)
..} -> do
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (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 :: XProjection GhcPs
proj_flds :: NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
proj_ext :: forall p. HsExpr p -> XProjection p
proj_flds :: forall p. HsExpr p -> NonEmpty (XRec p (DotFieldOcc p))
..} -> BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"."
[XRec GhcPs (DotFieldOcc GhcPs)] -> R ()
p_ldotFieldOccs (NonEmpty (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs))
-> [GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (XRec GhcPs (DotFieldOcc GhcPs))
NonEmpty (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcPs))
proj_flds)
ExprWithTySig XExprWithTySig GhcPs
_ XRec GhcPs (HsExpr GhcPs)
x HsWC {LHsSigType (NoGhcTc GhcPs)
hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body :: LHsSigType (NoGhcTc GhcPs)
hswc_body} -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
Text -> R ()
txt Text
"::"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> (HsSigType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsSigType (NoGhcTc GhcPs)
GenLocated SrcSpanAnnA (HsSigType GhcPs)
hswc_body HsSigType GhcPs -> R ()
p_hsSigType
ArithSeq XArithSeq GhcPs
_ Maybe (SyntaxExpr GhcPs)
_ ArithSeqInfo GhcPs
x ->
case ArithSeqInfo GhcPs
x of
From XRec GhcPs (HsExpr GhcPs)
from -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
from HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt Text
".."
FromThen XRec GhcPs (HsExpr GhcPs)
from XRec GhcPs (HsExpr GhcPs)
next -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((HsExpr GhcPs -> R ())
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
from, XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
next]
R ()
breakpoint
Text -> R ()
txt Text
".."
FromTo XRec GhcPs (HsExpr GhcPs)
from XRec GhcPs (HsExpr GhcPs)
to -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
from HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt Text
".."
R ()
space
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
to HsExpr GhcPs -> R ()
p_hsExpr
FromThenTo XRec GhcPs (HsExpr GhcPs)
from XRec GhcPs (HsExpr GhcPs)
next XRec GhcPs (HsExpr GhcPs)
to -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((HsExpr GhcPs -> R ())
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
from, XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
next]
R ()
breakpoint
Text -> R ()
txt Text
".."
R ()
space
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
to HsExpr GhcPs -> R ()
p_hsExpr
HsTypedBracket XTypedBracket GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr -> do
Text -> R ()
txt Text
"[||"
R ()
breakpoint'
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (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 [AddEpAnn]
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"
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p ((Pat GhcPs -> R ()) -> R ()) -> (Pat GhcPs -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \Pat GhcPs
x -> do
R ()
breakpoint
R () -> R ()
inci (Pat GhcPs -> R ()
p_pat Pat GhcPs
x)
R ()
breakpoint
Text -> R ()
txt Text
"->"
Placement -> R () -> R ()
placeHanging (HsCmdTop GhcPs -> Placement
cmdTopPlacement (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs) -> HsCmdTop GhcPs
forall l e. GenLocated l e -> e
unLoc LHsCmdTop GhcPs
GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs)
e)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs)
-> (HsCmdTop GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs)
e (BracketStyle -> HsCmdTop GhcPs -> R ()
p_hsCmdTop BracketStyle
N)
HsStatic XStatic GhcPs
_ XRec GhcPs (HsExpr GhcPs)
e -> do
Text -> R ()
txt Text
"static"
R ()
breakpoint
R () -> R ()
inci (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr)
HsPragE XPragE GhcPs
_ HsPragE GhcPs
prag XRec GhcPs (HsExpr GhcPs)
x -> case HsPragE GhcPs
prag of
HsPragSCC XSCC GhcPs
_ StringLiteral
name -> do
Text -> R ()
txt Text
"{-# SCC "
StringLiteral -> R ()
forall a. Outputable a => a -> R ()
atom StringLiteral
name
Text -> R ()
txt Text
" #-}"
R ()
breakpoint
let inciIfS :: R () -> R ()
inciIfS = case BracketStyle
s of BracketStyle
N -> R () -> R ()
forall a. a -> a
id; BracketStyle
S -> R () -> R ()
inci
R () -> R ()
inciIfS (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PSB {XPSB GhcPs GhcPs
LIdP GhcPs
LPat GhcPs
HsPatSynDetails GhcPs
HsPatSynDir GhcPs
psb_ext :: XPSB GhcPs GhcPs
psb_id :: LIdP GhcPs
psb_args :: HsPatSynDetails GhcPs
psb_def :: LPat GhcPs
psb_dir :: HsPatSynDir GhcPs
psb_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
..} = do
let rhs :: [SrcSpan] -> R ()
rhs [SrcSpan]
conSpans = do
R ()
space
let pattern_def_spans :: [SrcSpan]
pattern_def_spans = [LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
LocatedN RdrName
psb_id, GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
psb_def] [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ [SrcSpan]
conSpans
case HsPatSynDir GhcPs
psb_dir of
HsPatSynDir GhcPs
Unidirectional ->
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
pattern_def_spans (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"<-"
R ()
breakpoint
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
psb_def Pat GhcPs -> R ()
p_pat
HsPatSynDir GhcPs
ImplicitBidirectional ->
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
pattern_def_spans (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
equals
R ()
breakpoint
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
psb_def Pat GhcPs -> R ()
p_pat
ExplicitBidirectional MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup -> do
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
pattern_def_spans (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"<-"
R ()
breakpoint
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
psb_def Pat GhcPs -> R ()
p_pat
R ()
breakpoint
Text -> R ()
txt Text
"where"
R ()
breakpoint
R () -> R ()
inci (MatchGroupStyle
-> MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs)) -> R ()
p_matchGroup (LocatedN RdrName -> MatchGroupStyle
Function LIdP GhcPs
LocatedN RdrName
psb_id) MatchGroup GhcPs (XRec GhcPs (HsExpr GhcPs))
mgroup)
Text -> R ()
txt Text
"pattern"
case HsPatSynDetails GhcPs
psb_args of
PrefixCon [] [LIdP GhcPs]
xs -> do
R ()
space
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
psb_id
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
let conSpans :: [SrcSpan]
conSpans = LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (LocatedN RdrName -> SrcSpan) -> [LocatedN RdrName] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LIdP GhcPs]
[LocatedN RdrName]
xs
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conSpans (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LocatedN RdrName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIdP GhcPs]
[LocatedN RdrName]
xs) R ()
breakpoint
R () -> R ()
sitcc (R () -> (LocatedN RdrName -> R ()) -> [LocatedN RdrName] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint LocatedN RdrName -> R ()
p_rdrName [LIdP GhcPs]
[LocatedN RdrName]
xs)
[SrcSpan] -> R ()
rhs [SrcSpan]
conSpans
PrefixCon (Void
v : [Void]
_) [LIdP GhcPs]
_ -> Void -> R ()
forall a. Void -> a
absurd Void
v
RecCon [RecordPatSynField GhcPs]
xs -> do
R ()
space
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
psb_id
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
let conSpans :: [SrcSpan]
conSpans = LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (LocatedN RdrName -> SrcSpan)
-> (RecordPatSynField GhcPs -> LocatedN RdrName)
-> RecordPatSynField GhcPs
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField GhcPs -> LIdP GhcPs
RecordPatSynField GhcPs -> LocatedN RdrName
forall pass. RecordPatSynField pass -> LIdP pass
recordPatSynPatVar (RecordPatSynField GhcPs -> SrcSpan)
-> [RecordPatSynField GhcPs] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RecordPatSynField GhcPs]
xs
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conSpans (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([RecordPatSynField GhcPs] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RecordPatSynField GhcPs]
xs) R ()
breakpoint
BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R ()
-> (RecordPatSynField GhcPs -> R ())
-> [RecordPatSynField GhcPs]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (LocatedN RdrName -> R ()
p_rdrName (LocatedN RdrName -> R ())
-> (RecordPatSynField GhcPs -> LocatedN RdrName)
-> RecordPatSynField GhcPs
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField GhcPs -> LIdP GhcPs
RecordPatSynField GhcPs -> LocatedN RdrName
forall pass. RecordPatSynField pass -> LIdP pass
recordPatSynPatVar) [RecordPatSynField GhcPs]
xs
[SrcSpan] -> R ()
rhs [SrcSpan]
conSpans
InfixCon LIdP GhcPs
l LIdP GhcPs
r -> do
let conSpans :: [SrcSpan]
conSpans = [LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
LocatedN RdrName
l, LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
LocatedN RdrName
r]
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
conSpans (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
space
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
l
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
psb_id
R ()
space
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
r
R () -> R ()
inci ([SrcSpan] -> R ()
rhs [SrcSpan]
conSpans)
p_case ::
( Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
) =>
IsApplicand ->
(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) =>
IsApplicand
-> (body -> Placement)
-> (body -> R ())
-> XRec GhcPs (HsExpr GhcPs)
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_case IsApplicand
isApp body -> Placement
placer body -> R ()
render XRec GhcPs (HsExpr GhcPs)
e MatchGroup GhcPs (LocatedA body)
mgroup = do
Text -> R ()
txt Text
"case"
R ()
space
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
Text -> R ()
txt Text
"of"
R ()
breakpoint
IsApplicand -> R () -> R ()
inciApplicand IsApplicand
isApp ((body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
Case MatchGroup GhcPs (LocatedA body)
mgroup)
p_lamcase ::
( Anno (GRHS GhcPs (LocatedA body)) ~ SrcAnn NoEpAnns,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
) =>
IsApplicand ->
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) =>
IsApplicand
-> LamCaseVariant
-> (body -> Placement)
-> (body -> R ())
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_lamcase IsApplicand
isApp LamCaseVariant
variant body -> Placement
placer body -> R ()
render MatchGroup GhcPs (LocatedA body)
mgroup = do
Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ case LamCaseVariant
variant of
LamCaseVariant
LamCase -> Text
"\\case"
LamCaseVariant
LamCases -> Text
"\\cases"
R ()
breakpoint
IsApplicand -> R () -> R ()
inciApplicand IsApplicand
isApp ((body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
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 ()) ->
EpAnn AnnsIf ->
LHsExpr GhcPs ->
LocatedA body ->
LocatedA body ->
R ()
p_if :: forall body.
(body -> Placement)
-> (body -> R ())
-> EpAnn AnnsIf
-> XRec GhcPs (HsExpr GhcPs)
-> LocatedA body
-> LocatedA body
-> R ()
p_if body -> Placement
placer body -> R ()
render EpAnn AnnsIf
epAnn XRec GhcPs (HsExpr GhcPs)
if' LocatedA body
then' LocatedA body
else' = do
Text -> R ()
txt Text
"if"
R ()
space
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
if' HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
SrcSpan -> Text -> R ()
forall {l}. HasSrcSpan l => l -> Text -> R ()
locatedToken SrcSpan
thenSpan Text
"then"
R ()
space
SrcSpan -> LocatedA body -> R ()
placeHangingLocated SrcSpan
thenSpan LocatedA body
then'
R ()
breakpoint
SrcSpan -> Text -> R ()
forall {l}. HasSrcSpan l => l -> Text -> R ()
locatedToken SrcSpan
elseSpan Text
"else"
R ()
space
SrcSpan -> LocatedA body -> R ()
placeHangingLocated SrcSpan
elseSpan LocatedA body
else'
where
(SrcSpan
thenSpan, SrcSpan
elseSpan, [RealSrcSpan]
commentSpans) =
case EpAnn AnnsIf
epAnn of
EpAnn {anns :: forall ann. EpAnn ann -> ann
anns = AnnsIf {EpaLocation
aiThen :: EpaLocation
aiThen :: AnnsIf -> EpaLocation
aiThen, EpaLocation
aiElse :: EpaLocation
aiElse :: AnnsIf -> EpaLocation
aiElse}, EpAnnComments
comments :: EpAnnComments
comments :: forall ann. EpAnn ann -> EpAnnComments
comments} ->
( RealSrcSpan -> SrcSpan
forall l. HasSrcSpan l => l -> SrcSpan
loc' (RealSrcSpan -> SrcSpan) -> RealSrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ EpaLocation -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation
aiThen,
RealSrcSpan -> SrcSpan
forall l. HasSrcSpan l => l -> SrcSpan
loc' (RealSrcSpan -> SrcSpan) -> RealSrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ EpaLocation -> RealSrcSpan
epaLocationRealSrcSpan EpaLocation
aiElse,
(GenLocated Anchor EpaComment -> RealSrcSpan)
-> [GenLocated Anchor EpaComment] -> [RealSrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map (Anchor -> RealSrcSpan
anchor (Anchor -> RealSrcSpan)
-> (GenLocated Anchor EpaComment -> Anchor)
-> GenLocated Anchor EpaComment
-> RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated Anchor EpaComment -> Anchor
forall l e. GenLocated l e -> l
getLoc) ([GenLocated Anchor EpaComment] -> [RealSrcSpan])
-> [GenLocated Anchor EpaComment] -> [RealSrcSpan]
forall a b. (a -> b) -> a -> b
$
case EpAnnComments
comments of
EpaComments [GenLocated Anchor EpaComment]
cs -> [GenLocated Anchor EpaComment]
cs
EpaCommentsBalanced [GenLocated Anchor EpaComment]
pre [GenLocated Anchor EpaComment]
post -> [GenLocated Anchor EpaComment]
pre [GenLocated Anchor EpaComment]
-> [GenLocated Anchor EpaComment] -> [GenLocated Anchor EpaComment]
forall a. Semigroup a => a -> a -> a
<> [GenLocated Anchor EpaComment]
post
)
EpAnn AnnsIf
EpAnnNotUsed ->
(SrcSpan
noSrcSpan, SrcSpan
noSrcSpan, [])
locatedToken :: l -> Text -> R ()
locatedToken l
tokenSpan Text
token =
GenLocated l () -> (() -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (l -> () -> GenLocated l ()
forall l e. l -> e -> GenLocated l e
L l
tokenSpan ()) ((() -> R ()) -> R ()) -> (() -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \()
_ -> Text -> R ()
txt Text
token
betweenSpans :: a -> a -> a -> Bool
betweenSpans a
spanA a
spanB a
s = a
spanA a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
s Bool -> Bool -> Bool
&& a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
spanB
placeHangingLocated :: SrcSpan -> LocatedA body -> R ()
placeHangingLocated SrcSpan
tokenSpan bodyLoc :: LocatedA body
bodyLoc@(L SrcSpanAnnA
_ body
body) = do
let bodySpan :: SrcSpan
bodySpan = LocatedA body -> SrcSpan
forall l a. HasSrcSpan l => GenLocated l a -> SrcSpan
getLoc' LocatedA body
bodyLoc
hasComments :: Bool
hasComments = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
RealSrcSpan
tokenRealSpan <- SrcSpan -> Maybe RealSrcSpan
srcSpanToRealSrcSpan SrcSpan
tokenSpan
RealSrcSpan
bodyRealSpan <- SrcSpan -> Maybe RealSrcSpan
srcSpanToRealSrcSpan SrcSpan
bodySpan
Bool -> Maybe Bool
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ (RealSrcSpan -> Bool) -> [RealSrcSpan] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (RealSrcSpan -> RealSrcSpan -> RealSrcSpan -> Bool
forall {a}. Ord a => a -> a -> a -> Bool
betweenSpans RealSrcSpan
tokenRealSpan RealSrcSpan
bodyRealSpan) [RealSrcSpan]
commentSpans
placement :: Placement
placement = if Bool
hasComments then Placement
Normal else body -> Placement
placer body
body
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
tokenSpan, SrcSpan
bodySpan] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
Placement -> R () -> R ()
placeHanging Placement
placement (LocatedA body -> (body -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
bodyLoc body -> R ()
render)
p_let ::
(body -> R ()) ->
HsLocalBinds GhcPs ->
LocatedA body ->
R ()
p_let :: forall body.
(body -> R ()) -> HsLocalBinds GhcPs -> LocatedA body -> R ()
p_let body -> R ()
render HsLocalBinds GhcPs
localBinds LocatedA body
e = R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"let"
R ()
space
R () -> R ()
dontUseBraces (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> R ()
sitcc (HsLocalBinds GhcPs -> R ()
p_hsLocalBinds HsLocalBinds GhcPs
localBinds)
R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout R ()
space (R ()
newline R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
" ")
Text -> R ()
txt Text
"in"
R ()
space
R () -> R ()
sitcc (LocatedA body -> (body -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
e body -> R ()
render)
p_pat :: Pat GhcPs -> R ()
p_pat :: Pat GhcPs -> R ()
p_pat = \case
WildPat XWildPat GhcPs
_ -> Text -> R ()
txt Text
"_"
VarPat XVarPat GhcPs
_ LIdP GhcPs
name -> LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
name
LazyPat XLazyPat GhcPs
_ LPat GhcPs
pat -> do
Text -> R ()
txt Text
"~"
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
AsPat XAsPat GhcPs
_ LIdP GhcPs
name LHsToken "@" GhcPs
_ LPat GhcPs
pat -> do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
name
Text -> R ()
txt Text
"@"
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
ParPat XParPat GhcPs
_ LHsToken "(" GhcPs
_ LPat GhcPs
pat LHsToken ")" GhcPs
_ ->
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat (BracketStyle -> R () -> R ()
parens BracketStyle
S (R () -> R ()) -> (Pat GhcPs -> R ()) -> Pat GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat GhcPs -> R ()
p_pat)
BangPat XBangPat GhcPs
_ LPat GhcPs
pat -> do
Text -> R ()
txt Text
"!"
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
ListPat XListPat GhcPs
_ [LPat GhcPs]
pats ->
BracketStyle -> R () -> R ()
brackets BracketStyle
S (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
pats Boxity
boxing -> do
let parens' :: R () -> R ()
parens' =
case Boxity
boxing of
Boxity
Boxed -> BracketStyle -> R () -> R ()
parens BracketStyle
S
Boxity
Unboxed -> BracketStyle -> R () -> R ()
parensHash BracketStyle
S
R () -> R ()
parens' (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> GenLocated SrcSpanAnnA (Pat GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
SumPat XSumPat GhcPs
_ LPat GhcPs
pat ConTag
tag ConTag
arity ->
BracketStyle -> ConTag -> ConTag -> R () -> R ()
p_unboxedSum BracketStyle
S ConTag
tag ConTag
arity (GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat)
ConPat XConPat GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
pat HsConPatDetails GhcPs
details ->
case HsConPatDetails GhcPs
details of
PrefixCon [HsConPatTyArg (NoGhcTc GhcPs)]
tys [LPat GhcPs]
xs -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
pat
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([HsConPatTyArg GhcPs] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsConPatTyArg (NoGhcTc GhcPs)]
[HsConPatTyArg GhcPs]
tys Bool -> Bool -> Bool
&& [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
xs) R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R ()
-> (Either
(HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
-> R ())
-> [Either
(HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc (R () -> R ())
-> (Either
(HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
-> R ())
-> Either
(HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsConPatTyArg GhcPs -> R ())
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> Either
(HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
-> R ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsConPatTyArg GhcPs -> R ()
p_hsConPatTyArg ((Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat)) ([Either
(HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))]
-> R ())
-> [Either
(HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))]
-> R ()
forall a b. (a -> b) -> a -> b
$
(HsConPatTyArg GhcPs
-> Either
(HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a b. a -> Either a b
Left (HsConPatTyArg GhcPs
-> Either
(HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> [HsConPatTyArg GhcPs]
-> [Either
(HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HsConPatTyArg (NoGhcTc GhcPs)]
[HsConPatTyArg GhcPs]
tys) [Either (HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))]
-> [Either
(HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))]
-> [Either
(HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))]
forall a. Semigroup a => a -> a -> a
<> (GenLocated SrcSpanAnnA (Pat GhcPs)
-> Either
(HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a b. b -> Either a b
Right (GenLocated SrcSpanAnnA (Pat GhcPs)
-> Either
(HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> [Either
(HsConPatTyArg GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
xs)
RecCon (HsRecFields [LHsRecField GhcPs (LPat GhcPs)]
fields Maybe (XRec GhcPs RecFieldsDotDot)
dotdot) -> do
LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
pat
R ()
breakpoint
let f :: Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
-> R ()
f = \case
Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
Nothing -> Text -> R ()
txt Text
".."
Just GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
x -> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
-> (HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))
-> R ())
-> R ()
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 ()
HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))
-> R ()
p_pat_hsFieldBind
R () -> R ()
inci (R () -> R ())
-> ([Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ())
-> [Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ())
-> ([Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ())
-> [Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R ()
-> (Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
-> R ())
-> [Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ()
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 ([Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ())
-> [Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ()
forall a b. (a -> b) -> a -> b
$
case Maybe (XRec GhcPs RecFieldsDotDot)
dotdot of
Maybe (XRec GhcPs RecFieldsDotDot)
Nothing -> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
forall a. a -> Maybe a
Just (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> [Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (LPat GhcPs)]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
fields
Just (L SrcSpan
_ (RecFieldsDotDot ConTag
n)) -> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
forall a. a -> Maybe a
Just (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> [Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConTag
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
forall a. ConTag -> [a] -> [a]
take ConTag
n [LHsRecField GhcPs (LPat GhcPs)]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs)))]
fields) [Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> [Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> [Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))]
forall a. [a] -> [a] -> [a]
++ [Maybe
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
(GenLocated SrcSpanAnnA (Pat GhcPs))))
forall a. Maybe a
Nothing]
InfixCon LPat GhcPs
l LPat GhcPs
r -> do
[SrcSpan] -> R () -> R ()
switchLayout [GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
l, GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
r] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
l Pat GhcPs -> R ()
p_pat
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
pat
R ()
space
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
r Pat GhcPs -> R ()
p_pat
ViewPat XViewPat GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr LPat GhcPs
pat -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
Text -> R ()
txt Text
"->"
R ()
breakpoint
R () -> R ()
inci (GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat)
SplicePat XSplicePat GhcPs
_ HsUntypedSplice GhcPs
splice -> SpliceDecoration -> HsUntypedSplice GhcPs -> R ()
p_hsUntypedSplice SpliceDecoration
DollarSplice HsUntypedSplice GhcPs
splice
LitPat XLitPat GhcPs
_ HsLit GhcPs
p -> HsLit GhcPs -> R ()
forall a. Outputable a => a -> R ()
atom HsLit GhcPs
p
NPat XNPat GhcPs
_ XRec GhcPs (HsOverLit GhcPs)
v (Maybe NoExtField -> Bool
Maybe (SyntaxExpr GhcPs) -> Bool
forall a. Maybe a -> Bool
isJust -> Bool
isNegated) SyntaxExpr GhcPs
_ -> do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isNegated (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"-"
Bool
negativeLiterals <- Extension -> R Bool
isExtensionEnabled Extension
NegativeLiterals
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
negativeLiterals R ()
space
GenLocated (SrcAnn NoEpAnns) (HsOverLit GhcPs)
-> (HsOverLit GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsOverLit GhcPs)
GenLocated (SrcAnn NoEpAnns) (HsOverLit GhcPs)
v (OverLitVal -> R ()
forall a. Outputable a => a -> R ()
atom (OverLitVal -> R ())
-> (HsOverLit GhcPs -> OverLitVal) -> HsOverLit GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val)
NPlusKPat XNPlusKPat GhcPs
_ LIdP GhcPs
n XRec GhcPs (HsOverLit GhcPs)
k HsOverLit GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
n
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"+"
R ()
space
GenLocated (SrcAnn NoEpAnns) (HsOverLit GhcPs)
-> (HsOverLit GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsOverLit GhcPs)
GenLocated (SrcAnn NoEpAnns) (HsOverLit GhcPs)
k (OverLitVal -> R ()
forall a. Outputable a => a -> R ()
atom (OverLitVal -> R ())
-> (HsOverLit GhcPs -> OverLitVal) -> HsOverLit GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val)
SigPat XSigPat GhcPs
_ LPat GhcPs
pat HsPS {XHsPS (NoGhcTc GhcPs)
LHsType (NoGhcTc GhcPs)
hsps_ext :: XHsPS (NoGhcTc GhcPs)
hsps_body :: LHsType (NoGhcTc GhcPs)
hsps_ext :: forall pass. HsPatSigType pass -> XHsPS pass
hsps_body :: forall pass. HsPatSigType pass -> LHsType pass
..} -> do
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
LHsSigType GhcPs -> R ()
p_typeAscription (LHsType GhcPs -> LHsSigType GhcPs
lhsTypeToSigType LHsType (NoGhcTc GhcPs)
LHsType 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
"@" R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty HsType GhcPs -> R ()
p_hsType
p_hsConPatTyArg :: HsConPatTyArg GhcPs -> R ()
p_hsConPatTyArg :: HsConPatTyArg GhcPs -> R ()
p_hsConPatTyArg (HsConPatTyArg 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
XHsFieldBind (LFieldOcc GhcPs)
LPat GhcPs
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
hfbAnn :: XHsFieldBind (LFieldOcc GhcPs)
hfbLHS :: LFieldOcc GhcPs
hfbRHS :: LPat GhcPs
hfbPun :: Bool
..} = do
GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
-> (FieldOcc GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LFieldOcc GhcPs
GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
hfbLHS FieldOcc GhcPs -> R ()
p_fieldOcc
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hfbPun (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
space
R ()
equals
R ()
breakpoint
R () -> R ()
inci (GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
hfbRHS Pat GhcPs -> R ()
p_pat)
p_unboxedSum :: BracketStyle -> ConTag -> Arity -> R () -> R ()
p_unboxedSum :: BracketStyle -> ConTag -> ConTag -> R () -> R ()
p_unboxedSum BracketStyle
s ConTag
tag ConTag
arity R ()
m = do
let before :: ConTag
before = ConTag
tag ConTag -> ConTag -> ConTag
forall a. Num a => a -> a -> a
- ConTag
1
after :: ConTag
after = ConTag
arity ConTag -> ConTag -> ConTag
forall a. Num a => a -> a -> a
- ConTag
before ConTag -> ConTag -> ConTag
forall a. Num a => a -> a -> a
- ConTag
1
args :: [Maybe (R ())]
args = ConTag -> Maybe (R ()) -> [Maybe (R ())]
forall a. ConTag -> a -> [a]
replicate ConTag
before Maybe (R ())
forall a. Maybe a
Nothing [Maybe (R ())] -> [Maybe (R ())] -> [Maybe (R ())]
forall a. Semigroup a => a -> a -> a
<> [R () -> Maybe (R ())
forall a. a -> Maybe a
Just R ()
m] [Maybe (R ())] -> [Maybe (R ())] -> [Maybe (R ())]
forall a. Semigroup a => a -> a -> a
<> ConTag -> Maybe (R ()) -> [Maybe (R ())]
forall a. ConTag -> a -> [a]
replicate ConTag
after Maybe (R ())
forall a. Maybe a
Nothing
f :: Maybe (R ()) -> R ()
f Maybe (R ())
x =
case Maybe (R ())
x :: Maybe (R ()) of
Maybe (R ())
Nothing ->
R ()
space
Just R ()
m' -> do
R ()
space
R ()
m'
R ()
space
BracketStyle -> R () -> R ()
parensHash BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (Maybe (R ()) -> R ()) -> [Maybe (R ())] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt Text
"|") Maybe (R ()) -> R ()
f [Maybe (R ())]
args
p_hsUntypedSplice :: SpliceDecoration -> HsUntypedSplice GhcPs -> R ()
p_hsUntypedSplice :: SpliceDecoration -> HsUntypedSplice GhcPs -> R ()
p_hsUntypedSplice SpliceDecoration
deco = \case
HsUntypedSpliceExpr XUntypedSpliceExpr GhcPs
_ XRec GhcPs (HsExpr GhcPs)
expr -> Bool -> XRec GhcPs (HsExpr GhcPs) -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
False XRec GhcPs (HsExpr GhcPs)
expr SpliceDecoration
deco
HsQuasiQuote XQuasiQuote GhcPs
_ IdP GhcPs
quoterName XRec GhcPs FastString
str -> do
Text -> R ()
txt Text
"["
LocatedN RdrName -> R ()
p_rdrName (RdrName -> LocatedN RdrName
forall a an. a -> LocatedAn an a
noLocA IdP GhcPs
RdrName
quoterName)
Text -> R ()
txt Text
"|"
GenLocated (SrcAnn NoEpAnns) FastString -> R ()
forall a. Outputable a => a -> R ()
atom XRec GhcPs FastString
GenLocated (SrcAnn NoEpAnns) 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
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr (R () -> R ()
sitcc (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
SpliceDecoration
BareSplice ->
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr (R () -> R ()
sitcc (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
where
decoSymbol :: Text
decoSymbol = if Bool
isTyped then Text
"$$" else Text
"$"
p_hsQuote :: 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
| (Maybe EpaLocation -> Bool) -> [Maybe EpaLocation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Maybe EpaLocation -> Bool
forall a. Maybe a -> Bool
isJust (AnnKeywordId -> AddEpAnn -> Maybe EpaLocation
matchAddEpAnn AnnKeywordId
AnnOpenEQ (AddEpAnn -> Maybe EpaLocation)
-> [AddEpAnn] -> [Maybe EpaLocation]
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 (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr)
PatBr XPatBr GhcPs
_ LPat GhcPs
pat -> GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat (Text -> R () -> R ()
quote Text
"p" (R () -> R ()) -> (Pat GhcPs -> R ()) -> Pat GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat GhcPs -> R ()
p_pat)
DecBrL XDecBrL GhcPs
_ [LHsDecl GhcPs]
decls -> Text -> R () -> R ()
quote Text
"d" ([GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> R () -> R ()
forall a. Data a => a -> R () -> R ()
handleStarIsType [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls (FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDecls FamilyStyle
Free [LHsDecl GhcPs]
decls))
DecBrG XDecBrG GhcPs
_ HsGroup GhcPs
_ -> String -> R ()
forall a. String -> a
notImplemented String
"DecBrG"
TypBr XTypBr GhcPs
_ LHsType GhcPs
ty -> Text -> R () -> R ()
quote Text
"t" (GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty (GenLocated SrcSpanAnnA (HsType GhcPs) -> R () -> R ()
forall a. Data a => a -> R () -> R ()
handleStarIsType LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty (R () -> R ()) -> (HsType GhcPs -> R ()) -> HsType GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType GhcPs -> R ()
p_hsType))
VarBr XVarBr GhcPs
_ Bool
isSingleQuote LIdP GhcPs
name -> do
Text -> R ()
txt (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"''" Text
"'" Bool
isSingleQuote)
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
name
where
quote :: Text -> R () -> R ()
quote :: Text -> R () -> R ()
quote Text
name R ()
body = do
Text -> R ()
txt Text
"["
Text -> R ()
txt Text
name
Text -> R ()
txt Text
"|"
R ()
breakpoint'
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R () -> R ()
dontUseBraces R ()
body
R ()
breakpoint'
Text -> R ()
txt Text
"|]"
handleStarIsType :: (Data a) => a -> R () -> R ()
handleStarIsType :: forall a. Data a => a -> R () -> R ()
handleStarIsType a
a R ()
p
| a -> Bool
containsHsStarTy a
a = R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> R ()
p R () -> R () -> R ()
forall a b. R a -> R b -> R a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* R ()
space
| Bool
otherwise = R ()
p
where
containsHsStarTy :: a -> Bool
containsHsStarTy = (Bool -> Bool -> Bool) -> GenericQ Bool -> GenericQ Bool
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything Bool -> Bool -> Bool
(||) (GenericQ Bool -> GenericQ Bool) -> GenericQ Bool -> GenericQ Bool
forall a b. (a -> b) -> a -> b
$ \a
b -> case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast @_ @(HsType GhcPs) a
b of
Just HsStarTy {} -> Bool
True
Maybe (HsType GhcPs)
_ -> Bool
False
p_stringLit :: FastString -> R ()
p_stringLit :: FastString -> R ()
p_stringLit FastString
src =
let s :: [String]
s = String -> [String]
splitGaps (FastString -> String
unpackFS FastString
src)
singleLine :: R ()
singleLine =
Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack ([String] -> String
forall a. Monoid a => [a] -> a
mconcat [String]
s)
multiLine :: R ()
multiLine =
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (String -> R ()) -> [String] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (Text -> R ()
txt (Text -> R ()) -> (String -> Text) -> String -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) ([String] -> [String]
backslashes [String]
s)
in R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout R ()
singleLine R ()
multiLine
where
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 ((Maybe Char, Char, Maybe Char) -> Bool)
-> [(Maybe Char, Char, Maybe Char)]
-> ([(Maybe Char, Char, Maybe Char)],
[(Maybe Char, Char, Maybe Char)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Maybe Char, Char, Maybe Char) -> Bool
p (String -> [(Maybe Char, Char, Maybe Char)]
forall a. [a] -> [(Maybe a, a, Maybe a)]
zipPrevNext String
s) of
([(Maybe Char, Char, Maybe Char)]
l, [(Maybe Char, Char, Maybe Char)]
r) ->
let
r' :: String
r' = ConTag -> String -> String
forall a. ConTag -> [a] -> [a]
drop ConTag
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
ghcSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConTag -> String -> String
forall a. ConTag -> [a] -> [a]
drop ConTag
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ((Maybe Char, Char, Maybe Char) -> Char)
-> [(Maybe Char, Char, Maybe Char)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Char, Char, Maybe Char) -> Char
forall {a} {b} {c}. (a, b, c) -> b
orig [(Maybe Char, Char, Maybe Char)]
r
in ((Maybe Char, Char, Maybe Char) -> Char)
-> [(Maybe Char, Char, Maybe Char)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Char, Char, Maybe Char) -> Char
forall {a} {b} {c}. (a, b, c) -> b
orig [(Maybe Char, Char, Maybe Char)]
l String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
splitGaps String
r'
ghcSpace :: Char -> Bool
ghcSpace :: Char -> Bool
ghcSpace Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x7f' Bool -> Bool -> Bool
&& Char -> Bool
is_space Char
c
backslashes :: [String] -> [String]
backslashes :: [String] -> [String]
backslashes (String
x : String
y : [String]
xs) = (String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\\") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
backslashes ((Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: String
y) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs)
backslashes [String]
xs = [String]
xs
zipPrevNext :: [a] -> [(Maybe a, a, Maybe a)]
zipPrevNext :: forall a. [a] -> [(Maybe a, a, Maybe a)]
zipPrevNext [a]
xs =
[Maybe a] -> [a] -> [Maybe a] -> [(Maybe a, a, Maybe a)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 (Maybe a
forall a. Maybe a
Nothing Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: (a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just [a]
xs) [a]
xs ((a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just (ConTag -> [a] -> [a]
forall a. ConTag -> [a] -> [a]
drop ConTag
1 [a]
xs) [Maybe a] -> [Maybe a] -> [Maybe a]
forall a. [a] -> [a] -> [a]
++ [Maybe a
forall a. Maybe a
Nothing])
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 -> R () -> R ()
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 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys
liftAppend (a
x : [a]
xs) [] = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
liftAppend (a
x : [a]
xs) (a
y : [a]
ys) = a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend [a]
xs [a]
ys
getGRHSSpan :: GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan :: forall body. GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan (GRHS XCGRHS GhcPs (LocatedA body)
_ [GuardLStmt GhcPs]
guards LocatedA body
body) =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ LocatedA body -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedA body
body SrcSpan -> [SrcSpan] -> NonEmpty SrcSpan
forall a. a -> [a] -> NonEmpty a
:| (GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan)
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA [GuardLStmt GhcPs]
[GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan)
-> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> NonEmpty SrcSpan
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
x GenLocated SrcSpanAnnA (Pat GhcPs)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. a -> [a] -> NonEmpty a
:| [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
xs)) ->
Placement
Hanging
MatchGroup GhcPs (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 ((RdrName -> String) -> Maybe RdrName -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> String
getOpNameStr (Maybe RdrName -> Maybe String)
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Maybe RdrName)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> Maybe RdrName
getOpName (HsExpr GhcPs -> Maybe RdrName)
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc) XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op of
Just String
"$" -> HsExpr GhcPs -> Placement
exprPlacement (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y)
Maybe String
_ -> Placement
Normal
HsApp XApp GhcPs
_ XRec GhcPs (HsExpr GhcPs)
_ XRec GhcPs (HsExpr GhcPs)
y -> HsExpr GhcPs -> Placement
exprPlacement (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y)
HsProc XProc GhcPs
_ LPat GhcPs
p LHsCmdTop GhcPs
_ ->
if SrcSpan -> Bool
isOneLineSpan (GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p)
then Placement
Hanging
else Placement
Normal
HsExpr GhcPs
_ -> Placement
Normal
withGuards :: [LGRHS GhcPs body] -> Bool
withGuards :: forall body. [LGRHS GhcPs body] -> Bool
withGuards = (GenLocated (Anno (GRHS GhcPs body)) (GRHS GhcPs body) -> Bool)
-> [GenLocated (Anno (GRHS GhcPs body)) (GRHS GhcPs body)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GRHS GhcPs body -> Bool
forall {p} {body}. GRHS p body -> Bool
checkOne (GRHS GhcPs body -> Bool)
-> (GenLocated (Anno (GRHS GhcPs body)) (GRHS GhcPs body)
-> GRHS GhcPs body)
-> GenLocated (Anno (GRHS GhcPs body)) (GRHS GhcPs body)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (Anno (GRHS GhcPs body)) (GRHS GhcPs body)
-> GRHS GhcPs body
forall l e. GenLocated l e -> e
unLoc)
where
checkOne :: GRHS p body -> Bool
checkOne (GRHS XCGRHS p body
_ [] body
_) = Bool
False
checkOne GRHS p body
_ = Bool
True