{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

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 (mkVarOcc)
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

-- | Style of a group of equations.
data MatchGroupStyle
  = Function (Located RdrName)
  | PatternBind
  | Case
  | Lambda
  | LambdaCase

-- | Style of equations in a group.
data GroupStyle
  = EqualSign
  | RightArrow

-- | Expression placement. This marks the places where expressions that
-- implement handing forms may use them.
data Placement
  = -- | Multi-line layout should cause
    -- insertion of a newline and indentation
    -- bump
    Normal
  | -- | Expressions that have hanging form
    -- should use it and avoid bumping one level
    -- of indentation
    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)

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" -- introduced by the type checker
  AbsBinds {} -> String -> R ()
forall a. String -> a
notImplemented String
"AbsBinds" -- introduced by the type checker
  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 =>
  -- | How to get body placement
  (body -> Placement) ->
  -- | How to print body
  (body -> R ()) ->
  -- | Style of this group of equations
  MatchGroupStyle ->
  -- | Match group
  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
  -- Since we are forcing braces on 'sepSemi' based on 'ob', we have to
  -- restore the brace state inside the sepsemi.
  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

-- | Function id obtained through pattern matching on 'FunBind' should not
-- be used to print the actual equations because the different ‘RdrNames’
-- used in the equations may have different “decorations” (such as backticks
-- and paretheses) associated with them. It is necessary to use per-equation
-- names obtained from 'm_ctxt' of 'Match'. This function replaces function
-- name inside of 'Function' accordingly.
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 ::
  -- | Style of the group
  MatchGroupStyle ->
  -- | Is this an infix match?
  Bool ->
  -- | Strictness prefix (FunBind)
  SrcStrictness ->
  -- | Argument patterns
  [LPat GhcPs] ->
  -- | Equations
  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 =>
  -- | How to get body placement
  (body -> Placement) ->
  -- | How to print body
  (body -> R ()) ->
  -- | Style of this group of equations
  MatchGroupStyle ->
  -- | Is this an infix match?
  Bool ->
  -- | Strictness prefix (FunBind)
  SrcStrictness ->
  -- | Argument patterns
  [LPat GhcPs] ->
  -- | Equations
  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
  -- Normally, since patterns may be placed in a multi-line layout, it is
  -- necessary to bump indentation for the pattern group so it's more
  -- indented than function name. This in turn means that indentation for
  -- the body should also be bumped. Normally this would mean that bodies
  -- would start with two indentation steps applied, which is ugly, so we
  -- need to be a bit more clever here and bump indentation level only when
  -- pattern group is multiline.
  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
"~"
  R () -> R ()
inci' <- 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 -> R () -> R ()
forall a. a -> a
id (R () -> R ()) -> R () -> R (R () -> R ())
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 =
            NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$
              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
          inci' :: R () -> R ()
inci' =
            if SrcSpan -> Bool
isOneLineSpan SrcSpan
combinedSpans
              then R () -> R ()
forall a. a -> a
id
              else R () -> R ()
inci
      [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 -> (R () -> R ()) -> R () -> [R ()] -> R ()
p_infixDefHelper
              Bool
isInfix
              R () -> R ()
inci'
              (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
      (R () -> R ()) -> R (R () -> R ())
forall (m :: * -> *) a. Monad m => a -> m a
return R () -> R ()
inci'
  let -- Calculate position of end of patterns. This is useful when we decide
      -- about putting certain constructions in hanging positions.
      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
  let 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
  R () -> R ()
inci' (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 =>
  -- | How to get body placement
  (body -> Placement) ->
  -- | How to print body
  (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 ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) (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
$ 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
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 {} ->
    -- XXX Does this ever occur in the syntax tree? It does not seem like it
    -- does. Open an issue and ping @yumiova if this ever occurs in output.
    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. Data 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 :: Data a => (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
        -- Spacing before comments will be handled by the code
        -- that prints comments, so we just have to deal with
        -- blank lines between statements here.
        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
      -- In some cases the (f x) expression may insert a new mark. We want
      -- to be careful not to override comment marks.
      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 =>
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (body -> R ()) ->
  -- | Statement to render
  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" -- generated by renamer
  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 {} ->
    -- 'ParStmt' should always be eliminated in 'gatherStmt' already, such
    -- that it never occurs in 'p_stmt''. Consequently, handling it here
    -- would be redundant.
    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)
..} ->
    -- 'TransStmt' only needs to account for render printing itself, since
    -- pretty printing of relevant statements (e.g., in 'trS_stmts') is
    -- handled through 'gatherStmt'.
    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. Data 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
    let ssStart :: Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs) -> SrcLoc
ssStart =
          (LHsBindLR GhcPs GhcPs -> SrcLoc)
-> (LSig GhcPs -> SrcLoc)
-> Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)
-> SrcLoc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc)
-> (LHsBindLR GhcPs GhcPs -> SrcSpan)
-> LHsBindLR GhcPs GhcPs
-> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsBindLR GhcPs GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc)
            (SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc)
-> (LSig GhcPs -> SrcSpan) -> LSig GhcPs -> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSig GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc)
        items :: [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
items =
          (LHsBindLR GhcPs GhcPs
-> Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)
forall a b. a -> Either a b
Left (LHsBindLR GhcPs GhcPs
 -> Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs))
-> [LHsBindLR GhcPs GhcPs]
-> [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsBindsLR GhcPs GhcPs -> [LHsBindLR GhcPs GhcPs]
forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
bag) [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
-> [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
-> [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
forall a. [a] -> [a] -> [a]
++ (LSig GhcPs -> Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)
forall a b. b -> Either a b
Right (LSig GhcPs -> Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs))
-> [LSig GhcPs] -> [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LSig GhcPs]
lsigs)
        p_item :: Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs) -> R ()
p_item (Left LHsBindLR GhcPs GhcPs
x) = LHsBindLR GhcPs GhcPs -> (HsBindLR GhcPs GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsBindLR GhcPs GhcPs
x HsBindLR GhcPs GhcPs -> R ()
p_valDecl
        p_item (Right LSig GhcPs
x) = LSig GhcPs -> (Sig GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LSig GhcPs
x Sig GhcPs -> R ()
p_sigDecl
    -- When in a single-line layout, there is a chance that the inner
    -- elements will also contain semicolons and they will confuse the
    -- parser. so we request braces around every element except the last.
    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
    R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      ((RelativePos, Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs))
 -> R ())
-> [(RelativePos, Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs))]
-> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi
        ( \(RelativePos
p, Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)
i) ->
            ( case RelativePos
p of
                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
            )
              (Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs) -> R ()
p_item Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)
i)
        )
        ([Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
-> [(RelativePos, Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs))]
forall a. [a] -> [(RelativePos, a)]
attachRelativePos ([Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
 -> [(RelativePos, Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs))])
-> [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
-> [(RelativePos, Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs))]
forall a b. (a -> b) -> a -> b
$ (Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs) -> SrcLoc)
-> [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
-> [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs) -> SrcLoc
ssStart [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
items)
  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) ->
    -- Second argument of IPBind is always Left before type-checking.
    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
_) =
          -- Should only occur after the type checker
          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_hsTupArg :: HsTupArg GhcPs -> R ()
p_hsTupArg :: HsTupArg GhcPs -> R ()
p_hsTupArg = \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_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 -- In order to format function applications with multiple parameters
        -- nicer, traverse the AST to gather the function and all the
        -- parameters together.
        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
:| [])
        -- We need to handle the last argument specially if it is a
        -- hanging construct, so separate it from the rest.
        ([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]
        -- Hang the last argument only if the initial arguments span one
        -- line.
        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
    -- If the last argument is not hanging, just separate every argument as
    -- usual. If it is hanging, print the initial arguments and hang the
    -- last one. Also, use braces around the every argument except the last
    -- one.
    case Placement
placement of
      Placement
Normal -> do
        let -- Usually we want to bump indentation for arguments for the
            -- sake of readability. However, when the function itself is a
            -- do-block or case expression it is not a good idea. It seems
            -- to be safe to always bump indentation when the function
            -- expression is parenthesised.
            indent :: R () -> R ()
indent =
              case LHsExpr GhcPs
func of
                L SrcSpan
_ (HsPar XPar GhcPs
NoExtField LHsExpr GhcPs
_) -> R () -> R ()
inci
                L SrcSpan
_ (HsAppType XAppTypeE GhcPs
NoExtField LHsExpr GhcPs
_ LHsWcType (NoGhcTc GhcPs)
_) -> R () -> R ()
inci
                L SrcSpan
_ (HsMultiIf XMultiIf GhcPs
NoExtField [LGRHS GhcPs (LHsExpr GhcPs)]
_) -> R () -> R ()
inci
                L SrcSpan
spn HsExpr GhcPs
_ ->
                  if SrcSpan -> Bool
isOneLineSpan SrcSpan
spn
                    then R () -> R ()
inci
                    else R () -> R ()
forall a. a -> a
id
        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
          R () -> R ()
indent (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
        R () -> R ()
indent (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
"@"
      Located (HsType GhcPs) -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located (HsWildCardBndrs GhcPs (Located (HsType GhcPs))
-> Located (HsType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (Located (HsType 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)
    Bool
-> BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree Bool
True 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 -> do
    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
    let parens' :: BracketStyle -> R () -> R ()
parens' =
          case Boxity
boxity of
            Boxity
Boxed -> BracketStyle -> R () -> R ()
parens
            Boxity
Unboxed -> BracketStyle -> R () -> R ()
parensHash
    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 ((HsTupArg GhcPs -> R ()) -> LHsTupArg GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsTupArg GhcPs -> R ()
p_hsTupArg) [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 ()) -> 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 () -> (LHsTupArg GhcPs -> R ()) -> [LHsTupArg GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) (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_hsTupArg) [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 ()) -> 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 ()
-> (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. Data 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 ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ 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
"| ")
                  [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 ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint)
                    ((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 -> String -> R ()
forall a. String -> a
notImplemented String
"MonadComp"
      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 ()) -> 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 () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) (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 ()) -> 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 () -> (R () -> R ()) -> [R ()] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) 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
            }
    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 ()) -> 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 ()
-> (LHsRecUpdField GhcPs -> R ()) -> [LHsRecUpdField GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
        (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint)
        (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
$ Located (HsType GhcPs) -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located (HsType 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 ()) -> 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
$ 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 ()) -> 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
$ do
        R () -> R ()
sitcc (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 ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) ((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 ()) -> 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
$ 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 ()) -> 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
$ do
        R () -> R ()
sitcc (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 ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) ((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 ()
newline
            Text -> R ()
txt Text
"where"
            R ()
newline
            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 ()) -> 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 ()
-> (RecordPatSynField (Located RdrName) -> R ())
-> [RecordPatSynField (Located RdrName)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) (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 =>
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (body -> R ()) ->
  -- | Expression
  LHsExpr GhcPs ->
  -- | Match group
  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 =>
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (body -> R ()) ->
  -- | If
  LHsExpr GhcPs ->
  -- | Then
  Located body ->
  -- | Else
  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 =>
  -- | Render
  (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 ()) -> 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 ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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)]
pats
  TuplePat XTuplePat GhcPs
NoExtField [LPat GhcPs]
pats Boxity
boxing -> do
    let f :: R () -> R ()
f =
          case Boxity
boxing of
            Boxity
Boxed -> BracketStyle -> R () -> R ()
parens BracketStyle
S
            Boxity
Unboxed -> BracketStyle -> R () -> R ()
parensHash BracketStyle
S
    R () -> R ()
f (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 ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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)]
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 () -> R ()
sitcc (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 ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) 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" -- presumably created by renamer?
  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" -- apparently created at some later stage
  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 ()), Int) -> R ()
f (Maybe (R ())
x, Int
i) = do
        let isFirst :: Bool
isFirst = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            isLast :: Bool
isLast = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        case Maybe (R ())
x :: Maybe (R ()) of
          Maybe (R ())
Nothing ->
            Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
isFirst Bool -> Bool -> Bool
|| Bool
isLast) R ()
space
          Just R ()
m' -> do
            Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isFirst R ()
space
            R ()
m'
            Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isLast R ()
space
  BracketStyle -> R () -> R ()
parensHash BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> ((Maybe (R ()), Int) -> R ()) -> [(Maybe (R ()), Int)] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt Text
"|") (Maybe (R ()), Int) -> R ()
f ([Maybe (R ())] -> [Int] -> [(Maybe (R ()), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe (R ())]
args [Int
0 ..])

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
"|"
    -- QuasiQuoters often rely on precise custom strings. We cannot do any
    -- formatting here without potentially breaking someone's code.
    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 ::
  -- | Typed splice?
  Bool ->
  -- | Splice expression
  LHsExpr GhcPs ->
  -- | Splice decoration
  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" -- result of renamer
  TypBr XTypBr GhcPs
NoExtField Located (HsType GhcPs)
ty -> Text -> R () -> R ()
quote Text
"t" (Located (HsType GhcPs) -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located (HsType 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)
    -- HACK As you can see we use 'noLoc' here to be able to pass name into
    -- 'p_rdrName' since the latter expects a "located" thing. The problem
    -- is that 'VarBr' doesn't provide us with location of the name. This in
    -- turn makes it impossible to detect if there are parentheses around
    -- it, etc. So we have to add parentheses manually assuming they are
    -- necessary for all operators.
    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
"|]"

-- Print the source text of a string literal while indenting
-- gaps correctly.

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
    -- Split a string on gaps (backslash delimited whitespaces)
    --
    -- > splitGaps "bar\\  \\fo\\&o" == ["bar", "fo\\&o"]
    splitGaps :: String -> [String]
    splitGaps :: String -> [String]
splitGaps String
"" = []
    splitGaps String
s =
      let -- A backslash and a whitespace starts a "gap"
          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 -- drop the initial '\', any amount of 'ghcSpace', and another '\'
                  r' :: String
r' = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
ghcSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> String -> String
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'
    -- GHC's definition of whitespaces in strings
    -- See: https://gitlab.haskell.org/ghc/ghc/blob/86753475/compiler/parser/Lexer.x#L1653
    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
    -- Add backslashes to the inner side of the strings
    --
    -- > backslashes ["a", "b", "c"] == ["a\\", "\\b\\", "\\c"]
    backslashes :: [String] -> [String]
    backslashes :: [String] -> [String]
backslashes (String
x : String
y : [String]
xs) = (String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\\") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
backslashes ((Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: String
y) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs)
    backslashes [String]
xs = [String]
xs
    -- Attaches previous and next items to each list element
    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

----------------------------------------------------------------------------
-- Helpers

-- | Return the wrapping function controlling the use of braces according to
-- the current layout.
layoutToBraces :: Layout -> R () -> R ()
layoutToBraces :: Layout -> R () -> R ()
layoutToBraces = \case
  Layout
SingleLine -> R () -> R ()
useBraces
  Layout
MultiLine -> R () -> R ()
forall a. a -> a
id

-- | Append each element in both lists with semigroups. If one list is shorter
-- than the other, return the rest of the longer list unchanged.
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

-- | Place a thing that may have a hanging form. This function handles how
-- to separate it from preceding expressions and whether to bump indentation
-- depending on what sort of expression we have.
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

-- | Check if given block contains single expression which has a hanging
-- form.
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

-- | Check if given command has a hanging form.
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

-- | Check if given expression has a hanging form.
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement = \case
  -- Only hang lambdas with single line parameter lists
  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
  -- If the rightmost expression in an operator chain is hanging, make the
  -- whole block hanging; so that we can use the common @f = foo $ do@
  -- style.
  OpApp XOpApp GhcPs
NoExtField LHsExpr GhcPs
_ 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)
  -- Same thing for function applications (usually with -XBlockArguments)
  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
_ ->
    -- Indentation breaks if pattern is longer than one line and left
    -- hanging. Consequently, only apply hanging when it is safe.
    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

p_exprOpTree ::
  -- | Can use special handling of dollar?
  Bool ->
  -- | Bracket style to use
  BracketStyle ->
  OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->
  R ()
p_exprOpTree :: Bool
-> BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree Bool
_ 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 Bool
isDollarSpecial BracketStyle
s (OpBranch OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x LHsExpr GhcPs
op OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y) = do
  -- If the beginning of the first argument and the second argument are on
  -- the same line, and the second argument has a hanging form, use hanging
  -- placement.
  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
      -- Distinguish holes used in infix notation.
      -- eg. '1 _foo 2' and '1 `_foo` 2'
      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
      gotDollar :: Bool
gotDollar = case HsExpr GhcPs -> Maybe RdrName
getOpName (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
op) of
        Just RdrName
rname -> String -> OccName
mkVarOcc String
"$" OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName -> OccName
rdrNameOcc RdrName
rname
        Maybe RdrName
_ -> Bool
False
      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
$
          Bool
-> BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree (Bool -> Bool
not Bool
gotDollar) BracketStyle
s OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x
  let 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] (Bool
-> BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree Bool
True 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
  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) (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y)
  if Bool
useRecordDot' Bool -> Bool -> Bool
&& Bool
isRecordDot'
    then do
      R ()
lhs
      Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isSection R ()
space
      R ()
p_op
      R ()
p_y
    else
      if Bool
isDollarSpecial
        Bool -> Bool -> Bool
&& Bool
gotDollar
        Bool -> Bool -> Bool
&& Placement
placement
        Placement -> Placement -> Bool
forall a. Eq a => a -> a -> Bool
== Placement
Normal
        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)
        then do
          R () -> R ()
useBraces R ()
lhs
          R ()
space
          R ()
p_op
          R ()
breakpoint
          R () -> R ()
inci R ()
p_y
        else do
          R () -> R ()
ub R ()
lhs
          let opAndRhs :: R ()
opAndRhs = do
                R ()
p_op
                R ()
space
                R ()
p_y
          case OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x of
            -- 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.
            OpNode (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> HsDo _ _ _) | SrcSpan -> Bool
isOneLineSpan (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x) -> R ()
breakpoint R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
opAndRhs
            OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
_ -> Placement -> R () -> R ()
placeHanging Placement
placement R ()
opAndRhs

-- | Return 'True' if given expression is a record-dot operator expression.
isRecordDot ::
  -- | Operator expression
  HsExpr GhcPs ->
  -- | Span of the expression on the right-hand side of the operator
  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 -> Bool
isDot IdP GhcPs
RdrName
opName 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

-- | Check whether a given 'RdrName' is the dot operator.
isDot :: RdrName -> Bool
isDot :: RdrName -> Bool
isDot RdrName
name = RdrName -> OccName
rdrNameOcc RdrName
name OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== String -> OccName
mkVarOcc String
"."

-- | Get annotations for the enclosing element.
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')