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

module Ormolu.Printer.Meat.Declaration.Value
  ( p_valDecl,
    p_pat,
    p_hsExpr,
    p_hsSplice,
    p_stringLit,
  )
where

import Control.Monad
import Data.Bool (bool)
import Data.Char (isPunctuation, isSymbol)
import Data.Data hiding (Infix, Prefix)
import Data.Function (on)
import Data.Functor ((<&>))
import Data.Generics.Schemes (everything)
import Data.List (intersperse, sortBy)
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Data.Bag (bagToList)
import GHC.Hs.Binds
import GHC.Hs.Expr
import GHC.Hs.Extension
import GHC.Hs.Lit
import GHC.Hs.Pat
import GHC.Hs.Type
import GHC.LanguageExtensions.Type (Extension (NegativeLiterals))
import GHC.Parser.Annotation
import GHC.Parser.CharClass (is_space)
import GHC.Types.Basic
import GHC.Types.Name.Occurrence (occNameString)
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
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, Int -> Placement -> ShowS
[Placement] -> ShowS
Placement -> String
(Int -> Placement -> ShowS)
-> (Placement -> String)
-> ([Placement] -> ShowS)
-> Show Placement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Placement] -> ShowS
$cshowList :: [Placement] -> ShowS
show :: Placement -> String
$cshow :: Placement -> String
showsPrec :: Int -> Placement -> ShowS
$cshowsPrec :: Int -> Placement -> ShowS
Show)

p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
p_valDecl = \case
  FunBind XFunBind GhcPs GhcPs
NoExtField Located (IdP GhcPs)
funId MatchGroup GhcPs (LHsExpr GhcPs)
funMatches [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

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 :: MatchGroup GhcPs (Located body)
mg@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 ()
bracesIfEmpty
        MatchGroupStyle
LambdaCase -> R () -> R ()
bracesIfEmpty
        MatchGroupStyle
_ -> R () -> R ()
dontUseBraces
        where
          bracesIfEmpty :: R () -> R ()
bracesIfEmpty = if MatchGroup GhcPs (Located body) -> Bool
forall id body. MatchGroup id body -> Bool
isEmptyMatchGroup MatchGroup GhcPs (Located body)
mg then R () -> R ()
useBraces else R () -> R ()
forall a. a -> a
id
  -- 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)]
-> [LMatch GhcPs (Located body)]
forall l e. GenLocated l e -> e
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 (NoGhcTc 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 (NoGhcTc 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 (NoGhcTc 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

-- | 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 GhcPs -> Located RdrName
forall p. HsMatchContext p -> LIdP p
mc_fun (HsMatchContext GhcPs -> Located RdrName)
-> (Match GhcPs body -> HsMatchContext GhcPs)
-> Match GhcPs body
-> Located RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs body -> HsMatchContext GhcPs
forall p body. Match p body -> HsMatchContext (NoGhcTc 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 (NoGhcTc id)
forall p body. Match p body -> HsMatchContext (NoGhcTc p)
m_ctxt Match id body
match of
    FunRhs {mc_strictness :: forall p. HsMatchContext p -> SrcStrictness
mc_strictness = SrcStrictness
s} -> SrcStrictness
s
    HsMatchContext (NoGhcTc 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
"~"
  Bool
indentBody <- case [Located (Pat GhcPs)] -> Maybe (NonEmpty (Located (Pat GhcPs)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
[Located (Pat GhcPs)]
m_pats of
    Maybe (NonEmpty (Located (Pat GhcPs)))
Nothing ->
      Bool
False Bool -> R () -> R Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ case MatchGroupStyle
style of
        Function Located RdrName
name -> Located RdrName -> R ()
p_rdrName Located RdrName
name
        MatchGroupStyle
_ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just NonEmpty (Located (Pat GhcPs))
ne_pats -> do
      let combinedSpans :: SrcSpan
combinedSpans = case MatchGroupStyle
style of
            Function Located RdrName
name -> SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (Located RdrName -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located RdrName
name) SrcSpan
patSpans
            MatchGroupStyle
_ -> SrcSpan
patSpans
          patSpans :: SrcSpan
patSpans = NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (Located (Pat GhcPs) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (Located (Pat GhcPs) -> SrcSpan)
-> NonEmpty (Located (Pat GhcPs)) -> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Located (Pat GhcPs))
ne_pats)
          indentBody :: Bool
indentBody = Bool -> Bool
not (SrcSpan -> Bool
isOneLineSpan SrcSpan
combinedSpans)
      [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
combinedSpans] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        let stdCase :: R ()
stdCase = R ()
-> (Located (Pat GhcPs) -> R ()) -> [Located (Pat GhcPs)] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((Pat GhcPs -> R ()) -> Located (Pat GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[Located (Pat GhcPs)]
m_pats
        case MatchGroupStyle
style of
          Function Located RdrName
name ->
            Bool -> Bool -> R () -> [R ()] -> R ()
p_infixDefHelper
              Bool
isInfix
              Bool
indentBody
              (Located RdrName -> R ()
p_rdrName Located RdrName
name)
              ((Pat GhcPs -> R ()) -> Located (Pat GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Pat GhcPs -> R ()
p_pat (Located (Pat GhcPs) -> R ()) -> [Located (Pat GhcPs)] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs]
[Located (Pat GhcPs)]
m_pats)
          MatchGroupStyle
PatternBind -> R ()
stdCase
          MatchGroupStyle
Case -> R ()
stdCase
          MatchGroupStyle
Lambda -> do
            let needsSpace :: Bool
needsSpace = case Located (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc (NonEmpty (Located (Pat GhcPs)) -> Located (Pat GhcPs)
forall a. NonEmpty a -> a
NE.head NonEmpty (Located (Pat GhcPs))
ne_pats) of
                  LazyPat XLazyPat GhcPs
_ LPat GhcPs
_ -> Bool
True
                  BangPat XBangPat GhcPs
_ LPat GhcPs
_ -> Bool
True
                  SplicePat XSplicePat GhcPs
_ HsSplice GhcPs
_ -> Bool
True
                  Pat GhcPs
_ -> Bool
False
            Text -> R ()
txt Text
"\\"
            Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsSpace R ()
space
            R () -> R ()
sitcc R ()
stdCase
          MatchGroupStyle
LambdaCase -> R ()
stdCase
      Bool -> R Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
indentBody
  let -- 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 l e. GenLocated l e -> l
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 l e. GenLocated l e -> l
getLoc (Located (Pat GhcPs) -> SrcSpan)
-> (NonEmpty (Located (Pat GhcPs)) -> Located (Pat GhcPs))
-> NonEmpty (Located (Pat GhcPs))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Located (Pat GhcPs)) -> Located (Pat GhcPs)
forall a. NonEmpty a -> a
NE.last) NonEmpty (Located (Pat GhcPs))
pats
      isCase :: MatchGroupStyle -> Bool
isCase = \case
        MatchGroupStyle
Case -> Bool
True
        MatchGroupStyle
LambdaCase -> Bool
True
        MatchGroupStyle
_ -> Bool
False
      hasGuards :: Bool
hasGuards = [LGRHS GhcPs (Located body)] -> Bool
forall body. [LGRHS GhcPs (Located body)] -> Bool
withGuards [LGRHS GhcPs (Located body)]
grhssGRHSs
      grhssSpan :: SrcSpan
grhssSpan =
        NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$
          GRHS GhcPs (Located body) -> SrcSpan
forall body. GRHS GhcPs (Located body) -> SrcSpan
getGRHSSpan (GRHS GhcPs (Located body) -> SrcSpan)
-> (LGRHS GhcPs (Located body) -> GRHS GhcPs (Located body))
-> LGRHS GhcPs (Located body)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LGRHS GhcPs (Located body) -> GRHS GhcPs (Located body)
forall l e. GenLocated l e -> e
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 b. HsLocalBindsLR a b -> Bool
eqEmptyLocalBinds (LHsLocalBinds GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall l e. GenLocated l e -> e
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
eqEmptyLocalBinds (LHsLocalBinds GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall l e. GenLocated l e -> e
unLoc LHsLocalBinds GhcPs
grhssLocalBinds)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          R ()
breakpoint
          Text -> R ()
txt Text
"where"
          Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
whereIsEmpty R ()
breakpoint
          R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsLocalBinds GhcPs -> (HsLocalBindsLR GhcPs GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsLocalBinds GhcPs
grhssLocalBinds HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds
  Bool -> R () -> R ()
inciIf Bool
indentBody (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LGRHS GhcPs (Located body)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LGRHS GhcPs (Located body)]
grhssGRHSs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      case MatchGroupStyle
style of
        Function Located RdrName
_ | Bool
hasGuards -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Function Located RdrName
_ -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
equals
        MatchGroupStyle
PatternBind -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
equals
        MatchGroupStyle
s | MatchGroupStyle -> Bool
isCase MatchGroupStyle
s Bool -> Bool -> Bool
&& Bool
hasGuards -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        MatchGroupStyle
_ -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"->"
    [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
patGrhssSpan] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body
    R () -> R ()
inci R ()
p_where

p_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 ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (GuardLStmt GhcPs -> R ()) -> GuardLStmt GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt GhcPs (LHsExpr GhcPs) -> R ()) -> GuardLStmt GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt) [GuardLStmt GhcPs]
xs)
      R ()
space
      R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ case GroupStyle
style of
        GroupStyle
EqualSign -> R ()
equals
        GroupStyle
RightArrow -> Text -> R ()
txt Text
"->"
      Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body
  where
    placement :: Placement
placement =
      case Maybe SrcSpan
endOfGuards of
        Maybe SrcSpan
Nothing -> body -> Placement
placer (Located body -> body
forall l e. GenLocated l e -> e
unLoc Located body
body)
        Just SrcSpan
spn ->
          if SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn (Located body -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located body
body)
            then body -> Placement
placer (Located body -> body
forall l e. GenLocated l e -> e
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 l e. GenLocated l e -> l
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_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd = BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
N

p_hsCmd' :: BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' :: BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
s = \case
  HsCmdArrApp XCmdArrApp GhcPs
NoExtField LHsExpr GhcPs
body LHsExpr GhcPs
input HsArrAppType
arrType Bool
rightToLeft -> do
    let (LHsExpr GhcPs
l, LHsExpr GhcPs
r) = if Bool
rightToLeft then (LHsExpr GhcPs
body, LHsExpr GhcPs
input) else (LHsExpr GhcPs
input, LHsExpr GhcPs
body)
    LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
l 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, Bool
rightToLeft) of
        (HsArrAppType
HsFirstOrderApp, Bool
True) -> Text -> R ()
txt Text
"-<"
        (HsArrAppType
HsHigherOrderApp, Bool
True) -> Text -> R ()
txt Text
"-<<"
        (HsArrAppType
HsFirstOrderApp, Bool
False) -> Text -> R ()
txt Text
">-"
        (HsArrAppType
HsHigherOrderApp, Bool
False) -> Text -> R ()
txt Text
">>-"
      Placement -> R () -> R ()
placeHanging (HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
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
r HsExpr GhcPs -> R ()
p_hsExpr
  HsCmdArrForm XCmdArrForm GhcPs
NoExtField LHsExpr GhcPs
form LexicalFixity
Prefix Maybe Fixity
_ [LHsCmdTop GhcPs]
cmds -> BracketStyle -> R () -> R ()
banana BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
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] ->
    let opTree :: OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
opTree = OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
-> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
cmdOpTree LHsCmdTop GhcPs
left) LHsExpr GhcPs
form (LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
cmdOpTree LHsCmdTop GhcPs
right)
     in OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs) -> R ()
p_cmdOpTree ((HsExpr GhcPs -> Maybe RdrName)
-> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
-> OpTree (LHsCmdTop 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 (LHsCmdTop GhcPs) (LHsExpr GhcPs)
opTree)
  HsCmdArrForm XCmdArrForm GhcPs
NoExtField LHsExpr GhcPs
_ LexicalFixity
Infix Maybe Fixity
_ [LHsCmdTop GhcPs]
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsCmdArrForm"
  HsCmdApp XCmdApp GhcPs
NoExtField LHsCmd GhcPs
cmd LHsExpr GhcPs
expr -> do
    LHsCmd GhcPs -> (HsCmd GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
cmd (BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
s)
    R ()
space
    LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr HsExpr GhcPs -> R ()
p_hsExpr
  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
  HsCmdLamCase XCmdLamCase GhcPs
NoExtField MatchGroup GhcPs (LHsCmd GhcPs)
mgroup ->
    (HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ()) -> MatchGroup GhcPs (LHsCmd GhcPs) -> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> MatchGroup GhcPs (Located body) -> R ()
p_lamcase HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd MatchGroup GhcPs (LHsCmd GhcPs)
mgroup
  HsCmdIf XCmdIf GhcPs
NoExtField 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"
    (HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ()) -> Located [CmdLStmt GhcPs] -> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> Located [Located (Stmt GhcPs (Located body))]
-> R ()
p_stmts HsCmd GhcPs -> Placement
cmdPlacement (BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
S) Located [CmdLStmt GhcPs]
es

p_hsCmdTop :: HsCmdTop GhcPs -> R ()
p_hsCmdTop :: HsCmdTop GhcPs -> R ()
p_hsCmdTop (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

-- | Render an expression preserving blank lines between such consecutive
-- expressions found in the original source code.
withSpacing ::
  -- | Rendering function
  (a -> R ()) ->
  -- | Entity to render
  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 l e. GenLocated l e -> l
getLoc Located a
l of
    UnhelpfulSpan UnhelpfulSpanReason
_ -> a -> R ()
f a
x
    RealSrcSpan RealSrcSpan
currentSpn Maybe BufSpan
_ -> 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 Maybe 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 f :: Located body
f@(L SrcSpan
l body
x) -> 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 l e. GenLocated l e -> l
getLoc LPat GhcPs
Located (Pat GhcPs)
p
        placement :: Placement
placement
          | SrcSpan -> Bool
isOneLineSpan (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (SrcSpan -> SrcLoc
srcSpanEnd SrcSpan
loc) (SrcSpan -> SrcLoc
srcSpanStart SrcSpan
l)) = body -> Placement
placer body
x
          | Bool
otherwise = Placement
Normal
    [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
loc, SrcSpan
l] (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. (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

p_stmts ::
  Data body =>
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (body -> R ()) ->
  -- | Statements to render
  Located [Located (Stmt GhcPs (Located body))] ->
  R ()
p_stmts :: (body -> Placement)
-> (body -> R ())
-> Located [Located (Stmt GhcPs (Located body))]
-> R ()
p_stmts body -> Placement
placer body -> R ()
render Located [Located (Stmt GhcPs (Located body))]
es = do
  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 ())
-> (([Located (Stmt GhcPs (Located body))] -> R ()) -> R ())
-> ([Located (Stmt GhcPs (Located body))] -> R ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located [Located (Stmt GhcPs (Located body))]
-> ([Located (Stmt GhcPs (Located body))] -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located [Located (Stmt GhcPs (Located body))]
es (([Located (Stmt GhcPs (Located body))] -> R ()) -> R ())
-> ([Located (Stmt GhcPs (Located body))] -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$
    (Located (Stmt GhcPs (Located body)) -> R ())
-> [Located (Stmt GhcPs (Located body))] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi
      (R () -> R ()
ub (R () -> R ())
-> (Located (Stmt GhcPs (Located body)) -> R ())
-> Located (Stmt GhcPs (Located body))
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt GhcPs (Located body) -> R ())
-> Located (Stmt GhcPs (Located body)) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
withSpacing ((body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render))

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

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
    -- 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
    let items :: [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
items =
          let injectLeft :: GenLocated l a -> GenLocated l (Either a b)
injectLeft (L l
l a
x) = l -> Either a b -> GenLocated l (Either a b)
forall l e. l -> e -> GenLocated l e
L l
l (a -> Either a b
forall a b. a -> Either a b
Left a
x)
              injectRight :: GenLocated l b -> GenLocated l (Either a b)
injectRight (L l
l b
x) = l -> Either a b -> GenLocated l (Either a b)
forall l e. l -> e -> GenLocated l e
L l
l (b -> Either a b
forall a b. b -> Either a b
Right b
x)
           in (GenLocated SrcSpan (HsBindLR GhcPs GhcPs)
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
forall l a b. GenLocated l a -> GenLocated l (Either a b)
injectLeft (GenLocated SrcSpan (HsBindLR GhcPs GhcPs)
 -> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> [GenLocated SrcSpan (HsBindLR GhcPs GhcPs)]
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsBindsLR GhcPs GhcPs
-> [GenLocated SrcSpan (HsBindLR GhcPs GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
bag) [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall a. [a] -> [a] -> [a]
++ (LSig GhcPs
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
forall l b a. GenLocated l b -> GenLocated l (Either a b)
injectRight (LSig GhcPs
 -> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> [LSig GhcPs]
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LSig GhcPs]
lsigs)
        positionToBracing :: RelativePos -> R () -> R ()
positionToBracing = \case
          RelativePos
SinglePos -> R () -> R ()
forall a. a -> a
id
          RelativePos
FirstPos -> R () -> R ()
br
          RelativePos
MiddlePos -> R () -> R ()
br
          RelativePos
LastPos -> R () -> R ()
forall a. a -> a
id
        p_item' :: (RelativePos,
 GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> R ()
p_item' (RelativePos
p, GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
item) =
          RelativePos -> R () -> R ()
positionToBracing RelativePos
p (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
            (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs) -> R ())
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> R ()
forall a. (a -> R ()) -> Located a -> R ()
withSpacing ((HsBindLR GhcPs GhcPs -> R ())
-> (Sig GhcPs -> R ())
-> Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)
-> R ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsBindLR GhcPs GhcPs -> R ()
p_valDecl Sig GhcPs -> R ()
p_sigDecl) GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
item
        binds :: [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
binds = (GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
 -> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
 -> Ordering)
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
    -> SrcSpan)
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> SrcSpan
forall l e. GenLocated l e -> l
getLoc) [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
items
    R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ ((RelativePos,
  GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
 -> R ())
-> [(RelativePos,
     GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))]
-> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi (RelativePos,
 GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> R ()
p_item' ([GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [(RelativePos,
     GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))]
forall a. [a] -> [(RelativePos, a)]
attachRelativePos [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
binds)
  HsValBinds XHsValBinds GhcPs GhcPs
NoExtField HsValBindsLR GhcPs GhcPs
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsValBinds"
  HsIPBinds XHsIPBinds GhcPs GhcPs
NoExtField (IPBinds XIPBinds GhcPs
NoExtField [LIPBind GhcPs]
xs) ->
    -- 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 _) _"
     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
  EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
NoExtField -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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 l e. GenLocated l e -> l
getLoc Located RdrName
hsRecFieldLbl) (LHsExpr GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LHsExpr GhcPs
hsRecFieldArg)
            then HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
hsRecFieldArg)
            else Placement
Normal
    Placement -> R () -> R ()
placeHanging Placement
placement (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
hsRecFieldArg HsExpr GhcPs -> R ()
p_hsExpr)

p_hsExpr :: HsExpr GhcPs -> R ()
p_hsExpr :: HsExpr GhcPs -> R ()
p_hsExpr = BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
N

p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s = \case
  HsVar XVar GhcPs
NoExtField Located (IdP GhcPs)
name -> Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
name
  HsUnboundVar XUnboundVar GhcPs
NoExtField OccName
occ -> OccName -> R ()
forall a. Outputable a => a -> R ()
atom OccName
occ
  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
  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 ->
    (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> MatchGroup GhcPs (Located body) -> R ()
p_lamcase HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr 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 l e. GenLocated l e -> l
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 l e. GenLocated l e -> l
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 -> HsExpr GhcPs
forall l e. GenLocated l e -> e
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 is itself a multi line do-block or a case
            -- expression, we can't indent by indentStep or more.
            -- When we are on the other hand *in* a do block, we have to
            -- indent by at least 1.
            -- Thus, we indent by half of indentStep when the function is
            -- a multi line do block or case expression.
            indentArg :: R () -> R ()
indentArg
              | SrcSpan -> Bool
isOneLineSpan (LHsExpr GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LHsExpr GhcPs
func) = R () -> R ()
inci
              | Bool
otherwise = case LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
func of
                HsDo {} -> R () -> R ()
inciHalf
                HsCase {} -> R () -> R ()
inciHalf
                HsLamCase {} -> R () -> R ()
inciHalf
                HsExpr GhcPs
_ -> R () -> R ()
inci
        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 ()
indentArg (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 ()
indentArg (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 ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
dontUseBraces (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
"@"
      -- Insert a space when the type is represented as a TH splice to avoid
      -- gluing @ and $ together.
      case GenLocated SrcSpan (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc (HsWildCardBndrs GhcPs (GenLocated SrcSpan (HsType GhcPs))
-> GenLocated SrcSpan (HsType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (GenLocated SrcSpan (HsType GhcPs))
LHsWcType (NoGhcTc GhcPs)
a) of
        HsSpliceTy {} -> R ()
space
        HsType GhcPs
_ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      GenLocated SrcSpan (HsType GhcPs) -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located (HsWildCardBndrs GhcPs (GenLocated SrcSpan (HsType GhcPs))
-> GenLocated SrcSpan (HsType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (GenLocated SrcSpan (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)
    BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree BracketStyle
s ((HsExpr GhcPs -> Maybe RdrName)
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
forall op ty.
(op -> Maybe RdrName)
-> OpTree (Located ty) (Located op)
-> OpTree (Located ty) (Located op)
reassociateOpTree HsExpr GhcPs -> Maybe RdrName
getOpName OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
opTree)
  NegApp XNegApp GhcPs
NoExtField LHsExpr GhcPs
e SyntaxExpr GhcPs
NoExtField -> do
    Bool
negativeLiterals <- Extension -> R Bool
isExtensionEnabled Extension
NegativeLiterals
    let isLiteral :: Bool
isLiteral = case LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
e of
          HsLit {} -> Bool
True
          HsOverLit {} -> Bool
True
          HsExpr GhcPs
_ -> Bool
False
    Text -> R ()
txt Text
"-"
    -- If NegativeLiterals is enabled, we have to insert a space before
    -- negated literals, as `- 1` and `-1` have differing AST.
    Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
negativeLiterals Bool -> Bool -> Bool
&& Bool
isLiteral) 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 -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
op) (LHsExpr GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LHsExpr GhcPs
x)
    Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
useRecordDot' Bool -> Bool -> Bool
&& Bool
isRecordDot') R ()
breakpoint
    R () -> R ()
inci (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr)
  ExplicitTuple XExplicitTuple GhcPs
NoExtField [LHsTupArg GhcPs]
args Boxity
boxity ->
    let isSection :: Bool
isSection = (LHsTupArg GhcPs -> Bool) -> [LHsTupArg GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (HsTupArg GhcPs -> Bool
isMissing (HsTupArg GhcPs -> Bool)
-> (LHsTupArg GhcPs -> HsTupArg GhcPs) -> LHsTupArg GhcPs -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTupArg GhcPs -> HsTupArg GhcPs
forall l e. GenLocated l e -> e
unLoc) [LHsTupArg GhcPs]
args
        isMissing :: HsTupArg GhcPs -> Bool
isMissing = \case
          Missing XMissing GhcPs
NoExtField -> Bool
True
          HsTupArg GhcPs
_ -> Bool
False
        p_arg :: HsTupArg GhcPs -> R ()
p_arg = \case
          Present XPresent GhcPs
NoExtField LHsExpr GhcPs
x -> LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr
          Missing XMissing GhcPs
NoExtField -> () -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        p_larg :: LHsTupArg GhcPs -> R ()
p_larg = R () -> R ()
sitcc (R () -> R ())
-> (LHsTupArg GhcPs -> R ()) -> LHsTupArg GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsTupArg GhcPs -> R ()) -> LHsTupArg GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsTupArg GhcPs -> R ()
p_arg
        parens' :: BracketStyle -> R () -> R ()
parens' =
          case Boxity
boxity of
            Boxity
Boxed -> BracketStyle -> R () -> R ()
parens
            Boxity
Unboxed -> BracketStyle -> R () -> R ()
parensHash
     in if Bool
isSection
          then
            [SrcSpan] -> R () -> R ()
switchLayout [] (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
              R () -> (LHsTupArg GhcPs -> R ()) -> [LHsTupArg GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
comma LHsTupArg GhcPs -> R ()
p_larg [LHsTupArg GhcPs]
args
          else
            [SrcSpan] -> R () -> R ()
switchLayout (LHsTupArg GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (LHsTupArg GhcPs -> SrcSpan) -> [LHsTupArg GhcPs] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsTupArg GhcPs]
args) (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
              R () -> (LHsTupArg GhcPs -> R ()) -> [LHsTupArg GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel LHsTupArg GhcPs -> R ()
p_larg [LHsTupArg GhcPs]
args
  ExplicitSum XExplicitSum GhcPs
NoExtField Int
tag Int
arity LHsExpr GhcPs
e ->
    BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum BracketStyle
N Int
tag Int
arity (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr)
  HsCase XCase GhcPs
NoExtField LHsExpr GhcPs
e MatchGroup GhcPs (LHsExpr GhcPs)
mgroup ->
    (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (Located body)
-> R ()
p_case HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr LHsExpr GhcPs
e MatchGroup GhcPs (LHsExpr GhcPs)
mgroup
  HsIf XIf GhcPs
NoExtField LHsExpr GhcPs
if' LHsExpr GhcPs
then' LHsExpr GhcPs
else' ->
    (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> Located body
-> Located body
-> R ()
p_if HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr LHsExpr GhcPs
if' LHsExpr GhcPs
then' LHsExpr GhcPs
else'
  HsMultiIf XMultiIf GhcPs
NoExtField [LGRHS GhcPs (LHsExpr GhcPs)]
guards -> do
    Text -> R ()
txt Text
"if"
    R ()
breakpoint
    R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (LGRHS GhcPs (LHsExpr GhcPs) -> R ())
-> [LGRHS GhcPs (LHsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline ((GRHS GhcPs (LHsExpr GhcPs) -> R ())
-> LGRHS GhcPs (LHsExpr GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
p_grhs GroupStyle
RightArrow)) [LGRHS GhcPs (LHsExpr GhcPs)]
guards
  HsLet XLet GhcPs
NoExtField LHsLocalBinds GhcPs
localBinds LHsExpr GhcPs
e ->
    (HsExpr GhcPs -> R ())
-> LHsLocalBinds GhcPs -> LHsExpr GhcPs -> R ()
forall body.
Data body =>
(body -> R ()) -> LHsLocalBinds GhcPs -> Located body -> R ()
p_let HsExpr GhcPs -> R ()
p_hsExpr LHsLocalBinds GhcPs
localBinds LHsExpr GhcPs
e
  HsDo XDo GhcPs
NoExtField HsStmtContext GhcRn
ctx Located [GuardLStmt GhcPs]
es -> do
    let doBody :: t a -> Text -> R ()
doBody t a
moduleName Text
header = do
          t a -> (a -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t a
moduleName ((a -> R ()) -> R ()) -> (a -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \a
m -> a -> R ()
forall a. Outputable a => a -> R ()
atom a
m R () -> R () -> R ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> R ()
txt Text
"."
          Text -> R ()
txt Text
header
          (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ()) -> Located [GuardLStmt GhcPs] -> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> Located [Located (Stmt GhcPs (Located body))]
-> R ()
p_stmts HsExpr GhcPs -> Placement
exprPlacement (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
S) Located [GuardLStmt GhcPs]
es
        compBody :: R ()
compBody = BracketStyle -> R () -> R ()
brackets BracketStyle
N (R () -> R ())
-> (([GuardLStmt GhcPs] -> R ()) -> R ())
-> ([GuardLStmt GhcPs] -> R ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located [GuardLStmt GhcPs] -> ([GuardLStmt GhcPs] -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located [GuardLStmt GhcPs]
es (([GuardLStmt GhcPs] -> R ()) -> R ())
-> ([GuardLStmt GhcPs] -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \[GuardLStmt GhcPs]
xs -> do
          let p_parBody :: [[GuardLStmt GhcPs]] -> R ()
p_parBody =
                R ()
-> ([GuardLStmt GhcPs] -> R ()) -> [[GuardLStmt GhcPs]] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
                  (R ()
breakpoint R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|" R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space)
                  [GuardLStmt GhcPs] -> R ()
p_seqBody
              p_seqBody :: [GuardLStmt GhcPs] -> R ()
p_seqBody =
                R () -> R ()
sitcc
                  (R () -> R ())
-> ([GuardLStmt GhcPs] -> R ()) -> [GuardLStmt GhcPs] -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> (GuardLStmt GhcPs -> R ()) -> [GuardLStmt GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
                    R ()
commaDel
                    ((Stmt GhcPs (LHsExpr GhcPs) -> R ()) -> GuardLStmt GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (R () -> R ()
sitcc (R () -> R ())
-> (Stmt GhcPs (LHsExpr GhcPs) -> R ())
-> Stmt GhcPs (LHsExpr GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt))
              stmts :: [GuardLStmt GhcPs]
stmts = [GuardLStmt GhcPs] -> [GuardLStmt GhcPs]
forall a. [a] -> [a]
init [GuardLStmt GhcPs]
xs
              yield :: GuardLStmt GhcPs
yield = [GuardLStmt GhcPs] -> GuardLStmt GhcPs
forall a. [a] -> a
last [GuardLStmt GhcPs]
xs
              lists :: [[GuardLStmt GhcPs]]
lists = (GuardLStmt GhcPs -> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> [[GuardLStmt GhcPs]]
-> [GuardLStmt GhcPs]
-> [[GuardLStmt GhcPs]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend ([[GuardLStmt GhcPs]]
 -> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> (GuardLStmt GhcPs -> [[GuardLStmt GhcPs]])
-> GuardLStmt GhcPs
-> [[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt) [] [GuardLStmt GhcPs]
stmts
          GuardLStmt GhcPs -> (Stmt GhcPs (LHsExpr GhcPs) -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located GuardLStmt GhcPs
yield Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt
          R ()
breakpoint
          Text -> R ()
txt Text
"|"
          R ()
space
          [[GuardLStmt GhcPs]] -> R ()
p_parBody [[GuardLStmt GhcPs]]
lists
    case HsStmtContext GhcRn
ctx of
      DoExpr Maybe ModuleName
moduleName -> Maybe ModuleName -> Text -> R ()
forall (t :: * -> *) a.
(Foldable t, Outputable a) =>
t a -> Text -> R ()
doBody Maybe ModuleName
moduleName Text
"do"
      MDoExpr Maybe ModuleName
moduleName -> Maybe ModuleName -> Text -> R ()
forall (t :: * -> *) a.
(Foldable t, Outputable a) =>
t a -> Text -> R ()
doBody Maybe ModuleName
moduleName Text
"mdo"
      HsStmtContext GhcRn
ListComp -> R ()
compBody
      HsStmtContext GhcRn
MonadComp -> R ()
compBody
      HsStmtContext GhcRn
ArrowExpr -> String -> R ()
forall a. String -> a
notImplemented String
"ArrowExpr"
      HsStmtContext GhcRn
GhciStmtCtxt -> String -> R ()
forall a. String -> a
notImplemented String
"GhciStmtCtxt"
      PatGuard HsMatchContext GhcRn
_ -> String -> R ()
forall a. String -> a
notImplemented String
"PatGuard"
      ParStmtCtxt HsStmtContext GhcRn
_ -> String -> R ()
forall a. String -> a
notImplemented String
"ParStmtCtxt"
      TransStmtCtxt HsStmtContext GhcRn
_ -> String -> R ()
forall a. String -> a
notImplemented String
"TransStmtCtxt"
  ExplicitList XExplicitList GhcPs
_ Maybe (SyntaxExpr GhcPs)
_ [LHsExpr GhcPs]
xs ->
    BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      R () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ()) -> (LHsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs]
xs
  RecordCon {HsRecordBinds GhcPs
XRecordCon GhcPs
Located (IdP GhcPs)
rcon_ext :: forall p. HsExpr p -> XRecordCon p
rcon_con_name :: forall p. HsExpr p -> Located (IdP p)
rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_flds :: HsRecordBinds GhcPs
rcon_con_name :: Located (IdP GhcPs)
rcon_ext :: XRecordCon GhcPs
..} -> do
    Located RdrName -> (RdrName -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located (IdP GhcPs)
Located RdrName
rcon_con_name RdrName -> R ()
forall a. Outputable a => a -> R ()
atom
    R ()
breakpoint
    let HsRecFields {[LHsRecField GhcPs (LHsExpr GhcPs)]
Maybe (Located Int)
rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (Located Int)
rec_dotdot :: Maybe (Located Int)
rec_flds :: [LHsRecField GhcPs (LHsExpr GhcPs)]
..} = HsRecordBinds GhcPs
rcon_flds
        updName :: HsRecField GhcPs (LHsExpr GhcPs)
-> HsRecField' RdrName (LHsExpr GhcPs)
updName HsRecField GhcPs (LHsExpr GhcPs)
f =
          (HsRecField GhcPs (LHsExpr GhcPs)
f :: HsRecField GhcPs (LHsExpr GhcPs))
            { hsRecFieldLbl :: Located RdrName
hsRecFieldLbl = case GenLocated SrcSpan (FieldOcc GhcPs) -> FieldOcc GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (FieldOcc GhcPs) -> FieldOcc GhcPs)
-> GenLocated SrcSpan (FieldOcc GhcPs) -> FieldOcc GhcPs
forall a b. (a -> b) -> a -> b
$ HsRecField GhcPs (LHsExpr GhcPs)
-> GenLocated SrcSpan (FieldOcc GhcPs)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl HsRecField GhcPs (LHsExpr GhcPs)
f of
                FieldOcc XCFieldOcc GhcPs
_ Located RdrName
n -> Located RdrName
n
            }
        fields :: [R ()]
fields = (HsRecField GhcPs (LHsExpr GhcPs) -> R ())
-> LHsRecField GhcPs (LHsExpr GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (HsRecField' RdrName (LHsExpr GhcPs) -> R ()
p_hsRecField (HsRecField' RdrName (LHsExpr GhcPs) -> R ())
-> (HsRecField GhcPs (LHsExpr GhcPs)
    -> HsRecField' RdrName (LHsExpr GhcPs))
-> HsRecField GhcPs (LHsExpr GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecField GhcPs (LHsExpr GhcPs)
-> HsRecField' RdrName (LHsExpr GhcPs)
updName) (LHsRecField GhcPs (LHsExpr GhcPs) -> R ())
-> [LHsRecField GhcPs (LHsExpr GhcPs)] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (LHsExpr GhcPs)]
rec_flds
        dotdot :: [R ()]
dotdot =
          case Maybe (Located Int)
rec_dotdot of
            Just {} -> [Text -> R ()
txt Text
".."]
            Maybe (Located Int)
Nothing -> []
    R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      R () -> (R () -> R ()) -> [R ()] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel R () -> R ()
sitcc ([R ()]
fields [R ()] -> [R ()] -> [R ()]
forall a. Semigroup a => a -> a -> a
<> [R ()]
dotdot)
  RecordUpd {[LHsRecUpdField GhcPs]
XRecordUpd GhcPs
LHsExpr GhcPs
rupd_ext :: forall p. HsExpr p -> XRecordUpd p
rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_flds :: forall p. HsExpr p -> [LHsRecUpdField p]
rupd_flds :: [LHsRecUpdField GhcPs]
rupd_expr :: LHsExpr GhcPs
rupd_ext :: XRecordUpd GhcPs
..} -> do
    LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
rupd_expr HsExpr GhcPs -> R ()
p_hsExpr
    Bool
useRecordDot' <- R Bool
useRecordDot
    let mrs :: GenLocated SrcSpan e -> Maybe RealSrcSpan
mrs GenLocated SrcSpan e
sp = case GenLocated SrcSpan e -> SrcSpan
forall l e. GenLocated l e -> l
getLoc GenLocated SrcSpan e
sp of
          RealSrcSpan RealSrcSpan
r Maybe BufSpan
_ -> 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 e. GenLocated SrcSpan e -> 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 e. GenLocated SrcSpan e -> Maybe RealSrcSpan
mrs ([LHsRecUpdField GhcPs] -> LHsRecUpdField GhcPs
forall a. [a] -> a
head [LHsRecUpdField GhcPs]
rupd_flds))
            Bool -> Bool -> Bool
&& SrcSpan -> SrcSpan -> Bool
onTheSameLine (LHsExpr GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LHsExpr GhcPs
rupd_expr) (LHsRecUpdField GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (LHsRecUpdField GhcPs -> SrcSpan)
-> LHsRecUpdField GhcPs -> SrcSpan
forall a b. (a -> b) -> a -> b
$ [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 GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)
-> AmbiguousFieldOcc GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)
 -> AmbiguousFieldOcc GhcPs)
-> GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)
-> AmbiguousFieldOcc GhcPs
forall a b. (a -> b) -> a -> b
$ HsRecUpdField GhcPs -> GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl HsRecUpdField GhcPs
f of
                Ambiguous XAmbiguous GhcPs
_ Located RdrName
n -> Located RdrName
n
                Unambiguous XUnambiguous GhcPs
_ Located RdrName
n -> Located RdrName
n
            }
        updBraces :: R () -> R ()
updBraces =
          if Bool
useRecordDot' Bool -> Bool -> Bool
&& Bool
isPluginForm
            then R () -> R ()
recordDotBraces
            else R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N
    R () -> R ()
updBraces (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      R ()
-> (LHsRecUpdField GhcPs -> R ()) -> [LHsRecUpdField GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
        R ()
commaDel
        (R () -> R ()
sitcc (R () -> R ())
-> (LHsRecUpdField GhcPs -> R ()) -> LHsRecUpdField GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsRecUpdField GhcPs -> R ()) -> LHsRecUpdField GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (HsRecField' RdrName (LHsExpr GhcPs) -> R ()
p_hsRecField (HsRecField' RdrName (LHsExpr GhcPs) -> R ())
-> (HsRecUpdField GhcPs -> HsRecField' RdrName (LHsExpr GhcPs))
-> HsRecUpdField GhcPs
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecUpdField GhcPs -> HsRecField' RdrName (LHsExpr GhcPs)
updName))
        [LHsRecUpdField GhcPs]
rupd_flds
  ExprWithTySig XExprWithTySig GhcPs
NoExtField LHsExpr GhcPs
x HsWC {hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = HsIB {XHsIB (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs))
LHsType (NoGhcTc GhcPs)
hsib_ext :: forall pass thing. HsImplicitBndrs pass thing -> XHsIB pass thing
hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body :: LHsType (NoGhcTc GhcPs)
hsib_ext :: XHsIB (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs))
..}} -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr
    R ()
space
    Text -> R ()
txt Text
"::"
    R ()
breakpoint
    R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan (HsType GhcPs) -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located GenLocated SrcSpan (HsType GhcPs)
LHsType (NoGhcTc GhcPs)
hsib_body HsType GhcPs -> R ()
p_hsType
  ArithSeq XArithSeq GhcPs
NoExtField Maybe (SyntaxExpr GhcPs)
_ ArithSeqInfo GhcPs
x ->
    case ArithSeqInfo GhcPs
x of
      From LHsExpr GhcPs
from -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
from HsExpr GhcPs -> R ()
p_hsExpr
        R ()
breakpoint
        Text -> R ()
txt Text
".."
      FromThen LHsExpr GhcPs
from LHsExpr GhcPs
next -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        R () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs
from, LHsExpr GhcPs
next]
        R ()
breakpoint
        Text -> R ()
txt Text
".."
      FromTo LHsExpr GhcPs
from LHsExpr GhcPs
to -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
from HsExpr GhcPs -> R ()
p_hsExpr
        R ()
breakpoint
        Text -> R ()
txt Text
".."
        R ()
space
        LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
to HsExpr GhcPs -> R ()
p_hsExpr
      FromThenTo LHsExpr GhcPs
from LHsExpr GhcPs
next LHsExpr GhcPs
to -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        R () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs
from, LHsExpr GhcPs
next]
        R ()
breakpoint
        Text -> R ()
txt Text
".."
        R ()
space
        LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
to HsExpr GhcPs -> R ()
p_hsExpr
  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 -> HsCmdTop GhcPs
forall l e. GenLocated l e -> e
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"
  HsPragE XPragE GhcPs
NoExtField HsPragE GhcPs
prag LHsExpr GhcPs
x -> case HsPragE GhcPs
prag of
    HsPragSCC XSCC GhcPs
NoExtField SourceText
_ StringLiteral
name -> 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
    HsPragTick {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsTickPragma"

p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PSB {HsPatSynDir GhcPs
HsPatSynDetails (Located (IdP GhcPs))
LPat GhcPs
XPSB GhcPs GhcPs
Located (IdP GhcPs)
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_id :: forall idL idR. PatSynBind idL idR -> Located (IdP idL)
psb_args :: forall idL idR.
PatSynBind idL idR -> HsPatSynDetails (Located (IdP idR))
psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_dir :: HsPatSynDir GhcPs
psb_def :: LPat GhcPs
psb_args :: HsPatSynDetails (Located (IdP GhcPs))
psb_id :: Located (IdP GhcPs)
psb_ext :: XPSB GhcPs GhcPs
..} = do
  let rhs :: R ()
rhs = do
        R ()
space
        case HsPatSynDir GhcPs
psb_dir of
          HsPatSynDir GhcPs
Unidirectional -> do
            Text -> R ()
txt Text
"<-"
            R ()
breakpoint
            Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
psb_def Pat GhcPs -> R ()
p_pat
          HsPatSynDir GhcPs
ImplicitBidirectional -> do
            R ()
equals
            R ()
breakpoint
            Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
psb_def Pat GhcPs -> R ()
p_pat
          ExplicitBidirectional MatchGroup GhcPs (LHsExpr GhcPs)
mgroup -> do
            Text -> R ()
txt Text
"<-"
            R ()
breakpoint
            Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
psb_def Pat GhcPs -> R ()
p_pat
            R ()
breakpoint
            Text -> R ()
txt Text
"where"
            R ()
breakpoint
            R () -> R ()
inci (MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup (Located RdrName -> MatchGroupStyle
Function Located (IdP GhcPs)
Located RdrName
psb_id) MatchGroup GhcPs (LHsExpr GhcPs)
mgroup)
  Text -> R ()
txt Text
"pattern"
  case HsPatSynDetails (Located (IdP GhcPs))
psb_args of
    PrefixCon [Located (IdP GhcPs)]
xs -> do
      R ()
space
      Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
psb_id
      R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        [SrcSpan] -> R () -> R ()
switchLayout (Located RdrName -> SrcSpan
forall l e. GenLocated l e -> l
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 l e. GenLocated l e -> l
getLoc (Located RdrName -> SrcSpan)
-> (RecordPatSynField (Located RdrName) -> Located RdrName)
-> RecordPatSynField (Located RdrName)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField (Located RdrName) -> Located RdrName
forall a. RecordPatSynField a -> a
recordPatSynPatVar (RecordPatSynField (Located RdrName) -> SrcSpan)
-> [RecordPatSynField (Located RdrName)] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RecordPatSynField (Located (IdP GhcPs))]
[RecordPatSynField (Located RdrName)]
xs) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([RecordPatSynField (Located RdrName)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RecordPatSynField (Located (IdP GhcPs))]
[RecordPatSynField (Located RdrName)]
xs) R ()
breakpoint
          BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
            R ()
-> (RecordPatSynField (Located RdrName) -> R ())
-> [RecordPatSynField (Located RdrName)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (Located RdrName -> R ()
p_rdrName (Located RdrName -> R ())
-> (RecordPatSynField (Located RdrName) -> Located RdrName)
-> RecordPatSynField (Located RdrName)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField (Located RdrName) -> Located RdrName
forall a. RecordPatSynField a -> a
recordPatSynPatVar) [RecordPatSynField (Located (IdP GhcPs))]
[RecordPatSynField (Located RdrName)]
xs
        R ()
rhs
    InfixCon Located (IdP GhcPs)
l Located (IdP GhcPs)
r -> do
      [SrcSpan] -> R () -> R ()
switchLayout [Located RdrName -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located (IdP GhcPs)
Located RdrName
l, Located RdrName -> SrcSpan
forall l e. GenLocated l e -> l
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_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_lamcase ::
  Data body =>
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (body -> R ()) ->
  -- | Expression
  MatchGroup GhcPs (Located body) ->
  R ()
p_lamcase :: (body -> Placement)
-> (body -> R ()) -> MatchGroup GhcPs (Located body) -> R ()
p_lamcase body -> Placement
placer body -> R ()
render MatchGroup GhcPs (Located body)
mgroup = do
  Text -> R ()
txt Text
"\\case"
  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
LambdaCase 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 ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (Located (Pat GhcPs) -> R ()) -> [Located (Pat GhcPs)] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((Pat GhcPs -> R ()) -> Located (Pat GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[Located (Pat GhcPs)]
pats
  TuplePat XTuplePat GhcPs
NoExtField [LPat GhcPs]
pats Boxity
boxing -> do
    let parens' :: R () -> R ()
parens' =
          case Boxity
boxing of
            Boxity
Boxed -> BracketStyle -> R () -> R ()
parens BracketStyle
S
            Boxity
Unboxed -> BracketStyle -> R () -> R ()
parensHash BracketStyle
S
    R () -> R ()
parens' (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (Located (Pat GhcPs) -> R ()) -> [Located (Pat GhcPs)] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (Located (Pat GhcPs) -> R ()) -> Located (Pat GhcPs) -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat GhcPs -> R ()) -> Located (Pat GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[Located (Pat GhcPs)]
pats
  SumPat XSumPat GhcPs
NoExtField LPat GhcPs
pat Int
tag Int
arity ->
    BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum BracketStyle
S Int
tag Int
arity (Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat)
  ConPat XConPat GhcPs
NoExtField Located (ConLikeP 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 (ConLikeP 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 (ConLikeP GhcPs)
Located RdrName
pat
        R ()
breakpoint
        let f :: Maybe
  (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
-> R ()
f = \case
              Maybe
  (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
Nothing -> Text -> R ()
txt Text
".."
              Just Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
x -> Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
-> (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)) -> R ())
-> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
x HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)) -> R ()
p_pat_hsRecField
        R () -> R ()
inci (R () -> R ())
-> ([Maybe
       (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
    -> R ())
-> [Maybe
      (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ())
-> ([Maybe
       (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
    -> R ())
-> [Maybe
      (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R ()
-> (Maybe
      (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
    -> R ())
-> [Maybe
      (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel Maybe
  (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
-> R ()
f ([Maybe
    (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
 -> R ())
-> [Maybe
      (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ()
forall a b. (a -> b) -> a -> b
$
          case Maybe (Located Int)
dotdot of
            Maybe (Located Int)
Nothing -> Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
-> Maybe
     (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
forall a. a -> Maybe a
Just (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
 -> Maybe
      (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))))
-> [Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
-> [Maybe
      (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (LPat GhcPs)]
[Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
fields
            Just (L SrcSpan
_ Int
n) -> (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
-> Maybe
     (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
forall a. a -> Maybe a
Just (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
 -> Maybe
      (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))))
-> [Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
-> [Maybe
      (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> [Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
-> [Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
forall a. Int -> [a] -> [a]
take Int
n [LHsRecField GhcPs (LPat GhcPs)]
[Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
fields) [Maybe
   (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> [Maybe
      (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> [Maybe
      (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
forall a. [a] -> [a] -> [a]
++ [Maybe
  (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
forall a. Maybe a
Nothing]
      InfixCon LPat GhcPs
l LPat GhcPs
r -> do
        [SrcSpan] -> R () -> R ()
switchLayout [Located (Pat GhcPs) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LPat GhcPs
Located (Pat GhcPs)
l, Located (Pat GhcPs) -> SrcSpan
forall l e. GenLocated l e -> l
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 (ConLikeP 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
  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) -> Bool
forall a. Maybe a -> Bool
isJust -> Bool
isNegated) SyntaxExpr GhcPs
NoExtField -> do
    Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isNegated (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> R ()
txt Text
"-"
      Bool
negativeLiterals <- Extension -> R Bool
isExtensionEnabled Extension
NegativeLiterals
      Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
negativeLiterals R ()
space
    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 HsPS {XHsPS (NoGhcTc GhcPs)
LHsType (NoGhcTc GhcPs)
hsps_ext :: forall pass. HsPatSigType pass -> XHsPS pass
hsps_body :: forall pass. HsPatSigType pass -> LHsType pass
hsps_body :: LHsType (NoGhcTc GhcPs)
hsps_ext :: XHsPS (NoGhcTc GhcPs)
..} -> 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 (XHsWC
  GhcPs (HsImplicitBndrs GhcPs (GenLocated SrcSpan (HsType GhcPs)))
-> HsImplicitBndrs GhcPs (GenLocated SrcSpan (HsType GhcPs))
-> LHsSigWcType GhcPs
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC NoExtField
XHsWC
  GhcPs (HsImplicitBndrs GhcPs (GenLocated SrcSpan (HsType GhcPs)))
NoExtField (XHsIB GhcPs (GenLocated SrcSpan (HsType GhcPs))
-> GenLocated SrcSpan (HsType GhcPs)
-> HsImplicitBndrs GhcPs (GenLocated SrcSpan (HsType GhcPs))
forall pass thing.
XHsIB pass thing -> thing -> HsImplicitBndrs pass thing
HsIB NoExtField
XHsIB GhcPs (GenLocated SrcSpan (HsType GhcPs))
NoExtField GenLocated SrcSpan (HsType GhcPs)
LHsType (NoGhcTc GhcPs)
hsps_body))

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
GenLocated SrcSpan (FieldOcc GhcPs)
hsRecPun :: Bool
hsRecFieldArg :: LPat GhcPs
hsRecFieldLbl :: GenLocated SrcSpan (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
  GenLocated SrcSpan (FieldOcc GhcPs)
-> (FieldOcc GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located GenLocated SrcSpan (FieldOcc GhcPs)
hsRecFieldLbl ((FieldOcc GhcPs -> R ()) -> R ())
-> (FieldOcc GhcPs -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \FieldOcc GhcPs
x ->
    Located RdrName -> R ()
p_rdrName (FieldOcc GhcPs -> Located RdrName
forall pass. FieldOcc pass -> Located RdrName
rdrNameFieldOcc FieldOcc GhcPs
x)
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hsRecPun (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    R ()
space
    R ()
equals
    R ()
breakpoint
    R () -> R ()
inci (Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
hsRecFieldArg Pat GhcPs -> R ()
p_pat)

p_unboxedSum :: BracketStyle -> ConTag -> Arity -> R () -> R ()
p_unboxedSum :: BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum BracketStyle
s Int
tag Int
arity R ()
m = do
  let before :: Int
before = Int
tag Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      after :: Int
after = Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
before Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      args :: [Maybe (R ())]
args = Int -> Maybe (R ()) -> [Maybe (R ())]
forall a. Int -> a -> [a]
replicate Int
before Maybe (R ())
forall a. Maybe a
Nothing [Maybe (R ())] -> [Maybe (R ())] -> [Maybe (R ())]
forall a. Semigroup a => a -> a -> a
<> [R () -> Maybe (R ())
forall a. a -> Maybe a
Just R ()
m] [Maybe (R ())] -> [Maybe (R ())] -> [Maybe (R ())]
forall a. Semigroup a => a -> a -> a
<> Int -> Maybe (R ()) -> [Maybe (R ())]
forall a. Int -> a -> [a]
replicate Int
after Maybe (R ())
forall a. Maybe a
Nothing
      f :: Maybe (R ()) -> R ()
f Maybe (R ())
x =
        case Maybe (R ())
x :: Maybe (R ()) of
          Maybe (R ())
Nothing ->
            R ()
space
          Just R ()
m' -> do
            R ()
space
            R ()
m'
            R ()
space
  BracketStyle -> R () -> R ()
parensHash BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (Maybe (R ()) -> R ()) -> [Maybe (R ())] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt Text
"|") Maybe (R ()) -> R ()
f [Maybe (R ())]
args

p_hsSplice :: HsSplice GhcPs -> R ()
p_hsSplice :: HsSplice GhcPs -> R ()
p_hsSplice = \case
  HsTypedSplice XTypedSplice GhcPs
NoExtField SpliceDecoration
deco IdP GhcPs
_ LHsExpr GhcPs
expr -> Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
True LHsExpr GhcPs
expr SpliceDecoration
deco
  HsUntypedSplice XUntypedSplice GhcPs
NoExtField SpliceDecoration
deco IdP GhcPs
_ LHsExpr GhcPs
expr -> Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
False LHsExpr GhcPs
expr SpliceDecoration
deco
  HsQuasiQuote XQuasiQuote GhcPs
NoExtField IdP GhcPs
_ IdP GhcPs
quoterName SrcSpan
srcSpan FastString
str -> do
    Text -> R ()
txt Text
"["
    Located RdrName -> R ()
p_rdrName (SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcSpan IdP GhcPs
RdrName
quoterName)
    Text -> R ()
txt Text
"|"
    -- 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"

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
DollarSplice -> 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
BareSplice ->
    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" ([LHsDecl GhcPs] -> R () -> R ()
forall a. Data a => a -> R () -> R ()
handleStarIsType [LHsDecl GhcPs]
decls (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 GenLocated SrcSpan (HsType GhcPs)
ty -> Text -> R () -> R ()
quote Text
"t" (GenLocated SrcSpan (HsType GhcPs) -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located GenLocated SrcSpan (HsType GhcPs)
ty (GenLocated SrcSpan (HsType GhcPs) -> R () -> R ()
forall a. Data a => a -> R () -> R ()
handleStarIsType GenLocated SrcSpan (HsType GhcPs)
ty (R () -> R ()) -> (HsType GhcPs -> R ()) -> HsType GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (RdrName -> Located RdrName
forall e. e -> Located e
noLoc IdP GhcPs
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
"||]"
  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
"|]"
    -- With StarIsType, type and declaration brackets might end with a *,
    -- so we have to insert a space in the end to prevent the (mis)parsing
    -- of an (*|) operator.
    -- The detection is a bit overcautious, as it adds the spaces as soon as
    -- HsStarTy is anywhere in the type/declaration.
    handleStarIsType :: Data a => a -> R () -> R ()
    handleStarIsType :: a -> R () -> R ()
handleStarIsType a
a R ()
p
      | a -> Bool
containsHsStarTy a
a = R ()
space R () -> R () -> R ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> R ()
p R () -> R () -> R ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* R ()
space
      | Bool
otherwise = R ()
p
      where
        containsHsStarTy :: a -> Bool
containsHsStarTy = (Bool -> Bool -> Bool) -> GenericQ Bool -> GenericQ Bool
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything Bool -> Bool -> Bool
(||) (GenericQ Bool -> GenericQ Bool) -> GenericQ Bool -> GenericQ Bool
forall a b. (a -> b) -> a -> b
$ \a
b -> case a -> Maybe (HsType GhcPs)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast @_ @(HsType GhcPs) a
b of
          Just HsStarTy {} -> Bool
True
          Maybe (HsType GhcPs)
_ -> Bool
False

-- 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 -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
ghcSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ((Maybe Char, Char, Maybe Char) -> Char)
-> [(Maybe Char, Char, Maybe Char)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Char, Char, Maybe Char) -> Char
forall a b c. (a, b, c) -> b
orig [(Maybe Char, Char, Maybe Char)]
r
               in ((Maybe Char, Char, Maybe Char) -> Char)
-> [(Maybe Char, Char, Maybe Char)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Char, Char, Maybe Char) -> Char
forall a b c. (a, b, c) -> b
orig [(Maybe Char, Char, Maybe Char)]
l String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
splitGaps String
r'
    -- 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 -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
backslashes ((Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: String
y) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs)
    backslashes [String]
xs = [String]
xs
    -- 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 l e. GenLocated l e -> l
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 l e. GenLocated l e -> l
getLoc [GuardLStmt GhcPs]
guards

-- | 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
  HsCmdLamCase XCmdLamCase GhcPs
NoExtField 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 (HsCmdTop XCmdTop GhcPs
NoExtField (L SrcSpan
_ HsCmd GhcPs
x)) = HsCmd GhcPs -> Placement
cmdPlacement HsCmd 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 (NoGhcTc 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 l e. GenLocated l e -> l
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 (DoExpr Maybe ModuleName
_) Located [GuardLStmt GhcPs]
_ -> Placement
Hanging
  HsDo XDo GhcPs
NoExtField (MDoExpr Maybe ModuleName
_) Located [GuardLStmt GhcPs]
_ -> Placement
Hanging
  OpApp XOpApp GhcPs
NoExtField LHsExpr GhcPs
_ LHsExpr GhcPs
op LHsExpr GhcPs
y ->
    case ((RdrName -> String) -> Maybe RdrName -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> String
getOpNameStr (Maybe RdrName -> Maybe String)
-> (LHsExpr GhcPs -> Maybe RdrName)
-> LHsExpr GhcPs
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> Maybe RdrName
getOpName (HsExpr GhcPs -> Maybe RdrName)
-> (LHsExpr GhcPs -> HsExpr GhcPs)
-> LHsExpr GhcPs
-> Maybe RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc) LHsExpr GhcPs
op of
      Just String
"$" -> HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
y)
      Maybe String
_ -> Placement
Normal
  HsApp XApp GhcPs
NoExtField LHsExpr GhcPs
_ LHsExpr GhcPs
y -> HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
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 l e. GenLocated l e -> l
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 l e. GenLocated l e -> e
unLoc)
  where
    checkOne :: GRHS GhcPs (Located body) -> Bool
    checkOne :: GRHS GhcPs (Located body) -> Bool
checkOne (GRHS XCGRHS GhcPs (Located body)
NoExtField [] Located body
_) = Bool
False
    checkOne GRHS GhcPs (Located body)
_ = Bool
True

exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree (L SrcSpan
_ (OpApp XOpApp GhcPs
NoExtField LHsExpr GhcPs
x LHsExpr GhcPs
op LHsExpr GhcPs
y)) = OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
x) LHsExpr GhcPs
op (LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
y)
exprOpTree LHsExpr GhcPs
n = LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
forall ty op. ty -> OpTree ty op
OpNode LHsExpr GhcPs
n

getOpName :: HsExpr GhcPs -> Maybe RdrName
getOpName :: HsExpr GhcPs -> Maybe RdrName
getOpName = \case
  HsVar XVar GhcPs
NoExtField (L SrcSpan
_ IdP GhcPs
a) -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just IdP GhcPs
RdrName
a
  HsExpr GhcPs
_ -> Maybe RdrName
forall a. Maybe a
Nothing

getOpNameStr :: RdrName -> String
getOpNameStr :: RdrName -> String
getOpNameStr = OccName -> String
occNameString (OccName -> String) -> (RdrName -> OccName) -> RdrName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc

p_exprOpTree ::
  -- | Bracket style to use
  BracketStyle ->
  OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->
  R ()
p_exprOpTree :: BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree BracketStyle
s (OpNode LHsExpr GhcPs
x) = LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
p_exprOpTree BracketStyle
s (OpBranch OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x LHsExpr GhcPs
op OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y) = do
  let placement :: Placement
placement = (HsExpr GhcPs -> Placement)
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> Placement
forall ty op.
(ty -> Placement)
-> OpTree (Located ty) op -> OpTree (Located ty) op -> Placement
opBranchPlacement HsExpr GhcPs -> Placement
exprPlacement OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y
      -- Distinguish holes used in infix notation.
      -- eg. '1 _foo 2' and '1 `_foo` 2'
      opWrapper :: R () -> R ()
opWrapper = case LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
op of
        HsUnboundVar XUnboundVar GhcPs
NoExtField OccName
_ -> R () -> R ()
backticks
        HsExpr GhcPs
_ -> R () -> R ()
forall a. a -> a
id
  R () -> R ()
ub <- Placement -> R (R () -> R ())
opBranchBraceStyle Placement
placement
  let opNameStr :: Maybe String
opNameStr = ((RdrName -> String) -> Maybe RdrName -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> String
getOpNameStr (Maybe RdrName -> Maybe String)
-> (LHsExpr GhcPs -> Maybe RdrName)
-> LHsExpr GhcPs
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> Maybe RdrName
getOpName (HsExpr GhcPs -> Maybe RdrName)
-> (LHsExpr GhcPs -> HsExpr GhcPs)
-> LHsExpr GhcPs
-> Maybe RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc) LHsExpr GhcPs
op
      gotDollar :: Bool
gotDollar = Maybe String
opNameStr Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"$"
      gotColon :: Bool
gotColon = Maybe String
opNameStr Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
":"
      gotRecordDot :: Bool
gotRecordDot = HsExpr GhcPs -> SrcSpan -> Bool
isRecordDot (LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
op) (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y)
      lhs :: R ()
lhs =
        [SrcSpan] -> R () -> R ()
switchLayout [OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
          BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree BracketStyle
s OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x
      p_op :: R ()
p_op = LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
op (R () -> R ()
opWrapper (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
      p_y :: R ()
p_y = [SrcSpan] -> R () -> R ()
switchLayout [OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y] (BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree BracketStyle
N OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y)
      isSection :: Bool
isSection = case (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x, LHsExpr GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LHsExpr GhcPs
op) of
        (RealSrcSpan RealSrcSpan
treeSpan Maybe BufSpan
_, RealSrcSpan RealSrcSpan
opSpan Maybe BufSpan
_) ->
          RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
treeSpan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
opSpan
        (SrcSpan, SrcSpan)
_ -> Bool
False
      isDoBlock :: OpTree (GenLocated l (HsExpr p)) op -> Bool
isDoBlock = \case
        OpNode (L l
_ HsDo {}) -> Bool
True
        OpTree (GenLocated l (HsExpr p)) op
_ -> Bool
False
  Bool
useRecordDot' <- R Bool
useRecordDot
  if
      | Bool
gotColon -> do
        R ()
lhs
        R ()
space
        R ()
p_op
        case Placement
placement of
          Placement
Hanging -> do
            R ()
space
            R ()
p_y
          Placement
Normal -> do
            R ()
breakpoint
            Bool -> R () -> R ()
inciIf (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> Bool
forall l p op. OpTree (GenLocated l (HsExpr p)) op -> Bool
isDoBlock OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y) R ()
p_y
      | Bool
gotDollar
          Bool -> Bool -> Bool
&& SrcSpan -> Bool
isOneLineSpan (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x)
          Bool -> Bool -> Bool
&& Placement
placement Placement -> Placement -> Bool
forall a. Eq a => a -> a -> Bool
== Placement
Normal -> do
        R () -> R ()
useBraces R ()
lhs
        R ()
space
        R ()
p_op
        R ()
breakpoint
        R () -> R ()
inci R ()
p_y
      | Bool
useRecordDot' Bool -> Bool -> Bool
&& Bool
gotRecordDot -> do
        R ()
lhs
        Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isSection R ()
space
        R ()
p_op
        R ()
p_y
      | Bool
otherwise -> do
        R () -> R ()
ub R ()
lhs
        Placement -> R () -> R ()
placeHanging Placement
placement (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          R ()
p_op
          R ()
space
          R ()
p_y

pattern CmdTopCmd :: HsCmd GhcPs -> LHsCmdTop GhcPs
pattern $mCmdTopCmd :: forall r.
LHsCmdTop GhcPs -> (HsCmd GhcPs -> r) -> (Void# -> r) -> r
CmdTopCmd cmd <- (L _ (HsCmdTop NoExtField (L _ cmd)))

cmdOpTree :: LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
cmdOpTree :: LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
cmdOpTree = \case
  CmdTopCmd (HsCmdArrForm XCmdArrForm GhcPs
NoExtField LHsExpr GhcPs
op LexicalFixity
Infix Maybe Fixity
_ [LHsCmdTop GhcPs
x, LHsCmdTop GhcPs
y]) ->
    OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
-> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
cmdOpTree LHsCmdTop GhcPs
x) LHsExpr GhcPs
op (LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
cmdOpTree LHsCmdTop GhcPs
y)
  LHsCmdTop GhcPs
n -> LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
forall ty op. ty -> OpTree ty op
OpNode LHsCmdTop GhcPs
n

p_cmdOpTree :: OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs) -> R ()
p_cmdOpTree :: OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs) -> R ()
p_cmdOpTree = \case
  OpNode LHsCmdTop GhcPs
n -> LHsCmdTop GhcPs -> (HsCmdTop GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
n HsCmdTop GhcPs -> R ()
p_hsCmdTop
  OpBranch OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
x LHsExpr GhcPs
op OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
y -> do
    let placement :: Placement
placement = (HsCmdTop GhcPs -> Placement)
-> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
-> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
-> Placement
forall ty op.
(ty -> Placement)
-> OpTree (Located ty) op -> OpTree (Located ty) op -> Placement
opBranchPlacement HsCmdTop GhcPs -> Placement
cmdTopPlacement OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
x OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
y
    R () -> R ()
ub <- Placement -> R (R () -> R ())
opBranchBraceStyle Placement
placement
    R () -> R ()
ub (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs) -> R ()
p_cmdOpTree OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
x
    Placement -> R () -> R ()
placeHanging Placement
placement (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
op HsExpr GhcPs -> R ()
p_hsExpr
      R ()
space
      OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs) -> R ()
p_cmdOpTree OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
y

opBranchPlacement ::
  -- | Placement of nodes
  (ty -> Placement) ->
  -- | Left branch
  OpTree (Located ty) op ->
  -- | Right branch
  OpTree (Located ty) op ->
  Placement
opBranchPlacement :: (ty -> Placement)
-> OpTree (Located ty) op -> OpTree (Located ty) op -> Placement
opBranchPlacement ty -> Placement
f OpTree (Located ty) op
x OpTree (Located ty) op
y
  -- 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.
  | SrcSpan -> Bool
isOneLineSpan (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (SrcSpan -> SrcLoc
srcSpanStart (OpTree (Located ty) op -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (Located ty) op
x)) (SrcSpan -> SrcLoc
srcSpanStart (OpTree (Located ty) op -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (Located ty) op
y))),
    OpNode (L SrcSpan
_ ty
n) <- OpTree (Located ty) op
y =
    ty -> Placement
f ty
n
  | Bool
otherwise = Placement
Normal

opBranchBraceStyle :: Placement -> R (R () -> R ())
opBranchBraceStyle :: Placement -> R (R () -> R ())
opBranchBraceStyle Placement
placement =
  R Layout
getLayout R Layout -> (Layout -> R () -> R ()) -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    Layout
SingleLine -> R () -> R ()
useBraces
    Layout
MultiLine -> case Placement
placement of
      Placement
Hanging -> R () -> R ()
useBraces
      Placement
Normal -> R () -> R ()
dontUseBraces

-- | 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 Maybe BufSpan
_) = case HsExpr GhcPs
op of
  HsVar XVar GhcPs
NoExtField (L (RealSrcSpan RealSrcSpan
opSpan Maybe BufSpan
_) IdP GhcPs
opName) ->
    (RdrName -> String
getOpNameStr IdP GhcPs
RdrName
opName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".") Bool -> Bool -> Bool
&& (RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
opSpan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
ySpan)
  HsExpr GhcPs
_ -> Bool
False
isRecordDot HsExpr GhcPs
_ SrcSpan
_ = Bool
False

-- | 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 -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
e' Maybe BufSpan
forall a. Maybe a
Nothing)