{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}

-- | Printing of operator trees.
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.Config (poIndentation)
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)

-- | Extract the operator name of the specified 'HsExpr' if this expression
-- corresponds to an operator.
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

-- | Convert an operator name to a 'String'.
getOpNameStr :: RdrName -> String
getOpNameStr :: RdrName -> String
getOpNameStr = OccName -> String
occNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc

-- | Decide if the operands of an operator chain should be hanging.
opBranchPlacement ::
  HasSrcSpan l =>
  -- | Placer function for nodes
  (ty -> Placement) ->
  -- | first expression of the chain
  OpTree (GenLocated l ty) op ->
  -- | last expression of the chain
  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
  -- If the beginning of the first argument and the last argument starts on
  -- the same line, and the second argument has a hanging form, use hanging
  -- placement.
  | 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

-- | Decide whether to use braces or not based on the layout and placement
-- of an expression in an infix operator application.
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

-- | Convert a 'LHsExpr' containing an operator tree to the 'OpTree'
-- intermediate representation.
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

-- | Print an operator tree where leaves are values.
p_exprOpTree ::
  -- | Bracket style to use
  BracketStyle ->
  -- | N-ary 'OpTree' to render, enhanced with information regarding
  -- operator fixity
  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
      -- Whether we could place the operator in a trailing position,
      -- followed by a breakpoint before the RHS
      couldBeTrailing :: (OpTree (GenLocated l (HsExpr p)) op, OpInfo op) -> Bool
couldBeTrailing (OpTree (GenLocated l (HsExpr p)) op
prevExpr, OpInfo op
opi) =
        -- An operator with fixity InfixR 0, like seq, $, and $ variants,
        -- is required
        FixityInfo -> Bool
isHardSplitterOp (forall op. OpInfo op -> FixityInfo
opiFix OpInfo op
opi)
          -- the LHS must be single-line
          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)
          -- can only happen when a breakpoint would have been added anyway
          Bool -> Bool -> Bool
&& Placement
placement forall a. Eq a => a -> a -> Bool
== Placement
Normal
          -- if the node just on the left of the operator (so the rightmost
          -- node of the subtree prevExpr) is a do-block, then we cannot
          -- place the operator in a trailing position (because it would be
          -- read as being part of the do-block)
          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)
      -- If all operators at the current level match the conditions to be
      -- trailing, then put them in a trailing position
      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
  Int
indent <- forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f Int
poIndentation
  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
            -- Distinguish holes used in infix notation.
            -- eg. '1 _foo 2' and '1 `_foo` 2'
            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
              -- When we have a chain of trailing operators (staircase style),
              -- the last operand, when multiline, is allowed to hang
              -- (ex: do block, lambda...)
              ( 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
            let withPlacement :: R () -> R ()
withPlacement R ()
m =
                  -- This case prevents an operator from being indented past the start of a `do` block
                  -- constituting its left operand, thus altering the AST.
                  -- This is only relevant when the `do` block is on one line, as otherwise we will
                  -- insert a newline after `do` anyway.
                  -- This isn't an issue in Ormolu because this problem doesn't come up with 2-space
                  -- indents, only when the indentation goes past the "do" column.
                  if Int
indent forall a. Ord a => a -> a -> Bool
> Int
2 Bool -> Bool -> Bool
&& forall {l} {p} {op}. OpTree (GenLocated l (HsExpr p)) op -> Bool
isDoBlock OpTree
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
  (OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
firstExpr Bool -> Bool -> Bool
&& SrcSpan -> Bool
isOneLineSpan (forall l a b. HasSrcSpan l => OpTree (GenLocated l a) b -> SrcSpan
opTreeLoc OpTree
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
  (OpInfo (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
firstExpr)
                    then R ()
breakpoint forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
m
                    else Placement -> R () -> R ()
placeHanging Placement
placement R ()
m
            R () -> R ()
withPlacement 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

-- | Convert a 'LHsCmdTop' containing an operator tree to the 'OpTree'
-- intermediate representation.
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

-- | Print an operator tree where leaves are commands.
p_cmdOpTree ::
  -- | Bracket style to use
  BracketStyle ->
  -- | N-ary OpTree to render, enhanced with information regarding operator
  -- fixity
  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

-- | Check if given expression has a hanging form. Added for symmetry with
-- exprPlacement and cmdTopPlacement, which are all used in p_xxxOpTree
-- functions with opBranchPlacement.
tyOpPlacement :: HsType GhcPs -> Placement
tyOpPlacement :: HsType GhcPs -> Placement
tyOpPlacement = \case
  HsType GhcPs
_ -> Placement
Normal

-- | Convert a LHsType containing an operator tree to the 'OpTree'
-- intermediate representation.
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

-- | Print an operator tree where leaves are types.
p_tyOpTree ::
  -- | N-ary 'OpTree' to render, enhanced with information regarding
  -- operator fixity
  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