{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
module Ormolu.Printer.Meat.Declaration.OpTree
( p_exprOpTree,
exprOpTree,
p_cmdOpTree,
cmdOpTree,
p_tyOpTree,
tyOpTree,
getOpName,
getOpNameStr,
)
where
import Data.Functor ((<&>))
import GHC.Hs
import GHC.Types.Fixity
import GHC.Types.Name (occNameString)
import GHC.Types.Name.Reader (RdrName, rdrNameOcc)
import GHC.Types.SrcLoc
import Ormolu.Printer.Combinators
import Ormolu.Printer.Meat.Common (p_rdrName)
import Ormolu.Printer.Meat.Declaration.Value
( cmdTopPlacement,
exprPlacement,
p_hsCmdTop,
p_hsExpr,
p_hsExpr',
)
import Ormolu.Printer.Meat.Type (p_hsType)
import Ormolu.Printer.Operators
import Ormolu.Utils (HasSrcSpan)
getOpName :: HsExpr GhcPs -> Maybe RdrName
getOpName :: HsExpr GhcPs -> Maybe RdrName
getOpName = \case
HsVar XVar GhcPs
_ (L SrcSpanAnnN
_ RdrName
a) -> forall a. a -> Maybe a
Just RdrName
a
HsExpr GhcPs
_ -> forall a. Maybe a
Nothing
getOpNameStr :: RdrName -> String
getOpNameStr :: RdrName -> String
getOpNameStr = OccName -> String
occNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc
opBranchPlacement ::
HasSrcSpan l =>
(ty -> Placement) ->
OpTree (GenLocated l ty) op ->
OpTree (GenLocated l ty) op ->
Placement
opBranchPlacement :: forall l ty op.
HasSrcSpan l =>
(ty -> Placement)
-> OpTree (GenLocated l ty) op
-> OpTree (GenLocated l ty) op
-> Placement
opBranchPlacement ty -> Placement
placer OpTree (GenLocated l ty) op
firstExpr OpTree (GenLocated l ty) op
lastExpr
| SrcSpan -> Bool
isOneLineSpan
( SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan
(SrcSpan -> SrcLoc
srcSpanStart (forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (GenLocated l ty) op
firstExpr))
(SrcSpan -> SrcLoc
srcSpanStart (forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (GenLocated l ty) op
lastExpr))
),
OpNode (L l
_ ty
n) <- OpTree (GenLocated l ty) op
lastExpr =
ty -> Placement
placer ty
n
| Bool
otherwise = Placement
Normal
opBranchBraceStyle :: Placement -> R (R () -> R ())
opBranchBraceStyle :: Placement -> R (R () -> R ())
opBranchBraceStyle Placement
placement =
R Layout
getLayout forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Layout
SingleLine -> R () -> R ()
useBraces
Layout
MultiLine -> case Placement
placement of
Placement
Hanging -> R () -> R ()
useBraces
Placement
Normal -> R () -> R ()
dontUseBraces
exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree (L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
x LHsExpr GhcPs
op LHsExpr GhcPs
y)) = forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches [LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
x, LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
y] [LHsExpr GhcPs
op]
exprOpTree LHsExpr GhcPs
n = forall ty op. ty -> OpTree ty op
OpNode LHsExpr GhcPs
n
p_exprOpTree ::
BracketStyle ->
OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs)) ->
R ()
p_exprOpTree :: BracketStyle
-> OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs)) -> R ()
p_exprOpTree BracketStyle
s (OpNode LHsExpr GhcPs
x) = forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
p_exprOpTree BracketStyle
s t :: OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs))
t@(OpBranches [OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs))]
exprs [OpInfo (LHsExpr GhcPs)]
ops) = do
let firstExpr :: OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
firstExpr = forall a. [a] -> a
head [OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs))]
exprs
otherExprs :: [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
otherExprs = forall a. [a] -> [a]
tail [OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs))]
exprs
placement :: Placement
placement =
forall l ty op.
HasSrcSpan l =>
(ty -> Placement)
-> OpTree (GenLocated l ty) op
-> OpTree (GenLocated l ty) op
-> Placement
opBranchPlacement
HsExpr GhcPs -> Placement
exprPlacement
OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
firstExpr
(forall a. [a] -> a
last [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
otherExprs)
rightMostNode :: OpTree ty op -> OpTree ty op
rightMostNode = \case
n :: OpTree ty op
n@(OpNode ty
_) -> OpTree ty op
n
OpBranches [OpTree ty op]
exprs'' [op]
_ -> OpTree ty op -> OpTree ty op
rightMostNode (forall a. [a] -> a
last [OpTree ty op]
exprs'')
isDoBlock :: OpTree (GenLocated l (HsExpr p)) op -> Bool
isDoBlock = \case
OpNode (L l
_ (HsDo XDo p
_ HsDoFlavour
ctx XRec p [ExprLStmt p]
_)) -> case HsDoFlavour
ctx of
DoExpr Maybe ModuleName
_ -> Bool
True
MDoExpr Maybe ModuleName
_ -> Bool
True
HsDoFlavour
_ -> Bool
False
OpTree (GenLocated l (HsExpr p)) op
_ -> Bool
False
couldBeTrailing :: (OpTree (GenLocated l (HsExpr p)) op, OpInfo op) -> Bool
couldBeTrailing (OpTree (GenLocated l (HsExpr p)) op
prevExpr, OpInfo op
opi) =
FixityInfo -> Bool
isHardSplitterOp (forall op. OpInfo op -> FixityInfo
opiFix OpInfo op
opi)
Bool -> Bool -> Bool
&& SrcSpan -> Bool
isOneLineSpan (forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (GenLocated l (HsExpr p)) op
prevExpr)
Bool -> Bool -> Bool
&& Placement
placement forall a. Eq a => a -> a -> Bool
== Placement
Normal
Bool -> Bool -> Bool
&& Bool -> Bool
not (forall {l} {p} {op}. OpTree (GenLocated l (HsExpr p)) op -> Bool
isDoBlock forall a b. (a -> b) -> a -> b
$ forall {ty} {op}. OpTree ty op -> OpTree ty op
rightMostNode OpTree (GenLocated l (HsExpr p)) op
prevExpr)
isTrailing :: Bool
isTrailing = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall {l} {p} {op} {op}.
HasSrcSpan l =>
(OpTree (GenLocated l (HsExpr p)) op, OpInfo op) -> Bool
couldBeTrailing forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs))]
exprs [OpInfo (LHsExpr GhcPs)]
ops
R () -> R ()
ub <- if Bool
isTrailing then forall (m :: * -> *) a. Monad m => a -> m a
return R () -> R ()
useBraces else Placement -> R (R () -> R ())
opBranchBraceStyle Placement
placement
let p_x :: R ()
p_x = R () -> R ()
ub forall a b. (a -> b) -> a -> b
$ BracketStyle
-> OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs)) -> R ()
p_exprOpTree BracketStyle
s OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
firstExpr
putOpsExprs :: OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [OpInfo (GenLocated l (HsExpr GhcPs))]
-> [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
putOpsExprs OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
prevExpr (OpInfo (GenLocated l (HsExpr GhcPs))
opi : [OpInfo (GenLocated l (HsExpr GhcPs))]
ops') (OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
expr : [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
exprs') = do
let isLast :: Bool
isLast = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
exprs'
ub' :: R () -> R ()
ub' = if Bool -> Bool
not Bool
isLast then R () -> R ()
ub else forall a. a -> a
id
opWrapper :: R () -> R ()
opWrapper = case forall l e. GenLocated l e -> e
unLoc (forall op. OpInfo op -> op
opiOp OpInfo (GenLocated l (HsExpr GhcPs))
opi) of
HsUnboundVar XUnboundVar GhcPs
_ OccName
_ -> R () -> R ()
backticks
HsExpr GhcPs
_ -> forall a. a -> a
id
p_op :: R ()
p_op = forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (forall op. OpInfo op -> op
opiOp OpInfo (GenLocated l (HsExpr GhcPs))
opi) (R () -> R ()
opWrapper forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
p_y :: R ()
p_y = R () -> R ()
ub' forall a b. (a -> b) -> a -> b
$ BracketStyle
-> OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs)) -> R ()
p_exprOpTree BracketStyle
N OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
expr
if Bool
isTrailing
then do
R ()
space
R ()
p_op
Placement -> R () -> R ()
placeHanging
( if Bool
isLast Bool -> Bool -> Bool
&& (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Bool
isOneLineSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc forall a b. (a -> b) -> a -> b
$ OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
expr)
then forall l ty op.
HasSrcSpan l =>
(ty -> Placement)
-> OpTree (GenLocated l ty) op
-> OpTree (GenLocated l ty) op
-> Placement
opBranchPlacement HsExpr GhcPs -> Placement
exprPlacement OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
prevExpr OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
expr
else Placement
Normal
)
forall a b. (a -> b) -> a -> b
$ do
R ()
p_y
OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [OpInfo (GenLocated l (HsExpr GhcPs))]
-> [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
putOpsExprs OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
expr [OpInfo (GenLocated l (HsExpr GhcPs))]
ops' [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
exprs'
else do
Placement -> R () -> R ()
placeHanging Placement
placement forall a b. (a -> b) -> a -> b
$ do
R ()
p_op
R ()
space
R ()
p_y
OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [OpInfo (GenLocated l (HsExpr GhcPs))]
-> [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
putOpsExprs OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
expr [OpInfo (GenLocated l (HsExpr GhcPs))]
ops' [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
exprs'
putOpsExprs OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
_ [OpInfo (GenLocated l (HsExpr GhcPs))]
_ [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[SrcSpan] -> R () -> R ()
switchLayout [forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs))
t] forall a b. (a -> b) -> a -> b
$ do
R ()
p_x
forall {l}.
HasSrcSpan l =>
OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [OpInfo (GenLocated l (HsExpr GhcPs))]
-> [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
putOpsExprs OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
firstExpr [OpInfo (LHsExpr GhcPs)]
ops [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
otherExprs
cmdOpTree :: LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
cmdOpTree :: LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
cmdOpTree = \case
(L SrcAnn NoEpAnns
_ (HsCmdTop XCmdTop GhcPs
_ (L SrcSpanAnnA
_ (HsCmdArrForm XCmdArrForm GhcPs
_ LHsExpr GhcPs
op LexicalFixity
Infix Maybe Fixity
_ [LHsCmdTop GhcPs
x, LHsCmdTop GhcPs
y])))) ->
forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches [LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
cmdOpTree LHsCmdTop GhcPs
x, LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
cmdOpTree LHsCmdTop GhcPs
y] [LHsExpr GhcPs
op]
LHsCmdTop GhcPs
n -> forall ty op. ty -> OpTree ty op
OpNode LHsCmdTop GhcPs
n
p_cmdOpTree ::
BracketStyle ->
OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs)) ->
R ()
p_cmdOpTree :: BracketStyle
-> OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs)) -> R ()
p_cmdOpTree BracketStyle
s (OpNode LHsCmdTop GhcPs
x) = forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
x (BracketStyle -> HsCmdTop GhcPs -> R ()
p_hsCmdTop BracketStyle
s)
p_cmdOpTree BracketStyle
s t :: OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs))
t@(OpBranches [OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs))]
exprs [OpInfo (LHsExpr GhcPs)]
ops) = do
let firstExpr :: OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
firstExpr = forall a. [a] -> a
head [OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs))]
exprs
otherExprs :: [OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
otherExprs = forall a. [a] -> [a]
tail [OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs))]
exprs
placement :: Placement
placement =
forall l ty op.
HasSrcSpan l =>
(ty -> Placement)
-> OpTree (GenLocated l ty) op
-> OpTree (GenLocated l ty) op
-> Placement
opBranchPlacement
HsCmdTop GhcPs -> Placement
cmdTopPlacement
OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
firstExpr
(forall a. [a] -> a
last [OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
otherExprs)
R () -> R ()
ub <- Placement -> R (R () -> R ())
opBranchBraceStyle Placement
placement
let p_x :: R ()
p_x = R () -> R ()
ub forall a b. (a -> b) -> a -> b
$ BracketStyle
-> OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs)) -> R ()
p_cmdOpTree BracketStyle
s OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
firstExpr
putOpsExprs :: [OpInfo (GenLocated l (HsExpr GhcPs))]
-> [OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
putOpsExprs (OpInfo (GenLocated l (HsExpr GhcPs))
opi : [OpInfo (GenLocated l (HsExpr GhcPs))]
ops') (OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
expr : [OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
exprs') = do
let ub' :: R () -> R ()
ub' = if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
exprs') then R () -> R ()
ub else forall a. a -> a
id
p_op :: R ()
p_op = forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (forall op. OpInfo op -> op
opiOp OpInfo (GenLocated l (HsExpr GhcPs))
opi) HsExpr GhcPs -> R ()
p_hsExpr
p_y :: R ()
p_y = R () -> R ()
ub' forall a b. (a -> b) -> a -> b
$ BracketStyle
-> OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs)) -> R ()
p_cmdOpTree BracketStyle
N OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
expr
Placement -> R () -> R ()
placeHanging Placement
placement forall a b. (a -> b) -> a -> b
$ do
R ()
p_op
R ()
space
R ()
p_y
[OpInfo (GenLocated l (HsExpr GhcPs))]
-> [OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
putOpsExprs [OpInfo (GenLocated l (HsExpr GhcPs))]
ops' [OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
exprs'
putOpsExprs [OpInfo (GenLocated l (HsExpr GhcPs))]
_ [OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[SrcSpan] -> R () -> R ()
switchLayout [forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs))
t] forall a b. (a -> b) -> a -> b
$ do
R ()
p_x
forall {l}.
HasSrcSpan l =>
[OpInfo (GenLocated l (HsExpr GhcPs))]
-> [OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
putOpsExprs [OpInfo (LHsExpr GhcPs)]
ops [OpTree
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
otherExprs
tyOpPlacement :: HsType GhcPs -> Placement
tyOpPlacement :: HsType GhcPs -> Placement
tyOpPlacement = \case
HsType GhcPs
_ -> Placement
Normal
tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (LocatedN RdrName)
tyOpTree :: LHsType GhcPs
-> OpTree (LHsType GhcPs) (GenLocated SrcSpanAnnN RdrName)
tyOpTree (L SrcSpanAnnA
_ (HsOpTy XOpTy GhcPs
_ PromotionFlag
_ LHsType GhcPs
l LIdP GhcPs
op LHsType GhcPs
r)) =
forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches [LHsType GhcPs
-> OpTree (LHsType GhcPs) (GenLocated SrcSpanAnnN RdrName)
tyOpTree LHsType GhcPs
l, LHsType GhcPs
-> OpTree (LHsType GhcPs) (GenLocated SrcSpanAnnN RdrName)
tyOpTree LHsType GhcPs
r] [LIdP GhcPs
op]
tyOpTree LHsType GhcPs
n = forall ty op. ty -> OpTree ty op
OpNode LHsType GhcPs
n
p_tyOpTree ::
OpTree (LHsType GhcPs) (OpInfo (LocatedN RdrName)) ->
R ()
p_tyOpTree :: OpTree (LHsType GhcPs) (OpInfo (GenLocated SrcSpanAnnN RdrName))
-> R ()
p_tyOpTree (OpNode LHsType GhcPs
n) = forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsType GhcPs
n HsType GhcPs -> R ()
p_hsType
p_tyOpTree t :: OpTree (LHsType GhcPs) (OpInfo (GenLocated SrcSpanAnnN RdrName))
t@(OpBranches [OpTree (LHsType GhcPs) (OpInfo (GenLocated SrcSpanAnnN RdrName))]
exprs [OpInfo (GenLocated SrcSpanAnnN RdrName)]
ops) = do
let firstExpr :: OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (GenLocated SrcSpanAnnN RdrName))
firstExpr = forall a. [a] -> a
head [OpTree (LHsType GhcPs) (OpInfo (GenLocated SrcSpanAnnN RdrName))]
exprs
otherExprs :: [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (GenLocated SrcSpanAnnN RdrName))]
otherExprs = forall a. [a] -> [a]
tail [OpTree (LHsType GhcPs) (OpInfo (GenLocated SrcSpanAnnN RdrName))]
exprs
placement :: Placement
placement =
forall l ty op.
HasSrcSpan l =>
(ty -> Placement)
-> OpTree (GenLocated l ty) op
-> OpTree (GenLocated l ty) op
-> Placement
opBranchPlacement
HsType GhcPs -> Placement
tyOpPlacement
OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (GenLocated SrcSpanAnnN RdrName))
firstExpr
(forall a. [a] -> a
last [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (GenLocated SrcSpanAnnN RdrName))]
otherExprs)
p_x :: R ()
p_x = OpTree (LHsType GhcPs) (OpInfo (GenLocated SrcSpanAnnN RdrName))
-> R ()
p_tyOpTree OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (GenLocated SrcSpanAnnN RdrName))
firstExpr
putOpsExprs :: [OpInfo (GenLocated SrcSpanAnnN RdrName)]
-> [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (GenLocated SrcSpanAnnN RdrName))]
-> R ()
putOpsExprs (OpInfo (GenLocated SrcSpanAnnN RdrName)
opi : [OpInfo (GenLocated SrcSpanAnnN RdrName)]
ops') (OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (GenLocated SrcSpanAnnN RdrName))
expr : [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (GenLocated SrcSpanAnnN RdrName))]
exprs') = do
let p_op :: R ()
p_op = GenLocated SrcSpanAnnN RdrName -> R ()
p_rdrName (forall op. OpInfo op -> op
opiOp OpInfo (GenLocated SrcSpanAnnN RdrName)
opi)
p_y :: R ()
p_y = OpTree (LHsType GhcPs) (OpInfo (GenLocated SrcSpanAnnN RdrName))
-> R ()
p_tyOpTree OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (GenLocated SrcSpanAnnN RdrName))
expr
Placement -> R () -> R ()
placeHanging
Placement
placement
forall a b. (a -> b) -> a -> b
$ do
R ()
p_op
R ()
space
R ()
p_y
[OpInfo (GenLocated SrcSpanAnnN RdrName)]
-> [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (GenLocated SrcSpanAnnN RdrName))]
-> R ()
putOpsExprs [OpInfo (GenLocated SrcSpanAnnN RdrName)]
ops' [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (GenLocated SrcSpanAnnN RdrName))]
exprs'
putOpsExprs [OpInfo (GenLocated SrcSpanAnnN RdrName)]
_ [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (GenLocated SrcSpanAnnN RdrName))]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[SrcSpan] -> R () -> R ()
switchLayout [forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (LHsType GhcPs) (OpInfo (GenLocated SrcSpanAnnN RdrName))
t] forall a b. (a -> b) -> a -> b
$ do
R () -> R ()
ub <- Placement -> R (R () -> R ())
opBranchBraceStyle Placement
placement
R () -> R ()
ub R ()
p_x
[OpInfo (GenLocated SrcSpanAnnN RdrName)]
-> [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (GenLocated SrcSpanAnnN RdrName))]
-> R ()
putOpsExprs [OpInfo (GenLocated SrcSpanAnnN RdrName)]
ops [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (GenLocated SrcSpanAnnN RdrName))]
otherExprs