{-# 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 _ a) -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just RdrName
a
HsExpr GhcPs
_ -> Maybe RdrName
forall a. Maybe a
Nothing
getOpNameStr :: RdrName -> String
getOpNameStr :: RdrName -> String
getOpNameStr = OccName -> String
occNameString (OccName -> String) -> (RdrName -> OccName) -> RdrName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc
opBranchPlacement ::
HasSrcSpan l =>
(ty -> Placement) ->
OpTree (GenLocated l ty) op ->
OpTree (GenLocated l ty) op ->
Placement
opBranchPlacement :: (ty -> Placement)
-> OpTree (GenLocated l ty) op
-> OpTree (GenLocated l ty) op
-> Placement
opBranchPlacement ty -> Placement
placer OpTree (GenLocated l ty) op
firstExpr OpTree (GenLocated l ty) op
lastExpr
| SrcSpan -> Bool
isOneLineSpan
( SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan
(SrcSpan -> SrcLoc
srcSpanStart (OpTree (GenLocated l ty) op -> SrcSpan
forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (GenLocated l ty) op
firstExpr))
(SrcSpan -> SrcLoc
srcSpanStart (OpTree (GenLocated l ty) op -> SrcSpan
forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (GenLocated l ty) op
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 R Layout -> (Layout -> R () -> R ()) -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Layout
SingleLine -> R () -> R ()
useBraces
Layout
MultiLine -> case Placement
placement of
Placement
Hanging -> R () -> R ()
useBraces
Placement
Normal -> R () -> R ()
dontUseBraces
exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree (L _ (OpApp _ x op y)) = [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
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
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op]
exprOpTree LHsExpr GhcPs
n = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall ty op. ty -> OpTree ty op
OpNode LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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) = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr 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 = [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. [a] -> a
head [OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs))]
[OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
exprs
otherExprs :: [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
otherExprs = [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
tail [OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs))]
[OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
exprs
placement :: Placement
placement =
(HsExpr GhcPs -> Placement)
-> OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Placement
forall l ty op.
HasSrcSpan l =>
(ty -> Placement)
-> OpTree (GenLocated l ty) op
-> OpTree (GenLocated l ty) op
-> Placement
opBranchPlacement
HsExpr GhcPs -> Placement
exprPlacement
OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
firstExpr
([OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
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 ([OpTree ty op] -> OpTree ty op
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
_ HsStmtContext (HsDoRn p)
ctx XRec p [ExprLStmt p]
_)) -> case HsStmtContext (HsDoRn p)
ctx of
DoExpr Maybe ModuleName
_ -> Bool
True
MDoExpr Maybe ModuleName
_ -> Bool
True
HsStmtContext (HsDoRn p)
_ -> 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 (OpInfo op -> FixityInfo
forall op. OpInfo op -> FixityInfo
opiFix OpInfo op
opi)
Bool -> Bool -> Bool
&& SrcSpan -> Bool
isOneLineSpan (OpTree (GenLocated l (HsExpr p)) op -> SrcSpan
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 Placement -> Placement -> Bool
forall a. Eq a => a -> a -> Bool
== Placement
Normal
Bool -> Bool -> Bool
&& Bool -> Bool
not (OpTree (GenLocated l (HsExpr p)) op -> Bool
forall l p op. OpTree (GenLocated l (HsExpr p)) op -> Bool
isDoBlock (OpTree (GenLocated l (HsExpr p)) op -> Bool)
-> OpTree (GenLocated l (HsExpr p)) op -> Bool
forall a b. (a -> b) -> a -> b
$ OpTree (GenLocated l (HsExpr p)) op
-> OpTree (GenLocated l (HsExpr p)) op
forall ty op. OpTree ty op -> OpTree ty op
rightMostNode OpTree (GenLocated l (HsExpr p)) op
prevExpr)
isTrailing :: Bool
isTrailing = ((OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Bool)
-> [(OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Bool
forall l p op op.
HasSrcSpan l =>
(OpTree (GenLocated l (HsExpr p)) op, OpInfo op) -> Bool
couldBeTrailing ([(OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool)
-> [(OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall a b. (a -> b) -> a -> b
$ [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [(OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs))]
[OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
exprs [OpInfo (LHsExpr GhcPs)]
[OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
ops
R () -> R ()
ub <- if Bool
isTrailing then (R () -> R ()) -> R (R () -> R ())
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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ BracketStyle
-> OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs)) -> R ()
p_exprOpTree BracketStyle
s OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs))
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 = [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
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 R () -> R ()
forall a. a -> a
id
opWrapper :: R () -> R ()
opWrapper = case GenLocated l (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc (OpInfo (GenLocated l (HsExpr GhcPs)) -> GenLocated l (HsExpr GhcPs)
forall op. OpInfo op -> op
opiOp OpInfo (GenLocated l (HsExpr GhcPs))
opi) of
HsUnboundVar XUnboundVar GhcPs
_ OccName
_ -> R () -> R ()
backticks
HsExpr GhcPs
_ -> R () -> R ()
forall a. a -> a
id
p_op :: R ()
p_op = GenLocated l (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (OpInfo (GenLocated l (HsExpr GhcPs)) -> GenLocated l (HsExpr GhcPs)
forall op. OpInfo op -> op
opiOp OpInfo (GenLocated l (HsExpr GhcPs))
opi) (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 = R () -> R ()
ub' (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ BracketStyle
-> OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs)) -> R ()
p_exprOpTree BracketStyle
N OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs))
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 (Bool -> Bool)
-> (OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Bool)
-> OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Bool
isOneLineSpan (SrcSpan -> Bool)
-> (OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan)
-> OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc (OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Bool)
-> OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Bool
forall a b. (a -> b) -> a -> b
$ OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
expr)
then (HsExpr GhcPs -> Placement)
-> OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Placement
forall l ty op.
HasSrcSpan l =>
(ty -> Placement)
-> OpTree (GenLocated l ty) op
-> OpTree (GenLocated l ty) op
-> Placement
opBranchPlacement HsExpr GhcPs -> Placement
exprPlacement OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
prevExpr OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
expr
else Placement
Normal
)
(R () -> R ()) -> R () -> R ()
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 (R () -> R ()) -> R () -> R ()
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)))]
_ = () -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[SrcSpan] -> R () -> R ()
switchLayout [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs))
OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
t] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
p_x
OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [OpTree
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
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)]
[OpInfo (GenLocated SrcSpanAnnA (HsExpr 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 _ (HsCmdTop _ (L _ (HsCmdArrForm _ op Infix _ [x, y])))) ->
[OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
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
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op]
LHsCmdTop GhcPs
n -> GenLocated SrcSpan (HsCmdTop GhcPs)
-> OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall ty op. ty -> OpTree ty op
OpNode LHsCmdTop GhcPs
GenLocated SrcSpan (HsCmdTop 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) = GenLocated SrcSpan (HsCmdTop GhcPs)
-> (HsCmdTop GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
GenLocated SrcSpan (HsCmdTop GhcPs)
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 SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
firstExpr = [OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. [a] -> a
head [OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs))]
[OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
exprs
otherExprs :: [OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
otherExprs = [OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
tail [OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs))]
[OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
exprs
placement :: Placement
placement =
(HsCmdTop GhcPs -> Placement)
-> OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Placement
forall l ty op.
HasSrcSpan l =>
(ty -> Placement)
-> OpTree (GenLocated l ty) op
-> OpTree (GenLocated l ty) op
-> Placement
opBranchPlacement
HsCmdTop GhcPs -> Placement
cmdTopPlacement
OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
firstExpr
([OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. [a] -> a
last [OpTree
(GenLocated SrcSpan (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 (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ BracketStyle
-> OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs)) -> R ()
p_cmdOpTree BracketStyle
s OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs))
OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
firstExpr
putOpsExprs :: [OpInfo (GenLocated l (HsExpr GhcPs))]
-> [OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
putOpsExprs (OpInfo (GenLocated l (HsExpr GhcPs))
opi : [OpInfo (GenLocated l (HsExpr GhcPs))]
ops') (OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
expr : [OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
exprs') = do
let ub' :: R () -> R ()
ub' = if Bool -> Bool
not ([OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
exprs') then R () -> R ()
ub else R () -> R ()
forall a. a -> a
id
p_op :: R ()
p_op = GenLocated l (HsExpr GhcPs) -> (HsExpr GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (OpInfo (GenLocated l (HsExpr GhcPs)) -> GenLocated l (HsExpr GhcPs)
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' (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ BracketStyle
-> OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs)) -> R ()
p_cmdOpTree BracketStyle
N OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs))
OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
expr
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
[OpInfo (GenLocated l (HsExpr GhcPs))]
-> [OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
putOpsExprs [OpInfo (GenLocated l (HsExpr GhcPs))]
ops' [OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
exprs'
putOpsExprs [OpInfo (GenLocated l (HsExpr GhcPs))]
_ [OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_ = () -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[SrcSpan] -> R () -> R ()
switchLayout [OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs))
OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
t] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
p_x
[OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
forall l.
HasSrcSpan l =>
[OpInfo (GenLocated l (HsExpr GhcPs))]
-> [OpTree
(GenLocated SrcSpan (HsCmdTop GhcPs))
(OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> R ()
putOpsExprs [OpInfo (LHsExpr GhcPs)]
[OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
ops [OpTree
(GenLocated SrcSpan (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) (LocatedN RdrName)
tyOpTree (L _ (HsOpTy NoExtField l op r)) =
[OpTree (GenLocated SrcSpanAnnA (HsType GhcPs)) (LocatedN RdrName)]
-> [LocatedN RdrName]
-> OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs)) (LocatedN RdrName)
forall ty op. [OpTree ty op] -> [op] -> OpTree ty op
OpBranches [LHsType GhcPs -> OpTree (LHsType GhcPs) (LocatedN RdrName)
tyOpTree LHsType GhcPs
l, LHsType GhcPs -> OpTree (LHsType GhcPs) (LocatedN RdrName)
tyOpTree LHsType GhcPs
r] [LIdP GhcPs
LocatedN RdrName
op]
tyOpTree LHsType GhcPs
n = GenLocated SrcSpanAnnA (HsType GhcPs)
-> OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs)) (LocatedN RdrName)
forall ty op. ty -> OpTree ty op
OpNode LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
n
p_tyOpTree ::
OpTree (LHsType GhcPs) (OpInfo (LocatedN RdrName)) ->
R ()
p_tyOpTree :: OpTree (LHsType GhcPs) (OpInfo (LocatedN RdrName)) -> R ()
p_tyOpTree (OpNode LHsType GhcPs
n) = GenLocated SrcSpanAnnA (HsType GhcPs)
-> (HsType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
n HsType GhcPs -> R ()
p_hsType
p_tyOpTree t :: OpTree (LHsType GhcPs) (OpInfo (LocatedN RdrName))
t@(OpBranches [OpTree (LHsType GhcPs) (OpInfo (LocatedN RdrName))]
exprs [OpInfo (LocatedN RdrName)]
ops) = do
let firstExpr :: OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs)) (OpInfo (LocatedN RdrName))
firstExpr = [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (LocatedN RdrName))]
-> OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs)) (OpInfo (LocatedN RdrName))
forall a. [a] -> a
head [OpTree (LHsType GhcPs) (OpInfo (LocatedN RdrName))]
[OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (LocatedN RdrName))]
exprs
otherExprs :: [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (LocatedN RdrName))]
otherExprs = [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (LocatedN RdrName))]
-> [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (LocatedN RdrName))]
forall a. [a] -> [a]
tail [OpTree (LHsType GhcPs) (OpInfo (LocatedN RdrName))]
[OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (LocatedN RdrName))]
exprs
placement :: Placement
placement =
(HsType GhcPs -> Placement)
-> OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs)) (OpInfo (LocatedN RdrName))
-> OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs)) (OpInfo (LocatedN RdrName))
-> 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 (LocatedN RdrName))
firstExpr
([OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (LocatedN RdrName))]
-> OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs)) (OpInfo (LocatedN RdrName))
forall a. [a] -> a
last [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (LocatedN RdrName))]
otherExprs)
p_x :: R ()
p_x = OpTree (LHsType GhcPs) (OpInfo (LocatedN RdrName)) -> R ()
p_tyOpTree OpTree (LHsType GhcPs) (OpInfo (LocatedN RdrName))
OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs)) (OpInfo (LocatedN RdrName))
firstExpr
putOpsExprs :: [OpInfo (LocatedN RdrName)]
-> [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (LocatedN RdrName))]
-> R ()
putOpsExprs (OpInfo (LocatedN RdrName)
opi : [OpInfo (LocatedN RdrName)]
ops') (OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs)) (OpInfo (LocatedN RdrName))
expr : [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (LocatedN RdrName))]
exprs') = do
let p_op :: R ()
p_op = LocatedN RdrName -> R ()
p_rdrName (OpInfo (LocatedN RdrName) -> LocatedN RdrName
forall op. OpInfo op -> op
opiOp OpInfo (LocatedN RdrName)
opi)
p_y :: R ()
p_y = OpTree (LHsType GhcPs) (OpInfo (LocatedN RdrName)) -> R ()
p_tyOpTree OpTree (LHsType GhcPs) (OpInfo (LocatedN RdrName))
OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs)) (OpInfo (LocatedN RdrName))
expr
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
[OpInfo (LocatedN RdrName)]
-> [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (LocatedN RdrName))]
-> R ()
putOpsExprs [OpInfo (LocatedN RdrName)]
ops' [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (LocatedN RdrName))]
exprs'
putOpsExprs [OpInfo (LocatedN RdrName)]
_ [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (LocatedN RdrName))]
_ = () -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[SrcSpan] -> R () -> R ()
switchLayout [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs)) (OpInfo (LocatedN RdrName))
-> SrcSpan
forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree (LHsType GhcPs) (OpInfo (LocatedN RdrName))
OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs)) (OpInfo (LocatedN RdrName))
t] (R () -> R ()) -> R () -> R ()
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 (LocatedN RdrName)]
-> [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (LocatedN RdrName))]
-> R ()
putOpsExprs [OpInfo (LocatedN RdrName)]
ops [OpTree
(GenLocated SrcSpanAnnA (HsType GhcPs))
(OpInfo (LocatedN RdrName))]
otherExprs