{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
module Ormolu.Printer.Meat.Declaration.Value
( p_valDecl,
p_pat,
p_hsExpr,
p_hsSplice,
p_stringLit,
)
where
import Bag (bagToList)
import BasicTypes
import Control.Monad
import Ctype (is_space)
import Data.Bool (bool)
import Data.Char (isPunctuation, isSymbol)
import Data.Data hiding (Infix, Prefix)
import Data.Functor ((<&>))
import Data.List (intersperse, sortOn)
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as NE
import Data.Text (Text)
import qualified Data.Text as Text
import GHC
import OccName (occNameString)
import Ormolu.Printer.Combinators
import Ormolu.Printer.Internal
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 (Located 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
NoExtField Located (IdP GhcPs)
funId MatchGroup GhcPs (LHsExpr GhcPs)
funMatches HsWrapper
_ [Tickish Id]
_ -> Located RdrName -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_funBind Located (IdP GhcPs)
Located RdrName
funId MatchGroup GhcPs (LHsExpr GhcPs)
funMatches
PatBind XPatBind GhcPs GhcPs
NoExtField LPat GhcPs
pat GRHSs GhcPs (LHsExpr GhcPs)
grhss ([Tickish Id], [[Tickish Id]])
_ -> 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
NoExtField PatSynBind GhcPs GhcPs
psb -> PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PatSynBind GhcPs GhcPs
psb
XHsBindsLR XXHsBindsLR GhcPs GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXHsBindsLR GhcPs GhcPs
x
p_funBind ::
Located RdrName ->
MatchGroup GhcPs (LHsExpr GhcPs) ->
R ()
p_funBind :: Located RdrName -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_funBind Located RdrName
name = MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup (Located RdrName -> MatchGroupStyle
Function Located 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 (LHsExpr GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
p_matchGroup' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_matchGroup' ::
Data body =>
(body -> Placement) ->
(body -> R ()) ->
MatchGroupStyle ->
MatchGroup GhcPs (Located body) ->
R ()
p_matchGroup' :: (body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
style MG {XMG GhcPs (Located body)
Origin
Located [LMatch GhcPs (Located body)]
mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_origin :: forall p body. MatchGroup p body -> Origin
mg_origin :: Origin
mg_alts :: Located [LMatch GhcPs (Located body)]
mg_ext :: XMG GhcPs (Located body)
..} = do
let ob :: R () -> R ()
ob = case MatchGroupStyle
style of
MatchGroupStyle
Case -> R () -> R ()
forall a. a -> a
id
MatchGroupStyle
LambdaCase -> R () -> R ()
forall a. a -> a
id
MatchGroupStyle
_ -> R () -> R ()
dontUseBraces
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
$ (LMatch GhcPs (Located body) -> R ())
-> [LMatch GhcPs (Located body)] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((Match GhcPs (Located body) -> R ())
-> LMatch GhcPs (Located body) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (R () -> R ()
ub (R () -> R ())
-> (Match GhcPs (Located body) -> R ())
-> Match GhcPs (Located body)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs (Located body) -> R ()
p_Match)) (Located [LMatch GhcPs (Located body)]
-> SrcSpanLess (Located [LMatch GhcPs (Located body)])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LMatch GhcPs (Located body)]
mg_alts)
where
p_Match :: Match GhcPs (Located body) -> R ()
p_Match m :: Match GhcPs (Located body)
m@Match {[LPat GhcPs]
HsMatchContext (NameOrRdrName (IdP GhcPs))
GRHSs GhcPs (Located body)
XCMatch GhcPs (Located body)
m_ext :: forall p body. Match p body -> XCMatch p body
m_ctxt :: forall p body.
Match p body -> HsMatchContext (NameOrRdrName (IdP 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 (Located body)
m_pats :: [LPat GhcPs]
m_ctxt :: HsMatchContext (NameOrRdrName (IdP GhcPs))
m_ext :: XCMatch GhcPs (Located body)
..} =
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (Located body)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (Located body)
-> R ()
p_match'
body -> Placement
placer
body -> R ()
render
(Match GhcPs (Located body) -> MatchGroupStyle -> MatchGroupStyle
forall body. Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle Match GhcPs (Located body)
m MatchGroupStyle
style)
(Match GhcPs (Located body) -> Bool
forall id body. Match id body -> Bool
isInfixMatch Match GhcPs (Located body)
m)
(Match GhcPs (Located body) -> SrcStrictness
forall id body. Match id body -> SrcStrictness
matchStrictness Match GhcPs (Located body)
m)
[LPat GhcPs]
m_pats
GRHSs GhcPs (Located body)
m_grhss
p_Match (XMatch XXMatch GhcPs (Located body)
x) = NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXMatch GhcPs (Located body)
x
p_matchGroup' body -> Placement
_ body -> R ()
_ MatchGroupStyle
_ (XMatchGroup XXMatchGroup GhcPs (Located body)
x) = NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXMatchGroup GhcPs (Located body)
x
adjustMatchGroupStyle ::
Match GhcPs body ->
MatchGroupStyle ->
MatchGroupStyle
adjustMatchGroupStyle :: Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle Match GhcPs body
m = \case
Function Located RdrName
_ -> (Located RdrName -> MatchGroupStyle
Function (Located RdrName -> MatchGroupStyle)
-> (Match GhcPs body -> Located RdrName)
-> Match GhcPs body
-> MatchGroupStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsMatchContext RdrName -> Located RdrName
forall id. HsMatchContext id -> Located id
mc_fun (HsMatchContext RdrName -> Located RdrName)
-> (Match GhcPs body -> HsMatchContext RdrName)
-> Match GhcPs body
-> Located RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs body -> HsMatchContext RdrName
forall p body.
Match p body -> HsMatchContext (NameOrRdrName (IdP 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 (NameOrRdrName (IdP id))
forall p body.
Match p body -> HsMatchContext (NameOrRdrName (IdP p))
m_ctxt Match id body
match of
FunRhs {mc_strictness :: forall id. HsMatchContext id -> SrcStrictness
mc_strictness = SrcStrictness
s} -> SrcStrictness
s
HsMatchContext (NameOrRdrName (IdP 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 (LHsExpr GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (Located body)
-> R ()
p_match' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_match' ::
Data body =>
(body -> Placement) ->
(body -> R ()) ->
MatchGroupStyle ->
Bool ->
SrcStrictness ->
[LPat GhcPs] ->
GRHSs GhcPs (Located body) ->
R ()
p_match' :: (body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (Located body)
-> R ()
p_match' body -> Placement
placer body -> R ()
render MatchGroupStyle
style Bool
isInfix SrcStrictness
strictness [LPat GhcPs]
m_pats GRHSs {[LGRHS GhcPs (Located body)]
XCGRHSs GhcPs (Located body)
LHsLocalBinds GhcPs
grhssExt :: forall p body. GRHSs p body -> XCGRHSs p body
grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssLocalBinds :: forall p body. GRHSs p body -> LHsLocalBinds p
grhssLocalBinds :: LHsLocalBinds GhcPs
grhssGRHSs :: [LGRHS GhcPs (Located body)]
grhssExt :: XCGRHSs GhcPs (Located 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 [Located (Pat GhcPs)] -> Maybe (NonEmpty (Located (Pat GhcPs)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
[Located (Pat GhcPs)]
m_pats of
Maybe (NonEmpty (Located (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 Located RdrName
name -> Located RdrName -> R ()
p_rdrName Located RdrName
name
MatchGroupStyle
_ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just NonEmpty (Located (Pat GhcPs))
ne_pats -> do
let combinedSpans :: SrcSpan
combinedSpans = case MatchGroupStyle
style of
Function Located RdrName
name -> SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located RdrName
name) SrcSpan
patSpans
MatchGroupStyle
_ -> SrcSpan
patSpans
patSpans :: SrcSpan
patSpans = NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located (Pat GhcPs) -> SrcSpan)
-> NonEmpty (Located (Pat GhcPs)) -> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Located (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 ()
-> (Located (Pat GhcPs) -> R ()) -> [Located (Pat GhcPs)] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((Pat GhcPs -> R ()) -> Located (Pat GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[Located (Pat GhcPs)]
m_pats
case MatchGroupStyle
style of
Function Located RdrName
name ->
Bool -> Bool -> R () -> [R ()] -> R ()
p_infixDefHelper
Bool
isInfix
Bool
indentBody
(Located RdrName -> R ()
p_rdrName Located RdrName
name)
((Pat GhcPs -> R ()) -> Located (Pat GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Pat GhcPs -> R ()
p_pat (Located (Pat GhcPs) -> R ()) -> [Located (Pat GhcPs)] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs]
[Located (Pat GhcPs)]
m_pats)
MatchGroupStyle
PatternBind -> R ()
stdCase
MatchGroupStyle
Case -> R ()
stdCase
MatchGroupStyle
Lambda -> do
let needsSpace :: Bool
needsSpace = case Located (Pat GhcPs) -> SrcSpanLess (Located (Pat GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (NonEmpty (Located (Pat GhcPs)) -> Located (Pat GhcPs)
forall a. NonEmpty a -> a
NE.head NonEmpty (Located (Pat GhcPs))
ne_pats) of
LazyPat _ _ -> Bool
True
BangPat _ _ -> Bool
True
SplicePat _ _ -> Bool
True
SrcSpanLess (Located (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 [Located (Pat GhcPs)] -> Maybe (NonEmpty (Located (Pat GhcPs)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
[Located (Pat GhcPs)]
m_pats of
Maybe (NonEmpty (Located (Pat GhcPs)))
Nothing -> case MatchGroupStyle
style of
Function Located RdrName
name -> SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located RdrName
name)
MatchGroupStyle
_ -> Maybe SrcSpan
forall a. Maybe a
Nothing
Just NonEmpty (Located (Pat GhcPs))
pats -> (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (SrcSpan -> Maybe SrcSpan)
-> (NonEmpty (Located (Pat GhcPs)) -> SrcSpan)
-> NonEmpty (Located (Pat GhcPs))
-> Maybe SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located (Pat GhcPs) -> SrcSpan)
-> (NonEmpty (Located (Pat GhcPs)) -> Located (Pat GhcPs))
-> NonEmpty (Located (Pat GhcPs))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Located (Pat GhcPs)) -> Located (Pat GhcPs)
forall a. NonEmpty a -> a
NE.last) NonEmpty (Located (Pat GhcPs))
pats
isCase :: MatchGroupStyle -> Bool
isCase = \case
MatchGroupStyle
Case -> Bool
True
MatchGroupStyle
LambdaCase -> Bool
True
MatchGroupStyle
_ -> Bool
False
hasGuards :: Bool
hasGuards = [LGRHS GhcPs (Located body)] -> Bool
forall body. [LGRHS GhcPs (Located body)] -> Bool
withGuards [LGRHS GhcPs (Located body)]
grhssGRHSs
grhssSpan :: SrcSpan
grhssSpan =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$
GRHS GhcPs (Located body) -> SrcSpan
forall body. GRHS GhcPs (Located body) -> SrcSpan
getGRHSSpan (GRHS GhcPs (Located body) -> SrcSpan)
-> (LGRHS GhcPs (Located body) -> GRHS GhcPs (Located body))
-> LGRHS GhcPs (Located body)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LGRHS GhcPs (Located body) -> GRHS GhcPs (Located body)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LGRHS GhcPs (Located body) -> SrcSpan)
-> NonEmpty (LGRHS GhcPs (Located body)) -> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LGRHS GhcPs (Located body)]
-> NonEmpty (LGRHS GhcPs (Located body))
forall a. [a] -> NonEmpty a
NE.fromList [LGRHS GhcPs (Located 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
Maybe SrcSpan
Nothing -> (body -> Placement) -> [LGRHS GhcPs (Located body)] -> Placement
forall body.
(body -> Placement) -> [LGRHS GhcPs (Located body)] -> Placement
blockPlacement body -> Placement
placer [LGRHS GhcPs (Located body)]
grhssGRHSs
Just SrcSpan
spn ->
if SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn SrcSpan
grhssSpan
then (body -> Placement) -> [LGRHS GhcPs (Located body)] -> Placement
forall body.
(body -> Placement) -> [LGRHS GhcPs (Located body)] -> Placement
blockPlacement body -> Placement
placer [LGRHS GhcPs (Located body)]
grhssGRHSs
else Placement
Normal
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 ()
-> (LGRHS GhcPs (Located body) -> R ())
-> [LGRHS GhcPs (Located body)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline ((GRHS GhcPs (Located body) -> R ())
-> LGRHS GhcPs (Located body) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' ((body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (Located body)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (Located body)
-> R ()
p_grhs' body -> Placement
placer body -> R ()
render GroupStyle
groupStyle)) [LGRHS GhcPs (Located body)]
grhssGRHSs
p_where :: R ()
p_where = do
let whereIsEmpty :: Bool
whereIsEmpty = HsLocalBindsLR GhcPs GhcPs -> Bool
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b) -> Bool
GHC.isEmptyLocalBindsPR (LHsLocalBinds GhcPs -> SrcSpanLess (LHsLocalBinds GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsLocalBinds GhcPs
grhssLocalBinds)
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HsLocalBindsLR GhcPs GhcPs -> Bool
forall a b. HsLocalBindsLR a b -> Bool
GHC.eqEmptyLocalBinds (LHsLocalBinds GhcPs -> SrcSpanLess (LHsLocalBinds GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsLocalBinds GhcPs
grhssLocalBinds)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
Text -> R ()
txt Text
"where"
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
whereIsEmpty R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsLocalBinds GhcPs -> (HsLocalBindsLR GhcPs GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsLocalBinds GhcPs
grhssLocalBinds HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds
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 ([LGRHS GhcPs (Located body)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LGRHS GhcPs (Located 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 Located RdrName
_ | Bool
hasGuards -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Function Located 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_match' body -> Placement
_ body -> R ()
_ MatchGroupStyle
_ Bool
_ SrcStrictness
_ [LPat GhcPs]
_ (XGRHSs XXGRHSs GhcPs (Located body)
x) = NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXGRHSs GhcPs (Located body)
x
p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
p_grhs = (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> GroupStyle
-> GRHS GhcPs (LHsExpr GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (Located body)
-> R ()
p_grhs' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_grhs' ::
Data body =>
(body -> Placement) ->
(body -> R ()) ->
GroupStyle ->
GRHS GhcPs (Located body) ->
R ()
p_grhs' :: (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (Located body)
-> R ()
p_grhs' body -> Placement
placer body -> R ()
render GroupStyle
style (GRHS XCGRHS GhcPs (Located body)
NoExtField [GuardLStmt GhcPs]
guards Located body
body) =
case [GuardLStmt GhcPs]
guards of
[] -> R ()
p_body
[GuardLStmt GhcPs]
xs -> do
Text -> R ()
txt Text
"|"
R ()
space
R () -> R ()
sitcc (R () -> (GuardLStmt GhcPs -> R ()) -> [GuardLStmt GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (GuardLStmt GhcPs -> R ()) -> GuardLStmt GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt GhcPs (LHsExpr GhcPs) -> R ()) -> GuardLStmt GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt) [GuardLStmt 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
"->"
Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body
where
placement :: Placement
placement =
case Maybe SrcSpan
endOfGuards of
Maybe SrcSpan
Nothing -> body -> Placement
placer (Located body -> SrcSpanLess (Located body)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located body
body)
Just SrcSpan
spn ->
if SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn (Located body -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located body
body)
then body -> Placement
placer (Located body -> SrcSpanLess (Located body)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located body
body)
else Placement
Normal
endOfGuards :: Maybe SrcSpan
endOfGuards =
case [GuardLStmt GhcPs] -> Maybe (NonEmpty (GuardLStmt GhcPs))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [GuardLStmt GhcPs]
guards of
Maybe (NonEmpty (GuardLStmt GhcPs))
Nothing -> Maybe SrcSpan
forall a. Maybe a
Nothing
Just NonEmpty (GuardLStmt GhcPs)
gs -> (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (SrcSpan -> Maybe SrcSpan)
-> (NonEmpty (GuardLStmt GhcPs) -> SrcSpan)
-> NonEmpty (GuardLStmt GhcPs)
-> Maybe SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (GuardLStmt GhcPs -> SrcSpan)
-> (NonEmpty (GuardLStmt GhcPs) -> GuardLStmt GhcPs)
-> NonEmpty (GuardLStmt GhcPs)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (GuardLStmt GhcPs) -> GuardLStmt GhcPs
forall a. NonEmpty a -> a
NE.last) NonEmpty (GuardLStmt GhcPs)
gs
p_body :: R ()
p_body = Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located body
body body -> R ()
render
p_grhs' body -> Placement
_ body -> R ()
_ GroupStyle
_ (XGRHS XXGRHS GhcPs (Located body)
x) = NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXGRHS GhcPs (Located body)
x
p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd = \case
HsCmdArrApp XCmdArrApp GhcPs
NoExtField LHsExpr GhcPs
body LHsExpr GhcPs
input HsArrAppType
arrType Bool
_ -> do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
body 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 of
HsArrAppType
HsFirstOrderApp -> Text -> R ()
txt Text
"-<"
HsArrAppType
HsHigherOrderApp -> Text -> R ()
txt Text
"-<<"
Placement -> R () -> R ()
placeHanging (HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
input)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
input HsExpr GhcPs -> R ()
p_hsExpr
HsCmdArrForm XCmdArrForm GhcPs
NoExtField LHsExpr GhcPs
form LexicalFixity
Prefix Maybe Fixity
_ [LHsCmdTop GhcPs]
cmds -> R () -> R ()
banana (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
form HsExpr GhcPs -> R ()
p_hsExpr
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LHsCmdTop GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsCmdTop 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 ()) -> LHsCmdTop GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsCmdTop GhcPs -> R ()
p_hsCmdTop (LHsCmdTop GhcPs -> R ()) -> [LHsCmdTop GhcPs] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsCmdTop GhcPs]
cmds)))
HsCmdArrForm XCmdArrForm GhcPs
NoExtField LHsExpr GhcPs
form LexicalFixity
Infix Maybe Fixity
_ [LHsCmdTop GhcPs
left, LHsCmdTop GhcPs
right] -> do
LHsCmdTop GhcPs -> (HsCmdTop GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
left HsCmdTop GhcPs -> R ()
p_hsCmdTop
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
form HsExpr GhcPs -> R ()
p_hsExpr
Placement -> R () -> R ()
placeHanging (HsCmdTop GhcPs -> Placement
cmdTopPlacement (LHsCmdTop GhcPs -> SrcSpanLess (LHsCmdTop GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsCmdTop GhcPs
right)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
LHsCmdTop GhcPs -> (HsCmdTop GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
right HsCmdTop GhcPs -> R ()
p_hsCmdTop
HsCmdArrForm XCmdArrForm GhcPs
NoExtField LHsExpr GhcPs
_ LexicalFixity
Infix Maybe Fixity
_ [LHsCmdTop GhcPs]
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsCmdArrForm"
HsCmdApp {} ->
String -> R ()
forall a. String -> a
notImplemented String
"HsCmdApp"
HsCmdLam XCmdLam GhcPs
NoExtField MatchGroup GhcPs (LHsCmd GhcPs)
mgroup -> (HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LHsCmd GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
p_matchGroup' HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd MatchGroupStyle
Lambda MatchGroup GhcPs (LHsCmd GhcPs)
mgroup
HsCmdPar XCmdPar GhcPs
NoExtField LHsCmd GhcPs
c -> BracketStyle -> R () -> R ()
parens BracketStyle
N (LHsCmd GhcPs -> (HsCmd GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
c HsCmd GhcPs -> R ()
p_hsCmd)
HsCmdCase XCmdCase GhcPs
NoExtField LHsExpr GhcPs
e MatchGroup GhcPs (LHsCmd GhcPs)
mgroup ->
(HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LHsCmd GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (Located body)
-> R ()
p_case HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd LHsExpr GhcPs
e MatchGroup GhcPs (LHsCmd GhcPs)
mgroup
HsCmdIf XCmdIf GhcPs
NoExtField Maybe (SyntaxExpr GhcPs)
_ LHsExpr GhcPs
if' LHsCmd GhcPs
then' LHsCmd GhcPs
else' ->
(HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> LHsExpr GhcPs
-> LHsCmd GhcPs
-> LHsCmd GhcPs
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> Located body
-> Located body
-> R ()
p_if HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd LHsExpr GhcPs
if' LHsCmd GhcPs
then' LHsCmd GhcPs
else'
HsCmdLet XCmdLet GhcPs
NoExtField LHsLocalBinds GhcPs
localBinds LHsCmd GhcPs
c ->
(HsCmd GhcPs -> R ())
-> LHsLocalBinds GhcPs -> LHsCmd GhcPs -> R ()
forall body.
Data body =>
(body -> R ()) -> LHsLocalBinds GhcPs -> Located body -> R ()
p_let HsCmd GhcPs -> R ()
p_hsCmd LHsLocalBinds GhcPs
localBinds LHsCmd GhcPs
c
HsCmdDo XCmdDo GhcPs
NoExtField Located [CmdLStmt GhcPs]
es -> do
Text -> R ()
txt Text
"do"
R ()
newline
R () -> R ()
inci (R () -> R ())
-> (([CmdLStmt GhcPs] -> R ()) -> R ())
-> ([CmdLStmt GhcPs] -> R ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located [CmdLStmt GhcPs] -> ([CmdLStmt GhcPs] -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located [CmdLStmt GhcPs]
es (([CmdLStmt GhcPs] -> R ()) -> R ())
-> ([CmdLStmt GhcPs] -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> R ()
sitcc (R () -> R ())
-> ([CmdLStmt GhcPs] -> R ()) -> [CmdLStmt GhcPs] -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> (CmdLStmt GhcPs -> R ()) -> [CmdLStmt GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline (R () -> R ()
sitcc (R () -> R ())
-> (CmdLStmt GhcPs -> R ()) -> CmdLStmt GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt GhcPs (LHsCmd GhcPs) -> R ()) -> CmdLStmt GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
withSpacing ((HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ()) -> Stmt GhcPs (LHsCmd GhcPs) -> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
p_stmt' HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd))
HsCmdWrap {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsCmdWrap"
XCmd XXCmd GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXCmd GhcPs
x
p_hsCmdTop :: HsCmdTop GhcPs -> R ()
p_hsCmdTop :: HsCmdTop GhcPs -> R ()
p_hsCmdTop = \case
HsCmdTop XCmdTop GhcPs
NoExtField LHsCmd GhcPs
cmd -> LHsCmd GhcPs -> (HsCmd GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
cmd HsCmd GhcPs -> R ()
p_hsCmd
XCmdTop XXCmdTop GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXCmdTop GhcPs
x
withSpacing ::
(a -> R ()) ->
Located a ->
R ()
withSpacing :: (a -> R ()) -> Located a -> R ()
withSpacing a -> R ()
f Located a
l = Located a -> (a -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located a
l ((a -> R ()) -> R ()) -> (a -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
case Located a -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located a
l of
UnhelpfulSpan FastString
_ -> a -> R ()
f a
x
RealSrcSpan RealSrcSpan
currentSpn -> 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 ()) -> Stmt GhcPs (LHsExpr GhcPs) -> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
p_stmt' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_stmt' ::
Data body =>
(body -> Placement) ->
(body -> R ()) ->
Stmt GhcPs (Located body) ->
R ()
p_stmt' :: (body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render = \case
LastStmt XLastStmt GhcPs GhcPs (Located body)
NoExtField Located body
body Bool
_ SyntaxExpr GhcPs
_ -> Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located body
body body -> R ()
render
BindStmt XBindStmt GhcPs GhcPs (Located body)
NoExtField LPat GhcPs
p Located body
f SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ -> do
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
p Pat GhcPs -> R ()
p_pat
R ()
space
Text -> R ()
txt Text
"<-"
let loc :: SrcSpan
loc = Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LPat GhcPs
Located (Pat GhcPs)
p
placement :: Placement
placement =
case Located body
f of
L SrcSpan
l' body
x ->
if SrcSpan -> Bool
isOneLineSpan
(SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (SrcSpan -> SrcLoc
srcSpanEnd SrcSpan
loc) (SrcSpan -> SrcLoc
srcSpanStart SrcSpan
l'))
then body -> Placement
placer body
x
else Placement
Normal
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
loc, Located body -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located body
f] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
Placement -> R () -> R ()
placeHanging Placement
placement (Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located body
f body -> R ()
render)
ApplicativeStmt {} -> String -> R ()
forall a. String -> a
notImplemented String
"ApplicativeStmt"
BodyStmt XBodyStmt GhcPs GhcPs (Located body)
NoExtField Located body
body SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ -> Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located body
body body -> R ()
render
LetStmt XLetStmt GhcPs GhcPs (Located body)
NoExtField LHsLocalBinds GhcPs
binds -> do
Text -> R ()
txt Text
"let"
R ()
space
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsLocalBinds GhcPs -> (HsLocalBindsLR GhcPs GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsLocalBinds GhcPs
binds HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds
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
XTransStmt GhcPs GhcPs (Located body)
LHsExpr GhcPs
trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
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 (Located body)
..} ->
case (TransForm
trS_form, Maybe (LHsExpr GhcPs)
trS_by) of
(TransForm
ThenForm, Maybe (LHsExpr GhcPs)
Nothing) -> do
Text -> R ()
txt Text
"then"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
trS_using HsExpr GhcPs -> R ()
p_hsExpr
(TransForm
ThenForm, Just LHsExpr GhcPs
e) -> do
Text -> R ()
txt Text
"then"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr
(TransForm
GroupForm, Maybe (LHsExpr 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
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
trS_using HsExpr GhcPs -> R ()
p_hsExpr
(TransForm
GroupForm, Just LHsExpr 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
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
trS_using HsExpr GhcPs -> R ()
p_hsExpr
RecStmt {[IdP GhcPs]
[LStmtLR GhcPs GhcPs (Located body)]
SyntaxExpr GhcPs
XRecStmt GhcPs GhcPs (Located 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 -> [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 :: [LStmtLR GhcPs GhcPs (Located body)]
recS_ext :: XRecStmt GhcPs GhcPs (Located body)
..} -> do
Text -> R ()
txt Text
"rec"
R ()
space
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ (LStmtLR GhcPs GhcPs (Located body) -> R ())
-> [LStmtLR GhcPs GhcPs (Located body)] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((Stmt GhcPs (Located body) -> R ())
-> LStmtLR GhcPs GhcPs (Located body) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
withSpacing ((body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render)) [LStmtLR GhcPs GhcPs (Located body)]
recS_stmts
XStmtLR XXStmtLR GhcPs GhcPs (Located body)
c -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXStmtLR GhcPs GhcPs (Located body)
c
gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]
gatherStmt :: GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt (L SrcSpan
_ (ParStmt XParStmt GhcPs GhcPs (LHsExpr GhcPs)
NoExtField [ParStmtBlock GhcPs GhcPs]
block HsExpr GhcPs
_ SyntaxExpr GhcPs
_)) =
(ParStmtBlock GhcPs GhcPs
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> [[GuardLStmt GhcPs]]
-> [ParStmtBlock GhcPs GhcPs]
-> [[GuardLStmt GhcPs]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]]
forall a. Semigroup a => a -> a -> a
(<>) ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> (ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]])
-> ParStmtBlock GhcPs GhcPs
-> [[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]]
gatherStmtBlock) [] [ParStmtBlock GhcPs GhcPs]
block
gatherStmt (L SrcSpan
s stmt :: Stmt GhcPs (LHsExpr GhcPs)
stmt@TransStmt {[(IdP GhcPs, IdP GhcPs)]
[GuardLStmt GhcPs]
Maybe (LHsExpr GhcPs)
TransForm
HsExpr GhcPs
SyntaxExpr GhcPs
XTransStmt GhcPs GhcPs (LHsExpr GhcPs)
LHsExpr GhcPs
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 (LHsExpr GhcPs)
trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
..}) =
([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> [[GuardLStmt GhcPs]]
-> [[[GuardLStmt GhcPs]]]
-> [[GuardLStmt GhcPs]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend [] ((GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt (GuardLStmt GhcPs -> [[GuardLStmt GhcPs]])
-> [GuardLStmt GhcPs] -> [[[GuardLStmt GhcPs]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuardLStmt GhcPs]
trS_stmts) [[[GuardLStmt GhcPs]]]
-> [[[GuardLStmt GhcPs]]] -> [[[GuardLStmt GhcPs]]]
forall a. Semigroup a => a -> a -> a
<> [[GuardLStmt GhcPs]] -> [[[GuardLStmt GhcPs]]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[SrcSpan -> Stmt GhcPs (LHsExpr GhcPs) -> GuardLStmt GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
s Stmt GhcPs (LHsExpr 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
_) =
(GuardLStmt GhcPs -> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> [[GuardLStmt GhcPs]]
-> [GuardLStmt GhcPs]
-> [[GuardLStmt GhcPs]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> (GuardLStmt GhcPs -> [[GuardLStmt GhcPs]])
-> GuardLStmt GhcPs
-> [[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt) [] [GuardLStmt GhcPs]
stmts
gatherStmtBlock (XParStmtBlock XXParStmtBlock GhcPs GhcPs
x) = NoExtCon -> [[GuardLStmt GhcPs]]
forall a. NoExtCon -> a
noExtCon NoExtCon
XXParStmtBlock GhcPs GhcPs
x
p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds = \case
HsValBinds XHsValBinds GhcPs GhcPs
NoExtField (ValBinds XValBinds GhcPs GhcPs
NoExtField LHsBindsLR GhcPs GhcPs
bag [LSig GhcPs]
lsigs) -> 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 SrcSpan (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 SrcSpan (HsBindLR GhcPs GhcPs)
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
forall l a b. GenLocated l a -> GenLocated l (Either a b)
injectLeft (GenLocated SrcSpan (HsBindLR GhcPs GhcPs)
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> [GenLocated SrcSpan (HsBindLR GhcPs GhcPs)]
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsBindsLR GhcPs GhcPs
-> [GenLocated SrcSpan (HsBindLR GhcPs GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
bag) [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall a. [a] -> [a] -> [a]
++ (LSig GhcPs
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
forall l b a. GenLocated l b -> GenLocated l (Either a b)
injectRight (LSig GhcPs
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> [LSig GhcPs]
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LSig 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 SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> R ()
p_item' (RelativePos
p, GenLocated SrcSpan (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 SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> R ()
forall a. (a -> R ()) -> Located 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 SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
item
binds :: [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
binds = (GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> SrcLoc)
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc)
-> (GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> SrcSpan)
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc) [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
items
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ ((RelativePos,
GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> R ())
-> [(RelativePos,
GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))]
-> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi (RelativePos,
GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> R ()
p_item' ([GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [(RelativePos,
GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))]
forall a. [a] -> [(RelativePos, a)]
attachRelativePos [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
binds)
HsValBinds XHsValBinds GhcPs GhcPs
NoExtField HsValBindsLR GhcPs GhcPs
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsValBinds"
HsIPBinds XHsIPBinds GhcPs GhcPs
NoExtField (IPBinds XIPBinds GhcPs
NoExtField [LIPBind GhcPs]
xs) ->
let p_ipBind :: IPBind GhcPs -> R ()
p_ipBind (IPBind XCIPBind GhcPs
NoExtField (Left Located HsIPName
name) LHsExpr GhcPs
expr) = do
Located HsIPName -> R ()
forall a. Outputable a => a -> R ()
atom Located 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
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr HsExpr GhcPs -> R ()
p_hsExpr
p_ipBind (IPBind XCIPBind GhcPs
NoExtField (Right IdP GhcPs
_) LHsExpr GhcPs
_) =
String -> R ()
forall a. String -> a
notImplemented String
"IPBind _ (Right _) _"
p_ipBind (XIPBind XXIPBind GhcPs
x) = NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXIPBind GhcPs
x
in (LIPBind GhcPs -> R ()) -> [LIPBind GhcPs] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((IPBind GhcPs -> R ()) -> LIPBind GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' IPBind GhcPs -> R ()
p_ipBind) [LIPBind GhcPs]
xs
HsIPBinds XHsIPBinds GhcPs GhcPs
NoExtField HsIPBinds GhcPs
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsIpBinds"
EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
NoExtField -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
XHsLocalBindsLR XXHsLocalBindsLR GhcPs GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXHsLocalBindsLR GhcPs GhcPs
x
p_hsRecField ::
HsRecField' RdrName (LHsExpr GhcPs) ->
R ()
p_hsRecField :: HsRecField' RdrName (LHsExpr GhcPs) -> R ()
p_hsRecField HsRecField {Bool
LHsExpr GhcPs
Located RdrName
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 RdrName
..} = do
Located RdrName -> R ()
p_rdrName Located RdrName
hsRecFieldLbl
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 RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located RdrName
hsRecFieldLbl) (LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr GhcPs
hsRecFieldArg)
then HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
hsRecFieldArg)
else Placement
Normal
Placement -> R () -> R ()
placeHanging Placement
placement (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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
NoExtField Located (IdP GhcPs)
name -> Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
name
HsUnboundVar XUnboundVar GhcPs
NoExtField UnboundVar
v -> OccName -> R ()
forall a. Outputable a => a -> R ()
atom (UnboundVar -> OccName
unboundVarOcc UnboundVar
v)
HsConLikeOut XConLikeOut GhcPs
NoExtField ConLike
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsConLikeOut"
HsRecFld XRecFld GhcPs
NoExtField AmbiguousFieldOcc GhcPs
x ->
case AmbiguousFieldOcc GhcPs
x of
Unambiguous XUnambiguous GhcPs
NoExtField Located RdrName
name -> Located RdrName -> R ()
p_rdrName Located RdrName
name
Ambiguous XAmbiguous GhcPs
NoExtField Located RdrName
name -> Located RdrName -> R ()
p_rdrName Located RdrName
name
XAmbiguousFieldOcc XXAmbiguousFieldOcc GhcPs
xx -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXAmbiguousFieldOcc GhcPs
xx
HsOverLabel XOverLabel GhcPs
NoExtField Maybe (IdP GhcPs)
_ FastString
v -> do
Text -> R ()
txt Text
"#"
FastString -> R ()
forall a. Outputable a => a -> R ()
atom FastString
v
HsIPVar XIPVar GhcPs
NoExtField (HsIPName FastString
name) -> do
Text -> R ()
txt Text
"?"
FastString -> R ()
forall a. Outputable a => a -> R ()
atom FastString
name
HsOverLit XOverLitE GhcPs
NoExtField 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
NoExtField 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
NoExtField MatchGroup GhcPs (LHsExpr GhcPs)
mgroup ->
MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup MatchGroupStyle
Lambda MatchGroup GhcPs (LHsExpr GhcPs)
mgroup
HsLamCase XLamCase GhcPs
NoExtField MatchGroup GhcPs (LHsExpr GhcPs)
mgroup -> do
Text -> R ()
txt Text
"\\case"
R ()
breakpoint
R () -> R ()
inci (MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup MatchGroupStyle
LambdaCase MatchGroup GhcPs (LHsExpr GhcPs)
mgroup)
HsApp XApp GhcPs
NoExtField LHsExpr GhcPs
f LHsExpr GhcPs
x -> do
let
gatherArgs :: LHsExpr p
-> NonEmpty (LHsExpr p) -> (LHsExpr p, NonEmpty (LHsExpr p))
gatherArgs LHsExpr p
f' NonEmpty (LHsExpr p)
knownArgs =
case LHsExpr p
f' of
L SrcSpan
_ (HsApp XApp p
_ LHsExpr p
l LHsExpr p
r) -> LHsExpr p
-> NonEmpty (LHsExpr p) -> (LHsExpr p, NonEmpty (LHsExpr p))
gatherArgs LHsExpr p
l (LHsExpr p
r LHsExpr p -> NonEmpty (LHsExpr p) -> NonEmpty (LHsExpr p)
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty (LHsExpr p)
knownArgs)
LHsExpr p
_ -> (LHsExpr p
f', NonEmpty (LHsExpr p)
knownArgs)
(LHsExpr GhcPs
func, NonEmpty (LHsExpr GhcPs)
args) = LHsExpr GhcPs
-> NonEmpty (LHsExpr GhcPs)
-> (LHsExpr GhcPs, NonEmpty (LHsExpr GhcPs))
forall p.
LHsExpr p
-> NonEmpty (LHsExpr p) -> (LHsExpr p, NonEmpty (LHsExpr p))
gatherArgs LHsExpr GhcPs
f (LHsExpr GhcPs
x LHsExpr GhcPs -> [LHsExpr GhcPs] -> NonEmpty (LHsExpr GhcPs)
forall a. a -> [a] -> NonEmpty a
:| [])
([LHsExpr GhcPs]
initp, LHsExpr GhcPs
lastp) = (NonEmpty (LHsExpr GhcPs) -> [LHsExpr GhcPs]
forall a. NonEmpty a -> [a]
NE.init NonEmpty (LHsExpr GhcPs)
args, NonEmpty (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. NonEmpty a -> a
NE.last NonEmpty (LHsExpr GhcPs)
args)
initSpan :: SrcSpan
initSpan =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$
LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr GhcPs
f SrcSpan -> [SrcSpan] -> NonEmpty SrcSpan
forall a. a -> [a] -> NonEmpty a
:| [(SrcLoc -> SrcSpan
srcLocSpan (SrcLoc -> SrcSpan)
-> (LHsExpr GhcPs -> SrcLoc) -> LHsExpr GhcPs -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc)
-> (LHsExpr GhcPs -> SrcSpan) -> LHsExpr GhcPs -> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc) LHsExpr GhcPs
lastp]
placement :: Placement
placement =
if SrcSpan -> Bool
isOneLineSpan SrcSpan
initSpan
then HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
lastp)
else Placement
Normal
case Placement
placement of
Placement
Normal -> do
let
doIndent :: Bool
doIndent =
case LHsExpr GhcPs
func of
L SrcSpan
_ (HsPar XPar GhcPs
NoExtField LHsExpr GhcPs
_) -> Bool
True
L SrcSpan
_ (HsAppType XAppTypeE GhcPs
NoExtField LHsExpr GhcPs
_ LHsWcType (NoGhcTc GhcPs)
_) -> Bool
True
L SrcSpan
_ (HsMultiIf XMultiIf GhcPs
NoExtField [LGRHS GhcPs (LHsExpr GhcPs)]
_) -> Bool
True
L SrcSpan
spn HsExpr GhcPs
_ -> SrcSpan -> Bool
isOneLineSpan SrcSpan
spn
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
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
func (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
R ()
breakpoint
Bool -> R () -> R ()
inciIf Bool
doIndent (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs]
initp
Bool -> R () -> R ()
inciIf Bool
doIndent (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LHsExpr GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsExpr GhcPs]
initp) R ()
breakpoint
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
func (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
R ()
breakpoint
R () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs]
initp
Placement -> R () -> R ()
placeHanging Placement
placement (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
lastp HsExpr GhcPs -> R ()
p_hsExpr
HsAppType XAppTypeE GhcPs
NoExtField LHsExpr GhcPs
e LHsWcType (NoGhcTc GhcPs)
a -> do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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 LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (HsWildCardBndrs GhcPs (LHsType GhcPs) -> LHsType GhcPs
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (LHsType GhcPs)
LHsWcType (NoGhcTc GhcPs)
a) of
HsSpliceTy {} -> R ()
space
SrcSpanLess (LHsType GhcPs)
_ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located (HsWildCardBndrs GhcPs (LHsType GhcPs) -> LHsType GhcPs
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (LHsType GhcPs)
LHsWcType (NoGhcTc GhcPs)
a) HsType GhcPs -> R ()
p_hsType
OpApp XOpApp GhcPs
NoExtField LHsExpr GhcPs
x LHsExpr GhcPs
op LHsExpr GhcPs
y -> do
let opTree :: OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
opTree = OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> OpTree (LHsExpr GhcPs) (LHsExpr 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
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 (LHsExpr GhcPs) (LHsExpr GhcPs)
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
forall op ty.
(op -> Maybe RdrName)
-> OpTree (Located ty) (Located op)
-> OpTree (Located ty) (Located op)
reassociateOpTree HsExpr GhcPs -> Maybe RdrName
getOpName OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
opTree)
NegApp XNegApp GhcPs
NoExtField LHsExpr GhcPs
e SyntaxExpr GhcPs
_ -> do
Text -> R ()
txt Text
"-"
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr
HsPar XPar GhcPs
NoExtField LHsExpr GhcPs
e ->
BracketStyle -> R () -> R ()
parens BracketStyle
s (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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
NoExtField LHsExpr GhcPs
x LHsExpr GhcPs
op -> do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
op HsExpr GhcPs -> R ()
p_hsExpr)
SectionR XSectionR GhcPs
NoExtField LHsExpr GhcPs
op LHsExpr GhcPs
x -> do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
op HsExpr GhcPs -> R ()
p_hsExpr
Bool
useRecordDot' <- R Bool
useRecordDot
let isRecordDot' :: Bool
isRecordDot' = HsExpr GhcPs -> SrcSpan -> Bool
isRecordDot (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
op) (LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr GhcPs
x)
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
useRecordDot' Bool -> Bool -> Bool
&& Bool
isRecordDot') R ()
breakpoint
R () -> R ()
inci (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr)
ExplicitTuple XExplicitTuple GhcPs
NoExtField [LHsTupArg GhcPs]
args Boxity
boxity ->
let isSection :: Bool
isSection = (LHsTupArg GhcPs -> Bool) -> [LHsTupArg GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (HsTupArg GhcPs -> Bool
isMissing (HsTupArg GhcPs -> Bool)
-> (LHsTupArg GhcPs -> HsTupArg GhcPs) -> LHsTupArg GhcPs -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTupArg GhcPs -> HsTupArg GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LHsTupArg GhcPs]
args
isMissing :: HsTupArg GhcPs -> Bool
isMissing = \case
Missing XMissing GhcPs
NoExtField -> Bool
True
HsTupArg GhcPs
_ -> Bool
False
p_arg :: HsTupArg GhcPs -> R ()
p_arg = \case
Present XPresent GhcPs
NoExtField LHsExpr GhcPs
x -> LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr
Missing XMissing GhcPs
NoExtField -> () -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
XTupArg XXTupArg GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXTupArg GhcPs
x
p_larg :: LHsTupArg GhcPs -> R ()
p_larg = R () -> R ()
sitcc (R () -> R ())
-> (LHsTupArg GhcPs -> R ()) -> LHsTupArg GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsTupArg GhcPs -> R ()) -> LHsTupArg GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsTupArg GhcPs -> R ()
p_arg
parens' :: BracketStyle -> R () -> R ()
parens' =
case Boxity
boxity of
Boxity
Boxed -> BracketStyle -> R () -> R ()
parens
Boxity
Unboxed -> BracketStyle -> R () -> R ()
parensHash
in 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 () -> (LHsTupArg GhcPs -> R ()) -> [LHsTupArg GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
comma LHsTupArg GhcPs -> R ()
p_larg [LHsTupArg GhcPs]
args
else
[SrcSpan] -> R () -> R ()
switchLayout (LHsTupArg GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LHsTupArg GhcPs -> SrcSpan) -> [LHsTupArg GhcPs] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsTupArg GhcPs]
args) (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 () -> (LHsTupArg GhcPs -> R ()) -> [LHsTupArg GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel LHsTupArg GhcPs -> R ()
p_larg [LHsTupArg GhcPs]
args
ExplicitSum XExplicitSum GhcPs
NoExtField Int
tag Int
arity LHsExpr GhcPs
e ->
BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum BracketStyle
N Int
tag Int
arity (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr)
HsCase XCase GhcPs
NoExtField LHsExpr GhcPs
e MatchGroup GhcPs (LHsExpr GhcPs)
mgroup ->
(HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (Located body)
-> R ()
p_case HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr LHsExpr GhcPs
e MatchGroup GhcPs (LHsExpr GhcPs)
mgroup
HsIf XIf GhcPs
NoExtField Maybe (SyntaxExpr GhcPs)
_ LHsExpr GhcPs
if' LHsExpr GhcPs
then' LHsExpr GhcPs
else' ->
(HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> Located body
-> Located body
-> R ()
p_if HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr LHsExpr GhcPs
if' LHsExpr GhcPs
then' LHsExpr GhcPs
else'
HsMultiIf XMultiIf GhcPs
NoExtField [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 ()
-> (LGRHS GhcPs (LHsExpr GhcPs) -> R ())
-> [LGRHS GhcPs (LHsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline ((GRHS GhcPs (LHsExpr GhcPs) -> R ())
-> LGRHS GhcPs (LHsExpr GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
p_grhs GroupStyle
RightArrow)) [LGRHS GhcPs (LHsExpr GhcPs)]
guards
HsLet XLet GhcPs
NoExtField LHsLocalBinds GhcPs
localBinds LHsExpr GhcPs
e ->
(HsExpr GhcPs -> R ())
-> LHsLocalBinds GhcPs -> LHsExpr GhcPs -> R ()
forall body.
Data body =>
(body -> R ()) -> LHsLocalBinds GhcPs -> Located body -> R ()
p_let HsExpr GhcPs -> R ()
p_hsExpr LHsLocalBinds GhcPs
localBinds LHsExpr GhcPs
e
HsDo XDo GhcPs
NoExtField HsStmtContext Name
ctx Located [GuardLStmt GhcPs]
es -> do
let doBody :: Text -> R ()
doBody Text
header = do
Text -> R ()
txt Text
header
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 ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
(GuardLStmt GhcPs -> R ()) -> [GuardLStmt GhcPs] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi
(R () -> R ()
ub (R () -> R ())
-> (GuardLStmt GhcPs -> R ()) -> GuardLStmt GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt GhcPs (LHsExpr GhcPs) -> R ()) -> GuardLStmt GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
withSpacing ((HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ()) -> Stmt GhcPs (LHsExpr GhcPs) -> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
p_stmt' HsExpr GhcPs -> Placement
exprPlacement (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
S)))
(Located [GuardLStmt GhcPs]
-> SrcSpanLess (Located [GuardLStmt GhcPs])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [GuardLStmt GhcPs]
es)
compBody :: R ()
compBody = BracketStyle -> R () -> R ()
brackets BracketStyle
N (R () -> R ())
-> (([GuardLStmt GhcPs] -> R ()) -> R ())
-> ([GuardLStmt GhcPs] -> R ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located [GuardLStmt GhcPs] -> ([GuardLStmt GhcPs] -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located [GuardLStmt GhcPs]
es (([GuardLStmt GhcPs] -> R ()) -> R ())
-> ([GuardLStmt GhcPs] -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \[GuardLStmt GhcPs]
xs -> do
let p_parBody :: [[GuardLStmt GhcPs]] -> R ()
p_parBody =
R ()
-> ([GuardLStmt GhcPs] -> R ()) -> [[GuardLStmt 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)
[GuardLStmt GhcPs] -> R ()
p_seqBody
p_seqBody :: [GuardLStmt GhcPs] -> R ()
p_seqBody =
R () -> R ()
sitcc
(R () -> R ())
-> ([GuardLStmt GhcPs] -> R ()) -> [GuardLStmt GhcPs] -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> (GuardLStmt GhcPs -> R ()) -> [GuardLStmt GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
R ()
commaDel
((Stmt GhcPs (LHsExpr GhcPs) -> R ()) -> GuardLStmt GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (R () -> R ()
sitcc (R () -> R ())
-> (Stmt GhcPs (LHsExpr GhcPs) -> R ())
-> Stmt GhcPs (LHsExpr GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt))
stmts :: [GuardLStmt GhcPs]
stmts = [GuardLStmt GhcPs] -> [GuardLStmt GhcPs]
forall a. [a] -> [a]
init [GuardLStmt GhcPs]
xs
yield :: GuardLStmt GhcPs
yield = [GuardLStmt GhcPs] -> GuardLStmt GhcPs
forall a. [a] -> a
last [GuardLStmt GhcPs]
xs
lists :: [[GuardLStmt GhcPs]]
lists = (GuardLStmt GhcPs -> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> [[GuardLStmt GhcPs]]
-> [GuardLStmt GhcPs]
-> [[GuardLStmt GhcPs]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> (GuardLStmt GhcPs -> [[GuardLStmt GhcPs]])
-> GuardLStmt GhcPs
-> [[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt) [] [GuardLStmt GhcPs]
stmts
GuardLStmt GhcPs -> (Stmt GhcPs (LHsExpr GhcPs) -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located GuardLStmt GhcPs
yield Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt
R ()
breakpoint
Text -> R ()
txt Text
"|"
R ()
space
[[GuardLStmt GhcPs]] -> R ()
p_parBody [[GuardLStmt GhcPs]]
lists
case HsStmtContext Name
ctx of
HsStmtContext Name
DoExpr -> Text -> R ()
doBody Text
"do"
HsStmtContext Name
MDoExpr -> Text -> R ()
doBody Text
"mdo"
HsStmtContext Name
ListComp -> R ()
compBody
HsStmtContext Name
MonadComp -> R ()
compBody
HsStmtContext Name
ArrowExpr -> String -> R ()
forall a. String -> a
notImplemented String
"ArrowExpr"
HsStmtContext Name
GhciStmtCtxt -> String -> R ()
forall a. String -> a
notImplemented String
"GhciStmtCtxt"
PatGuard HsMatchContext Name
_ -> String -> R ()
forall a. String -> a
notImplemented String
"PatGuard"
ParStmtCtxt HsStmtContext Name
_ -> String -> R ()
forall a. String -> a
notImplemented String
"ParStmtCtxt"
TransStmtCtxt HsStmtContext Name
_ -> String -> R ()
forall a. String -> a
notImplemented String
"TransStmtCtxt"
ExplicitList XExplicitList GhcPs
_ Maybe (SyntaxExpr GhcPs)
_ [LHsExpr GhcPs]
xs ->
BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ()) -> (LHsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs]
xs
RecordCon {HsRecordBinds GhcPs
XRecordCon GhcPs
Located (IdP GhcPs)
rcon_ext :: forall p. HsExpr p -> XRecordCon p
rcon_con_name :: forall p. HsExpr p -> Located (IdP p)
rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_flds :: HsRecordBinds GhcPs
rcon_con_name :: Located (IdP GhcPs)
rcon_ext :: XRecordCon GhcPs
..} -> do
Located RdrName -> (RdrName -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located (IdP GhcPs)
Located RdrName
rcon_con_name RdrName -> R ()
forall a. Outputable a => a -> R ()
atom
R ()
breakpoint
let HsRecFields {[LHsRecField GhcPs (LHsExpr 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 (LHsExpr GhcPs)]
..} = HsRecordBinds GhcPs
rcon_flds
updName :: HsRecField GhcPs (LHsExpr GhcPs)
-> HsRecField' RdrName (LHsExpr GhcPs)
updName HsRecField GhcPs (LHsExpr GhcPs)
f =
(HsRecField GhcPs (LHsExpr GhcPs)
f :: HsRecField GhcPs (LHsExpr GhcPs))
{ hsRecFieldLbl :: Located RdrName
hsRecFieldLbl = case Located (FieldOcc GhcPs) -> SrcSpanLess (Located (FieldOcc GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located (FieldOcc GhcPs)
-> SrcSpanLess (Located (FieldOcc GhcPs)))
-> Located (FieldOcc GhcPs)
-> SrcSpanLess (Located (FieldOcc GhcPs))
forall a b. (a -> b) -> a -> b
$ HsRecField GhcPs (LHsExpr GhcPs) -> Located (FieldOcc GhcPs)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl HsRecField GhcPs (LHsExpr GhcPs)
f of
FieldOcc _ n -> Located RdrName
n
XFieldOcc x -> NoExtCon -> Located RdrName
forall a. NoExtCon -> a
noExtCon NoExtCon
XXFieldOcc GhcPs
x
}
fields :: [R ()]
fields = (HsRecField GhcPs (LHsExpr GhcPs) -> R ())
-> LHsRecField GhcPs (LHsExpr GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (HsRecField' RdrName (LHsExpr GhcPs) -> R ()
p_hsRecField (HsRecField' RdrName (LHsExpr GhcPs) -> R ())
-> (HsRecField GhcPs (LHsExpr GhcPs)
-> HsRecField' RdrName (LHsExpr GhcPs))
-> HsRecField GhcPs (LHsExpr GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecField GhcPs (LHsExpr GhcPs)
-> HsRecField' RdrName (LHsExpr GhcPs)
updName) (LHsRecField GhcPs (LHsExpr GhcPs) -> R ())
-> [LHsRecField GhcPs (LHsExpr GhcPs)] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (LHsExpr 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 {[LHsRecUpdField GhcPs]
XRecordUpd GhcPs
LHsExpr GhcPs
rupd_ext :: forall p. HsExpr p -> XRecordUpd p
rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_flds :: forall p. HsExpr p -> [LHsRecUpdField p]
rupd_flds :: [LHsRecUpdField GhcPs]
rupd_expr :: LHsExpr GhcPs
rupd_ext :: XRecordUpd GhcPs
..} -> do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
rupd_expr HsExpr GhcPs -> R ()
p_hsExpr
Bool
useRecordDot' <- R Bool
useRecordDot
let mrs :: a -> Maybe RealSrcSpan
mrs a
sp = case a -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc a
sp of
RealSrcSpan RealSrcSpan
r -> RealSrcSpan -> Maybe RealSrcSpan
forall a. a -> Maybe a
Just RealSrcSpan
r
SrcSpan
_ -> Maybe RealSrcSpan
forall a. Maybe a
Nothing
let isPluginForm :: Bool
isPluginForm =
((Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (RealSrcSpan -> Int) -> RealSrcSpan -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcSpan -> Int
srcSpanEndCol (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsExpr GhcPs -> Maybe RealSrcSpan
forall a. HasSrcSpan a => a -> Maybe RealSrcSpan
mrs LHsExpr GhcPs
rupd_expr)
Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== (RealSrcSpan -> Int
srcSpanStartCol (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsRecUpdField GhcPs -> Maybe RealSrcSpan
forall a. HasSrcSpan a => a -> Maybe RealSrcSpan
mrs ([LHsRecUpdField GhcPs] -> LHsRecUpdField GhcPs
forall a. [a] -> a
head [LHsRecUpdField GhcPs]
rupd_flds))
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
useRecordDot' Bool -> Bool -> Bool
&& Bool
isPluginForm) R ()
breakpoint
let updName :: HsRecUpdField GhcPs -> HsRecField' RdrName (LHsExpr GhcPs)
updName HsRecUpdField GhcPs
f =
(HsRecUpdField GhcPs
f :: HsRecUpdField GhcPs)
{ hsRecFieldLbl :: Located RdrName
hsRecFieldLbl = case Located (AmbiguousFieldOcc GhcPs)
-> SrcSpanLess (Located (AmbiguousFieldOcc GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located (AmbiguousFieldOcc GhcPs)
-> SrcSpanLess (Located (AmbiguousFieldOcc GhcPs)))
-> Located (AmbiguousFieldOcc GhcPs)
-> SrcSpanLess (Located (AmbiguousFieldOcc GhcPs))
forall a b. (a -> b) -> a -> b
$ HsRecUpdField GhcPs -> Located (AmbiguousFieldOcc GhcPs)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl HsRecUpdField GhcPs
f of
Ambiguous _ n -> Located RdrName
n
Unambiguous _ n -> Located RdrName
n
XAmbiguousFieldOcc x -> NoExtCon -> Located RdrName
forall a. NoExtCon -> a
noExtCon NoExtCon
XXAmbiguousFieldOcc GhcPs
x
}
updBraces :: R () -> R ()
updBraces =
if Bool
useRecordDot' Bool -> Bool -> Bool
&& Bool
isPluginForm
then R () -> R ()
recordDotBraces
else 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 ()
updBraces (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R ()
-> (LHsRecUpdField GhcPs -> R ()) -> [LHsRecUpdField GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
R ()
commaDel
(R () -> R ()
sitcc (R () -> R ())
-> (LHsRecUpdField GhcPs -> R ()) -> LHsRecUpdField GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsRecUpdField GhcPs -> R ()) -> LHsRecUpdField GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (HsRecField' RdrName (LHsExpr GhcPs) -> R ()
p_hsRecField (HsRecField' RdrName (LHsExpr GhcPs) -> R ())
-> (HsRecUpdField GhcPs -> HsRecField' RdrName (LHsExpr GhcPs))
-> HsRecUpdField GhcPs
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecUpdField GhcPs -> HsRecField' RdrName (LHsExpr GhcPs)
updName))
[LHsRecUpdField GhcPs]
rupd_flds
ExprWithTySig XExprWithTySig GhcPs
NoExtField LHsExpr GhcPs
x HsWC {hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = HsIB {XHsIB (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs))
LHsType (NoGhcTc GhcPs)
hsib_ext :: forall pass thing. HsImplicitBndrs pass thing -> XHsIB pass thing
hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body :: LHsType (NoGhcTc GhcPs)
hsib_ext :: XHsIB (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs))
..}} -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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
$ LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
LHsType (NoGhcTc GhcPs)
hsib_body HsType GhcPs -> R ()
p_hsType
ExprWithTySig XExprWithTySig GhcPs
NoExtField LHsExpr GhcPs
_ HsWC {hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = XHsImplicitBndrs XXHsImplicitBndrs (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs))
x} -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXHsImplicitBndrs (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs))
x
ExprWithTySig XExprWithTySig GhcPs
NoExtField LHsExpr GhcPs
_ (XHsWildCardBndrs XXHsWildCardBndrs (NoGhcTc GhcPs) (LHsSigType (NoGhcTc GhcPs))
x) -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXHsWildCardBndrs (NoGhcTc GhcPs) (LHsSigType (NoGhcTc GhcPs))
x
ArithSeq XArithSeq GhcPs
NoExtField 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
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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 () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs
from, LHsExpr 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
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
from HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt Text
".."
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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 () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs
from, LHsExpr GhcPs
next]
R ()
breakpoint
Text -> R ()
txt Text
".."
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
to HsExpr GhcPs -> R ()
p_hsExpr
HsSCC XSCC GhcPs
NoExtField SourceText
_ StringLiteral
name LHsExpr GhcPs
x -> do
Text -> R ()
txt Text
"{-# SCC "
StringLiteral -> R ()
forall a. Outputable a => a -> R ()
atom StringLiteral
name
Text -> R ()
txt Text
" #-}"
R ()
breakpoint
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr
HsCoreAnn XCoreAnn GhcPs
NoExtField SourceText
_ StringLiteral
value LHsExpr GhcPs
x -> do
Text -> R ()
txt Text
"{-# CORE "
StringLiteral -> R ()
forall a. Outputable a => a -> R ()
atom StringLiteral
value
Text -> R ()
txt Text
" #-}"
R ()
breakpoint
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr
HsBracket XBracket GhcPs
NoExtField HsBracket GhcPs
x -> HsBracket GhcPs -> R ()
p_hsBracket 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
NoExtField HsSplice GhcPs
splice -> HsSplice GhcPs -> R ()
p_hsSplice HsSplice GhcPs
splice
HsProc XProc GhcPs
NoExtField LPat GhcPs
p LHsCmdTop GhcPs
e -> do
Text -> R ()
txt Text
"proc"
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (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 (LHsCmdTop GhcPs -> SrcSpanLess (LHsCmdTop GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsCmdTop GhcPs
e)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
LHsCmdTop GhcPs -> (HsCmdTop GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
e HsCmdTop GhcPs -> R ()
p_hsCmdTop
HsStatic XStatic GhcPs
_ LHsExpr GhcPs
e -> do
Text -> R ()
txt Text
"static"
R ()
breakpoint
R () -> R ()
inci (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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"
HsTickPragma {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsTickPragma"
HsWrap {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsWrap"
XExpr XXExpr GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXExpr GhcPs
x
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PSB {HsPatSynDir GhcPs
HsPatSynDetails (Located (IdP GhcPs))
LPat GhcPs
XPSB GhcPs GhcPs
Located (IdP GhcPs)
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_id :: forall idL idR. PatSynBind idL idR -> Located (IdP idL)
psb_args :: forall idL idR.
PatSynBind idL idR -> HsPatSynDetails (Located (IdP 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 (Located (IdP GhcPs))
psb_id :: Located (IdP 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
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
psb_def Pat GhcPs -> R ()
p_pat
HsPatSynDir GhcPs
ImplicitBidirectional -> do
R ()
equals
R ()
breakpoint
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
psb_def Pat GhcPs -> R ()
p_pat
ExplicitBidirectional MatchGroup GhcPs (LHsExpr GhcPs)
mgroup -> do
Text -> R ()
txt Text
"<-"
R ()
breakpoint
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (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 (Located RdrName -> MatchGroupStyle
Function Located (IdP GhcPs)
Located RdrName
psb_id) MatchGroup GhcPs (LHsExpr GhcPs)
mgroup)
Text -> R ()
txt Text
"pattern"
case HsPatSynDetails (Located (IdP GhcPs))
psb_args of
PrefixCon [Located (IdP GhcPs)]
xs -> do
R ()
space
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
psb_id
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
[SrcSpan] -> R () -> R ()
switchLayout (Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located RdrName -> SrcSpan) -> [Located RdrName] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located (IdP GhcPs)]
[Located 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 ([Located RdrName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Located (IdP GhcPs)]
[Located RdrName]
xs) R ()
breakpoint
R () -> R ()
sitcc (R () -> (Located RdrName -> R ()) -> [Located RdrName] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint Located RdrName -> R ()
p_rdrName [Located (IdP GhcPs)]
[Located RdrName]
xs)
R ()
rhs
RecCon [RecordPatSynField (Located (IdP GhcPs))]
xs -> do
R ()
space
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
psb_id
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
[SrcSpan] -> R () -> R ()
switchLayout (Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located RdrName -> SrcSpan)
-> (RecordPatSynField (Located RdrName) -> Located RdrName)
-> RecordPatSynField (Located RdrName)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField (Located RdrName) -> Located RdrName
forall a. RecordPatSynField a -> a
recordPatSynPatVar (RecordPatSynField (Located RdrName) -> SrcSpan)
-> [RecordPatSynField (Located RdrName)] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RecordPatSynField (Located (IdP GhcPs))]
[RecordPatSynField (Located 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 ([RecordPatSynField (Located RdrName)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RecordPatSynField (Located (IdP GhcPs))]
[RecordPatSynField (Located RdrName)]
xs) R ()
breakpoint
BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R ()
-> (RecordPatSynField (Located RdrName) -> R ())
-> [RecordPatSynField (Located RdrName)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (Located RdrName -> R ()
p_rdrName (Located RdrName -> R ())
-> (RecordPatSynField (Located RdrName) -> Located RdrName)
-> RecordPatSynField (Located RdrName)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField (Located RdrName) -> Located RdrName
forall a. RecordPatSynField a -> a
recordPatSynPatVar) [RecordPatSynField (Located (IdP GhcPs))]
[RecordPatSynField (Located RdrName)]
xs
R ()
rhs
InfixCon Located (IdP GhcPs)
l Located (IdP GhcPs)
r -> do
[SrcSpan] -> R () -> R ()
switchLayout [Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located (IdP GhcPs)
Located RdrName
l, Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located (IdP GhcPs)
Located RdrName
r] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
space
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
l
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
psb_id
R ()
space
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
r
R () -> R ()
inci R ()
rhs
p_patSynBind (XPatSynBind XXPatSynBind GhcPs GhcPs
x) = NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXPatSynBind GhcPs GhcPs
x
p_case ::
Data body =>
(body -> Placement) ->
(body -> R ()) ->
LHsExpr GhcPs ->
MatchGroup GhcPs (Located body) ->
R ()
p_case :: (body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (Located body)
-> R ()
p_case body -> Placement
placer body -> R ()
render LHsExpr GhcPs
e MatchGroup GhcPs (Located body)
mgroup = do
Text -> R ()
txt Text
"case"
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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 (Located body)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
Case MatchGroup GhcPs (Located body)
mgroup)
p_if ::
Data body =>
(body -> Placement) ->
(body -> R ()) ->
LHsExpr GhcPs ->
Located body ->
Located body ->
R ()
p_if :: (body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> Located body
-> Located body
-> R ()
p_if body -> Placement
placer body -> R ()
render LHsExpr GhcPs
if' Located body
then' Located body
else' = do
Text -> R ()
txt Text
"if"
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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
Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located 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
Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located 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 ::
Data body =>
(body -> R ()) ->
Located (HsLocalBindsLR GhcPs GhcPs) ->
Located body ->
R ()
p_let :: (body -> R ()) -> LHsLocalBinds GhcPs -> Located body -> R ()
p_let body -> R ()
render LHsLocalBinds GhcPs
localBinds Located 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 (LHsLocalBinds GhcPs -> (HsLocalBindsLR GhcPs GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsLocalBinds GhcPs
localBinds HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds)
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 (Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located body
e body -> R ()
render)
p_pat :: Pat GhcPs -> R ()
p_pat :: Pat GhcPs -> R ()
p_pat = \case
WildPat XWildPat GhcPs
NoExtField -> Text -> R ()
txt Text
"_"
VarPat XVarPat GhcPs
NoExtField Located (IdP GhcPs)
name -> Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
name
LazyPat XLazyPat GhcPs
NoExtField LPat GhcPs
pat -> do
Text -> R ()
txt Text
"~"
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
AsPat XAsPat GhcPs
NoExtField Located (IdP GhcPs)
name LPat GhcPs
pat -> do
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
name
Text -> R ()
txt Text
"@"
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
ParPat XParPat GhcPs
NoExtField LPat GhcPs
pat ->
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat (BracketStyle -> R () -> R ()
parens BracketStyle
S (R () -> R ()) -> (Pat GhcPs -> R ()) -> Pat GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat GhcPs -> R ()
p_pat)
BangPat XBangPat GhcPs
NoExtField LPat GhcPs
pat -> do
Text -> R ()
txt Text
"!"
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
ListPat XListPat GhcPs
NoExtField [LPat GhcPs]
pats ->
BracketStyle -> R () -> R ()
brackets BracketStyle
S (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (Located (Pat GhcPs) -> R ()) -> [Located (Pat GhcPs)] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((Pat GhcPs -> R ()) -> Located (Pat GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[Located (Pat GhcPs)]
pats
TuplePat XTuplePat GhcPs
NoExtField [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 ()
-> (Located (Pat GhcPs) -> R ()) -> [Located (Pat GhcPs)] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (Located (Pat GhcPs) -> R ()) -> Located (Pat GhcPs) -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat GhcPs -> R ()) -> Located (Pat GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[Located (Pat GhcPs)]
pats
SumPat XSumPat GhcPs
NoExtField LPat GhcPs
pat Int
tag Int
arity ->
BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum BracketStyle
S Int
tag Int
arity (Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat)
ConPatIn Located (IdP 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
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
pat
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Located (Pat GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
[Located (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 ()
-> (Located (Pat GhcPs) -> R ()) -> [Located (Pat GhcPs)] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc (R () -> R ())
-> (Located (Pat GhcPs) -> R ()) -> Located (Pat GhcPs) -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat GhcPs -> R ()) -> Located (Pat GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[Located (Pat GhcPs)]
xs
RecCon (HsRecFields [LHsRecField GhcPs (LPat GhcPs)]
fields Maybe (Located Int)
dotdot) -> do
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
pat
R ()
breakpoint
let f :: Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
-> R ()
f = \case
Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
Nothing -> Text -> R ()
txt Text
".."
Just Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
x -> Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
-> (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)) -> R ())
-> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
x HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)) -> R ()
p_pat_hsRecField
R () -> R ()
inci (R () -> R ())
-> ([Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ())
-> [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ())
-> ([Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ())
-> [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R ()
-> (Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
-> R ())
-> [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
-> R ()
f ([Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ())
-> [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ()
forall a b. (a -> b) -> a -> b
$
case Maybe (Located Int)
dotdot of
Maybe (Located Int)
Nothing -> Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
-> Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
forall a. a -> Maybe a
Just (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
-> Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))))
-> [Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
-> [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (LPat GhcPs)]
[Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
fields
Just (L SrcSpan
_ Int
n) -> (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
-> Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
forall a. a -> Maybe a
Just (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
-> Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))))
-> [Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
-> [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> [Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
-> [Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
forall a. Int -> [a] -> [a]
take Int
n [LHsRecField GhcPs (LPat GhcPs)]
[Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
fields) [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
forall a. [a] -> [a] -> [a]
++ [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
forall a. Maybe a
Nothing]
InfixCon LPat GhcPs
l LPat GhcPs
r -> do
[SrcSpan] -> R () -> R ()
switchLayout [Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LPat GhcPs
Located (Pat GhcPs)
l, Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LPat GhcPs
Located (Pat GhcPs)
r] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (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
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
pat
R ()
space
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
r Pat GhcPs -> R ()
p_pat
ConPatOut {} -> String -> R ()
forall a. String -> a
notImplemented String
"ConPatOut"
ViewPat XViewPat GhcPs
NoExtField LHsExpr GhcPs
expr LPat GhcPs
pat -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
Text -> R ()
txt Text
"->"
R ()
breakpoint
R () -> R ()
inci (Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat)
SplicePat XSplicePat GhcPs
NoExtField HsSplice GhcPs
splice -> HsSplice GhcPs -> R ()
p_hsSplice HsSplice GhcPs
splice
LitPat XLitPat GhcPs
NoExtField HsLit GhcPs
p -> HsLit GhcPs -> R ()
forall a. Outputable a => a -> R ()
atom HsLit GhcPs
p
NPat XNPat GhcPs
NoExtField Located (HsOverLit GhcPs)
v Maybe (SyntaxExpr GhcPs)
_ SyntaxExpr GhcPs
_ -> Located (HsOverLit GhcPs) -> (HsOverLit GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located (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
NoExtField Located (IdP GhcPs)
n Located (HsOverLit GhcPs)
k HsOverLit GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located 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
Located (HsOverLit GhcPs) -> (HsOverLit GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located (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
NoExtField LPat GhcPs
pat HsWildCardBndrs (NoGhcTc GhcPs) (LHsSigType (NoGhcTc GhcPs))
hswc -> do
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
LHsSigWcType GhcPs -> R ()
p_typeAscription LHsSigWcType GhcPs
HsWildCardBndrs (NoGhcTc GhcPs) (LHsSigType (NoGhcTc GhcPs))
hswc
CoPat {} -> String -> R ()
forall a. String -> a
notImplemented String
"CoPat"
XPat XXPat GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXPat GhcPs
x
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
Located (FieldOcc GhcPs)
hsRecPun :: Bool
hsRecFieldArg :: LPat GhcPs
hsRecFieldLbl :: Located (FieldOcc GhcPs)
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 a. Located a -> (a -> R ()) -> R ()
located Located (FieldOcc GhcPs)
hsRecFieldLbl ((FieldOcc GhcPs -> R ()) -> R ())
-> (FieldOcc GhcPs -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \FieldOcc GhcPs
x ->
Located RdrName -> R ()
p_rdrName (FieldOcc GhcPs -> Located RdrName
forall pass. FieldOcc pass -> Located RdrName
rdrNameFieldOcc FieldOcc GhcPs
x)
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 (Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (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
NoExtField SpliceDecoration
deco IdP GhcPs
_ LHsExpr GhcPs
expr -> Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
True LHsExpr GhcPs
expr SpliceDecoration
deco
HsUntypedSplice XUntypedSplice GhcPs
NoExtField SpliceDecoration
deco IdP GhcPs
_ LHsExpr GhcPs
expr -> Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
False LHsExpr GhcPs
expr SpliceDecoration
deco
HsQuasiQuote XQuasiQuote GhcPs
NoExtField IdP GhcPs
_ IdP GhcPs
quoterName SrcSpan
srcSpan FastString
str -> do
Text -> R ()
txt Text
"["
Located RdrName -> R ()
p_rdrName (SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcSpan 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"
HsSplicedT {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsSplicedT"
XSplice XXSplice GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXSplice GhcPs
x
p_hsSpliceTH ::
Bool ->
LHsExpr GhcPs ->
SpliceDecoration ->
R ()
p_hsSpliceTH :: Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
isTyped LHsExpr GhcPs
expr = \case
SpliceDecoration
HasParens -> do
Text -> R ()
txt Text
decoSymbol
BracketStyle -> R () -> R ()
parens BracketStyle
N (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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
HasDollar -> do
Text -> R ()
txt Text
decoSymbol
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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
NoParens ->
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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 :: HsBracket GhcPs -> R ()
p_hsBracket :: HsBracket GhcPs -> R ()
p_hsBracket = \case
ExpBr XExpBr GhcPs
NoExtField LHsExpr GhcPs
expr -> do
[AnnKeywordId]
anns <- R [AnnKeywordId]
getEnclosingAnns
let name :: Text
name = case [AnnKeywordId]
anns of
AnnKeywordId
AnnOpenEQ : [AnnKeywordId]
_ -> Text
""
[AnnKeywordId]
_ -> Text
"e"
Text -> R () -> R ()
quote Text
name (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr HsExpr GhcPs -> R ()
p_hsExpr)
PatBr XPatBr GhcPs
NoExtField LPat GhcPs
pat -> Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (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
NoExtField [LHsDecl GhcPs]
decls -> Text -> R () -> R ()
quote Text
"d" (FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDecls FamilyStyle
Free [LHsDecl GhcPs]
decls)
DecBrG XDecBrG GhcPs
NoExtField HsGroup GhcPs
_ -> String -> R ()
forall a. String -> a
notImplemented String
"DecBrG"
TypBr XTypBr GhcPs
NoExtField LHsType GhcPs
ty -> Text -> R () -> R ()
quote Text
"t" (LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
ty HsType GhcPs -> R ()
p_hsType)
VarBr XVarBr GhcPs
NoExtField Bool
isSingleQuote IdP GhcPs
name -> do
Text -> R ()
txt (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"''" Text
"'" Bool
isSingleQuote)
let isOperator :: Bool
isOperator =
(Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
(\Char
i -> Char -> Bool
isPunctuation Char
i Bool -> Bool -> Bool
|| Char -> Bool
isSymbol Char
i)
(OccName -> String
forall o. Outputable o => o -> String
showOutputable (RdrName -> OccName
rdrNameOcc IdP GhcPs
RdrName
name))
Bool -> Bool -> Bool
&& Bool -> Bool
not (RdrName -> Bool
doesNotNeedExtraParens IdP GhcPs
RdrName
name)
wrapper :: R () -> R ()
wrapper = if Bool
isOperator then BracketStyle -> R () -> R ()
parens BracketStyle
N else R () -> R ()
forall a. a -> a
id
R () -> R ()
wrapper (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> R ()
p_rdrName (SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc IdP GhcPs
SrcSpanLess (Located RdrName)
name)
TExpBr XTExpBr GhcPs
NoExtField LHsExpr GhcPs
expr -> do
Text -> R ()
txt Text
"[||"
R ()
breakpoint'
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint'
Text -> R ()
txt Text
"||]"
XBracket XXBracket GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXBracket GhcPs
x
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
"|]"
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 (Located body) -> SrcSpan
getGRHSSpan :: GRHS GhcPs (Located body) -> SrcSpan
getGRHSSpan (GRHS XCGRHS GhcPs (Located body)
NoExtField [GuardLStmt GhcPs]
guards Located body
body) =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ Located body -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located body
body SrcSpan -> [SrcSpan] -> NonEmpty SrcSpan
forall a. a -> [a] -> NonEmpty a
:| (GuardLStmt GhcPs -> SrcSpan) -> [GuardLStmt GhcPs] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GuardLStmt GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc [GuardLStmt GhcPs]
guards
getGRHSSpan (XGRHS XXGRHS GhcPs (Located body)
x) = NoExtCon -> SrcSpan
forall a. NoExtCon -> a
noExtCon NoExtCon
XXGRHS GhcPs (Located body)
x
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 (Located body)] ->
Placement
blockPlacement :: (body -> Placement) -> [LGRHS GhcPs (Located body)] -> Placement
blockPlacement body -> Placement
placer [L SrcSpan
_ (GRHS XCGRHS GhcPs (Located body)
NoExtField [GuardLStmt GhcPs]
_ (L SrcSpan
_ body
x))] = body -> Placement
placer body
x
blockPlacement body -> Placement
_ [LGRHS GhcPs (Located body)]
_ = Placement
Normal
cmdPlacement :: HsCmd GhcPs -> Placement
cmdPlacement :: HsCmd GhcPs -> Placement
cmdPlacement = \case
HsCmdLam XCmdLam GhcPs
NoExtField MatchGroup GhcPs (LHsCmd GhcPs)
_ -> Placement
Hanging
HsCmdCase XCmdCase GhcPs
NoExtField LHsExpr GhcPs
_ MatchGroup GhcPs (LHsCmd GhcPs)
_ -> Placement
Hanging
HsCmdDo XCmdDo GhcPs
NoExtField Located [CmdLStmt GhcPs]
_ -> Placement
Hanging
HsCmd GhcPs
_ -> Placement
Normal
cmdTopPlacement :: HsCmdTop GhcPs -> Placement
cmdTopPlacement :: HsCmdTop GhcPs -> Placement
cmdTopPlacement = \case
HsCmdTop XCmdTop GhcPs
NoExtField (L SrcSpan
_ HsCmd GhcPs
x) -> HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs
x
XCmdTop XXCmdTop GhcPs
x -> NoExtCon -> Placement
forall a. NoExtCon -> a
noExtCon NoExtCon
XXCmdTop GhcPs
x
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement = \case
HsLam XLam GhcPs
NoExtField MatchGroup GhcPs (LHsExpr GhcPs)
mg -> case MatchGroup GhcPs (LHsExpr GhcPs)
mg of
MG XMG GhcPs (LHsExpr GhcPs)
_ (L SrcSpan
_ [L SrcSpan
_ (Match XCMatch GhcPs (LHsExpr GhcPs)
NoExtField HsMatchContext (NameOrRdrName (IdP GhcPs))
_ (LPat GhcPs
x : [LPat GhcPs]
xs) GRHSs GhcPs (LHsExpr GhcPs)
_)]) Origin
_
| SrcSpan -> Bool
isOneLineSpan (NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ (Located (Pat GhcPs) -> SrcSpan)
-> NonEmpty (Located (Pat GhcPs)) -> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LPat GhcPs
Located (Pat GhcPs)
x Located (Pat GhcPs)
-> [Located (Pat GhcPs)] -> NonEmpty (Located (Pat GhcPs))
forall a. a -> [a] -> NonEmpty a
:| [LPat GhcPs]
[Located (Pat GhcPs)]
xs)) ->
Placement
Hanging
MatchGroup GhcPs (LHsExpr GhcPs)
_ -> Placement
Normal
HsLamCase XLamCase GhcPs
NoExtField MatchGroup GhcPs (LHsExpr GhcPs)
_ -> Placement
Hanging
HsCase XCase GhcPs
NoExtField LHsExpr GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
_ -> Placement
Hanging
HsDo XDo GhcPs
NoExtField HsStmtContext Name
DoExpr Located [GuardLStmt GhcPs]
_ -> Placement
Hanging
HsDo XDo GhcPs
NoExtField HsStmtContext Name
MDoExpr Located [GuardLStmt GhcPs]
_ -> Placement
Hanging
OpApp XOpApp GhcPs
NoExtField 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)
-> (LHsExpr GhcPs -> Maybe RdrName)
-> LHsExpr GhcPs
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> Maybe RdrName
getOpName (HsExpr GhcPs -> Maybe RdrName)
-> (LHsExpr GhcPs -> HsExpr GhcPs)
-> LHsExpr GhcPs
-> Maybe RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> HsExpr GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) LHsExpr GhcPs
op of
Just String
"$" -> HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
y)
Maybe String
_ -> Placement
Normal
HsApp XApp GhcPs
NoExtField LHsExpr GhcPs
_ LHsExpr GhcPs
y -> HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
y)
HsProc XProc GhcPs
NoExtField LPat GhcPs
p LHsCmdTop GhcPs
_ ->
if SrcSpan -> Bool
isOneLineSpan (Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LPat GhcPs
Located (Pat GhcPs)
p)
then Placement
Hanging
else Placement
Normal
HsExpr GhcPs
_ -> Placement
Normal
withGuards :: [LGRHS GhcPs (Located body)] -> Bool
withGuards :: [LGRHS GhcPs (Located body)] -> Bool
withGuards = (LGRHS GhcPs (Located body) -> Bool)
-> [LGRHS GhcPs (Located body)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GRHS GhcPs (Located body) -> Bool
forall body. GRHS GhcPs (Located body) -> Bool
checkOne (GRHS GhcPs (Located body) -> Bool)
-> (LGRHS GhcPs (Located body) -> GRHS GhcPs (Located body))
-> LGRHS GhcPs (Located body)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LGRHS GhcPs (Located body) -> GRHS GhcPs (Located body)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
where
checkOne :: GRHS GhcPs (Located body) -> Bool
checkOne :: GRHS GhcPs (Located body) -> Bool
checkOne (GRHS XCGRHS GhcPs (Located body)
NoExtField [] Located body
_) = Bool
False
checkOne GRHS GhcPs (Located body)
_ = Bool
True
exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree (L SrcSpan
_ (OpApp XOpApp GhcPs
NoExtField LHsExpr GhcPs
x LHsExpr GhcPs
op LHsExpr GhcPs
y)) = OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> OpTree (LHsExpr GhcPs) (LHsExpr 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
op (LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
y)
exprOpTree LHsExpr GhcPs
n = LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
forall ty op. ty -> OpTree ty op
OpNode LHsExpr GhcPs
n
getOpName :: HsExpr GhcPs -> Maybe RdrName
getOpName :: HsExpr GhcPs -> Maybe RdrName
getOpName = \case
HsVar XVar GhcPs
NoExtField (L SrcSpan
_ IdP GhcPs
a) -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just IdP GhcPs
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) = LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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 =
if SrcSpan -> Bool
isOneLineSpan
(SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (SrcSpan -> SrcLoc
srcSpanStart (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x)) (SrcSpan -> SrcLoc
srcSpanStart (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y)))
then case OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y of
OpNode (L SrcSpan
_ HsExpr GhcPs
n) -> HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs
n
OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
_ -> Placement
Normal
else Placement
Normal
opWrapper :: R () -> R ()
opWrapper = case LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
op of
HsUnboundVar NoExtField _ -> R () -> R ()
backticks
SrcSpanLess (LHsExpr GhcPs)
_ -> R () -> R ()
forall a. a -> a
id
Layout
layout <- R Layout
getLayout
let ub :: R () -> R ()
ub = case Layout
layout of
Layout
SingleLine -> R () -> R ()
useBraces
Layout
MultiLine -> case Placement
placement of
Placement
Hanging -> R () -> R ()
useBraces
Placement
Normal -> R () -> R ()
dontUseBraces
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)
-> (LHsExpr GhcPs -> Maybe RdrName)
-> LHsExpr GhcPs
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> Maybe RdrName
getOpName (HsExpr GhcPs -> Maybe RdrName)
-> (LHsExpr GhcPs -> HsExpr GhcPs)
-> LHsExpr GhcPs
-> Maybe RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> HsExpr GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) LHsExpr 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
":"
gotRecordDot :: Bool
gotRecordDot = HsExpr GhcPs -> SrcSpan -> Bool
isRecordDot (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
op) (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y)
lhs :: R ()
lhs =
[SrcSpan] -> R () -> R ()
switchLayout [OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr 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 = LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr 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 (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y] (BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree BracketStyle
N OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y)
isSection :: Bool
isSection = case (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x, LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr GhcPs
op) of
(RealSrcSpan RealSrcSpan
treeSpan, RealSrcSpan RealSrcSpan
opSpan) ->
RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
treeSpan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
opSpan
(SrcSpan, SrcSpan)
_ -> Bool
False
isDoBlock :: OpTree (GenLocated l (HsExpr p)) op -> Bool
isDoBlock = \case
OpNode (L l
_ HsDo {}) -> Bool
True
OpTree (GenLocated l (HsExpr p)) op
_ -> Bool
False
Bool
useRecordDot' <- R Bool
useRecordDot
if
| Bool
gotColon -> do
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 (LHsExpr GhcPs) (LHsExpr GhcPs) -> Bool
forall l p op. OpTree (GenLocated l (HsExpr p)) op -> Bool
isDoBlock OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y) R ()
p_y
| Bool
gotDollar
Bool -> Bool -> Bool
&& SrcSpan -> Bool
isOneLineSpan (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr 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
useRecordDot' Bool -> Bool -> Bool
&& Bool
gotRecordDot -> do
R ()
lhs
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isSection R ()
space
R ()
p_op
R ()
p_y
| Bool
otherwise -> do
R () -> R ()
ub R ()
lhs
Placement -> R () -> R ()
placeHanging Placement
placement (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
p_op
R ()
space
R ()
p_y
isRecordDot ::
HsExpr GhcPs ->
SrcSpan ->
Bool
isRecordDot :: HsExpr GhcPs -> SrcSpan -> Bool
isRecordDot HsExpr GhcPs
op (RealSrcSpan RealSrcSpan
ySpan) = case HsExpr GhcPs
op of
HsVar XVar GhcPs
NoExtField (L (RealSrcSpan RealSrcSpan
opSpan) IdP GhcPs
opName) ->
(RdrName -> String
getOpNameStr IdP GhcPs
RdrName
opName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".") Bool -> Bool -> Bool
&& (RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
opSpan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
ySpan)
HsExpr GhcPs
_ -> Bool
False
isRecordDot HsExpr GhcPs
_ SrcSpan
_ = Bool
False
getEnclosingAnns :: R [AnnKeywordId]
getEnclosingAnns :: R [AnnKeywordId]
getEnclosingAnns = do
Maybe RealSrcSpan
e <- (RealSrcSpan -> Bool) -> R (Maybe RealSrcSpan)
getEnclosingSpan (Bool -> RealSrcSpan -> Bool
forall a b. a -> b -> a
const Bool
True)
case Maybe RealSrcSpan
e of
Maybe RealSrcSpan
Nothing -> [AnnKeywordId] -> R [AnnKeywordId]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just RealSrcSpan
e' -> SrcSpan -> R [AnnKeywordId]
getAnns (RealSrcSpan -> SrcSpan
RealSrcSpan RealSrcSpan
e')