{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Ormolu.Printer.Meat.Declaration.Value
( p_valDecl,
p_pat,
p_hsExpr,
p_hsSplice,
p_stringLit,
)
where
import Control.Monad
import Data.Bool (bool)
import Data.Coerce (coerce)
import Data.Data hiding (Infix, Prefix)
import Data.Function (on)
import Data.Functor ((<&>))
import Data.Generics.Schemes (everything)
import Data.List (intersperse, sortBy)
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Void
import GHC.Data.Bag (bagToList)
import GHC.Data.FastString (FastString, lengthFS)
import GHC.Hs
import GHC.LanguageExtensions.Type (Extension (NegativeLiterals))
import GHC.Parser.CharClass (is_space)
import GHC.Types.Basic
import GHC.Types.Fixity
import GHC.Types.Name.Occurrence (occNameString)
import GHC.Types.Name.Reader
import GHC.Types.SourceText
import GHC.Types.SrcLoc
import Ormolu.Config
import Ormolu.Printer.Combinators
import Ormolu.Printer.Internal (inciBy, sitccIfTrailing)
import Ormolu.Printer.Meat.Common
import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration
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
data Placement
=
Normal
|
Hanging
deriving (Placement -> Placement -> Bool
(Placement -> Placement -> Bool)
-> (Placement -> Placement -> Bool) -> Eq Placement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Placement -> Placement -> Bool
$c/= :: Placement -> Placement -> Bool
== :: Placement -> Placement -> Bool
$c== :: Placement -> Placement -> Bool
Eq, Int -> Placement -> ShowS
[Placement] -> ShowS
Placement -> String
(Int -> Placement -> ShowS)
-> (Placement -> String)
-> ([Placement] -> ShowS)
-> Show Placement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Placement] -> ShowS
$cshowList :: [Placement] -> ShowS
show :: Placement -> String
$cshow :: Placement -> String
showsPrec :: Int -> Placement -> ShowS
$cshowsPrec :: Int -> Placement -> ShowS
Show)
p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
p_valDecl = \case
FunBind XFunBind GhcPs GhcPs
_ LIdP GhcPs
funId MatchGroup GhcPs (LHsExpr GhcPs)
funMatches [CoreTickish]
_ -> LocatedN RdrName -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_funBind LIdP GhcPs
LocatedN RdrName
funId MatchGroup GhcPs (LHsExpr GhcPs)
funMatches
PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
pat GRHSs GhcPs (LHsExpr GhcPs)
grhss ([CoreTickish], [[CoreTickish]])
_ -> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LHsExpr GhcPs)
-> R ()
p_match MatchGroupStyle
PatternBind Bool
False SrcStrictness
NoSrcStrict [LPat GhcPs
pat] GRHSs GhcPs (LHsExpr GhcPs)
grhss
VarBind {} -> String -> R ()
forall a. String -> a
notImplemented String
"VarBinds"
AbsBinds {} -> String -> R ()
forall a. String -> a
notImplemented String
"AbsBinds"
PatSynBind XPatSynBind GhcPs GhcPs
_ PatSynBind GhcPs GhcPs
psb -> PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PatSynBind GhcPs GhcPs
psb
p_funBind ::
LocatedN RdrName ->
MatchGroup GhcPs (LHsExpr GhcPs) ->
R ()
p_funBind :: LocatedN RdrName -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_funBind LocatedN RdrName
name = MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup (LocatedN RdrName -> MatchGroupStyle
Function LocatedN RdrName
name)
p_matchGroup ::
MatchGroupStyle ->
MatchGroup GhcPs (LHsExpr GhcPs) ->
R ()
p_matchGroup :: MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup = (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA (HsExpr GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_matchGroup' ::
( Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
) =>
(body -> Placement) ->
(body -> R ()) ->
MatchGroupStyle ->
MatchGroup GhcPs (LocatedA body) ->
R ()
p_matchGroup' :: (body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
style mg :: MatchGroup GhcPs (LocatedA body)
mg@MG {XRec GhcPs [LMatch GhcPs (LocatedA body)]
XMG GhcPs (LocatedA body)
Origin
mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_origin :: forall p body. MatchGroup p body -> Origin
mg_origin :: Origin
mg_alts :: XRec GhcPs [LMatch GhcPs (LocatedA body)]
mg_ext :: XMG GhcPs (LocatedA body)
..} = do
let ob :: R () -> R ()
ob = case MatchGroupStyle
style of
MatchGroupStyle
Case -> R () -> R ()
bracesIfEmpty
MatchGroupStyle
LambdaCase -> R () -> R ()
bracesIfEmpty
MatchGroupStyle
_ -> R () -> R ()
dontUseBraces
where
bracesIfEmpty :: R () -> R ()
bracesIfEmpty = if MatchGroup GhcPs (LocatedA body) -> Bool
forall (p :: Pass) body. MatchGroup (GhcPass p) body -> Bool
isEmptyMatchGroup MatchGroup GhcPs (LocatedA body)
mg then R () -> R ()
useBraces else R () -> R ()
forall a. a -> a
id
R () -> R ()
ub <- (R () -> R ()) -> (R () -> R ()) -> Bool -> R () -> R ()
forall a. a -> a -> Bool -> a
bool R () -> R ()
dontUseBraces R () -> R ()
useBraces (Bool -> R () -> R ()) -> R Bool -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Bool
canUseBraces
R () -> R ()
ob (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body)) -> R ())
-> [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((Match GhcPs (LocatedA body) -> R ())
-> GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body)) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (R () -> R ()
ub (R () -> R ())
-> (Match GhcPs (LocatedA body) -> R ())
-> Match GhcPs (LocatedA body)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs (LocatedA body) -> R ()
p_Match)) (GenLocated
(Anno [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))])
[GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))]
-> [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))]
forall l e. GenLocated l e -> e
unLoc XRec GhcPs [LMatch GhcPs (LocatedA body)]
GenLocated
(Anno [GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))])
[GenLocated SrcSpanAnnA (Match GhcPs (LocatedA body))]
mg_alts)
where
p_Match :: Match GhcPs (LocatedA body) -> R ()
p_Match m :: Match GhcPs (LocatedA body)
m@Match {[LPat GhcPs]
HsMatchContext (NoGhcTc GhcPs)
GRHSs GhcPs (LocatedA body)
XCMatch GhcPs (LocatedA body)
m_ext :: forall p body. Match p body -> XCMatch p body
m_ctxt :: forall p body. Match p body -> HsMatchContext (NoGhcTc p)
m_pats :: forall p body. Match p body -> [LPat p]
m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss :: GRHSs GhcPs (LocatedA body)
m_pats :: [LPat GhcPs]
m_ctxt :: HsMatchContext (NoGhcTc GhcPs)
m_ext :: XCMatch GhcPs (LocatedA body)
..} =
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
p_match'
body -> Placement
placer
body -> R ()
render
(Match GhcPs (LocatedA body) -> MatchGroupStyle -> MatchGroupStyle
forall body. Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle Match GhcPs (LocatedA body)
m MatchGroupStyle
style)
(Match GhcPs (LocatedA body) -> Bool
forall id body. Match id body -> Bool
isInfixMatch Match GhcPs (LocatedA body)
m)
(Match GhcPs (LocatedA body) -> SrcStrictness
forall id body. Match id body -> SrcStrictness
matchStrictness Match GhcPs (LocatedA body)
m)
[LPat GhcPs]
m_pats
GRHSs GhcPs (LocatedA body)
m_grhss
adjustMatchGroupStyle ::
Match GhcPs body ->
MatchGroupStyle ->
MatchGroupStyle
adjustMatchGroupStyle :: Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle Match GhcPs body
m = \case
Function LocatedN RdrName
_ -> (LocatedN RdrName -> MatchGroupStyle
Function (LocatedN RdrName -> MatchGroupStyle)
-> (Match GhcPs body -> LocatedN RdrName)
-> Match GhcPs body
-> MatchGroupStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsMatchContext GhcPs -> LocatedN RdrName
forall p. HsMatchContext p -> LIdP p
mc_fun (HsMatchContext GhcPs -> LocatedN RdrName)
-> (Match GhcPs body -> HsMatchContext GhcPs)
-> Match GhcPs body
-> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs body -> HsMatchContext GhcPs
forall p body. Match p body -> HsMatchContext (NoGhcTc p)
m_ctxt) Match GhcPs body
m
MatchGroupStyle
style -> MatchGroupStyle
style
matchStrictness :: Match id body -> SrcStrictness
matchStrictness :: Match id body -> SrcStrictness
matchStrictness Match id body
match =
case Match id body -> HsMatchContext (NoGhcTc id)
forall p body. Match p body -> HsMatchContext (NoGhcTc p)
m_ctxt Match id body
match of
FunRhs {mc_strictness :: forall p. HsMatchContext p -> SrcStrictness
mc_strictness = SrcStrictness
s} -> SrcStrictness
s
HsMatchContext (NoGhcTc id)
_ -> SrcStrictness
NoSrcStrict
p_match ::
MatchGroupStyle ->
Bool ->
SrcStrictness ->
[LPat GhcPs] ->
GRHSs GhcPs (LHsExpr GhcPs) ->
R ()
p_match :: MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LHsExpr GhcPs)
-> R ()
p_match = (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA (HsExpr GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
p_match' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_match' ::
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan) =>
(body -> Placement) ->
(body -> R ()) ->
MatchGroupStyle ->
Bool ->
SrcStrictness ->
[LPat GhcPs] ->
GRHSs GhcPs (LocatedA body) ->
R ()
p_match' :: (body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LocatedA body)
-> R ()
p_match' body -> Placement
placer body -> R ()
render MatchGroupStyle
style Bool
isInfix SrcStrictness
strictness [LPat GhcPs]
m_pats GRHSs {[LGRHS GhcPs (LocatedA body)]
HsLocalBinds GhcPs
XCGRHSs GhcPs (LocatedA body)
grhssExt :: forall p body. GRHSs p body -> XCGRHSs p body
grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
grhssLocalBinds :: HsLocalBinds GhcPs
grhssGRHSs :: [LGRHS GhcPs (LocatedA body)]
grhssExt :: XCGRHSs GhcPs (LocatedA body)
..} = do
case SrcStrictness
strictness of
SrcStrictness
NoSrcStrict -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
SrcStrictness
SrcStrict -> Text -> R ()
txt Text
"!"
SrcStrictness
SrcLazy -> Text -> R ()
txt Text
"~"
Bool
indentBody <- case [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> Maybe (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats of
Maybe (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)))
Nothing ->
Bool
False Bool -> R () -> R Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ case MatchGroupStyle
style of
Function LocatedN RdrName
name -> LocatedN RdrName -> R ()
p_rdrName LocatedN RdrName
name
MatchGroupStyle
_ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
ne_pats -> do
let combinedSpans :: SrcSpan
combinedSpans = case MatchGroupStyle
style of
Function LocatedN RdrName
name -> SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedN RdrName
name) SrcSpan
patSpans
MatchGroupStyle
_ -> SrcSpan
patSpans
patSpans :: SrcSpan
patSpans = NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan)
-> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
ne_pats)
indentBody :: Bool
indentBody = Bool -> Bool
not (SrcSpan -> Bool
isOneLineSpan SrcSpan
combinedSpans)
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
combinedSpans] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
let stdCase :: R ()
stdCase = R ()
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats
case MatchGroupStyle
style of
Function LocatedN RdrName
name ->
Bool -> Bool -> R () -> [R ()] -> R ()
p_infixDefHelper
Bool
isInfix
Bool
indentBody
(LocatedN RdrName -> R ()
p_rdrName LocatedN RdrName
name)
((Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats)
MatchGroupStyle
PatternBind -> R ()
stdCase
MatchGroupStyle
Case -> R ()
stdCase
MatchGroupStyle
Lambda -> do
let needsSpace :: Bool
needsSpace = case GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a. NonEmpty a -> a
NE.head NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
ne_pats) of
LazyPat XLazyPat GhcPs
_ LPat GhcPs
_ -> Bool
True
BangPat XBangPat GhcPs
_ LPat GhcPs
_ -> Bool
True
SplicePat XSplicePat GhcPs
_ HsSplice GhcPs
_ -> Bool
True
Pat GhcPs
_ -> Bool
False
Text -> R ()
txt Text
"\\"
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsSpace R ()
space
R () -> R ()
sitcc R ()
stdCase
MatchGroupStyle
LambdaCase -> R ()
stdCase
Bool -> R Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
indentBody
let
endOfPats :: Maybe SrcSpan
endOfPats = case [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> Maybe (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats of
Maybe (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)))
Nothing -> case MatchGroupStyle
style of
Function LocatedN RdrName
name -> SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedN RdrName
name)
MatchGroupStyle
_ -> Maybe SrcSpan
forall a. Maybe a
Nothing
Just NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
pats -> (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (SrcSpan -> Maybe SrcSpan)
-> (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs)) -> SrcSpan)
-> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> Maybe SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan)
-> (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> GenLocated SrcSpanAnnA (Pat GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a. NonEmpty a -> a
NE.last) NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
pats
isCase :: MatchGroupStyle -> Bool
isCase = \case
MatchGroupStyle
Case -> Bool
True
MatchGroupStyle
LambdaCase -> Bool
True
MatchGroupStyle
_ -> Bool
False
hasGuards :: Bool
hasGuards = [LGRHS GhcPs (LocatedA body)] -> Bool
forall body. [LGRHS GhcPs body] -> Bool
withGuards [LGRHS GhcPs (LocatedA body)]
grhssGRHSs
grhssSpan :: SrcSpan
grhssSpan =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$
GRHS GhcPs (LocatedA body) -> SrcSpan
forall body. GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan (GRHS GhcPs (LocatedA body) -> SrcSpan)
-> (GenLocated SrcSpan (GRHS GhcPs (LocatedA body))
-> GRHS GhcPs (LocatedA body))
-> GenLocated SrcSpan (GRHS GhcPs (LocatedA body))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (GRHS GhcPs (LocatedA body))
-> GRHS GhcPs (LocatedA body)
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (GRHS GhcPs (LocatedA body)) -> SrcSpan)
-> NonEmpty (GenLocated SrcSpan (GRHS GhcPs (LocatedA body)))
-> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated SrcSpan (GRHS GhcPs (LocatedA body))]
-> NonEmpty (GenLocated SrcSpan (GRHS GhcPs (LocatedA body)))
forall a. [a] -> NonEmpty a
NE.fromList [LGRHS GhcPs (LocatedA body)]
[GenLocated SrcSpan (GRHS GhcPs (LocatedA body))]
grhssGRHSs
patGrhssSpan :: SrcSpan
patGrhssSpan =
SrcSpan -> (SrcSpan -> SrcSpan) -> Maybe SrcSpan -> SrcSpan
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
SrcSpan
grhssSpan
(SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
grhssSpan (SrcSpan -> SrcSpan) -> (SrcSpan -> SrcSpan) -> SrcSpan -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcLoc -> SrcSpan
srcLocSpan (SrcLoc -> SrcSpan) -> (SrcSpan -> SrcLoc) -> SrcSpan -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanEnd)
Maybe SrcSpan
endOfPats
placement :: Placement
placement =
case Maybe SrcSpan
endOfPats of
Just SrcSpan
spn
| (GenLocated SrcSpan (GRHS GhcPs (LocatedA body)) -> Bool)
-> [GenLocated SrcSpan (GRHS GhcPs (LocatedA body))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any GenLocated SrcSpan (GRHS GhcPs (LocatedA body)) -> Bool
forall body. Located (GRHS GhcPs body) -> Bool
guardNeedsLineBreak [LGRHS GhcPs (LocatedA body)]
[GenLocated SrcSpan (GRHS GhcPs (LocatedA body))]
grhssGRHSs
Bool -> Bool -> Bool
|| Bool -> Bool
not (SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn SrcSpan
grhssSpan) ->
Placement
Normal
Maybe SrcSpan
_ -> (body -> Placement) -> [LGRHS GhcPs (LocatedA body)] -> Placement
forall body.
(body -> Placement) -> [LGRHS GhcPs (LocatedA body)] -> Placement
blockPlacement body -> Placement
placer [LGRHS GhcPs (LocatedA body)]
grhssGRHSs
guardNeedsLineBreak :: Located (GRHS GhcPs body) -> Bool
guardNeedsLineBreak :: Located (GRHS GhcPs body) -> Bool
guardNeedsLineBreak (L SrcSpan
_ (GRHS XCGRHS GhcPs body
_ [GuardLStmt GhcPs]
guardLStmts body
_)) = case [GuardLStmt GhcPs]
guardLStmts of
[] -> Bool
False
[GuardLStmt GhcPs
g] -> Bool -> Bool
not (Bool -> Bool)
-> (GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> Bool)
-> GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Bool
isOneLineSpan (SrcSpan -> Bool)
-> (GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> SrcSpan)
-> GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> Bool)
-> GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> Bool
forall a b. (a -> b) -> a -> b
$ GuardLStmt GhcPs
GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
g
[GuardLStmt GhcPs]
_ -> Bool
True
p_body :: R ()
p_body = do
let groupStyle :: GroupStyle
groupStyle =
if MatchGroupStyle -> Bool
isCase MatchGroupStyle
style Bool -> Bool -> Bool
&& Bool
hasGuards
then GroupStyle
RightArrow
else GroupStyle
EqualSign
R ()
-> (GenLocated SrcSpan (GRHS GhcPs (LocatedA body)) -> R ())
-> [GenLocated SrcSpan (GRHS GhcPs (LocatedA body))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
R ()
breakpoint
((GRHS GhcPs (LocatedA body) -> R ())
-> GenLocated (SrcAnn Any) (GRHS GhcPs (LocatedA body)) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (Placement
-> (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA body)
-> R ()
forall body.
Placement
-> (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA body)
-> R ()
p_grhs' Placement
placement body -> Placement
placer body -> R ()
render GroupStyle
groupStyle) (GenLocated (SrcAnn Any) (GRHS GhcPs (LocatedA body)) -> R ())
-> (GenLocated SrcSpan (GRHS GhcPs (LocatedA body))
-> GenLocated (SrcAnn Any) (GRHS GhcPs (LocatedA body)))
-> GenLocated SrcSpan (GRHS GhcPs (LocatedA body))
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (GRHS GhcPs (LocatedA body))
-> GenLocated (SrcAnn Any) (GRHS GhcPs (LocatedA body))
forall e ann. Located e -> LocatedAn ann e
reLocA)
[LGRHS GhcPs (LocatedA body)]
[GenLocated SrcSpan (GRHS GhcPs (LocatedA body))]
grhssGRHSs
p_where :: R ()
p_where = do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HsLocalBinds GhcPs -> Bool
forall a b. HsLocalBindsLR a b -> Bool
eqEmptyLocalBinds HsLocalBinds GhcPs
grhssLocalBinds) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
Bool
indentWhere <- (forall (f :: * -> *). PrinterOpts f -> f Bool) -> R Bool
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f Bool
poIndentWheres
(R () -> R ()) -> (R () -> R ()) -> Bool -> R () -> R ()
forall a. a -> a -> Bool -> a
bool (Int -> R () -> R ()
inciByFrac (Int -> R () -> R ()) -> Int -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ -Int
2) R () -> R ()
forall a. a -> a
id Bool
indentWhere (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ Text -> R ()
txt Text
"where"
R ()
breakpoint
Bool -> R () -> R ()
inciIf Bool
indentWhere (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ HsLocalBinds GhcPs -> R ()
p_hsLocalBinds HsLocalBinds GhcPs
grhssLocalBinds
Bool -> R () -> R ()
inciIf Bool
indentBody (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpan (GRHS GhcPs (LocatedA body))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LGRHS GhcPs (LocatedA body)]
[GenLocated SrcSpan (GRHS GhcPs (LocatedA body))]
grhssGRHSs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
case MatchGroupStyle
style of
Function LocatedN RdrName
_ | Bool
hasGuards -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Function LocatedN RdrName
_ -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
equals
MatchGroupStyle
PatternBind -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
equals
MatchGroupStyle
s | MatchGroupStyle -> Bool
isCase MatchGroupStyle
s Bool -> Bool -> Bool
&& Bool
hasGuards -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MatchGroupStyle
_ -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"->"
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
patGrhssSpan] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body
R () -> R ()
inci R ()
p_where
p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
p_grhs = Placement
-> (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA (HsExpr GhcPs))
-> R ()
forall body.
Placement
-> (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA body)
-> R ()
p_grhs' Placement
Normal HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_grhs' ::
Placement ->
(body -> Placement) ->
(body -> R ()) ->
GroupStyle ->
GRHS GhcPs (LocatedA body) ->
R ()
p_grhs' :: Placement
-> (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (LocatedA body)
-> R ()
p_grhs' Placement
parentPlacement body -> Placement
placer body -> R ()
render GroupStyle
style (GRHS XCGRHS GhcPs (LocatedA body)
_ [GuardLStmt GhcPs]
guards LocatedA body
body) =
case [GuardLStmt GhcPs]
guards of
[] -> R ()
p_body
[GuardLStmt GhcPs]
xs -> do
Text -> R ()
txt Text
"|"
R ()
space
R () -> R ()
sitccIfTrailing (R ()
-> (GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> R ())
-> [GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> R ())
-> GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> R ())
-> GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Stmt GhcPs (LHsExpr GhcPs) -> R ()
StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> R ()
p_stmt) [GuardLStmt GhcPs]
[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
xs)
R ()
space
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ case GroupStyle
style of
GroupStyle
EqualSign -> R ()
equals
GroupStyle
RightArrow -> Text -> R ()
txt Text
"->"
Int
indent <- (forall (f :: * -> *). PrinterOpts f -> f Int) -> R Int
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f Int
poIndentation
Bool -> R () -> R ()
inciIf (Int
indent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2 Bool -> Bool -> Bool
&& Placement
parentPlacement Placement -> Placement -> Bool
forall a. Eq a => a -> a -> Bool
== Placement
Normal) (Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body)
where
placement :: Placement
placement =
case Maybe SrcSpan
endOfGuards of
Maybe SrcSpan
Nothing -> body -> Placement
placer (LocatedA body -> body
forall l e. GenLocated l e -> e
unLoc LocatedA body
body)
Just SrcSpan
spn ->
if SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn (LocatedA body -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedA body
body)
then body -> Placement
placer (LocatedA body -> body
forall l e. GenLocated l e -> e
unLoc LocatedA body
body)
else Placement
Normal
endOfGuards :: Maybe SrcSpan
endOfGuards =
case [GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> Maybe
(NonEmpty
(GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [GuardLStmt GhcPs]
[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
guards of
Maybe
(NonEmpty
(GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))))
Nothing -> Maybe SrcSpan
forall a. Maybe a
Nothing
Just NonEmpty
(GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
gs -> (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (SrcSpan -> Maybe SrcSpan)
-> (NonEmpty
(GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
-> SrcSpan)
-> NonEmpty
(GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
-> Maybe SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> SrcSpan)
-> (NonEmpty
(GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
-> NonEmpty
(GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty
(GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
-> GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
forall a. NonEmpty a -> a
NE.last) NonEmpty
(GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
gs
p_body :: R ()
p_body = LocatedA body -> (body -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
body body -> R ()
render
p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd = BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
N
p_hsCmd' :: BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' :: BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
s = \case
HsCmdArrApp XCmdArrApp GhcPs
_ LHsExpr GhcPs
body LHsExpr GhcPs
input HsArrAppType
arrType Bool
rightToLeft -> do
let (LocatedA (HsExpr GhcPs)
l, LocatedA (HsExpr GhcPs)
r) = if Bool
rightToLeft then (LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
body, LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
input) else (LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
input, LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
body)
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA (HsExpr GhcPs)
l HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
case (HsArrAppType
arrType, Bool
rightToLeft) of
(HsArrAppType
HsFirstOrderApp, Bool
True) -> Text -> R ()
txt Text
"-<"
(HsArrAppType
HsHigherOrderApp, Bool
True) -> Text -> R ()
txt Text
"-<<"
(HsArrAppType
HsFirstOrderApp, Bool
False) -> Text -> R ()
txt Text
">-"
(HsArrAppType
HsHigherOrderApp, Bool
False) -> Text -> R ()
txt Text
">>-"
Placement -> R () -> R ()
placeHanging (HsExpr GhcPs -> Placement
exprPlacement (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
input)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA (HsExpr GhcPs)
r HsExpr GhcPs -> R ()
p_hsExpr
HsCmdArrForm XCmdArrForm GhcPs
_ LHsExpr GhcPs
form LexicalFixity
Prefix Maybe Fixity
_ [LHsCmdTop GhcPs]
cmds -> BracketStyle -> R () -> R ()
banana BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
form HsExpr GhcPs -> R ()
p_hsExpr
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpan (HsCmdTop GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsCmdTop GhcPs]
[GenLocated SrcSpan (HsCmdTop GhcPs)]
cmds) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
R () -> R ()
inci ([R ()] -> R ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (R () -> [R ()] -> [R ()]
forall a. a -> [a] -> [a]
intersperse R ()
breakpoint ((HsCmdTop GhcPs -> R ())
-> GenLocated SrcSpan (HsCmdTop GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsCmdTop GhcPs -> R ()
p_hsCmdTop (GenLocated SrcSpan (HsCmdTop GhcPs) -> R ())
-> [GenLocated SrcSpan (HsCmdTop GhcPs)] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsCmdTop GhcPs]
[GenLocated SrcSpan (HsCmdTop GhcPs)]
cmds)))
HsCmdArrForm XCmdArrForm GhcPs
_ LHsExpr GhcPs
form LexicalFixity
Infix Maybe Fixity
_ [LHsCmdTop GhcPs
left, LHsCmdTop GhcPs
right] ->
let opTree :: OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
opTree = OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
-> LocatedA (HsExpr GhcPs)
-> OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
-> OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
cmdOpTree LHsCmdTop GhcPs
left) LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
form (LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
cmdOpTree LHsCmdTop GhcPs
right)
in OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs) -> R ()
p_cmdOpTree ((HsExpr GhcPs -> Maybe RdrName)
-> OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
-> OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
forall l l' op ty.
(HasSrcSpan l, HasSrcSpan l') =>
(op -> Maybe RdrName)
-> OpTree (GenLocated l ty) (GenLocated l' op)
-> OpTree (GenLocated l ty) (GenLocated l' op)
reassociateOpTree HsExpr GhcPs -> Maybe RdrName
getOpName OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
opTree)
HsCmdArrForm XCmdArrForm GhcPs
_ LHsExpr GhcPs
_ LexicalFixity
Infix Maybe Fixity
_ [LHsCmdTop GhcPs]
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsCmdArrForm"
HsCmdApp XCmdApp GhcPs
_ LHsCmd GhcPs
cmd LHsExpr GhcPs
expr -> do
GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> (HsCmd GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd (BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
s)
R ()
space
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
HsCmdLam XCmdLam GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
mgroup -> (HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd MatchGroupStyle
Lambda MatchGroup GhcPs (LHsCmd GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mgroup
HsCmdPar XCmdPar GhcPs
_ LHsCmd GhcPs
c -> BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> (HsCmd GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
c HsCmd GhcPs -> R ()
p_hsCmd
HsCmdCase XCmdCase GhcPs
_ LHsExpr GhcPs
e MatchGroup GhcPs (LHsCmd GhcPs)
mgroup ->
(HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_case HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd LHsExpr GhcPs
e MatchGroup GhcPs (LHsCmd GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mgroup
HsCmdLamCase XCmdLamCase GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
mgroup ->
(HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ()) -> MatchGroup GhcPs (LocatedA body) -> R ()
p_lamcase HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd MatchGroup GhcPs (LHsCmd GhcPs)
MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))
mgroup
HsCmdIf XCmdIf GhcPs
_ SyntaxExpr GhcPs
_ LHsExpr GhcPs
if' LHsCmd GhcPs
then' LHsCmd GhcPs
else' ->
(HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> LHsExpr GhcPs
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> R ()
forall body.
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> LocatedA body
-> LocatedA body
-> R ()
p_if HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd LHsExpr GhcPs
if' LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
then' LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
else'
HsCmdLet XCmdLet GhcPs
_ HsLocalBinds GhcPs
localBinds LHsCmd GhcPs
c ->
(HsCmd GhcPs -> R ())
-> HsLocalBinds GhcPs
-> GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> R ()
forall body.
(body -> R ()) -> HsLocalBinds GhcPs -> LocatedA body -> R ()
p_let HsCmd GhcPs -> R ()
p_hsCmd HsLocalBinds GhcPs
localBinds LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
c
HsCmdDo XCmdDo GhcPs
_ XRec GhcPs [CmdLStmt GhcPs]
es -> do
Text -> R ()
txt Text
"do"
(HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> LocatedL
[LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
-> R ()
forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ())
-> LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> R ()
p_stmts HsCmd GhcPs -> Placement
cmdPlacement (BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
S) XRec GhcPs [CmdLStmt GhcPs]
LocatedL
[LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs)))]
es
p_hsCmdTop :: HsCmdTop GhcPs -> R ()
p_hsCmdTop :: HsCmdTop GhcPs -> R ()
p_hsCmdTop (HsCmdTop XCmdTop GhcPs
_ LHsCmd GhcPs
cmd) = GenLocated SrcSpanAnnA (HsCmd GhcPs)
-> (HsCmd GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
GenLocated SrcSpanAnnA (HsCmd GhcPs)
cmd HsCmd GhcPs -> R ()
p_hsCmd
withSpacing ::
(a -> R ()) ->
LocatedAn ann a ->
R ()
withSpacing :: (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing a -> R ()
f LocatedAn ann a
l = LocatedAn ann a -> (a -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedAn ann a
l ((a -> R ()) -> R ()) -> (a -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
case LocatedAn ann a -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedAn ann a
l of
UnhelpfulSpan UnhelpfulSpanReason
_ -> a -> R ()
f a
x
RealSrcSpan RealSrcSpan
currentSpn Maybe BufSpan
_ -> do
R (Maybe SpanMark)
getSpanMark R (Maybe SpanMark) -> (Maybe SpanMark -> R ()) -> R ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (StatementSpan RealSrcSpan
lastSpn) ->
if RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
currentSpn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
lastSpn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
then R ()
newline
else () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe SpanMark
_ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
a -> R ()
f a
x
R (Maybe SpanMark)
getSpanMark R (Maybe SpanMark) -> (Maybe SpanMark -> R ()) -> R ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (HaddockSpan HaddockStyle
_ RealSrcSpan
_) -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (CommentSpan RealSrcSpan
_) -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe SpanMark
_ -> SpanMark -> R ()
setSpanMark (RealSrcSpan -> SpanMark
StatementSpan RealSrcSpan
currentSpn)
p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt = (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))
-> R ()
forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
p_stmt' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_stmt' ::
( Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL
) =>
(body -> Placement) ->
(body -> R ()) ->
Stmt GhcPs (LocatedA body) ->
R ()
p_stmt' :: (body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render = \case
LastStmt XLastStmt GhcPs GhcPs (LocatedA body)
_ LocatedA body
body Maybe Bool
_ SyntaxExpr GhcPs
_ -> LocatedA body -> (body -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
body body -> R ()
render
BindStmt XBindStmt GhcPs GhcPs (LocatedA body)
_ LPat GhcPs
p f :: LocatedA body
f@(LocatedA body -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA -> SrcSpan
l) -> do
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p Pat GhcPs -> R ()
p_pat
R ()
space
Text -> R ()
txt Text
"<-"
let loc :: SrcSpan
loc = GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p
placement :: Placement
placement
| SrcSpan -> Bool
isOneLineSpan (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (SrcSpan -> SrcLoc
srcSpanEnd SrcSpan
loc) (SrcSpan -> SrcLoc
srcSpanStart SrcSpan
l)) = body -> Placement
placer (LocatedA body -> body
forall l e. GenLocated l e -> e
unLoc LocatedA body
f)
| Bool
otherwise = Placement
Normal
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
loc, SrcSpan
l] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
Placement -> R () -> R ()
placeHanging Placement
placement (LocatedA body -> (body -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
f body -> R ()
render)
ApplicativeStmt {} -> String -> R ()
forall a. String -> a
notImplemented String
"ApplicativeStmt"
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 (LHsExpr GhcPs)
TransForm
HsExpr GhcPs
SyntaxExpr GhcPs
LHsExpr GhcPs
XTransStmt GhcPs GhcPs (LocatedA body)
trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
trS_fmap :: HsExpr GhcPs
trS_bind :: SyntaxExpr GhcPs
trS_ret :: SyntaxExpr GhcPs
trS_by :: Maybe (LHsExpr GhcPs)
trS_using :: LHsExpr GhcPs
trS_bndrs :: [(IdP GhcPs, IdP GhcPs)]
trS_stmts :: [GuardLStmt GhcPs]
trS_form :: TransForm
trS_ext :: XTransStmt GhcPs GhcPs (LocatedA body)
..} ->
case (TransForm
trS_form, Maybe (LHsExpr GhcPs)
Maybe (LocatedA (HsExpr GhcPs))
trS_by) of
(TransForm
ThenForm, Maybe (LocatedA (HsExpr GhcPs))
Nothing) -> do
Text -> R ()
txt Text
"then"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
trS_using HsExpr GhcPs -> R ()
p_hsExpr
(TransForm
ThenForm, Just LocatedA (HsExpr GhcPs)
e) -> do
Text -> R ()
txt Text
"then"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
trS_using HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt Text
"by"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
(TransForm
GroupForm, Maybe (LocatedA (HsExpr GhcPs))
Nothing) -> do
Text -> R ()
txt Text
"then group using"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
trS_using HsExpr GhcPs -> R ()
p_hsExpr
(TransForm
GroupForm, Just LocatedA (HsExpr GhcPs)
e) -> do
Text -> R ()
txt Text
"then group by"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt Text
"using"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
trS_using HsExpr GhcPs -> R ()
p_hsExpr
RecStmt {[IdP GhcPs]
SyntaxExpr GhcPs
XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA body)]
XRecStmt GhcPs GhcPs (LocatedA body)
recS_ext :: forall idL idR body. StmtLR idL idR body -> XRecStmt idL idR body
recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_bind_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_ret_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_mfix_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_mfix_fn :: SyntaxExpr GhcPs
recS_ret_fn :: SyntaxExpr GhcPs
recS_bind_fn :: SyntaxExpr GhcPs
recS_rec_ids :: [IdP GhcPs]
recS_later_ids :: [IdP GhcPs]
recS_stmts :: XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA body)]
recS_ext :: XRecStmt GhcPs GhcPs (LocatedA body)
..} -> do
Text -> R ()
txt Text
"rec"
R ()
space
R () -> R ()
sitcc (R () -> R ())
-> (([LocatedAn AnnListItem (Stmt GhcPs (LocatedA body))] -> R ())
-> R ())
-> ([LocatedAn AnnListItem (Stmt GhcPs (LocatedA body))] -> R ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
SrcSpanAnnL [LocatedAn AnnListItem (Stmt GhcPs (LocatedA body))]
-> ([LocatedAn AnnListItem (Stmt GhcPs (LocatedA body))] -> R ())
-> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs [LStmtLR GhcPs GhcPs (LocatedA body)]
GenLocated
SrcSpanAnnL [LocatedAn AnnListItem (Stmt GhcPs (LocatedA body))]
recS_stmts (([LocatedAn AnnListItem (Stmt GhcPs (LocatedA body))] -> R ())
-> R ())
-> ([LocatedAn AnnListItem (Stmt GhcPs (LocatedA body))] -> R ())
-> R ()
forall a b. (a -> b) -> a -> b
$ (LocatedAn AnnListItem (Stmt GhcPs (LocatedA body)) -> R ())
-> [LocatedAn AnnListItem (Stmt GhcPs (LocatedA body))] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((Stmt GhcPs (LocatedA body) -> R ())
-> LocatedAn AnnListItem (Stmt GhcPs (LocatedA body)) -> R ()
forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing ((body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render))
p_stmts ::
( Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL
) =>
(body -> Placement) ->
(body -> R ()) ->
LocatedL [LocatedA (Stmt GhcPs (LocatedA body))] ->
R ()
p_stmts :: (body -> Placement)
-> (body -> R ())
-> LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> R ()
p_stmts body -> Placement
placer body -> R ()
render LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
es = do
R ()
breakpoint
R () -> R ()
ub <- Layout -> R () -> R ()
layoutToBraces (Layout -> R () -> R ()) -> R Layout -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Layout
getLayout
R () -> R ()
inci (R () -> R ())
-> (([LocatedA (Stmt GhcPs (LocatedA body))] -> R ()) -> R ())
-> ([LocatedA (Stmt GhcPs (LocatedA body))] -> R ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> ([LocatedA (Stmt GhcPs (LocatedA body))] -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
es (([LocatedA (Stmt GhcPs (LocatedA body))] -> R ()) -> R ())
-> ([LocatedA (Stmt GhcPs (LocatedA body))] -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$
(LocatedA (Stmt GhcPs (LocatedA body)) -> R ())
-> [LocatedA (Stmt GhcPs (LocatedA body))] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi
(R () -> R ()
ub (R () -> R ())
-> (LocatedA (Stmt GhcPs (LocatedA body)) -> R ())
-> LocatedA (Stmt GhcPs (LocatedA body))
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt GhcPs (LocatedA body) -> R ())
-> LocatedA (Stmt GhcPs (LocatedA body)) -> R ()
forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing ((body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (LocatedA body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render))
gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]
gatherStmt :: GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt (L _ (ParStmt _ block _ _)) =
(ParStmtBlock GhcPs GhcPs
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]])
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [ParStmtBlock GhcPs GhcPs]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
forall a. Semigroup a => a -> a -> a
(<>) ([[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]])
-> (ParStmtBlock GhcPs GhcPs
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]])
-> ParStmtBlock GhcPs GhcPs
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]]
ParStmtBlock GhcPs GhcPs
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
gatherStmtBlock) [] [ParStmtBlock GhcPs GhcPs]
block
gatherStmt (L s stmt@TransStmt {..}) =
([[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]])
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend [] ((GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
gatherStmt (GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]])
-> [GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> [[[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuardLStmt GhcPs]
[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
trS_stmts) [[[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]]
-> [[[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]]
-> [[[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]]
forall a. Semigroup a => a -> a -> a
<> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[SrcSpanAnnA
-> StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
s StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))
stmt]])
gatherStmt GuardLStmt GhcPs
stmt = [[GuardLStmt GhcPs
stmt]]
gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[ExprLStmt GhcPs]]
gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]]
gatherStmtBlock (ParStmtBlock XParStmtBlock GhcPs GhcPs
_ [GuardLStmt GhcPs]
stmts [IdP GhcPs]
_ SyntaxExpr GhcPs
_) =
(GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]])
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend ([[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]])
-> (GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]])
-> GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
gatherStmt) [] [GuardLStmt GhcPs]
[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
stmts
p_hsLocalBinds :: HsLocalBinds GhcPs -> R ()
p_hsLocalBinds :: HsLocalBinds GhcPs -> R ()
p_hsLocalBinds = \case
HsValBinds XHsValBinds GhcPs GhcPs
epAnn (ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
bag [LSig GhcPs]
lsigs) -> EpAnn AnnList -> R () -> R ()
pseudoLocated XHsValBinds GhcPs GhcPs
EpAnn AnnList
epAnn (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R () -> R ()
br <- Layout -> R () -> R ()
layoutToBraces (Layout -> R () -> R ()) -> R Layout -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Layout
getLayout
let items :: [GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
items =
let injectLeft :: GenLocated l a -> GenLocated l (Either a b)
injectLeft (L l
l a
x) = l -> Either a b -> GenLocated l (Either a b)
forall l e. l -> e -> GenLocated l e
L l
l (a -> Either a b
forall a b. a -> Either a b
Left a
x)
injectRight :: GenLocated l b -> GenLocated l (Either a b)
injectRight (L l
l b
x) = l -> Either a b -> GenLocated l (Either a b)
forall l e. l -> e -> GenLocated l e
L l
l (b -> Either a b
forall a b. b -> Either a b
Right b
x)
in (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
forall l a b. GenLocated l a -> GenLocated l (Either a b)
injectLeft (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)
-> GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
-> [GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
bag) [GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall a. [a] -> [a] -> [a]
++ (GenLocated SrcSpanAnnA (Sig GhcPs)
-> GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
forall l b a. GenLocated l b -> GenLocated l (Either a b)
injectRight (GenLocated SrcSpanAnnA (Sig GhcPs)
-> GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
-> [GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
lsigs)
positionToBracing :: RelativePos -> R () -> R ()
positionToBracing = \case
RelativePos
SinglePos -> R () -> R ()
forall a. a -> a
id
RelativePos
FirstPos -> R () -> R ()
br
RelativePos
MiddlePos -> R () -> R ()
br
RelativePos
LastPos -> R () -> R ()
forall a. a -> a
id
p_item' :: (RelativePos,
GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> R ()
p_item' (RelativePos
p, GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
item) =
RelativePos -> R () -> R ()
positionToBracing RelativePos
p (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
(Either (HsBindLR GhcPs GhcPs) (Sig GhcPs) -> R ())
-> GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> R ()
forall a ann. (a -> R ()) -> LocatedAn ann a -> R ()
withSpacing ((HsBindLR GhcPs GhcPs -> R ())
-> (Sig GhcPs -> R ())
-> Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)
-> R ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsBindLR GhcPs GhcPs -> R ()
p_valDecl Sig GhcPs -> R ()
p_sigDecl) GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
item
binds :: [GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
binds = (GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> Ordering)
-> [GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> SrcSpan)
-> GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) [GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
items
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ ((RelativePos,
GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> R ())
-> [(RelativePos,
GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))]
-> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi (RelativePos,
GenLocated SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> R ()
p_item' ([GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [(RelativePos,
GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))]
forall a. [a] -> [(RelativePos, a)]
attachRelativePos [GenLocated
SrcSpanAnnA (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
binds)
HsValBinds XHsValBinds GhcPs GhcPs
_ HsValBindsLR GhcPs GhcPs
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsValBinds"
HsIPBinds XHsIPBinds GhcPs GhcPs
epAnn (IPBinds XIPBinds GhcPs
_ [LIPBind GhcPs]
xs) -> EpAnn AnnList -> R () -> R ()
pseudoLocated XHsIPBinds GhcPs GhcPs
EpAnn AnnList
epAnn (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
let p_ipBind :: IPBind GhcPs -> R ()
p_ipBind (IPBind XCIPBind GhcPs
_ (Left XRec GhcPs HsIPName
name) LHsExpr GhcPs
expr) = do
GenLocated SrcSpan HsIPName -> R ()
forall a. Outputable a => a -> R ()
atom XRec GhcPs HsIPName
GenLocated SrcSpan HsIPName
name
R ()
space
R ()
equals
R ()
breakpoint
R () -> R ()
useBraces (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
p_ipBind (IPBind XCIPBind GhcPs
_ (Right IdP GhcPs
_) LHsExpr GhcPs
_) =
String -> R ()
forall a. String -> a
notImplemented String
"IPBind _ (Right _) _"
(GenLocated SrcSpanAnnA (IPBind GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (IPBind GhcPs)] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((IPBind GhcPs -> R ())
-> GenLocated SrcSpanAnnA (IPBind GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' IPBind GhcPs -> R ()
p_ipBind) [LIPBind GhcPs]
[GenLocated SrcSpanAnnA (IPBind GhcPs)]
xs
EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
pseudoLocated :: EpAnn AnnList -> R () -> R ()
pseudoLocated = \case
EpAnn {anns :: forall ann. EpAnn ann -> ann
anns = AnnList {al_anchor :: AnnList -> Maybe Anchor
al_anchor = Just Anchor {RealSrcSpan
anchor :: Anchor -> RealSrcSpan
anchor :: RealSrcSpan
anchor}}} ->
GenLocated SrcSpan () -> (() -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (SrcSpan -> () -> GenLocated SrcSpan ()
forall l e. l -> e -> GenLocated l e
L (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
anchor Maybe BufSpan
forall a. Maybe a
Nothing) ()) ((() -> R ()) -> R ()) -> (R () -> () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> () -> R ()
forall a b. a -> b -> a
const
EpAnn AnnList
_ -> R () -> R ()
forall a. a -> a
id
p_lhsFieldLabel :: Located (HsFieldLabel GhcPs) -> R ()
p_lhsFieldLabel :: Located (HsFieldLabel GhcPs) -> R ()
p_lhsFieldLabel = (HsFieldLabel GhcPs -> R ())
-> Located (HsFieldLabel GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' ((HsFieldLabel GhcPs -> R ())
-> Located (HsFieldLabel GhcPs) -> R ())
-> (HsFieldLabel GhcPs -> R ())
-> Located (HsFieldLabel GhcPs)
-> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan FastString -> R ()
p_lFieldLabelString (GenLocated SrcSpan FastString -> R ())
-> (HsFieldLabel GhcPs -> GenLocated SrcSpan FastString)
-> HsFieldLabel GhcPs
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsFieldLabel GhcPs -> GenLocated SrcSpan FastString
forall p. HsFieldLabel p -> GenLocated SrcSpan FastString
hflLabel
where
p_lFieldLabelString :: GenLocated SrcSpan FastString -> R ()
p_lFieldLabelString (L SrcSpan
s FastString
fs) = R () -> R ()
parensIfOp (R () -> R ()) -> (FastString -> R ()) -> FastString -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Outputable FastString => FastString -> R ()
forall a. Outputable a => a -> R ()
atom @FastString (FastString -> R ()) -> FastString -> R ()
forall a b. (a -> b) -> a -> b
$ FastString
fs
where
parensIfOp :: R () -> R ()
parensIfOp
| SrcSpan -> Bool
isOneLineSpan SrcSpan
s,
Just RealSrcSpan
realS <- SrcSpan -> Maybe RealSrcSpan
srcSpanToRealSrcSpan SrcSpan
s,
let spanLength :: Int
spanLength = RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
realS Int -> Int -> Int
forall a. Num a => a -> a -> a
- RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
realS,
FastString -> Int
lengthFS FastString
fs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spanLength =
BracketStyle -> R () -> R ()
parens BracketStyle
N
| Bool
otherwise = R () -> R ()
forall a. a -> a
id
p_fieldLabels :: [Located (HsFieldLabel GhcPs)] -> R ()
p_fieldLabels :: [Located (HsFieldLabel GhcPs)] -> R ()
p_fieldLabels [Located (HsFieldLabel GhcPs)]
flss =
R ()
-> (Located (HsFieldLabel GhcPs) -> R ())
-> [Located (HsFieldLabel GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt Text
".") Located (HsFieldLabel GhcPs) -> R ()
p_lhsFieldLabel [Located (HsFieldLabel GhcPs)]
flss
p_hsRecField ::
(id -> R ()) ->
HsRecField' id (LHsExpr GhcPs) ->
R ()
p_hsRecField :: (id -> R ()) -> HsRecField' id (LHsExpr GhcPs) -> R ()
p_hsRecField id -> R ()
p_lbl HsRecField {Bool
LHsExpr GhcPs
XHsRecField id
Located id
hsRecFieldAnn :: forall id arg. HsRecField' id arg -> XHsRecField id
hsRecFieldLbl :: forall id arg. HsRecField' id arg -> Located id
hsRecFieldArg :: forall id arg. HsRecField' id arg -> arg
hsRecPun :: forall id arg. HsRecField' id arg -> Bool
hsRecPun :: Bool
hsRecFieldArg :: LHsExpr GhcPs
hsRecFieldLbl :: Located id
hsRecFieldAnn :: XHsRecField id
..} = do
Located id -> (id -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located Located id
hsRecFieldLbl id -> R ()
p_lbl
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hsRecPun (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
space
R ()
equals
let placement :: Placement
placement =
if SrcSpan -> SrcSpan -> Bool
onTheSameLine (Located id -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located id
hsRecFieldLbl) (LocatedA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
hsRecFieldArg)
then HsExpr GhcPs -> Placement
exprPlacement (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
hsRecFieldArg)
else Placement
Normal
Placement -> R () -> R ()
placeHanging Placement
placement (LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
hsRecFieldArg HsExpr GhcPs -> R ()
p_hsExpr)
p_hsExpr :: HsExpr GhcPs -> R ()
p_hsExpr :: HsExpr GhcPs -> R ()
p_hsExpr = BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
N
p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s = \case
HsVar XVar GhcPs
_ LIdP GhcPs
name -> LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
name
HsUnboundVar XUnboundVar GhcPs
_ OccName
occ -> OccName -> R ()
forall a. Outputable a => a -> R ()
atom OccName
occ
HsConLikeOut XConLikeOut GhcPs
_ ConLike
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsConLikeOut"
HsRecFld XRecFld GhcPs
_ AmbiguousFieldOcc GhcPs
x ->
case AmbiguousFieldOcc GhcPs
x of
Unambiguous XUnambiguous GhcPs
_ LocatedN RdrName
name -> LocatedN RdrName -> R ()
p_rdrName LocatedN RdrName
name
Ambiguous XAmbiguous GhcPs
_ LocatedN RdrName
name -> LocatedN RdrName -> R ()
p_rdrName LocatedN RdrName
name
HsOverLabel XOverLabel GhcPs
_ FastString
v -> do
Text -> R ()
txt Text
"#"
FastString -> R ()
forall a. Outputable a => a -> R ()
atom FastString
v
HsIPVar XIPVar GhcPs
_ (HsIPName FastString
name) -> do
Text -> R ()
txt Text
"?"
FastString -> R ()
forall a. Outputable a => a -> R ()
atom FastString
name
HsOverLit XOverLitE GhcPs
_ HsOverLit GhcPs
v -> OverLitVal -> R ()
forall a. Outputable a => a -> R ()
atom (HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit GhcPs
v)
HsLit XLitE GhcPs
_ HsLit GhcPs
lit ->
case HsLit GhcPs
lit of
HsString (SourceText stxt) FastString
_ -> String -> R ()
p_stringLit String
stxt
HsStringPrim (SourceText stxt) ByteString
_ -> String -> R ()
p_stringLit String
stxt
HsLit GhcPs
r -> HsLit GhcPs -> R ()
forall a. Outputable a => a -> R ()
atom HsLit GhcPs
r
HsLam XLam GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
mgroup ->
MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup MatchGroupStyle
Lambda MatchGroup GhcPs (LHsExpr GhcPs)
mgroup
HsLamCase XLamCase GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
mgroup ->
(HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> MatchGroup GhcPs (LocatedA (HsExpr GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ()) -> MatchGroup GhcPs (LocatedA body) -> R ()
p_lamcase HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr MatchGroup GhcPs (LHsExpr GhcPs)
MatchGroup GhcPs (LocatedA (HsExpr GhcPs))
mgroup
HsApp XApp GhcPs
_ LHsExpr GhcPs
f LHsExpr GhcPs
x -> do
let
gatherArgs :: GenLocated l (HsExpr p)
-> NonEmpty (GenLocated l (HsExpr p))
-> (GenLocated l (HsExpr p), NonEmpty (GenLocated l (HsExpr p)))
gatherArgs GenLocated l (HsExpr p)
f' NonEmpty (GenLocated l (HsExpr p))
knownArgs =
case GenLocated l (HsExpr p)
f' of
L l
_ (HsApp XApp p
_ LHsExpr p
l LHsExpr p
r) -> GenLocated l (HsExpr p)
-> NonEmpty (GenLocated l (HsExpr p))
-> (GenLocated l (HsExpr p), NonEmpty (GenLocated l (HsExpr p)))
gatherArgs LHsExpr p
GenLocated l (HsExpr p)
l (LHsExpr p
GenLocated l (HsExpr p)
r GenLocated l (HsExpr p)
-> NonEmpty (GenLocated l (HsExpr p))
-> NonEmpty (GenLocated l (HsExpr p))
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty (GenLocated l (HsExpr p))
knownArgs)
GenLocated l (HsExpr p)
_ -> (GenLocated l (HsExpr p)
f', NonEmpty (GenLocated l (HsExpr p))
knownArgs)
(LocatedA (HsExpr GhcPs)
func, NonEmpty (LocatedA (HsExpr GhcPs))
args) = LocatedA (HsExpr GhcPs)
-> NonEmpty (LocatedA (HsExpr GhcPs))
-> (LocatedA (HsExpr GhcPs), NonEmpty (LocatedA (HsExpr GhcPs)))
forall p l.
(LHsExpr p ~ GenLocated l (HsExpr p)) =>
GenLocated l (HsExpr p)
-> NonEmpty (GenLocated l (HsExpr p))
-> (GenLocated l (HsExpr p), NonEmpty (GenLocated l (HsExpr p)))
gatherArgs LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
f (LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
x LocatedA (HsExpr GhcPs)
-> [LocatedA (HsExpr GhcPs)] -> NonEmpty (LocatedA (HsExpr GhcPs))
forall a. a -> [a] -> NonEmpty a
:| [])
([LocatedA (HsExpr GhcPs)]
initp, LocatedA (HsExpr GhcPs)
lastp) = (NonEmpty (LocatedA (HsExpr GhcPs)) -> [LocatedA (HsExpr GhcPs)]
forall a. NonEmpty a -> [a]
NE.init NonEmpty (LocatedA (HsExpr GhcPs))
args, NonEmpty (LocatedA (HsExpr GhcPs)) -> LocatedA (HsExpr GhcPs)
forall a. NonEmpty a -> a
NE.last NonEmpty (LocatedA (HsExpr GhcPs))
args)
initSpan :: SrcSpan
initSpan =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$
LocatedA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
f SrcSpan -> [SrcSpan] -> NonEmpty SrcSpan
forall a. a -> [a] -> NonEmpty a
:| [(SrcLoc -> SrcSpan
srcLocSpan (SrcLoc -> SrcSpan)
-> (LocatedA (HsExpr GhcPs) -> SrcLoc)
-> LocatedA (HsExpr GhcPs)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc)
-> (LocatedA (HsExpr GhcPs) -> SrcSpan)
-> LocatedA (HsExpr GhcPs)
-> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) LocatedA (HsExpr GhcPs)
lastp]
placement :: Placement
placement =
if SrcSpan -> Bool
isOneLineSpan SrcSpan
initSpan
then HsExpr GhcPs -> Placement
exprPlacement (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LocatedA (HsExpr GhcPs)
lastp)
else Placement
Normal
case Placement
placement of
Placement
Normal -> do
let
indentArg :: R () -> R ()
indentArg
| SrcSpan -> Bool
isOneLineSpan (LocatedA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedA (HsExpr GhcPs)
func) = case LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LocatedA (HsExpr GhcPs)
func of
HsDo {} -> Int -> R () -> R ()
inciBy Int
2
HsExpr GhcPs
_ -> R () -> R ()
inci
| Bool
otherwise = case LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LocatedA (HsExpr GhcPs)
func of
HsDo {} -> R () -> R ()
inciHalf
HsCase {} -> R () -> R ()
inciHalf
HsLamCase {} -> R () -> R ()
inciHalf
HsExpr GhcPs
_ -> R () -> R ()
inci
R () -> R ()
ub <-
R Layout
getLayout R Layout -> (Layout -> R () -> R ()) -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Layout
SingleLine -> R () -> R ()
useBraces
Layout
MultiLine -> R () -> R ()
forall a. a -> a
id
R () -> R ()
ub (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA (HsExpr GhcPs)
func (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
R ()
breakpoint
R () -> R ()
indentArg (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (LocatedA (HsExpr GhcPs) -> R ())
-> [LocatedA (HsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((HsExpr GhcPs -> R ()) -> LocatedA (HsExpr GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LocatedA (HsExpr GhcPs)]
initp
R () -> R ()
indentArg (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LocatedA (HsExpr GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LocatedA (HsExpr GhcPs)]
initp) R ()
breakpoint
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA (HsExpr GhcPs)
lastp HsExpr GhcPs -> R ()
p_hsExpr
Placement
Hanging -> do
R () -> R ()
useBraces (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
initSpan] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA (HsExpr GhcPs)
func (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
R ()
breakpoint
R ()
-> (LocatedA (HsExpr GhcPs) -> R ())
-> [LocatedA (HsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((HsExpr GhcPs -> R ()) -> LocatedA (HsExpr GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LocatedA (HsExpr GhcPs)]
initp
Placement -> R () -> R ()
placeHanging Placement
placement (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
dontUseBraces (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA (HsExpr GhcPs)
lastp HsExpr GhcPs -> R ()
p_hsExpr
HsAppType XAppTypeE GhcPs
_ LHsExpr GhcPs
e LHsWcType (NoGhcTc GhcPs)
a -> do
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"@"
case GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
LHsWcType (NoGhcTc GhcPs)
a) of
HsSpliceTy {} -> R ()
space
HsType GhcPs
_ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
LHsWcType (NoGhcTc GhcPs)
a) HsType GhcPs -> R ()
p_hsType
OpApp XOpApp GhcPs
_ LHsExpr GhcPs
x LHsExpr GhcPs
op LHsExpr GhcPs
y -> do
let opTree :: OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
opTree = OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
-> LocatedA (HsExpr GhcPs)
-> OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
-> OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
x) LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
op (LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
y)
BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree BracketStyle
s ((HsExpr GhcPs -> Maybe RdrName)
-> OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
-> OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
forall l l' op ty.
(HasSrcSpan l, HasSrcSpan l') =>
(op -> Maybe RdrName)
-> OpTree (GenLocated l ty) (GenLocated l' op)
-> OpTree (GenLocated l ty) (GenLocated l' op)
reassociateOpTree HsExpr GhcPs -> Maybe RdrName
getOpName OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
opTree)
NegApp XNegApp GhcPs
_ LHsExpr GhcPs
e SyntaxExpr GhcPs
_ -> do
Bool
negativeLiterals <- Extension -> R Bool
isExtensionEnabled Extension
NegativeLiterals
let isLiteral :: Bool
isLiteral = case LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
e of
HsLit {} -> Bool
True
HsOverLit {} -> Bool
True
HsExpr GhcPs
_ -> Bool
False
Text -> R ()
txt Text
"-"
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
negativeLiterals Bool -> Bool -> Bool
&& Bool
isLiteral) R ()
space
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
HsPar XPar GhcPs
_ LHsExpr GhcPs
e ->
BracketStyle -> R () -> R ()
parens BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> R ()
sitcc (LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
e (R () -> R ()
dontUseBraces (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr))
SectionL XSectionL GhcPs
_ LHsExpr GhcPs
x LHsExpr GhcPs
op -> do
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
op HsExpr GhcPs -> R ()
p_hsExpr)
SectionR XSectionR GhcPs
_ LHsExpr GhcPs
op LHsExpr GhcPs
x -> do
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
op HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr)
ExplicitTuple XExplicitTuple GhcPs
_ [HsTupArg GhcPs]
args Boxity
boxity -> do
let isSection :: Bool
isSection = (HsTupArg GhcPs -> Bool) -> [HsTupArg GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any HsTupArg GhcPs -> Bool
forall id. HsTupArg id -> Bool
isMissing [HsTupArg GhcPs]
args
isMissing :: HsTupArg id -> Bool
isMissing = \case
Missing XMissing id
_ -> Bool
True
HsTupArg id
_ -> Bool
False
p_arg :: HsTupArg GhcPs -> R ()
p_arg = \case
Present XPresent GhcPs
_ LHsExpr GhcPs
x -> LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExprListItem
Missing XMissing GhcPs
_ -> () -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
parens' :: BracketStyle -> R () -> R ()
parens' =
case Boxity
boxity of
Boxity
Boxed -> BracketStyle -> R () -> R ()
parens
Boxity
Unboxed -> BracketStyle -> R () -> R ()
parensHash
[SrcSpan]
enclSpan <- (RealSrcSpan -> SrcSpan) -> [RealSrcSpan] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RealSrcSpan -> Maybe BufSpan -> SrcSpan)
-> Maybe BufSpan -> RealSrcSpan -> SrcSpan
forall a b c. (a -> b -> c) -> b -> a -> c
flip RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan Maybe BufSpan
forall a. Maybe a
Nothing) ([RealSrcSpan] -> [SrcSpan])
-> (Maybe RealSrcSpan -> [RealSrcSpan])
-> Maybe RealSrcSpan
-> [SrcSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe RealSrcSpan -> [RealSrcSpan]
forall a. Maybe a -> [a]
maybeToList (Maybe RealSrcSpan -> [SrcSpan])
-> R (Maybe RealSrcSpan) -> R [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RealSrcSpan -> Bool) -> R (Maybe RealSrcSpan)
getEnclosingSpan (Bool -> RealSrcSpan -> Bool
forall a b. a -> b -> a
const Bool
True)
if Bool
isSection
then
[SrcSpan] -> R () -> R ()
switchLayout [] (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> (HsTupArg GhcPs -> R ()) -> [HsTupArg GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
comma HsTupArg GhcPs -> R ()
p_arg [HsTupArg GhcPs]
args
else
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
enclSpan (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> (HsTupArg GhcPs -> R ()) -> [HsTupArg GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel HsTupArg GhcPs -> R ()
p_arg [HsTupArg GhcPs]
args
ExplicitSum XExplicitSum GhcPs
_ Int
tag Int
arity LHsExpr GhcPs
e ->
BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum BracketStyle
N Int
tag Int
arity (LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr)
HsCase XCase GhcPs
_ LHsExpr GhcPs
e MatchGroup GhcPs (LHsExpr GhcPs)
mgroup ->
(HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LocatedA (HsExpr GhcPs))
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_case HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr LHsExpr GhcPs
e MatchGroup GhcPs (LHsExpr GhcPs)
MatchGroup GhcPs (LocatedA (HsExpr GhcPs))
mgroup
HsIf XIf GhcPs
_ LHsExpr GhcPs
if' LHsExpr GhcPs
then' LHsExpr GhcPs
else' ->
(HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> LHsExpr GhcPs
-> LocatedA (HsExpr GhcPs)
-> LocatedA (HsExpr GhcPs)
-> R ()
forall body.
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> LocatedA body
-> LocatedA body
-> R ()
p_if HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr LHsExpr GhcPs
if' LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
then' LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
else'
HsMultiIf XMultiIf GhcPs
_ [LGRHS GhcPs (LHsExpr GhcPs)]
guards -> do
Text -> R ()
txt Text
"if"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated SrcSpan (GRHS GhcPs (LocatedA (HsExpr GhcPs)))
-> R ())
-> [GenLocated SrcSpan (GRHS GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline ((GRHS GhcPs (LocatedA (HsExpr GhcPs)) -> R ())
-> GenLocated SrcSpan (GRHS GhcPs (LocatedA (HsExpr GhcPs)))
-> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
p_grhs GroupStyle
RightArrow)) [LGRHS GhcPs (LHsExpr GhcPs)]
[GenLocated SrcSpan (GRHS GhcPs (LocatedA (HsExpr GhcPs)))]
guards
HsLet XLet GhcPs
_ HsLocalBinds GhcPs
localBinds LHsExpr GhcPs
e ->
(HsExpr GhcPs -> R ())
-> HsLocalBinds GhcPs -> LocatedA (HsExpr GhcPs) -> R ()
forall body.
(body -> R ()) -> HsLocalBinds GhcPs -> LocatedA body -> R ()
p_let HsExpr GhcPs -> R ()
p_hsExpr HsLocalBinds GhcPs
localBinds LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
e
HsDo XDo GhcPs
_ HsStmtContext (HsDoRn GhcPs)
ctx XRec GhcPs [GuardLStmt GhcPs]
es -> do
let doBody :: Maybe ModuleName -> Text -> R ()
doBody Maybe ModuleName
moduleName Text
header = do
Maybe ModuleName -> (ModuleName -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ModuleName
moduleName ((ModuleName -> R ()) -> R ()) -> (ModuleName -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \ModuleName
m -> ModuleName -> R ()
forall a. Outputable a => a -> R ()
atom ModuleName
m R () -> R () -> R ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> R ()
txt Text
"."
Text -> R ()
txt Text
header
(HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> LocatedL
[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ()
forall body.
(Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL) =>
(body -> Placement)
-> (body -> R ())
-> LocatedL [LocatedA (Stmt GhcPs (LocatedA body))]
-> R ()
p_stmts HsExpr GhcPs -> Placement
exprPlacement (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
S) XRec GhcPs [GuardLStmt GhcPs]
LocatedL
[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
es
compBody :: R ()
compBody = BracketStyle -> R () -> R ()
brackets BracketStyle
N (R () -> R ())
-> (([GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ())
-> R ())
-> ([GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedL
[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> ([GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ())
-> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs [GuardLStmt GhcPs]
LocatedL
[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
es (([GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ())
-> R ())
-> ([GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ())
-> R ()
forall a b. (a -> b) -> a -> b
$ \[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
xs -> do
let p_parBody :: [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> R ()
p_parBody =
R ()
-> ([GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ())
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
(R ()
breakpoint R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|" R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space)
[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ()
p_seqBody
p_seqBody :: [GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ()
p_seqBody =
R () -> R ()
sitccIfTrailing
(R () -> R ())
-> ([GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ())
-> [GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R ()
-> (GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> R ())
-> [GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
R ()
commaDel
((StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> R ())
-> GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' (R () -> R ()
sitcc (R () -> R ())
-> (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> R ())
-> StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stmt GhcPs (LHsExpr GhcPs) -> R ()
StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> R ()
p_stmt))
stmts :: [GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
stmts = [GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> [GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
forall a. [a] -> [a]
init [GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
xs
yield :: GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
yield = [GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
forall a. [a] -> a
last [GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
xs
lists :: [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
lists = (GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]])
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend ([[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]])
-> (GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]])
-> GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
gatherStmt) [] [GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
stmts
GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
yield Stmt GhcPs (LHsExpr GhcPs) -> R ()
StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> R ()
p_stmt
R ()
breakpoint
Text -> R ()
txt Text
"|"
R ()
space
[[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
-> R ()
p_parBody [[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]]
lists
case HsStmtContext (HsDoRn GhcPs)
ctx of
DoExpr Maybe ModuleName
moduleName -> Maybe ModuleName -> Text -> R ()
doBody Maybe ModuleName
moduleName Text
"do"
MDoExpr Maybe ModuleName
moduleName -> Maybe ModuleName -> Text -> R ()
doBody Maybe ModuleName
moduleName Text
"mdo"
HsStmtContext (HsDoRn GhcPs)
ListComp -> R ()
compBody
HsStmtContext (HsDoRn GhcPs)
MonadComp -> R ()
compBody
HsStmtContext (HsDoRn GhcPs)
ArrowExpr -> String -> R ()
forall a. String -> a
notImplemented String
"ArrowExpr"
HsStmtContext (HsDoRn GhcPs)
GhciStmtCtxt -> String -> R ()
forall a. String -> a
notImplemented String
"GhciStmtCtxt"
PatGuard HsMatchContext (HsDoRn GhcPs)
_ -> String -> R ()
forall a. String -> a
notImplemented String
"PatGuard"
ParStmtCtxt HsStmtContext (HsDoRn GhcPs)
_ -> String -> R ()
forall a. String -> a
notImplemented String
"ParStmtCtxt"
TransStmtCtxt HsStmtContext (HsDoRn GhcPs)
_ -> String -> R ()
forall a. String -> a
notImplemented String
"TransStmtCtxt"
ExplicitList XExplicitList GhcPs
_ [LHsExpr GhcPs]
xs ->
BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R ()
-> (LocatedA (HsExpr GhcPs) -> R ())
-> [LocatedA (HsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (LocatedA (HsExpr GhcPs) -> R ())
-> LocatedA (HsExpr GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsExpr GhcPs -> R ()) -> LocatedA (HsExpr GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExprListItem) [LHsExpr GhcPs]
[LocatedA (HsExpr GhcPs)]
xs
RecordCon {HsRecordBinds GhcPs
XRec GhcPs (ConLikeP GhcPs)
XRecordCon GhcPs
rcon_ext :: forall p. HsExpr p -> XRecordCon p
rcon_con :: forall p. HsExpr p -> XRec p (ConLikeP p)
rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_flds :: HsRecordBinds GhcPs
rcon_con :: XRec GhcPs (ConLikeP GhcPs)
rcon_ext :: XRecordCon GhcPs
..} -> do
LocatedN RdrName -> (RdrName -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
rcon_con RdrName -> R ()
forall a. Outputable a => a -> R ()
atom
R ()
breakpointPreRecordBrace
let HsRecFields {[LHsRecField GhcPs (LocatedA (HsExpr GhcPs))]
Maybe (Located Int)
rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (Located Int)
rec_dotdot :: Maybe (Located Int)
rec_flds :: [LHsRecField GhcPs (LocatedA (HsExpr GhcPs))]
..} = HsRecordBinds GhcPs
HsRecFields GhcPs (LocatedA (HsExpr GhcPs))
rcon_flds
p_lbl :: FieldOcc pass -> R ()
p_lbl = LocatedN RdrName -> R ()
p_rdrName (LocatedN RdrName -> R ())
-> (FieldOcc pass -> LocatedN RdrName) -> FieldOcc pass -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc pass -> LocatedN RdrName
forall pass. FieldOcc pass -> LocatedN RdrName
rdrNameFieldOcc
fields :: [R ()]
fields = (HsRecField' (FieldOcc GhcPs) (LocatedA (HsExpr GhcPs)) -> R ())
-> GenLocated
SrcSpanAnnA
(HsRecField' (FieldOcc GhcPs) (LocatedA (HsExpr GhcPs)))
-> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' ((FieldOcc GhcPs -> R ())
-> HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs) -> R ()
forall id. (id -> R ()) -> HsRecField' id (LHsExpr GhcPs) -> R ()
p_hsRecField FieldOcc GhcPs -> R ()
forall pass. FieldOcc pass -> R ()
p_lbl) (GenLocated
SrcSpanAnnA
(HsRecField' (FieldOcc GhcPs) (LocatedA (HsExpr GhcPs)))
-> R ())
-> [GenLocated
SrcSpanAnnA
(HsRecField' (FieldOcc GhcPs) (LocatedA (HsExpr GhcPs)))]
-> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (LocatedA (HsExpr GhcPs))]
[GenLocated
SrcSpanAnnA
(HsRecField' (FieldOcc GhcPs) (LocatedA (HsExpr GhcPs)))]
rec_flds
dotdot :: [R ()]
dotdot =
case Maybe (Located Int)
rec_dotdot of
Just {} -> [Text -> R ()
txt Text
".."]
Maybe (Located Int)
Nothing -> []
R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> (R () -> R ()) -> [R ()] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel R () -> R ()
sitcc ([R ()]
fields [R ()] -> [R ()] -> [R ()]
forall a. Semigroup a => a -> a -> a
<> [R ()]
dotdot)
RecordUpd {Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
LHsExpr GhcPs
XRecordUpd GhcPs
rupd_ext :: forall p. HsExpr p -> XRecordUpd p
rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_flds :: forall p. HsExpr p -> Either [LHsRecUpdField p] [LHsRecUpdProj p]
rupd_flds :: Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
rupd_expr :: LHsExpr GhcPs
rupd_ext :: XRecordUpd GhcPs
..} -> do
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
rupd_expr HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpointPreRecordBrace
let p_updLbl :: AmbiguousFieldOcc GhcPs -> R ()
p_updLbl =
LocatedN RdrName -> R ()
p_rdrName (LocatedN RdrName -> R ())
-> (AmbiguousFieldOcc GhcPs -> LocatedN RdrName)
-> AmbiguousFieldOcc GhcPs
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Unambiguous XUnambiguous GhcPs
NoExtField LocatedN RdrName
n -> LocatedN RdrName
n
Ambiguous XAmbiguous GhcPs
NoExtField LocatedN RdrName
n -> LocatedN RdrName
n
p_recFields :: (id -> R ())
-> [GenLocated l (HsRecField' id (LocatedA (HsExpr GhcPs)))]
-> R ()
p_recFields id -> R ()
p_lbl =
R ()
-> (GenLocated l (HsRecField' id (LocatedA (HsExpr GhcPs)))
-> R ())
-> [GenLocated l (HsRecField' id (LocatedA (HsExpr GhcPs)))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated l (HsRecField' id (LocatedA (HsExpr GhcPs)))
-> R ())
-> GenLocated l (HsRecField' id (LocatedA (HsExpr GhcPs)))
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsRecField' id (LocatedA (HsExpr GhcPs)) -> R ())
-> GenLocated l (HsRecField' id (LocatedA (HsExpr GhcPs))) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' ((id -> R ()) -> HsRecField' id (LHsExpr GhcPs) -> R ()
forall id. (id -> R ()) -> HsRecField' id (LHsExpr GhcPs) -> R ()
p_hsRecField id -> R ()
p_lbl))
R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
([GenLocated
SrcSpanAnnA
(HsRecField' (AmbiguousFieldOcc GhcPs) (LocatedA (HsExpr GhcPs)))]
-> R ())
-> ([GenLocated
SrcSpanAnnA
(HsRecField' (FieldLabelStrings GhcPs) (LocatedA (HsExpr GhcPs)))]
-> R ())
-> Either
[GenLocated
SrcSpanAnnA
(HsRecField' (AmbiguousFieldOcc GhcPs) (LocatedA (HsExpr GhcPs)))]
[GenLocated
SrcSpanAnnA
(HsRecField' (FieldLabelStrings GhcPs) (LocatedA (HsExpr GhcPs)))]
-> R ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
((AmbiguousFieldOcc GhcPs -> R ())
-> [GenLocated
SrcSpanAnnA
(HsRecField' (AmbiguousFieldOcc GhcPs) (LocatedA (HsExpr GhcPs)))]
-> R ()
forall l id.
HasSrcSpan l =>
(id -> R ())
-> [GenLocated l (HsRecField' id (LocatedA (HsExpr GhcPs)))]
-> R ()
p_recFields AmbiguousFieldOcc GhcPs -> R ()
p_updLbl)
((FieldLabelStrings GhcPs -> R ())
-> [GenLocated
SrcSpanAnnA
(HsRecField' (FieldLabelStrings GhcPs) (LocatedA (HsExpr GhcPs)))]
-> R ()
forall l id.
HasSrcSpan l =>
(id -> R ())
-> [GenLocated l (HsRecField' id (LocatedA (HsExpr GhcPs)))]
-> R ()
p_recFields ([Located (HsFieldLabel GhcPs)] -> R ()
p_fieldLabels ([Located (HsFieldLabel GhcPs)] -> R ())
-> (FieldLabelStrings GhcPs -> [Located (HsFieldLabel GhcPs)])
-> FieldLabelStrings GhcPs
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabelStrings GhcPs -> [Located (HsFieldLabel GhcPs)]
coerce))
Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
Either
[GenLocated
SrcSpanAnnA
(HsRecField' (AmbiguousFieldOcc GhcPs) (LocatedA (HsExpr GhcPs)))]
[GenLocated
SrcSpanAnnA
(HsRecField' (FieldLabelStrings GhcPs) (LocatedA (HsExpr GhcPs)))]
rupd_flds
HsGetField {LHsExpr GhcPs
XGetField GhcPs
Located (HsFieldLabel GhcPs)
gf_ext :: forall p. HsExpr p -> XGetField p
gf_expr :: forall p. HsExpr p -> LHsExpr p
gf_field :: forall p. HsExpr p -> Located (HsFieldLabel p)
gf_field :: Located (HsFieldLabel GhcPs)
gf_expr :: LHsExpr GhcPs
gf_ext :: XGetField GhcPs
..} -> do
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
gf_expr HsExpr GhcPs -> R ()
p_hsExpr
Text -> R ()
txt Text
"."
Located (HsFieldLabel GhcPs) -> R ()
p_lhsFieldLabel Located (HsFieldLabel GhcPs)
gf_field
HsProjection {NonEmpty (Located (HsFieldLabel GhcPs))
XProjection GhcPs
proj_ext :: forall p. HsExpr p -> XProjection p
proj_flds :: forall p. HsExpr p -> NonEmpty (Located (HsFieldLabel p))
proj_flds :: NonEmpty (Located (HsFieldLabel GhcPs))
proj_ext :: XProjection GhcPs
..} -> BracketStyle -> R () -> R ()
parens BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"."
[Located (HsFieldLabel GhcPs)] -> R ()
p_fieldLabels (NonEmpty (Located (HsFieldLabel GhcPs))
-> [Located (HsFieldLabel GhcPs)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Located (HsFieldLabel GhcPs))
proj_flds)
ExprWithTySig XExprWithTySig GhcPs
_ LHsExpr GhcPs
x HsWC {LHsSigType (NoGhcTc GhcPs)
hswc_body :: LHsSigType (NoGhcTc GhcPs)
hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body} -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
Text -> R ()
txt Text
"::"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> (HsSigType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsSigType (NoGhcTc GhcPs)
GenLocated SrcSpanAnnA (HsSigType GhcPs)
hswc_body HsSigType GhcPs -> R ()
p_hsSigType
ArithSeq XArithSeq GhcPs
_ Maybe (SyntaxExpr GhcPs)
_ ArithSeqInfo GhcPs
x ->
case ArithSeqInfo GhcPs
x of
From LHsExpr GhcPs
from -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
from HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt Text
".."
FromThen LHsExpr GhcPs
from LHsExpr GhcPs
next -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
-> (LocatedA (HsExpr GhcPs) -> R ())
-> [LocatedA (HsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((HsExpr GhcPs -> R ()) -> LocatedA (HsExpr GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
from, LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
next]
R ()
breakpoint
Text -> R ()
txt Text
".."
FromTo LHsExpr GhcPs
from LHsExpr GhcPs
to -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
from HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt Text
".."
R ()
space
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
to HsExpr GhcPs -> R ()
p_hsExpr
FromThenTo LHsExpr GhcPs
from LHsExpr GhcPs
next LHsExpr GhcPs
to -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
-> (LocatedA (HsExpr GhcPs) -> R ())
-> [LocatedA (HsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((HsExpr GhcPs -> R ()) -> LocatedA (HsExpr GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
from, LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
next]
R ()
breakpoint
Text -> R ()
txt Text
".."
R ()
space
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
to HsExpr GhcPs -> R ()
p_hsExpr
HsBracket XBracket GhcPs
epAnn HsBracket GhcPs
x -> EpAnn [AddEpAnn] -> HsBracket GhcPs -> R ()
p_hsBracket XBracket GhcPs
EpAnn [AddEpAnn]
epAnn HsBracket GhcPs
x
HsRnBracketOut {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsRnBracketOut"
HsTcBracketOut {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsTcBracketOut"
HsSpliceE XSpliceE GhcPs
_ HsSplice GhcPs
splice -> HsSplice GhcPs -> R ()
p_hsSplice HsSplice GhcPs
splice
HsProc XProc GhcPs
_ LPat GhcPs
p LHsCmdTop GhcPs
e -> do
Text -> R ()
txt Text
"proc"
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p ((Pat GhcPs -> R ()) -> R ()) -> (Pat GhcPs -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \Pat GhcPs
x -> do
R ()
breakpoint
R () -> R ()
inci (Pat GhcPs -> R ()
p_pat Pat GhcPs
x)
R ()
breakpoint
Text -> R ()
txt Text
"->"
Placement -> R () -> R ()
placeHanging (HsCmdTop GhcPs -> Placement
cmdTopPlacement (GenLocated SrcSpan (HsCmdTop GhcPs) -> HsCmdTop GhcPs
forall l e. GenLocated l e -> e
unLoc LHsCmdTop GhcPs
GenLocated SrcSpan (HsCmdTop GhcPs)
e)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
GenLocated SrcSpan (HsCmdTop GhcPs)
-> (HsCmdTop GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
GenLocated SrcSpan (HsCmdTop GhcPs)
e HsCmdTop GhcPs -> R ()
p_hsCmdTop
HsStatic XStatic GhcPs
_ LHsExpr GhcPs
e -> do
Text -> R ()
txt Text
"static"
R ()
breakpoint
R () -> R ()
inci (LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr)
HsTick {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsTick"
HsBinTick {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsBinTick"
HsPragE XPragE GhcPs
_ HsPragE GhcPs
prag LHsExpr GhcPs
x -> case HsPragE GhcPs
prag of
HsPragSCC XSCC GhcPs
_ SourceText
_ StringLiteral
name -> do
Text -> R ()
txt Text
"{-# SCC "
StringLiteral -> R ()
forall a. Outputable a => a -> R ()
atom StringLiteral
name
Text -> R ()
txt Text
" #-}"
R ()
breakpoint
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
x HsExpr GhcPs -> R ()
p_hsExpr
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PSB {HsPatSynDir GhcPs
HsPatSynDetails GhcPs
LPat GhcPs
LIdP GhcPs
XPSB GhcPs GhcPs
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_dir :: HsPatSynDir GhcPs
psb_def :: LPat GhcPs
psb_args :: HsPatSynDetails GhcPs
psb_id :: LIdP GhcPs
psb_ext :: XPSB GhcPs GhcPs
..} = do
let rhs :: R ()
rhs = do
R ()
space
case HsPatSynDir GhcPs
psb_dir of
HsPatSynDir GhcPs
Unidirectional -> 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 -> do
R ()
equals
R ()
breakpoint
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
psb_def Pat GhcPs -> R ()
p_pat
ExplicitBidirectional MatchGroup GhcPs (LHsExpr GhcPs)
mgroup -> do
Text -> R ()
txt Text
"<-"
R ()
breakpoint
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
psb_def Pat GhcPs -> R ()
p_pat
R ()
breakpoint
Text -> R ()
txt Text
"where"
R ()
breakpoint
R () -> R ()
inci (MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup (LocatedN RdrName -> MatchGroupStyle
Function LIdP GhcPs
LocatedN RdrName
psb_id) MatchGroup GhcPs (LHsExpr GhcPs)
mgroup)
Text -> R ()
txt Text
"pattern"
case HsPatSynDetails GhcPs
psb_args of
PrefixCon [] [LIdP GhcPs]
xs -> do
R ()
space
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
psb_id
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
[SrcSpan] -> R () -> R ()
switchLayout (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) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LocatedN RdrName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIdP GhcPs]
[LocatedN RdrName]
xs) R ()
breakpoint
R () -> R ()
sitcc (R () -> (LocatedN RdrName -> R ()) -> [LocatedN RdrName] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint LocatedN RdrName -> R ()
p_rdrName [LIdP GhcPs]
[LocatedN RdrName]
xs)
R ()
rhs
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
[SrcSpan] -> R () -> R ()
switchLayout (LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (LocatedN RdrName -> SrcSpan)
-> (RecordPatSynField GhcPs -> LocatedN RdrName)
-> RecordPatSynField GhcPs
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField GhcPs -> LocatedN RdrName
forall pass. RecordPatSynField pass -> LIdP pass
recordPatSynPatVar (RecordPatSynField GhcPs -> SrcSpan)
-> [RecordPatSynField GhcPs] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RecordPatSynField GhcPs]
xs) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([RecordPatSynField GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RecordPatSynField GhcPs]
xs) R ()
breakpointPreRecordBrace
BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R ()
-> (RecordPatSynField GhcPs -> R ())
-> [RecordPatSynField GhcPs]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (LocatedN RdrName -> R ()
p_rdrName (LocatedN RdrName -> R ())
-> (RecordPatSynField GhcPs -> LocatedN RdrName)
-> RecordPatSynField GhcPs
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField GhcPs -> LocatedN RdrName
forall pass. RecordPatSynField pass -> LIdP pass
recordPatSynPatVar) [RecordPatSynField GhcPs]
xs
R ()
rhs
InfixCon LIdP GhcPs
l LIdP GhcPs
r -> do
[SrcSpan] -> R () -> R ()
switchLayout [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] (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 R ()
rhs
p_case ::
( Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
) =>
(body -> Placement) ->
(body -> R ()) ->
LHsExpr GhcPs ->
MatchGroup GhcPs (LocatedA body) ->
R ()
p_case :: (body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_case body -> Placement
placer body -> R ()
render LHsExpr GhcPs
e MatchGroup GhcPs (LocatedA body)
mgroup = do
Text -> R ()
txt Text
"case"
R ()
space
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
e HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
Text -> R ()
txt Text
"of"
R ()
breakpoint
R () -> R ()
inci ((body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
Case MatchGroup GhcPs (LocatedA body)
mgroup)
p_lamcase ::
( Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
) =>
(body -> Placement) ->
(body -> R ()) ->
MatchGroup GhcPs (LocatedA body) ->
R ()
p_lamcase :: (body -> Placement)
-> (body -> R ()) -> MatchGroup GhcPs (LocatedA body) -> R ()
p_lamcase body -> Placement
placer body -> R ()
render MatchGroup GhcPs (LocatedA body)
mgroup = do
Text -> R ()
txt Text
"\\case"
R ()
breakpoint
R () -> R ()
inci ((body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
forall body.
(Anno (GRHS GhcPs (LocatedA body)) ~ SrcSpan,
Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA) =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LocatedA body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
LambdaCase MatchGroup GhcPs (LocatedA body)
mgroup)
p_if ::
(body -> Placement) ->
(body -> R ()) ->
LHsExpr GhcPs ->
LocatedA body ->
LocatedA body ->
R ()
p_if :: (body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> LocatedA body
-> LocatedA body
-> R ()
p_if body -> Placement
placer body -> R ()
render LHsExpr GhcPs
if' LocatedA body
then' LocatedA body
else' = do
Text -> R ()
txt Text
"if"
R ()
space
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
if' HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"then"
R ()
space
LocatedA body -> (body -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
then' ((body -> R ()) -> R ()) -> (body -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \body
x ->
Placement -> R () -> R ()
placeHanging (body -> Placement
placer body
x) (body -> R ()
render body
x)
R ()
breakpoint
Text -> R ()
txt Text
"else"
R ()
space
LocatedA body -> (body -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
else' ((body -> R ()) -> R ()) -> (body -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \body
x ->
Placement -> R () -> R ()
placeHanging (body -> Placement
placer body
x) (body -> R ()
render body
x)
p_let ::
(body -> R ()) ->
HsLocalBinds GhcPs ->
LocatedA body ->
R ()
p_let :: (body -> R ()) -> HsLocalBinds GhcPs -> LocatedA body -> R ()
p_let body -> R ()
render HsLocalBinds GhcPs
localBinds LocatedA body
e = R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"let"
R ()
space
R () -> R ()
dontUseBraces (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> R ()
sitcc (HsLocalBinds GhcPs -> R ()
p_hsLocalBinds HsLocalBinds GhcPs
localBinds)
R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout R ()
space (R ()
newline R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
" ")
Text -> R ()
txt Text
"in"
R ()
space
R () -> R ()
sitcc (LocatedA body -> (body -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LocatedA body
e body -> R ()
render)
p_pat :: Pat GhcPs -> R ()
p_pat :: Pat GhcPs -> R ()
p_pat = \case
WildPat XWildPat GhcPs
_ -> Text -> R ()
txt Text
"_"
VarPat XVarPat GhcPs
_ LIdP GhcPs
name -> LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
name
LazyPat XLazyPat GhcPs
_ LPat GhcPs
pat -> do
Text -> R ()
txt Text
"~"
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
AsPat XAsPat GhcPs
_ LIdP GhcPs
name LPat GhcPs
pat -> do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
name
Text -> R ()
txt Text
"@"
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
ParPat XParPat GhcPs
_ LPat GhcPs
pat ->
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat (BracketStyle -> R () -> R ()
parens BracketStyle
S (R () -> R ()) -> (Pat GhcPs -> R ()) -> Pat GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> (Pat GhcPs -> R ()) -> Pat GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat GhcPs -> R ()
p_pat)
BangPat XBangPat GhcPs
_ LPat GhcPs
pat -> do
Text -> R ()
txt Text
"!"
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
ListPat XListPat GhcPs
_ [LPat GhcPs]
pats ->
BracketStyle -> R () -> R ()
brackets BracketStyle
S (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
pats Boxity
boxing -> do
let parens' :: R () -> R ()
parens' =
case Boxity
boxing of
Boxity
Boxed -> BracketStyle -> R () -> R ()
parens BracketStyle
S
Boxity
Unboxed -> BracketStyle -> R () -> R ()
parensHash BracketStyle
S
R () -> R ()
parens' (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> GenLocated SrcSpanAnnA (Pat GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
SumPat XSumPat GhcPs
_ LPat GhcPs
pat Int
tag Int
arity ->
BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum BracketStyle
S Int
tag Int
arity (GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat)
ConPat XConPat GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
pat HsConPatDetails GhcPs
details ->
case HsConPatDetails GhcPs
details of
PrefixCon [] [LPat GhcPs]
xs -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
pat
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (Pat GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
xs) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc (R () -> R ())
-> (GenLocated SrcSpanAnnA (Pat GhcPs) -> R ())
-> GenLocated SrcSpanAnnA (Pat GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat GhcPs -> R ()) -> GenLocated SrcSpanAnnA (Pat GhcPs) -> R ()
forall l a. HasSrcSpan l => (a -> R ()) -> GenLocated l a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
xs
PrefixCon {} -> String -> R ()
forall a. String -> a
notImplemented String
"Unexpected types in constructor pattern"
RecCon (HsRecFields [LHsRecField GhcPs (LPat GhcPs)]
fields Maybe (Located Int)
dotdot) -> do
LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
pat
R ()
breakpointPreRecordBrace
let f :: Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
-> R ()
f = \case
Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
Nothing -> Text -> R ()
txt Text
".."
Just GenLocated
SrcSpanAnnA
(HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
x -> GenLocated
SrcSpanAnnA
(HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> (HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
-> R ())
-> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated
SrcSpanAnnA
(HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
x HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))
-> R ()
p_pat_hsRecField
R () -> R ()
inci (R () -> R ())
-> ([Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ())
-> [Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ())
-> ([Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ())
-> [Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R ()
-> (Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
-> R ())
-> [Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
-> R ()
f ([Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ())
-> [Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> R ()
forall a b. (a -> b) -> a -> b
$
case Maybe (Located Int)
dotdot of
Maybe (Located Int)
Nothing -> GenLocated
SrcSpanAnnA
(HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
forall a. a -> Maybe a
Just (GenLocated
SrcSpanAnnA
(HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))))
-> [GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> [Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (LPat GhcPs)]
[GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))]
fields
Just (L SrcSpan
_ Int
n) -> (GenLocated
SrcSpanAnnA
(HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
forall a. a -> Maybe a
Just (GenLocated
SrcSpanAnnA
(HsRecField' (FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))))
-> [GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> [Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> [GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))]
-> [GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))]
forall a. Int -> [a] -> [a]
take Int
n [LHsRecField GhcPs (LPat GhcPs)]
[GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs)))]
fields) [Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> [Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
-> [Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))]
forall a. [a] -> [a] -> [a]
++ [Maybe
(GenLocated
SrcSpanAnnA
(HsRecField'
(FieldOcc GhcPs) (GenLocated SrcSpanAnnA (Pat GhcPs))))
forall a. Maybe a
Nothing]
InfixCon LPat GhcPs
l LPat GhcPs
r -> do
[SrcSpan] -> R () -> R ()
switchLayout [GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
l, GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
r] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
l Pat GhcPs -> R ()
p_pat
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedN RdrName -> R ()
p_rdrName XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
pat
R ()
space
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
r Pat GhcPs -> R ()
p_pat
ViewPat XViewPat GhcPs
_ LHsExpr GhcPs
expr LPat GhcPs
pat -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
Text -> R ()
txt Text
"->"
R ()
breakpoint
R () -> R ()
inci (GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat)
SplicePat XSplicePat GhcPs
_ HsSplice GhcPs
splice -> HsSplice GhcPs -> R ()
p_hsSplice HsSplice GhcPs
splice
LitPat XLitPat GhcPs
_ HsLit GhcPs
p -> HsLit GhcPs -> R ()
forall a. Outputable a => a -> R ()
atom HsLit GhcPs
p
NPat XNPat GhcPs
_ XRec GhcPs (HsOverLit GhcPs)
v (Maybe (SyntaxExpr GhcPs) -> Bool
forall a. Maybe a -> Bool
isJust -> Bool
isNegated) SyntaxExpr GhcPs
_ -> do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isNegated (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"-"
Bool
negativeLiterals <- Extension -> R Bool
isExtensionEnabled Extension
NegativeLiterals
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
negativeLiterals R ()
space
GenLocated SrcSpan (HsOverLit GhcPs)
-> (HsOverLit GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsOverLit GhcPs)
GenLocated SrcSpan (HsOverLit GhcPs)
v (OverLitVal -> R ()
forall a. Outputable a => a -> R ()
atom (OverLitVal -> R ())
-> (HsOverLit GhcPs -> OverLitVal) -> HsOverLit GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val)
NPlusKPat XNPlusKPat GhcPs
_ LIdP GhcPs
n XRec GhcPs (HsOverLit GhcPs)
k HsOverLit GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
n
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"+"
R ()
space
GenLocated SrcSpan (HsOverLit GhcPs)
-> (HsOverLit GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located XRec GhcPs (HsOverLit GhcPs)
GenLocated SrcSpan (HsOverLit GhcPs)
k (OverLitVal -> R ()
forall a. Outputable a => a -> R ()
atom (OverLitVal -> R ())
-> (HsOverLit GhcPs -> OverLitVal) -> HsOverLit GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val)
SigPat XSigPat GhcPs
_ LPat GhcPs
pat HsPS {LHsType (NoGhcTc GhcPs)
XHsPS (NoGhcTc GhcPs)
hsps_ext :: forall pass. HsPatSigType pass -> XHsPS pass
hsps_body :: forall pass. HsPatSigType pass -> LHsType pass
hsps_body :: LHsType (NoGhcTc GhcPs)
hsps_ext :: XHsPS (NoGhcTc GhcPs)
..} -> do
GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
LHsSigType GhcPs -> R ()
p_typeAscription (LHsType GhcPs -> LHsSigType GhcPs
lhsTypeToSigType LHsType GhcPs
LHsType (NoGhcTc GhcPs)
hsps_body)
p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
p_pat_hsRecField HsRecField {Bool
LPat GhcPs
XHsRecField (FieldOcc GhcPs)
Located (FieldOcc GhcPs)
hsRecPun :: Bool
hsRecFieldArg :: LPat GhcPs
hsRecFieldLbl :: Located (FieldOcc GhcPs)
hsRecFieldAnn :: XHsRecField (FieldOcc GhcPs)
hsRecFieldAnn :: forall id arg. HsRecField' id arg -> XHsRecField id
hsRecFieldLbl :: forall id arg. HsRecField' id arg -> Located id
hsRecFieldArg :: forall id arg. HsRecField' id arg -> arg
hsRecPun :: forall id arg. HsRecField' id arg -> Bool
..} = do
Located (FieldOcc GhcPs) -> (FieldOcc GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located Located (FieldOcc GhcPs)
hsRecFieldLbl ((FieldOcc GhcPs -> R ()) -> R ())
-> (FieldOcc GhcPs -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> R ()
p_rdrName (LocatedN RdrName -> R ())
-> (FieldOcc GhcPs -> LocatedN RdrName) -> FieldOcc GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc GhcPs -> LocatedN RdrName
forall pass. FieldOcc pass -> LocatedN RdrName
rdrNameFieldOcc
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hsRecPun (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
space
R ()
equals
R ()
breakpoint
R () -> R ()
inci (GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
hsRecFieldArg Pat GhcPs -> R ()
p_pat)
p_unboxedSum :: BracketStyle -> ConTag -> Arity -> R () -> R ()
p_unboxedSum :: BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum BracketStyle
s Int
tag Int
arity R ()
m = do
let before :: Int
before = Int
tag Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
after :: Int
after = Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
before Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
args :: [Maybe (R ())]
args = Int -> Maybe (R ()) -> [Maybe (R ())]
forall a. Int -> a -> [a]
replicate Int
before Maybe (R ())
forall a. Maybe a
Nothing [Maybe (R ())] -> [Maybe (R ())] -> [Maybe (R ())]
forall a. Semigroup a => a -> a -> a
<> [R () -> Maybe (R ())
forall a. a -> Maybe a
Just R ()
m] [Maybe (R ())] -> [Maybe (R ())] -> [Maybe (R ())]
forall a. Semigroup a => a -> a -> a
<> Int -> Maybe (R ()) -> [Maybe (R ())]
forall a. Int -> a -> [a]
replicate Int
after Maybe (R ())
forall a. Maybe a
Nothing
f :: Maybe (R ()) -> R ()
f Maybe (R ())
x =
case Maybe (R ())
x :: Maybe (R ()) of
Maybe (R ())
Nothing ->
R ()
space
Just R ()
m' -> do
R ()
space
R ()
m'
R ()
space
BracketStyle -> R () -> R ()
parensHash BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (Maybe (R ()) -> R ()) -> [Maybe (R ())] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt Text
"|") Maybe (R ()) -> R ()
f [Maybe (R ())]
args
p_hsSplice :: HsSplice GhcPs -> R ()
p_hsSplice :: HsSplice GhcPs -> R ()
p_hsSplice = \case
HsTypedSplice XTypedSplice GhcPs
_ SpliceDecoration
deco IdP GhcPs
_ LHsExpr GhcPs
expr -> Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
True LHsExpr GhcPs
expr SpliceDecoration
deco
HsUntypedSplice XUntypedSplice GhcPs
_ SpliceDecoration
deco IdP GhcPs
_ LHsExpr GhcPs
expr -> Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
False LHsExpr GhcPs
expr SpliceDecoration
deco
HsQuasiQuote XQuasiQuote GhcPs
_ IdP GhcPs
_ IdP GhcPs
quoterName SrcSpan
_ FastString
str -> do
Text -> R ()
txt Text
"["
LocatedN RdrName -> R ()
p_rdrName (RdrName -> LocatedN RdrName
forall a an. a -> LocatedAn an a
noLocA IdP GhcPs
RdrName
quoterName)
Text -> R ()
txt Text
"|"
FastString -> R ()
forall a. Outputable a => a -> R ()
atom FastString
str
Text -> R ()
txt Text
"|]"
HsSpliced {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsSpliced"
p_hsSpliceTH ::
Bool ->
LHsExpr GhcPs ->
SpliceDecoration ->
R ()
p_hsSpliceTH :: Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
isTyped LHsExpr GhcPs
expr = \case
SpliceDecoration
DollarSplice -> do
Text -> R ()
txt Text
decoSymbol
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
expr (R () -> R ()
sitcc (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
SpliceDecoration
BareSplice ->
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
expr (R () -> R ()
sitcc (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
where
decoSymbol :: Text
decoSymbol = if Bool
isTyped then Text
"$$" else Text
"$"
p_hsBracket :: EpAnn [AddEpAnn] -> HsBracket GhcPs -> R ()
p_hsBracket :: EpAnn [AddEpAnn] -> HsBracket GhcPs -> R ()
p_hsBracket EpAnn [AddEpAnn]
epAnn = \case
ExpBr XExpBr GhcPs
_ LHsExpr GhcPs
expr -> do
let name :: Text
name
| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool
True | AddEpAnn AnnKeywordId
AnnOpenEQ EpaLocation
_ <- EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns EpAnn [AddEpAnn]
epAnn] = Text
""
| Bool
otherwise = Text
"e"
Text -> R () -> R ()
quote Text
name (LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr)
PatBr XPatBr GhcPs
_ LPat GhcPs
pat -> GenLocated SrcSpanAnnA (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
pat (Text -> R () -> R ()
quote Text
"p" (R () -> R ()) -> (Pat GhcPs -> R ()) -> Pat GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat GhcPs -> R ()
p_pat)
DecBrL XDecBrL GhcPs
_ [LHsDecl GhcPs]
decls -> Text -> R () -> R ()
quote Text
"d" ([GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> R () -> R ()
forall a. Data a => a -> R () -> R ()
handleStarIsType [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls (FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDecls FamilyStyle
Free [LHsDecl GhcPs]
decls))
DecBrG XDecBrG GhcPs
_ HsGroup GhcPs
_ -> String -> R ()
forall a. String -> a
notImplemented String
"DecBrG"
TypBr XTypBr GhcPs
_ LHsType GhcPs
ty -> Text -> R () -> R ()
quote Text
"t" (GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty (GenLocated SrcSpanAnnA (HsType GhcPs) -> R () -> R ()
forall a. Data a => a -> R () -> R ()
handleStarIsType LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty (R () -> R ()) -> (HsType GhcPs -> R ()) -> HsType GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType GhcPs -> R ()
p_hsType))
VarBr XVarBr GhcPs
_ Bool
isSingleQuote LIdP GhcPs
name -> do
Text -> R ()
txt (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"''" Text
"'" Bool
isSingleQuote)
LocatedN RdrName -> R ()
p_rdrName LIdP GhcPs
LocatedN RdrName
name
TExpBr XTExpBr GhcPs
_ LHsExpr GhcPs
expr -> do
Text -> R ()
txt Text
"[||"
R ()
breakpoint'
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
expr HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint'
Text -> R ()
txt Text
"||]"
where
quote :: Text -> R () -> R ()
quote :: Text -> R () -> R ()
quote Text
name R ()
body = do
Text -> R ()
txt Text
"["
Text -> R ()
txt Text
name
Text -> R ()
txt Text
"|"
R ()
breakpoint'
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R () -> R ()
dontUseBraces R ()
body
R ()
breakpoint'
Text -> R ()
txt Text
"|]"
handleStarIsType :: Data a => a -> R () -> R ()
handleStarIsType :: a -> R () -> R ()
handleStarIsType a
a R ()
p
| a -> Bool
containsHsStarTy a
a = R ()
space R () -> R () -> R ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> R ()
p R () -> R () -> R ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* R ()
space
| Bool
otherwise = R ()
p
where
containsHsStarTy :: a -> Bool
containsHsStarTy = (Bool -> Bool -> Bool) -> GenericQ Bool -> GenericQ Bool
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything Bool -> Bool -> Bool
(||) (GenericQ Bool -> GenericQ Bool) -> GenericQ Bool -> GenericQ Bool
forall a b. (a -> b) -> a -> b
$ \a
b -> case a -> Maybe (HsType GhcPs)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast @_ @(HsType GhcPs) a
b of
Just HsStarTy {} -> Bool
True
Maybe (HsType GhcPs)
_ -> Bool
False
p_stringLit :: String -> R ()
p_stringLit :: String -> R ()
p_stringLit String
src =
let s :: [String]
s = String -> [String]
splitGaps String
src
singleLine :: R ()
singleLine =
Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack ([String] -> String
forall a. Monoid a => [a] -> a
mconcat [String]
s)
multiLine :: R ()
multiLine =
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (String -> R ()) -> [String] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (Text -> R ()
txt (Text -> R ()) -> (String -> Text) -> String -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) ([String] -> [String]
backslashes [String]
s)
in R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout R ()
singleLine R ()
multiLine
where
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' = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
ghcSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
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 -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
backslashes ((Char
'\\' Char -> ShowS
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 :: [a] -> [(Maybe a, a, Maybe a)]
zipPrevNext [a]
xs =
let z :: [((Maybe a, a), Maybe a)]
z =
[(Maybe a, a)] -> [Maybe a] -> [((Maybe a, a), Maybe a)]
forall a b. [a] -> [b] -> [(a, b)]
zip
([Maybe a] -> [a] -> [(Maybe a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Maybe a
forall a. Maybe a
Nothing Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: (a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just [a]
xs) [a]
xs)
((a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just ([a] -> [a]
forall a. [a] -> [a]
tail [a]
xs) [Maybe a] -> [Maybe a] -> [Maybe a]
forall a. [a] -> [a] -> [a]
++ Maybe a -> [Maybe a]
forall a. a -> [a]
repeat Maybe a
forall a. Maybe a
Nothing)
in (((Maybe a, a), Maybe a) -> (Maybe a, a, Maybe a))
-> [((Maybe a, a), Maybe a)] -> [(Maybe a, a, Maybe a)]
forall a b. (a -> b) -> [a] -> [b]
map (\((Maybe a
p, a
x), Maybe a
n) -> (Maybe a
p, a
x, Maybe a
n)) [((Maybe a, a), Maybe a)]
z
orig :: (a, b, c) -> b
orig (a
_, b
x, c
_) = b
x
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 :: [a] -> [a] -> [a]
liftAppend [] [] = []
liftAppend [] (a
y : [a]
ys) = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys
liftAppend (a
x : [a]
xs) [] = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
liftAppend (a
x : [a]
xs) (a
y : [a]
ys) = a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend [a]
xs [a]
ys
getGRHSSpan :: GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan :: GRHS GhcPs (LocatedA body) -> SrcSpan
getGRHSSpan (GRHS XCGRHS GhcPs (LocatedA body)
_ [GuardLStmt GhcPs]
guards LocatedA body
body) =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ LocatedA body -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedA body
body SrcSpan -> [SrcSpan] -> NonEmpty SrcSpan
forall a. a -> [a] -> NonEmpty a
:| (GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> SrcSpan)
-> [GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA [GuardLStmt GhcPs]
[GenLocated
SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
guards
placeHanging :: Placement -> R () -> R ()
placeHanging :: Placement -> R () -> R ()
placeHanging Placement
placement R ()
m =
case Placement
placement of
Placement
Hanging -> do
R ()
space
R ()
m
Placement
Normal -> do
R ()
breakpoint
R () -> R ()
inci R ()
m
blockPlacement ::
(body -> Placement) ->
[LGRHS GhcPs (LocatedA body)] ->
Placement
blockPlacement :: (body -> Placement) -> [LGRHS GhcPs (LocatedA body)] -> Placement
blockPlacement body -> Placement
placer [L _ (GRHS _ _ (L _ x))] = body -> Placement
placer body
x
blockPlacement body -> Placement
_ [LGRHS GhcPs (LocatedA body)]
_ = Placement
Normal
cmdPlacement :: HsCmd GhcPs -> Placement
cmdPlacement :: HsCmd GhcPs -> Placement
cmdPlacement = \case
HsCmdLam XCmdLam GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
_ -> Placement
Hanging
HsCmdCase XCmdCase GhcPs
_ LHsExpr GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
_ -> Placement
Hanging
HsCmdLamCase XCmdLamCase GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
_ -> Placement
Hanging
HsCmdDo XCmdDo GhcPs
_ XRec GhcPs [CmdLStmt GhcPs]
_ -> Placement
Hanging
HsCmd GhcPs
_ -> Placement
Normal
cmdTopPlacement :: HsCmdTop GhcPs -> Placement
cmdTopPlacement :: HsCmdTop GhcPs -> Placement
cmdTopPlacement (HsCmdTop XCmdTop GhcPs
_ (L _ x)) = HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs
x
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement = \case
HsLam XLam GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
mg -> case MatchGroup GhcPs (LHsExpr GhcPs)
mg of
MG XMG GhcPs (LHsExpr GhcPs)
_ (L _ [L _ (Match _ _ (x : xs) _)]) Origin
_
| SrcSpan -> Bool
isOneLineSpan (NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan)
-> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
-> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
x GenLocated SrcSpanAnnA (Pat GhcPs)
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. a -> [a] -> NonEmpty a
:| [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
xs)) ->
Placement
Hanging
MatchGroup GhcPs (LHsExpr GhcPs)
_ -> Placement
Normal
HsLamCase XLamCase GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
_ -> Placement
Hanging
HsCase XCase GhcPs
_ LHsExpr GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
_ -> Placement
Hanging
HsDo XDo GhcPs
_ (DoExpr Maybe ModuleName
_) XRec GhcPs [GuardLStmt GhcPs]
_ -> Placement
Hanging
HsDo XDo GhcPs
_ (MDoExpr Maybe ModuleName
_) XRec GhcPs [GuardLStmt GhcPs]
_ -> Placement
Hanging
OpApp XOpApp GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
op LHsExpr GhcPs
y ->
case ((RdrName -> String) -> Maybe RdrName -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> String
getOpNameStr (Maybe RdrName -> Maybe String)
-> (LocatedA (HsExpr GhcPs) -> Maybe RdrName)
-> LocatedA (HsExpr GhcPs)
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> Maybe RdrName
getOpName (HsExpr GhcPs -> Maybe RdrName)
-> (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs)
-> LocatedA (HsExpr GhcPs)
-> Maybe RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc) LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
op of
Just String
"$" -> HsExpr GhcPs -> Placement
exprPlacement (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
y)
Maybe String
_ -> Placement
Normal
HsApp XApp GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
y -> HsExpr GhcPs -> Placement
exprPlacement (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
y)
HsProc XProc GhcPs
_ LPat GhcPs
p LHsCmdTop GhcPs
_ ->
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 :: [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
exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree (L _ (OpApp _ x op y)) = OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
-> LocatedA (HsExpr GhcPs)
-> OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
-> OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
x) LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
op (LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
y)
exprOpTree LHsExpr GhcPs
n = LocatedA (HsExpr GhcPs)
-> OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
forall ty op. ty -> OpTree ty op
OpNode LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
n
getOpName :: HsExpr GhcPs -> Maybe RdrName
getOpName :: HsExpr GhcPs -> Maybe RdrName
getOpName = \case
HsVar XVar GhcPs
_ (L _ a) -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just RdrName
a
HsExpr GhcPs
_ -> Maybe RdrName
forall a. Maybe a
Nothing
getOpNameStr :: RdrName -> String
getOpNameStr :: RdrName -> String
getOpNameStr = OccName -> String
occNameString (OccName -> String) -> (RdrName -> OccName) -> RdrName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc
p_exprOpTree ::
BracketStyle ->
OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->
R ()
p_exprOpTree :: BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree BracketStyle
s (OpNode LHsExpr GhcPs
x) = LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
x (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
p_exprOpTree BracketStyle
s (OpBranch OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x LHsExpr GhcPs
op OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y) = do
let placement :: Placement
placement = (HsExpr GhcPs -> Placement)
-> OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
-> OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
-> Placement
forall l ty op.
HasSrcSpan l =>
(ty -> Placement)
-> OpTree (GenLocated l ty) op
-> OpTree (GenLocated l ty) op
-> Placement
opBranchPlacement HsExpr GhcPs -> Placement
exprPlacement OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
x OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
y
opWrapper :: R () -> R ()
opWrapper = case LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
op of
HsUnboundVar XUnboundVar GhcPs
_ OccName
_ -> R () -> R ()
backticks
HsExpr GhcPs
_ -> R () -> R ()
forall a. a -> a
id
R () -> R ()
ub <- Placement -> R (R () -> R ())
opBranchBraceStyle Placement
placement
let opNameStr :: Maybe String
opNameStr = ((RdrName -> String) -> Maybe RdrName -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> String
getOpNameStr (Maybe RdrName -> Maybe String)
-> (LocatedA (HsExpr GhcPs) -> Maybe RdrName)
-> LocatedA (HsExpr GhcPs)
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> Maybe RdrName
getOpName (HsExpr GhcPs -> Maybe RdrName)
-> (LocatedA (HsExpr GhcPs) -> HsExpr GhcPs)
-> LocatedA (HsExpr GhcPs)
-> Maybe RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc) LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
op
gotDollar :: Bool
gotDollar = Maybe String
opNameStr Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"$"
gotColon :: Bool
gotColon = Maybe String
opNameStr Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
":"
lhs :: R ()
lhs =
[SrcSpan] -> R () -> R ()
switchLayout [OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
-> SrcSpan
forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
x] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree BracketStyle
s OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x
p_op :: R ()
p_op = LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
op (R () -> R ()
opWrapper (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
p_y :: R ()
p_y = [SrcSpan] -> R () -> R ()
switchLayout [OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
-> SrcSpan
forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
y] (BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree BracketStyle
N OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y)
isDoBlock :: OpTree (GenLocated l (HsExpr p)) op -> Bool
isDoBlock = \case
OpNode (L l
_ HsDo {}) -> Bool
True
OpTree (GenLocated l (HsExpr p)) op
_ -> Bool
False
if
| Bool
gotColon -> do
R () -> R ()
ub R ()
lhs
R ()
space
R ()
p_op
case Placement
placement of
Placement
Hanging -> do
R ()
space
R ()
p_y
Placement
Normal -> do
R ()
breakpoint
Bool -> R () -> R ()
inciIf (OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs)) -> Bool
forall l p op. OpTree (GenLocated l (HsExpr p)) op -> Bool
isDoBlock OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
y) R ()
p_y
| Bool
gotDollar
Bool -> Bool -> Bool
&& SrcSpan -> Bool
isOneLineSpan (OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
-> SrcSpan
forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
x)
Bool -> Bool -> Bool
&& Placement
placement Placement -> Placement -> Bool
forall a. Eq a => a -> a -> Bool
== Placement
Normal -> do
R () -> R ()
useBraces R ()
lhs
R ()
space
R ()
p_op
R ()
breakpoint
R () -> R ()
inci R ()
p_y
| Bool
otherwise -> do
R () -> R ()
ub R ()
lhs
let opAndRhs :: R ()
opAndRhs = do
R ()
p_op
R ()
space
R ()
p_y
case OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x of
OpNode (LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc -> HsDo XDo GhcPs
_ HsStmtContext (HsDoRn GhcPs)
_ XRec GhcPs [GuardLStmt GhcPs]
_) | SrcSpan -> Bool
isOneLineSpan (OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
-> SrcSpan
forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
OpTree (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
x) -> R ()
breakpoint R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
opAndRhs
OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
_ -> Placement -> R () -> R ()
placeHanging Placement
placement R ()
opAndRhs
pattern CmdTopCmd :: HsCmd GhcPs -> LHsCmdTop GhcPs
pattern $mCmdTopCmd :: forall r.
LHsCmdTop GhcPs -> (HsCmd GhcPs -> r) -> (Void# -> r) -> r
CmdTopCmd cmd <- (L _ (HsCmdTop _ (L _ cmd)))
cmdOpTree :: LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
cmdOpTree :: LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
cmdOpTree = \case
CmdTopCmd (HsCmdArrForm XCmdArrForm GhcPs
_ LHsExpr GhcPs
op LexicalFixity
Infix Maybe Fixity
_ [LHsCmdTop GhcPs
x, LHsCmdTop GhcPs
y]) ->
OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
-> LocatedA (HsExpr GhcPs)
-> OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
-> OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
cmdOpTree LHsCmdTop GhcPs
x) LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
op (LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
cmdOpTree LHsCmdTop GhcPs
y)
LHsCmdTop GhcPs
n -> GenLocated SrcSpan (HsCmdTop GhcPs)
-> OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
forall ty op. ty -> OpTree ty op
OpNode LHsCmdTop GhcPs
GenLocated SrcSpan (HsCmdTop GhcPs)
n
p_cmdOpTree :: OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs) -> R ()
p_cmdOpTree :: OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs) -> R ()
p_cmdOpTree = \case
OpNode LHsCmdTop GhcPs
n -> GenLocated SrcSpan (HsCmdTop GhcPs)
-> (HsCmdTop GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
GenLocated SrcSpan (HsCmdTop GhcPs)
n HsCmdTop GhcPs -> R ()
p_hsCmdTop
OpBranch OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
x LHsExpr GhcPs
op OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
y -> do
let placement :: Placement
placement = (HsCmdTop GhcPs -> Placement)
-> OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
-> OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
-> Placement
forall l ty op.
HasSrcSpan l =>
(ty -> Placement)
-> OpTree (GenLocated l ty) op
-> OpTree (GenLocated l ty) op
-> Placement
opBranchPlacement HsCmdTop GhcPs -> Placement
cmdTopPlacement OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
x OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs)) (LocatedA (HsExpr GhcPs))
y
R () -> R ()
ub <- Placement -> R (R () -> R ())
opBranchBraceStyle Placement
placement
R () -> R ()
ub (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs) -> R ()
p_cmdOpTree OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
x
Placement -> R () -> R ()
placeHanging Placement
placement (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LocatedA (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
op HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs) -> R ()
p_cmdOpTree OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
y
opBranchPlacement ::
HasSrcSpan l =>
(ty -> Placement) ->
OpTree (GenLocated l ty) op ->
OpTree (GenLocated l ty) op ->
Placement
opBranchPlacement :: (ty -> Placement)
-> OpTree (GenLocated l ty) op
-> OpTree (GenLocated l ty) op
-> Placement
opBranchPlacement ty -> Placement
f OpTree (GenLocated l ty) op
x OpTree (GenLocated l ty) op
y
| SrcSpan -> Bool
isOneLineSpan (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (SrcSpan -> SrcLoc
srcSpanStart (OpTree (GenLocated l ty) op -> SrcSpan
forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (GenLocated l ty) op
x)) (SrcSpan -> SrcLoc
srcSpanStart (OpTree (GenLocated l ty) op -> SrcSpan
forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (GenLocated l ty) op
y))),
OpNode (L l
_ ty
n) <- OpTree (GenLocated l ty) op
y =
ty -> Placement
f ty
n
| Bool
otherwise = Placement
Normal
opBranchBraceStyle :: Placement -> R (R () -> R ())
opBranchBraceStyle :: Placement -> R (R () -> R ())
opBranchBraceStyle Placement
placement =
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 -> case Placement
placement of
Placement
Hanging -> R () -> R ()
useBraces
Placement
Normal -> R () -> R ()
dontUseBraces
breakpointPreRecordBrace :: R ()
breakpointPreRecordBrace :: R ()
breakpointPreRecordBrace = do
Bool
useSpace <- (forall (f :: * -> *). PrinterOpts f -> f Bool) -> R Bool
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f Bool
poRecordBraceSpace
if Bool
useSpace
then R ()
breakpoint
else R ()
breakpoint'
p_hsExprListItem :: HsExpr GhcPs -> R ()
p_hsExprListItem :: HsExpr GhcPs -> R ()
p_hsExprListItem HsExpr GhcPs
e = do
Int
indent <- (forall (f :: * -> *). PrinterOpts f -> f Int) -> R Int
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f Int
poIndentation
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HsExpr GhcPs -> Bool
forall p. HsExpr p -> Bool
listLike HsExpr GhcPs
e) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
(forall (f :: * -> *). PrinterOpts f -> f CommaStyle)
-> R CommaStyle
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f CommaStyle
poCommaStyle R CommaStyle -> (CommaStyle -> R ()) -> R ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
CommaStyle
Leading -> R ()
breakpoint'
CommaStyle
Trailing -> () -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout (() -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Int -> R ()
spaces (Int -> R ()) -> Int -> R ()
forall a b. (a -> b) -> a -> b
$ Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
HsExpr GhcPs -> R ()
p_hsExpr HsExpr GhcPs
e
where
spaces :: Int -> R ()
spaces Int
n = Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.replicate Int
n Text
" "
listLike :: HsExpr p -> Bool
listLike = \case
ExplicitList {} -> Bool
True
ExplicitTuple {} -> Bool
True
HsExpr p
_ -> Bool
False