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

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

import Bag (bagToList)
import BasicTypes
import Control.Monad
import Ctype (is_space)
import Data.Bool (bool)
import Data.Char (isPunctuation, isSymbol)
import Data.Data hiding (Infix, Prefix)
import Data.Functor ((<&>))
import Data.List (intersperse, sortOn)
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as NE
import Data.Text (Text)
import qualified Data.Text as Text
import GHC
import OccName (occNameString)
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 NoExtField funId :: Located (IdP GhcPs)
funId funMatches :: MatchGroup GhcPs (LHsExpr GhcPs)
funMatches _ _ -> Located RdrName -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_funBind Located RdrName
Located (IdP GhcPs)
funId MatchGroup GhcPs (LHsExpr GhcPs)
funMatches
  PatBind NoExtField pat :: LPat GhcPs
pat grhss :: GRHSs GhcPs (LHsExpr GhcPs)
grhss _ -> 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 "VarBinds" -- introduced by the type checker
  AbsBinds {} -> String -> R ()
forall a. String -> a
notImplemented "AbsBinds" -- introduced by the type checker
  PatSynBind NoExtField psb :: PatSynBind GhcPs GhcPs
psb -> PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PatSynBind GhcPs GhcPs
psb
  XHsBindsLR x :: XXHsBindsLR GhcPs GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXHsBindsLR GhcPs GhcPs
x

p_funBind ::
  Located RdrName ->
  MatchGroup GhcPs (LHsExpr GhcPs) ->
  R ()
p_funBind :: Located RdrName -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_funBind name :: 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' placer :: body -> Placement
placer render :: body -> R ()
render style :: MatchGroupStyle
style MG {..} = do
  let ob :: R () -> R ()
ob = case MatchGroupStyle
style of
        Case -> R () -> R ()
forall a. a -> a
id
        LambdaCase -> R () -> R ()
forall a. a -> a
id
        _ -> R () -> R ()
dontUseBraces
  -- Since we are forcing braces on 'sepSemi' based on 'ob', we have to
  -- restore the brace state inside the sepsemi.
  R () -> R ()
ub <- (R () -> R ()) -> (R () -> R ()) -> Bool -> R () -> R ()
forall a. a -> a -> Bool -> a
bool R () -> R ()
dontUseBraces R () -> R ()
useBraces (Bool -> R () -> R ()) -> R Bool -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Bool
canUseBraces
  R () -> R ()
ob (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ (LMatch GhcPs (Located body) -> R ())
-> [LMatch GhcPs (Located body)] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((Match GhcPs (Located body) -> R ())
-> LMatch GhcPs (Located body) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (R () -> R ()
ub (R () -> R ())
-> (Match GhcPs (Located body) -> R ())
-> Match GhcPs (Located body)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs (Located body) -> R ()
p_Match)) (Located [LMatch GhcPs (Located body)]
-> SrcSpanLess (Located [LMatch GhcPs (Located body)])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LMatch GhcPs (Located body)]
mg_alts)
  where
    p_Match :: Match GhcPs (Located body) -> R ()
p_Match m :: Match GhcPs (Located body)
m@Match {..} =
      (body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (Located body)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (Located body)
-> R ()
p_match'
        body -> Placement
placer
        body -> R ()
render
        (Match GhcPs (Located body) -> MatchGroupStyle -> MatchGroupStyle
forall body. Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle Match GhcPs (Located body)
m MatchGroupStyle
style)
        (Match GhcPs (Located body) -> Bool
forall id body. Match id body -> Bool
isInfixMatch Match GhcPs (Located body)
m)
        (Match GhcPs (Located body) -> SrcStrictness
forall id body. Match id body -> SrcStrictness
matchStrictness Match GhcPs (Located body)
m)
        [LPat GhcPs]
m_pats
        GRHSs GhcPs (Located body)
m_grhss
    p_Match (XMatch x :: XXMatch GhcPs (Located body)
x) = NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXMatch GhcPs (Located body)
x
p_matchGroup' _ _ _ (XMatchGroup x :: XXMatchGroup GhcPs (Located body)
x) = NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXMatchGroup GhcPs (Located body)
x

-- | Function id obtained through pattern matching on 'FunBind' should not
-- be used to print the actual equations because the different ‘RdrNames’
-- used in the equations may have different “decorations” (such as backticks
-- and paretheses) associated with them. It is necessary to use per-equation
-- names obtained from 'm_ctxt' of 'Match'. This function replaces function
-- name inside of 'Function' accordingly.
adjustMatchGroupStyle ::
  Match GhcPs body ->
  MatchGroupStyle ->
  MatchGroupStyle
adjustMatchGroupStyle :: Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle m :: Match GhcPs body
m = \case
  Function _ -> (Located RdrName -> MatchGroupStyle
Function (Located RdrName -> MatchGroupStyle)
-> (Match GhcPs body -> Located RdrName)
-> Match GhcPs body
-> MatchGroupStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsMatchContext RdrName -> Located RdrName
forall id. HsMatchContext id -> Located id
mc_fun (HsMatchContext RdrName -> Located RdrName)
-> (Match GhcPs body -> HsMatchContext RdrName)
-> Match GhcPs body
-> Located RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs body -> HsMatchContext RdrName
forall p body.
Match p body -> HsMatchContext (NameOrRdrName (IdP p))
m_ctxt) Match GhcPs body
m
  style :: MatchGroupStyle
style -> MatchGroupStyle
style

matchStrictness :: Match id body -> SrcStrictness
matchStrictness :: Match id body -> SrcStrictness
matchStrictness match :: Match id body
match =
  case Match id body -> HsMatchContext (NameOrRdrName (IdP id))
forall p body.
Match p body -> HsMatchContext (NameOrRdrName (IdP p))
m_ctxt Match id body
match of
    FunRhs {mc_strictness :: forall id. HsMatchContext id -> SrcStrictness
mc_strictness = SrcStrictness
s} -> SrcStrictness
s
    _ -> 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' placer :: body -> Placement
placer render :: body -> R ()
render style :: MatchGroupStyle
style isInfix :: Bool
isInfix strictness :: SrcStrictness
strictness m_pats :: [LPat GhcPs]
m_pats GRHSs {..} = 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
    NoSrcStrict -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    SrcStrict -> Text -> R ()
txt "!"
    SrcLazy -> Text -> R ()
txt "~"
  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
    Nothing ->
      Bool
False Bool -> R () -> R Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ case MatchGroupStyle
style of
        Function name :: Located RdrName
name -> Located RdrName -> R ()
p_rdrName Located RdrName
name
        _ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just ne_pats :: NonEmpty (Located (Pat GhcPs))
ne_pats -> do
      let combinedSpans :: SrcSpan
combinedSpans = case MatchGroupStyle
style of
            Function name :: Located RdrName
name -> SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located RdrName
name) SrcSpan
patSpans
            _ -> SrcSpan
patSpans
          patSpans :: SrcSpan
patSpans = NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located (Pat GhcPs) -> SrcSpan)
-> NonEmpty (Located (Pat GhcPs)) -> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Located (Pat GhcPs))
ne_pats)
          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 name :: 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)
          PatternBind -> R ()
stdCase
          Case -> R ()
stdCase
          Lambda -> do
            let needsSpace :: Bool
needsSpace = case Located (Pat GhcPs) -> SrcSpanLess (Located (Pat GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (NonEmpty (Located (Pat GhcPs)) -> Located (Pat GhcPs)
forall a. NonEmpty a -> a
NE.head NonEmpty (Located (Pat GhcPs))
ne_pats) of
                  LazyPat _ _ -> Bool
True
                  BangPat _ _ -> Bool
True
                  SplicePat _ _ -> Bool
True
                  _ -> Bool
False
            Text -> R ()
txt "\\"
            Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsSpace R ()
space
            R () -> R ()
sitcc R ()
stdCase
          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
        Nothing -> case MatchGroupStyle
style of
          Function name :: Located RdrName
name -> SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located RdrName
name)
          _ -> Maybe SrcSpan
forall a. Maybe a
Nothing
        Just pats :: NonEmpty (Located (Pat GhcPs))
pats -> (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (SrcSpan -> Maybe SrcSpan)
-> (NonEmpty (Located (Pat GhcPs)) -> SrcSpan)
-> NonEmpty (Located (Pat GhcPs))
-> Maybe SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located (Pat GhcPs) -> SrcSpan)
-> (NonEmpty (Located (Pat GhcPs)) -> Located (Pat GhcPs))
-> NonEmpty (Located (Pat GhcPs))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Located (Pat GhcPs)) -> Located (Pat GhcPs)
forall a. NonEmpty a -> a
NE.last) NonEmpty (Located (Pat GhcPs))
pats
      isCase :: MatchGroupStyle -> Bool
isCase = \case
        Case -> Bool
True
        LambdaCase -> Bool
True
        _ -> 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 a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LGRHS GhcPs (Located body) -> SrcSpan)
-> NonEmpty (LGRHS GhcPs (Located body)) -> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LGRHS GhcPs (Located body)]
-> NonEmpty (LGRHS GhcPs (Located body))
forall a. [a] -> NonEmpty a
NE.fromList [LGRHS GhcPs (Located body)]
grhssGRHSs
      patGrhssSpan :: SrcSpan
patGrhssSpan =
        SrcSpan -> (SrcSpan -> SrcSpan) -> Maybe SrcSpan -> SrcSpan
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          SrcSpan
grhssSpan
          (SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
grhssSpan (SrcSpan -> SrcSpan) -> (SrcSpan -> SrcSpan) -> SrcSpan -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcLoc -> SrcSpan
srcLocSpan (SrcLoc -> SrcSpan) -> (SrcSpan -> SrcLoc) -> SrcSpan -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanEnd)
          Maybe SrcSpan
endOfPats
      placement :: Placement
placement =
        case Maybe SrcSpan
endOfPats of
          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 spn :: SrcSpan
spn ->
            if SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn SrcSpan
grhssSpan
              then (body -> Placement) -> [LGRHS GhcPs (Located body)] -> Placement
forall body.
(body -> Placement) -> [LGRHS GhcPs (Located body)] -> Placement
blockPlacement body -> Placement
placer [LGRHS GhcPs (Located body)]
grhssGRHSs
              else Placement
Normal
      p_body :: R ()
p_body = do
        let groupStyle :: GroupStyle
groupStyle =
              if MatchGroupStyle -> Bool
isCase MatchGroupStyle
style Bool -> Bool -> Bool
&& Bool
hasGuards
                then GroupStyle
RightArrow
                else GroupStyle
EqualSign
        R ()
-> (LGRHS GhcPs (Located body) -> R ())
-> [LGRHS GhcPs (Located body)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline ((GRHS GhcPs (Located body) -> R ())
-> LGRHS GhcPs (Located body) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' ((body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (Located body)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (Located body)
-> R ()
p_grhs' body -> Placement
placer body -> R ()
render GroupStyle
groupStyle)) [LGRHS GhcPs (Located body)]
grhssGRHSs
      p_where :: R ()
p_where = do
        let whereIsEmpty :: Bool
whereIsEmpty = HsLocalBindsLR GhcPs GhcPs -> Bool
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b) -> Bool
GHC.isEmptyLocalBindsPR (LHsLocalBinds GhcPs -> SrcSpanLess (LHsLocalBinds GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsLocalBinds GhcPs
grhssLocalBinds)
        Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HsLocalBindsLR GhcPs GhcPs -> Bool
forall a b. HsLocalBindsLR a b -> Bool
GHC.eqEmptyLocalBinds (LHsLocalBinds GhcPs -> SrcSpanLess (LHsLocalBinds GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsLocalBinds GhcPs
grhssLocalBinds)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          R ()
breakpoint
          Text -> R ()
txt "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
> 1) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      case MatchGroupStyle
style of
        Function _ | Bool
hasGuards -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Function _ -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
equals
        PatternBind -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
equals
        s :: MatchGroupStyle
s | MatchGroupStyle -> Bool
isCase MatchGroupStyle
s Bool -> Bool -> Bool
&& Bool
hasGuards -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        _ -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt "->"
    [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
patGrhssSpan] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body
    R () -> R ()
inci R ()
p_where
p_match' _ _ _ _ _ _ (XGRHSs x :: XXGRHSs GhcPs (Located body)
x) = NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXGRHSs GhcPs (Located body)
x

p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
p_grhs = (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> GroupStyle
-> GRHS GhcPs (LHsExpr GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (Located body)
-> R ()
p_grhs' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr

p_grhs' ::
  Data body =>
  -- | How to get body placement
  (body -> Placement) ->
  -- | How to print body
  (body -> R ()) ->
  GroupStyle ->
  GRHS GhcPs (Located body) ->
  R ()
p_grhs' :: (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (Located body)
-> R ()
p_grhs' placer :: body -> Placement
placer render :: body -> R ()
render style :: GroupStyle
style (GRHS NoExtField guards :: [GuardLStmt GhcPs]
guards body :: Located body
body) =
  case [GuardLStmt GhcPs]
guards of
    [] -> R ()
p_body
    xs :: [GuardLStmt GhcPs]
xs -> do
      Text -> R ()
txt "|"
      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
        EqualSign -> R ()
equals
        RightArrow -> Text -> R ()
txt "->"
      Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body
  where
    placement :: Placement
placement =
      case Maybe SrcSpan
endOfGuards of
        Nothing -> body -> Placement
placer (Located body -> SrcSpanLess (Located body)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located body
body)
        Just spn :: SrcSpan
spn ->
          if SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn (Located body -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located body
body)
            then body -> Placement
placer (Located body -> SrcSpanLess (Located body)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located body
body)
            else Placement
Normal
    endOfGuards :: Maybe SrcSpan
endOfGuards =
      case [GuardLStmt GhcPs] -> Maybe (NonEmpty (GuardLStmt GhcPs))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [GuardLStmt GhcPs]
guards of
        Nothing -> Maybe SrcSpan
forall a. Maybe a
Nothing
        Just gs :: NonEmpty (GuardLStmt GhcPs)
gs -> (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (SrcSpan -> Maybe SrcSpan)
-> (NonEmpty (GuardLStmt GhcPs) -> SrcSpan)
-> NonEmpty (GuardLStmt GhcPs)
-> Maybe SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (GuardLStmt GhcPs -> SrcSpan)
-> (NonEmpty (GuardLStmt GhcPs) -> GuardLStmt GhcPs)
-> NonEmpty (GuardLStmt GhcPs)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (GuardLStmt GhcPs) -> GuardLStmt GhcPs
forall a. NonEmpty a -> a
NE.last) NonEmpty (GuardLStmt GhcPs)
gs
    p_body :: R ()
p_body = Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located body
body body -> R ()
render
p_grhs' _ _ _ (XGRHS x :: XXGRHS GhcPs (Located body)
x) = NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXGRHS GhcPs (Located body)
x

p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd = \case
  HsCmdArrApp NoExtField body :: LHsExpr GhcPs
body input :: LHsExpr GhcPs
input arrType :: HsArrAppType
arrType _ -> do
    LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
body HsExpr GhcPs -> R ()
p_hsExpr
    R ()
breakpoint
    R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      case HsArrAppType
arrType of
        HsFirstOrderApp -> Text -> R ()
txt "-<"
        HsHigherOrderApp -> Text -> R ()
txt "-<<"
      Placement -> R () -> R ()
placeHanging (HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
input)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
        LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
input HsExpr GhcPs -> R ()
p_hsExpr
  HsCmdArrForm NoExtField form :: LHsExpr GhcPs
form Prefix _ cmds :: [LHsCmdTop GhcPs]
cmds -> R () -> R ()
banana (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 NoExtField form :: LHsExpr GhcPs
form Infix _ [left :: LHsCmdTop GhcPs
left, right :: LHsCmdTop GhcPs
right] -> do
    LHsCmdTop GhcPs -> (HsCmdTop GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
left HsCmdTop GhcPs -> R ()
p_hsCmdTop
    R ()
space
    LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
form HsExpr GhcPs -> R ()
p_hsExpr
    Placement -> R () -> R ()
placeHanging (HsCmdTop GhcPs -> Placement
cmdTopPlacement (LHsCmdTop GhcPs -> SrcSpanLess (LHsCmdTop GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsCmdTop GhcPs
right)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      LHsCmdTop GhcPs -> (HsCmdTop GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
right HsCmdTop GhcPs -> R ()
p_hsCmdTop
  HsCmdArrForm NoExtField _ Infix _ _ -> String -> R ()
forall a. String -> a
notImplemented "HsCmdArrForm"
  HsCmdApp {} ->
    -- XXX Does this ever occur in the syntax tree? It does not seem like it
    -- does. Open an issue and ping @yumiova if this ever occurs in output.
    String -> R ()
forall a. String -> a
notImplemented "HsCmdApp"
  HsCmdLam NoExtField mgroup :: 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 NoExtField c :: 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 NoExtField e :: LHsExpr GhcPs
e mgroup :: MatchGroup GhcPs (LHsCmd GhcPs)
mgroup ->
    (HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LHsCmd GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (Located body)
-> R ()
p_case HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd LHsExpr GhcPs
e MatchGroup GhcPs (LHsCmd GhcPs)
mgroup
  HsCmdIf NoExtField _ if' :: LHsExpr GhcPs
if' then' :: LHsCmd GhcPs
then' else' :: 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 NoExtField localBinds :: LHsLocalBinds GhcPs
localBinds c :: 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 NoExtField es :: Located [CmdLStmt GhcPs]
es -> do
    Text -> R ()
txt "do"
    R ()
newline
    R () -> R ()
inci (R () -> R ())
-> (([CmdLStmt GhcPs] -> R ()) -> R ())
-> ([CmdLStmt GhcPs] -> R ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located [CmdLStmt GhcPs] -> ([CmdLStmt GhcPs] -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located [CmdLStmt GhcPs]
es (([CmdLStmt GhcPs] -> R ()) -> R ())
-> ([CmdLStmt GhcPs] -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$
      R () -> R ()
sitcc (R () -> R ())
-> ([CmdLStmt GhcPs] -> R ()) -> [CmdLStmt GhcPs] -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> (CmdLStmt GhcPs -> R ()) -> [CmdLStmt GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline (R () -> R ()
sitcc (R () -> R ())
-> (CmdLStmt GhcPs -> R ()) -> CmdLStmt GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt GhcPs (LHsCmd GhcPs) -> R ()) -> CmdLStmt GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
withSpacing ((HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ()) -> Stmt GhcPs (LHsCmd GhcPs) -> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
p_stmt' HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd))
  HsCmdWrap {} -> String -> R ()
forall a. String -> a
notImplemented "HsCmdWrap"
  XCmd x :: XXCmd GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXCmd GhcPs
x

p_hsCmdTop :: HsCmdTop GhcPs -> R ()
p_hsCmdTop :: HsCmdTop GhcPs -> R ()
p_hsCmdTop = \case
  HsCmdTop NoExtField cmd :: LHsCmd GhcPs
cmd -> LHsCmd GhcPs -> (HsCmd GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
cmd HsCmd GhcPs -> R ()
p_hsCmd
  XCmdTop x :: XXCmdTop GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXCmdTop GhcPs
x

-- | 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 f :: a -> R ()
f l :: 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
$ \x :: a
x -> do
  case Located a -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located a
l of
    UnhelpfulSpan _ -> a -> R ()
f a
x
    RealSrcSpan currentSpn :: RealSrcSpan
currentSpn -> do
      R (Maybe SpanMark)
getSpanMark R (Maybe SpanMark) -> (Maybe SpanMark -> R ()) -> R ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        -- Spacing before comments will be handled by the code
        -- that prints comments, so we just have to deal with
        -- blank lines between statements here.
        Just (StatementSpan lastSpn :: 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
+ 1
            then R ()
newline
            else () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        _ -> () -> 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 _ _) -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (CommentSpan _) -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        _ -> 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' placer :: body -> Placement
placer render :: body -> R ()
render = \case
  LastStmt NoExtField body :: Located body
body _ _ -> Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located body
body body -> R ()
render
  BindStmt NoExtField p :: LPat GhcPs
p f :: Located body
f _ _ -> 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 "<-"
    let loc :: SrcSpan
loc = Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LPat GhcPs
Located (Pat GhcPs)
p
        placement :: Placement
placement =
          case Located body
f of
            L l' :: SrcSpan
l' x :: body
x ->
              if SrcSpan -> Bool
isOneLineSpan
                (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (SrcSpan -> SrcLoc
srcSpanEnd SrcSpan
loc) (SrcSpan -> SrcLoc
srcSpanStart SrcSpan
l'))
                then body -> Placement
placer body
x
                else Placement
Normal
    [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
loc, Located body -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located body
f] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      Placement -> R () -> R ()
placeHanging Placement
placement (Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located body
f body -> R ()
render)
  ApplicativeStmt {} -> String -> R ()
forall a. String -> a
notImplemented "ApplicativeStmt" -- generated by renamer
  BodyStmt NoExtField body :: Located body
body _ _ -> Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located body
body body -> R ()
render
  LetStmt NoExtField binds :: LHsLocalBinds GhcPs
binds -> do
    Text -> R ()
txt "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 "ParStmt"
  TransStmt {..} ->
    -- '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
      (ThenForm, Nothing) -> do
        Text -> R ()
txt "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
      (ThenForm, Just e :: LHsExpr GhcPs
e) -> do
        Text -> R ()
txt "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 "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
      (GroupForm, Nothing) -> do
        Text -> R ()
txt "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
      (GroupForm, Just e :: LHsExpr GhcPs
e) -> do
        Text -> R ()
txt "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 "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 {..} -> do
    Text -> R ()
txt "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
  XStmtLR c :: XXStmtLR GhcPs GhcPs (Located body)
c -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXStmtLR GhcPs GhcPs (Located body)
c

gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]
gatherStmt :: GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt (L _ (ParStmt NoExtField block :: [ParStmtBlock GhcPs GhcPs]
block _ _)) =
  (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 s :: SrcSpan
s stmt :: Stmt GhcPs (LHsExpr GhcPs)
stmt@TransStmt {..}) =
  ([[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 stmt :: GuardLStmt GhcPs
stmt = [[GuardLStmt GhcPs
stmt]]

gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[ExprLStmt GhcPs]]
gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]]
gatherStmtBlock (ParStmtBlock _ stmts :: [GuardLStmt GhcPs]
stmts _ _) =
  (GuardLStmt GhcPs -> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> [[GuardLStmt GhcPs]]
-> [GuardLStmt GhcPs]
-> [[GuardLStmt GhcPs]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend ([[GuardLStmt GhcPs]]
 -> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> (GuardLStmt GhcPs -> [[GuardLStmt GhcPs]])
-> GuardLStmt GhcPs
-> [[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt) [] [GuardLStmt GhcPs]
stmts
gatherStmtBlock (XParStmtBlock x :: XXParStmtBlock GhcPs GhcPs
x) = NoExtCon -> [[GuardLStmt GhcPs]]
forall a. NoExtCon -> a
noExtCon NoExtCon
XXParStmtBlock GhcPs GhcPs
x

p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds = \case
  HsValBinds NoExtField (ValBinds NoExtField bag :: LHsBindsLR GhcPs GhcPs
bag lsigs :: [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
l x :: 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
l x :: 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
          SinglePos -> R () -> R ()
forall a. a -> a
id
          FirstPos -> R () -> R ()
br
          MiddlePos -> R () -> R ()
br
          LastPos -> R () -> R ()
forall a. a -> a
id
        p_item' :: (RelativePos,
 GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> R ()
p_item' (p :: RelativePos
p, item :: 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))
 -> SrcLoc)
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc)
-> (GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
    -> SrcSpan)
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
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 NoExtField _ -> String -> R ()
forall a. String -> a
notImplemented "HsValBinds"
  HsIPBinds NoExtField (IPBinds NoExtField xs :: [LIPBind GhcPs]
xs) ->
    -- Second argument of IPBind is always Left before type-checking.
    let p_ipBind :: IPBind GhcPs -> R ()
p_ipBind (IPBind NoExtField (Left name :: Located HsIPName
name) expr :: 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 NoExtField (Right _) _) =
          -- Should only occur after the type checker
          String -> R ()
forall a. String -> a
notImplemented "IPBind _ (Right _) _"
        p_ipBind (XIPBind x :: XXIPBind GhcPs
x) = NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXIPBind GhcPs
x
     in (LIPBind GhcPs -> R ()) -> [LIPBind GhcPs] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((IPBind GhcPs -> R ()) -> LIPBind GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' IPBind GhcPs -> R ()
p_ipBind) [LIPBind GhcPs]
xs
  HsIPBinds NoExtField _ -> String -> R ()
forall a. String -> a
notImplemented "HsIpBinds"
  EmptyLocalBinds NoExtField -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  XHsLocalBindsLR x :: XXHsLocalBindsLR GhcPs GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXHsLocalBindsLR GhcPs GhcPs
x

p_hsRecField ::
  HsRecField' RdrName (LHsExpr GhcPs) ->
  R ()
p_hsRecField :: HsRecField' RdrName (LHsExpr GhcPs) -> R ()
p_hsRecField HsRecField {..} = do
  Located RdrName -> R ()
p_rdrName Located RdrName
hsRecFieldLbl
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hsRecPun (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    R ()
space
    R ()
equals
    let placement :: Placement
placement =
          if SrcSpan -> SrcSpan -> Bool
onTheSameLine (Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located RdrName
hsRecFieldLbl) (LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr GhcPs
hsRecFieldArg)
            then HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
hsRecFieldArg)
            else Placement
Normal
    Placement -> R () -> R ()
placeHanging Placement
placement (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
hsRecFieldArg HsExpr GhcPs -> R ()
p_hsExpr)

p_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' s :: BracketStyle
s = \case
  HsVar NoExtField name :: Located (IdP GhcPs)
name -> Located RdrName -> R ()
p_rdrName Located RdrName
Located (IdP GhcPs)
name
  HsUnboundVar NoExtField v :: UnboundVar
v -> OccName -> R ()
forall a. Outputable a => a -> R ()
atom (UnboundVar -> OccName
unboundVarOcc UnboundVar
v)
  HsConLikeOut NoExtField _ -> String -> R ()
forall a. String -> a
notImplemented "HsConLikeOut"
  HsRecFld NoExtField x :: AmbiguousFieldOcc GhcPs
x ->
    case AmbiguousFieldOcc GhcPs
x of
      Unambiguous NoExtField name :: Located RdrName
name -> Located RdrName -> R ()
p_rdrName Located RdrName
name
      Ambiguous NoExtField name :: Located RdrName
name -> Located RdrName -> R ()
p_rdrName Located RdrName
name
      XAmbiguousFieldOcc xx :: XXAmbiguousFieldOcc GhcPs
xx -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXAmbiguousFieldOcc GhcPs
xx
  HsOverLabel NoExtField _ v :: FastString
v -> do
    Text -> R ()
txt "#"
    FastString -> R ()
forall a. Outputable a => a -> R ()
atom FastString
v
  HsIPVar NoExtField (HsIPName name :: FastString
name) -> do
    Text -> R ()
txt "?"
    FastString -> R ()
forall a. Outputable a => a -> R ()
atom FastString
name
  HsOverLit NoExtField v :: 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 NoExtField lit :: HsLit GhcPs
lit ->
    case HsLit GhcPs
lit of
      HsString (SourceText stxt) _ -> String -> R ()
p_stringLit String
stxt
      HsStringPrim (SourceText stxt) _ -> String -> R ()
p_stringLit String
stxt
      r :: HsLit GhcPs
r -> HsLit GhcPs -> R ()
forall a. Outputable a => a -> R ()
atom HsLit GhcPs
r
  HsLam NoExtField mgroup :: MatchGroup GhcPs (LHsExpr GhcPs)
mgroup ->
    MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup MatchGroupStyle
Lambda MatchGroup GhcPs (LHsExpr GhcPs)
mgroup
  HsLamCase NoExtField mgroup :: MatchGroup GhcPs (LHsExpr GhcPs)
mgroup -> do
    Text -> R ()
txt "\\case"
    R ()
breakpoint
    R () -> R ()
inci (MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup MatchGroupStyle
LambdaCase MatchGroup GhcPs (LHsExpr GhcPs)
mgroup)
  HsApp NoExtField f :: LHsExpr GhcPs
f x :: 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 f' :: LHsExpr p
f' knownArgs :: NonEmpty (LHsExpr p)
knownArgs =
          case LHsExpr p
f' of
            L _ (HsApp _ l :: LHsExpr p
l r :: 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
f', NonEmpty (LHsExpr p)
knownArgs)
        (func :: LHsExpr GhcPs
func, args :: 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.
        (initp :: [LHsExpr GhcPs]
initp, lastp :: LHsExpr GhcPs
lastp) = (NonEmpty (LHsExpr GhcPs) -> [LHsExpr GhcPs]
forall a. NonEmpty a -> [a]
NE.init NonEmpty (LHsExpr GhcPs)
args, NonEmpty (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. NonEmpty a -> a
NE.last NonEmpty (LHsExpr GhcPs)
args)
        initSpan :: SrcSpan
initSpan =
          NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$
            LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr GhcPs
f SrcSpan -> [SrcSpan] -> NonEmpty SrcSpan
forall a. a -> [a] -> NonEmpty a
:| [(SrcLoc -> SrcSpan
srcLocSpan (SrcLoc -> SrcSpan)
-> (LHsExpr GhcPs -> SrcLoc) -> LHsExpr GhcPs -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc)
-> (LHsExpr GhcPs -> SrcSpan) -> LHsExpr GhcPs -> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc) LHsExpr GhcPs
lastp]
        -- Hang the last argument only if the initial arguments span one
        -- line.
        placement :: Placement
placement =
          if SrcSpan -> Bool
isOneLineSpan SrcSpan
initSpan
            then HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
lastp)
            else Placement
Normal
    -- If the last argument is not hanging, just separate every argument as
    -- usual. If it is hanging, print the initial arguments and hang the
    -- last one. Also, use braces around the every argument except the last
    -- one.
    case Placement
placement of
      Normal -> do
        let -- Usually we want to bump indentation for arguments for the
            -- sake of readability. However, when the function itself is a
            -- do-block or case expression it is not a good idea. It seems
            -- to be safe to always bump indentation when the function
            -- expression is parenthesised.
            doIndent :: Bool
doIndent =
              case LHsExpr GhcPs
func of
                L _ (HsPar NoExtField _) -> Bool
True
                L _ (HsAppType NoExtField _ _) -> Bool
True
                L _ (HsMultiIf NoExtField _) -> Bool
True
                L spn :: SrcSpan
spn _ -> SrcSpan -> Bool
isOneLineSpan SrcSpan
spn
        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
            SingleLine -> R () -> R ()
useBraces
            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
          Bool -> R () -> R ()
inciIf Bool
doIndent (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
        Bool -> R () -> R ()
inciIf Bool
doIndent (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
      Hanging -> do
        R () -> R ()
useBraces (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
initSpan] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
func (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
          R ()
breakpoint
          R () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs]
initp
        Placement -> R () -> R ()
placeHanging Placement
placement (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
          LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
lastp HsExpr GhcPs -> R ()
p_hsExpr
  HsAppType NoExtField e :: LHsExpr GhcPs
e a :: 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 "@"
      -- Insert a space when the type is represented as a TH splice to avoid
      -- gluing @ and $ together.
      case LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (HsWildCardBndrs GhcPs (LHsType GhcPs) -> LHsType GhcPs
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (LHsType GhcPs)
LHsWcType (NoGhcTc GhcPs)
a) of
        HsSpliceTy {} -> R ()
space
        _ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located (HsWildCardBndrs GhcPs (LHsType GhcPs) -> LHsType GhcPs
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (LHsType GhcPs)
LHsWcType (NoGhcTc GhcPs)
a) HsType GhcPs -> R ()
p_hsType
  OpApp NoExtField x :: LHsExpr GhcPs
x op :: LHsExpr GhcPs
op y :: 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 NoExtField e :: LHsExpr GhcPs
e _ -> do
    Text -> R ()
txt "-"
    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 NoExtField e :: 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 NoExtField x :: LHsExpr GhcPs
x op :: 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 NoExtField op :: LHsExpr GhcPs
op x :: LHsExpr GhcPs
x -> do
    LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
op HsExpr GhcPs -> R ()
p_hsExpr
    Bool
useRecordDot' <- R Bool
useRecordDot
    let isRecordDot' :: Bool
isRecordDot' = HsExpr GhcPs -> SrcSpan -> Bool
isRecordDot (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
op) (LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr GhcPs
x)
    Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
useRecordDot' Bool -> Bool -> Bool
&& Bool
isRecordDot') R ()
breakpoint
    R () -> R ()
inci (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr)
  ExplicitTuple NoExtField args :: [LHsTupArg GhcPs]
args boxity :: 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 a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LHsTupArg GhcPs]
args
        isMissing :: HsTupArg GhcPs -> Bool
isMissing = \case
          Missing NoExtField -> Bool
True
          _ -> Bool
False
        p_arg :: HsTupArg GhcPs -> R ()
p_arg = \case
          Present NoExtField x :: 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 NoExtField -> () -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          XTupArg x :: XXTupArg GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXTupArg GhcPs
x
        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
            Boxed -> BracketStyle -> R () -> R ()
parens
            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 a. HasSrcSpan a => a -> SrcSpan
getLoc (LHsTupArg GhcPs -> SrcSpan) -> [LHsTupArg GhcPs] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsTupArg GhcPs]
args) (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s (R () -> R ()) -> R () -> R ()
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 NoExtField tag :: Int
tag arity :: Int
arity e :: 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 NoExtField e :: LHsExpr GhcPs
e mgroup :: 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 NoExtField _ if' :: LHsExpr GhcPs
if' then' :: LHsExpr GhcPs
then' else' :: 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 NoExtField guards :: [LGRHS GhcPs (LHsExpr GhcPs)]
guards -> do
    Text -> R ()
txt "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 NoExtField localBinds :: LHsLocalBinds GhcPs
localBinds e :: 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 NoExtField ctx :: HsStmtContext Name
ctx es :: Located [GuardLStmt GhcPs]
es -> do
    let doBody :: Text -> R ()
doBody header :: Text
header = do
          Text -> R ()
txt Text
header
          R ()
breakpoint
          R () -> R ()
ub <- Layout -> R () -> R ()
layoutToBraces (Layout -> R () -> R ()) -> R Layout -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Layout
getLayout
          R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
            (GuardLStmt GhcPs -> R ()) -> [GuardLStmt GhcPs] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi
              (R () -> R ()
ub (R () -> R ())
-> (GuardLStmt GhcPs -> R ()) -> GuardLStmt GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt GhcPs (LHsExpr GhcPs) -> R ()) -> GuardLStmt GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
withSpacing ((HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ()) -> Stmt GhcPs (LHsExpr GhcPs) -> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
p_stmt' HsExpr GhcPs -> Placement
exprPlacement (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
S)))
              (Located [GuardLStmt GhcPs]
-> SrcSpanLess (Located [GuardLStmt GhcPs])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [GuardLStmt GhcPs]
es)
        compBody :: R ()
compBody = BracketStyle -> R () -> R ()
brackets BracketStyle
N (R () -> R ())
-> (([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
$ \xs :: [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 "|" 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 "|"
          R ()
space
          [[GuardLStmt GhcPs]] -> R ()
p_parBody [[GuardLStmt GhcPs]]
lists
    case HsStmtContext Name
ctx of
      DoExpr -> Text -> R ()
doBody "do"
      MDoExpr -> Text -> R ()
doBody "mdo"
      ListComp -> R ()
compBody
      MonadComp -> String -> R ()
forall a. String -> a
notImplemented "MonadComp"
      ArrowExpr -> String -> R ()
forall a. String -> a
notImplemented "ArrowExpr"
      GhciStmtCtxt -> String -> R ()
forall a. String -> a
notImplemented "GhciStmtCtxt"
      PatGuard _ -> String -> R ()
forall a. String -> a
notImplemented "PatGuard"
      ParStmtCtxt _ -> String -> R ()
forall a. String -> a
notImplemented "ParStmtCtxt"
      TransStmtCtxt _ -> String -> R ()
forall a. String -> a
notImplemented "TransStmtCtxt"
  ExplicitList _ _ xs :: [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 {..} -> do
    Located RdrName -> (RdrName -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located RdrName
Located (IdP GhcPs)
rcon_con_name RdrName -> R ()
forall a. Outputable a => a -> R ()
atom
    R ()
breakpoint
    let HsRecFields {..} = HsRecordBinds GhcPs
rcon_flds
        updName :: HsRecField GhcPs (LHsExpr GhcPs)
-> HsRecField' RdrName (LHsExpr GhcPs)
updName f :: HsRecField GhcPs (LHsExpr GhcPs)
f =
          (HsRecField GhcPs (LHsExpr GhcPs)
f :: HsRecField GhcPs (LHsExpr GhcPs))
            { hsRecFieldLbl :: Located RdrName
hsRecFieldLbl = case Located (FieldOcc GhcPs) -> SrcSpanLess (Located (FieldOcc GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located (FieldOcc GhcPs)
 -> SrcSpanLess (Located (FieldOcc GhcPs)))
-> Located (FieldOcc GhcPs)
-> SrcSpanLess (Located (FieldOcc GhcPs))
forall a b. (a -> b) -> a -> b
$ HsRecField GhcPs (LHsExpr GhcPs) -> Located (FieldOcc GhcPs)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl HsRecField GhcPs (LHsExpr GhcPs)
f of
                FieldOcc _ n -> Located RdrName
n
                XFieldOcc x -> NoExtCon -> Located RdrName
forall a. NoExtCon -> a
noExtCon NoExtCon
XXFieldOcc GhcPs
x
            }
        fields :: [R ()]
fields = (HsRecField GhcPs (LHsExpr GhcPs) -> R ())
-> LHsRecField GhcPs (LHsExpr GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (HsRecField' RdrName (LHsExpr GhcPs) -> R ()
p_hsRecField (HsRecField' RdrName (LHsExpr GhcPs) -> R ())
-> (HsRecField GhcPs (LHsExpr GhcPs)
    -> HsRecField' RdrName (LHsExpr GhcPs))
-> HsRecField GhcPs (LHsExpr GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecField GhcPs (LHsExpr GhcPs)
-> HsRecField' RdrName (LHsExpr GhcPs)
updName) (LHsRecField GhcPs (LHsExpr GhcPs) -> R ())
-> [LHsRecField GhcPs (LHsExpr GhcPs)] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (LHsExpr GhcPs)]
rec_flds
        dotdot :: [R ()]
dotdot =
          case Maybe (Located Int)
rec_dotdot of
            Just {} -> [Text -> R ()
txt ".."]
            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 {..} -> do
    LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
rupd_expr HsExpr GhcPs -> R ()
p_hsExpr
    Bool
useRecordDot' <- R Bool
useRecordDot
    let mrs :: a -> Maybe RealSrcSpan
mrs sp :: a
sp = case a -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc a
sp of
          RealSrcSpan r :: RealSrcSpan
r -> RealSrcSpan -> Maybe RealSrcSpan
forall a. a -> Maybe a
Just RealSrcSpan
r
          _ -> Maybe RealSrcSpan
forall a. Maybe a
Nothing
    let isPluginForm :: Bool
isPluginForm =
          ((1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (RealSrcSpan -> Int) -> RealSrcSpan -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcSpan -> Int
srcSpanEndCol (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsExpr GhcPs -> Maybe RealSrcSpan
forall a. HasSrcSpan a => a -> Maybe RealSrcSpan
mrs LHsExpr GhcPs
rupd_expr)
            Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== (RealSrcSpan -> Int
srcSpanStartCol (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsRecUpdField GhcPs -> Maybe RealSrcSpan
forall a. HasSrcSpan a => a -> Maybe RealSrcSpan
mrs ([LHsRecUpdField GhcPs] -> LHsRecUpdField GhcPs
forall a. [a] -> a
head [LHsRecUpdField GhcPs]
rupd_flds))
    Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
useRecordDot' Bool -> Bool -> Bool
&& Bool
isPluginForm) R ()
breakpoint
    let updName :: HsRecUpdField GhcPs -> HsRecField' RdrName (LHsExpr GhcPs)
updName f :: HsRecUpdField GhcPs
f =
          (HsRecUpdField GhcPs
f :: HsRecUpdField GhcPs)
            { hsRecFieldLbl :: Located RdrName
hsRecFieldLbl = case Located (AmbiguousFieldOcc GhcPs)
-> SrcSpanLess (Located (AmbiguousFieldOcc GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located (AmbiguousFieldOcc GhcPs)
 -> SrcSpanLess (Located (AmbiguousFieldOcc GhcPs)))
-> Located (AmbiguousFieldOcc GhcPs)
-> SrcSpanLess (Located (AmbiguousFieldOcc GhcPs))
forall a b. (a -> b) -> a -> b
$ HsRecUpdField GhcPs -> Located (AmbiguousFieldOcc GhcPs)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl HsRecUpdField GhcPs
f of
                Ambiguous _ n -> Located RdrName
n
                Unambiguous _ n -> Located RdrName
n
                XAmbiguousFieldOcc x -> NoExtCon -> Located RdrName
forall a. NoExtCon -> a
noExtCon NoExtCon
XXAmbiguousFieldOcc GhcPs
x
            }
    R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> R () -> R ()
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 NoExtField x :: LHsExpr GhcPs
x HsWC {hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = HsIB {..}} -> 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 "::"
    R ()
breakpoint
    R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
LHsType (NoGhcTc GhcPs)
hsib_body HsType GhcPs -> R ()
p_hsType
  ExprWithTySig NoExtField _ HsWC {hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = XHsImplicitBndrs x :: XXHsImplicitBndrs (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs))
x} -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXHsImplicitBndrs (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs))
x
  ExprWithTySig NoExtField _ (XHsWildCardBndrs x :: XXHsWildCardBndrs
  (NoGhcTc GhcPs)
  (HsImplicitBndrs (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs)))
x) -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXHsWildCardBndrs
  (NoGhcTc GhcPs)
  (HsImplicitBndrs (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs)))
x
  ArithSeq NoExtField _ x :: ArithSeqInfo GhcPs
x ->
    case ArithSeqInfo GhcPs
x of
      From 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 ".."
      FromThen from :: LHsExpr GhcPs
from next :: 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 ".."
      FromTo from :: LHsExpr GhcPs
from to :: 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 ".."
        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 from :: LHsExpr GhcPs
from next :: LHsExpr GhcPs
next to :: 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 ".."
        R ()
space
        LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
to HsExpr GhcPs -> R ()
p_hsExpr
  HsSCC NoExtField _ name :: StringLiteral
name x :: LHsExpr GhcPs
x -> do
    Text -> R ()
txt "{-# SCC "
    StringLiteral -> R ()
forall a. Outputable a => a -> R ()
atom StringLiteral
name
    Text -> R ()
txt " #-}"
    R ()
breakpoint
    LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr
  HsCoreAnn NoExtField _ value :: StringLiteral
value x :: LHsExpr GhcPs
x -> do
    Text -> R ()
txt "{-# CORE "
    StringLiteral -> R ()
forall a. Outputable a => a -> R ()
atom StringLiteral
value
    Text -> R ()
txt " #-}"
    R ()
breakpoint
    LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr
  HsBracket NoExtField x :: HsBracket GhcPs
x -> HsBracket GhcPs -> R ()
p_hsBracket HsBracket GhcPs
x
  HsRnBracketOut {} -> String -> R ()
forall a. String -> a
notImplemented "HsRnBracketOut"
  HsTcBracketOut {} -> String -> R ()
forall a. String -> a
notImplemented "HsTcBracketOut"
  HsSpliceE NoExtField splice :: HsSplice GhcPs
splice -> HsSplice GhcPs -> R ()
p_hsSplice HsSplice GhcPs
splice
  HsProc NoExtField p :: LPat GhcPs
p e :: LHsCmdTop GhcPs
e -> do
    Text -> R ()
txt "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
$ \x :: Pat GhcPs
x -> do
      R ()
breakpoint
      R () -> R ()
inci (Pat GhcPs -> R ()
p_pat Pat GhcPs
x)
      R ()
breakpoint
    Text -> R ()
txt "->"
    Placement -> R () -> R ()
placeHanging (HsCmdTop GhcPs -> Placement
cmdTopPlacement (LHsCmdTop GhcPs -> SrcSpanLess (LHsCmdTop GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsCmdTop GhcPs
e)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      LHsCmdTop GhcPs -> (HsCmdTop GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
e HsCmdTop GhcPs -> R ()
p_hsCmdTop
  HsStatic _ e :: LHsExpr GhcPs
e -> do
    Text -> R ()
txt "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 "HsTick"
  HsBinTick {} -> String -> R ()
forall a. String -> a
notImplemented "HsBinTick"
  HsTickPragma {} -> String -> R ()
forall a. String -> a
notImplemented "HsTickPragma"
  HsWrap {} -> String -> R ()
forall a. String -> a
notImplemented "HsWrap"
  XExpr x :: XXExpr GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXExpr GhcPs
x

p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PSB {..} = do
  let rhs :: R ()
rhs = do
        R ()
space
        case HsPatSynDir GhcPs
psb_dir of
          Unidirectional -> do
            Text -> R ()
txt "<-"
            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
          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 mgroup :: MatchGroup GhcPs (LHsExpr GhcPs)
mgroup -> do
            Text -> R ()
txt "<-"
            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 "where"
            R ()
breakpoint
            R () -> R ()
inci (MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup (Located RdrName -> MatchGroupStyle
Function Located RdrName
Located (IdP GhcPs)
psb_id) MatchGroup GhcPs (LHsExpr GhcPs)
mgroup)
  Text -> R ()
txt "pattern"
  case HsPatSynDetails (Located (IdP GhcPs))
psb_args of
    PrefixCon xs :: [Located (IdP GhcPs)]
xs -> do
      R ()
space
      Located RdrName -> R ()
p_rdrName Located RdrName
Located (IdP GhcPs)
psb_id
      R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        [SrcSpan] -> R () -> R ()
switchLayout (Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located RdrName -> SrcSpan) -> [Located RdrName] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located RdrName]
[Located (IdP GhcPs)]
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 RdrName]
[Located (IdP GhcPs)]
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 RdrName]
[Located (IdP GhcPs)]
xs)
        R ()
rhs
    RecCon xs :: [RecordPatSynField (Located (IdP GhcPs))]
xs -> do
      R ()
space
      Located RdrName -> R ()
p_rdrName Located RdrName
Located (IdP GhcPs)
psb_id
      R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        [SrcSpan] -> R () -> R ()
switchLayout (Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located RdrName -> SrcSpan)
-> (RecordPatSynField (Located RdrName) -> Located RdrName)
-> RecordPatSynField (Located RdrName)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField (Located RdrName) -> Located RdrName
forall a. RecordPatSynField a -> a
recordPatSynPatVar (RecordPatSynField (Located RdrName) -> SrcSpan)
-> [RecordPatSynField (Located RdrName)] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RecordPatSynField (Located RdrName)]
[RecordPatSynField (Located (IdP GhcPs))]
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 RdrName)]
[RecordPatSynField (Located (IdP GhcPs))]
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 RdrName)]
[RecordPatSynField (Located (IdP GhcPs))]
xs
        R ()
rhs
    InfixCon l :: Located (IdP GhcPs)
l r :: Located (IdP GhcPs)
r -> do
      [SrcSpan] -> R () -> R ()
switchLayout [Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located RdrName
Located (IdP GhcPs)
l, Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located RdrName
Located (IdP GhcPs)
r] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        R ()
space
        Located RdrName -> R ()
p_rdrName Located RdrName
Located (IdP GhcPs)
l
        R ()
breakpoint
        R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          Located RdrName -> R ()
p_rdrName Located RdrName
Located (IdP GhcPs)
psb_id
          R ()
space
          Located RdrName -> R ()
p_rdrName Located RdrName
Located (IdP GhcPs)
r
      R () -> R ()
inci R ()
rhs
p_patSynBind (XPatSynBind x :: XXPatSynBind GhcPs GhcPs
x) = NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXPatSynBind GhcPs GhcPs
x

p_case ::
  Data body =>
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (body -> R ()) ->
  -- | Expression
  LHsExpr GhcPs ->
  -- | Match group
  MatchGroup GhcPs (Located body) ->
  R ()
p_case :: (body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (Located body)
-> R ()
p_case placer :: body -> Placement
placer render :: body -> R ()
render e :: LHsExpr GhcPs
e mgroup :: MatchGroup GhcPs (Located body)
mgroup = do
  Text -> R ()
txt "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 "of"
  R ()
breakpoint
  R () -> R ()
inci ((body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
Case MatchGroup GhcPs (Located body)
mgroup)

p_if ::
  Data body =>
  -- | Placer
  (body -> Placement) ->
  -- | Render
  (body -> R ()) ->
  -- | If
  LHsExpr GhcPs ->
  -- | Then
  Located body ->
  -- | Else
  Located body ->
  R ()
p_if :: (body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> Located body
-> Located body
-> R ()
p_if placer :: body -> Placement
placer render :: body -> R ()
render if' :: LHsExpr GhcPs
if' then' :: Located body
then' else' :: Located body
else' = do
  Text -> R ()
txt "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 "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
$ \x :: body
x ->
      Placement -> R () -> R ()
placeHanging (body -> Placement
placer body
x) (body -> R ()
render body
x)
    R ()
breakpoint
    Text -> R ()
txt "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
$ \x :: 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 render :: body -> R ()
render localBinds :: LHsLocalBinds GhcPs
localBinds e :: Located body
e = R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
  Text -> R ()
txt "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 -> R ()
txt "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 NoExtField -> Text -> R ()
txt "_"
  VarPat NoExtField name :: Located (IdP GhcPs)
name -> Located RdrName -> R ()
p_rdrName Located RdrName
Located (IdP GhcPs)
name
  LazyPat NoExtField pat :: LPat GhcPs
pat -> do
    Text -> R ()
txt "~"
    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 NoExtField name :: Located (IdP GhcPs)
name pat :: LPat GhcPs
pat -> do
    Located RdrName -> R ()
p_rdrName Located RdrName
Located (IdP GhcPs)
name
    Text -> R ()
txt "@"
    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 NoExtField pat :: 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 NoExtField pat :: LPat GhcPs
pat -> do
    Text -> R ()
txt "!"
    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 NoExtField pats :: [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 NoExtField pats :: [LPat GhcPs]
pats boxing :: Boxity
boxing -> do
    let parens' :: R () -> R ()
parens' =
          case Boxity
boxing of
            Boxed -> BracketStyle -> R () -> R ()
parens BracketStyle
S
            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 NoExtField pat :: LPat GhcPs
pat tag :: Int
tag arity :: Int
arity ->
    BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum BracketStyle
S Int
tag Int
arity (Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat)
  ConPatIn pat :: Located (IdP GhcPs)
pat details :: HsConPatDetails GhcPs
details ->
    case HsConPatDetails GhcPs
details of
      PrefixCon xs :: [LPat GhcPs]
xs -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        Located RdrName -> R ()
p_rdrName Located RdrName
Located (IdP GhcPs)
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 fields :: [LHsRecField GhcPs (LPat GhcPs)]
fields dotdot :: Maybe (Located Int)
dotdot) -> do
        Located RdrName -> R ()
p_rdrName Located RdrName
Located (IdP GhcPs)
pat
        R ()
breakpoint
        let f :: Maybe
  (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
-> R ()
f = \case
              Nothing -> Text -> R ()
txt ".."
              Just x :: 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
            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 _ n :: 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 l :: LPat GhcPs
l r :: LPat GhcPs
r -> do
        [SrcSpan] -> R () -> R ()
switchLayout [Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LPat GhcPs
Located (Pat GhcPs)
l, Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LPat GhcPs
Located (Pat GhcPs)
r] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
          Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
l Pat GhcPs -> R ()
p_pat
          R ()
breakpoint
          R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
            Located RdrName -> R ()
p_rdrName Located RdrName
Located (IdP GhcPs)
pat
            R ()
space
            Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
r Pat GhcPs -> R ()
p_pat
  ConPatOut {} -> String -> R ()
forall a. String -> a
notImplemented "ConPatOut" -- presumably created by renamer?
  ViewPat NoExtField expr :: LHsExpr GhcPs
expr pat :: 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 "->"
    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 NoExtField splice :: HsSplice GhcPs
splice -> HsSplice GhcPs -> R ()
p_hsSplice HsSplice GhcPs
splice
  LitPat NoExtField p :: HsLit GhcPs
p -> HsLit GhcPs -> R ()
forall a. Outputable a => a -> R ()
atom HsLit GhcPs
p
  NPat NoExtField v :: Located (HsOverLit GhcPs)
v _ _ -> 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 NoExtField n :: Located (IdP GhcPs)
n k :: Located (HsOverLit GhcPs)
k _ _ _ -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    Located RdrName -> R ()
p_rdrName Located RdrName
Located (IdP GhcPs)
n
    R ()
breakpoint
    R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> R ()
txt "+"
      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 NoExtField pat :: LPat GhcPs
pat hswc :: HsWildCardBndrs
  (NoGhcTc GhcPs)
  (HsImplicitBndrs (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs)))
hswc -> do
    Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
    LHsSigWcType GhcPs -> R ()
p_typeAscription LHsSigWcType GhcPs
HsWildCardBndrs
  (NoGhcTc GhcPs)
  (HsImplicitBndrs (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs)))
hswc
  CoPat {} -> String -> R ()
forall a. String -> a
notImplemented "CoPat" -- apparently created at some later stage
  XPat x :: XXPat GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXPat GhcPs
x

p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
p_pat_hsRecField HsRecField {..} = do
  Located (FieldOcc GhcPs) -> (FieldOcc GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located (FieldOcc GhcPs)
hsRecFieldLbl ((FieldOcc GhcPs -> R ()) -> R ())
-> (FieldOcc GhcPs -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \x :: 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 s :: BracketStyle
s tag :: Int
tag arity :: Int
arity m :: R ()
m = do
  let before :: Int
before = Int
tag Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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
- 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 x :: Maybe (R ())
x =
        case Maybe (R ())
x :: Maybe (R ()) of
          Nothing ->
            R ()
space
          Just m' :: 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 "|") Maybe (R ()) -> R ()
f [Maybe (R ())]
args

p_hsSplice :: HsSplice GhcPs -> R ()
p_hsSplice :: HsSplice GhcPs -> R ()
p_hsSplice = \case
  HsTypedSplice NoExtField deco :: SpliceDecoration
deco _ expr :: LHsExpr GhcPs
expr -> Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
True LHsExpr GhcPs
expr SpliceDecoration
deco
  HsUntypedSplice NoExtField deco :: SpliceDecoration
deco _ expr :: LHsExpr GhcPs
expr -> Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
False LHsExpr GhcPs
expr SpliceDecoration
deco
  HsQuasiQuote NoExtField _ quoterName :: IdP GhcPs
quoterName srcSpan :: SrcSpan
srcSpan str :: FastString
str -> do
    Text -> R ()
txt "["
    Located RdrName -> R ()
p_rdrName (SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcSpan RdrName
IdP GhcPs
quoterName)
    Text -> R ()
txt "|"
    -- 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 "|]"
  HsSpliced {} -> String -> R ()
forall a. String -> a
notImplemented "HsSpliced"
  HsSplicedT {} -> String -> R ()
forall a. String -> a
notImplemented "HsSplicedT"
  XSplice x :: XXSplice GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXSplice GhcPs
x

p_hsSpliceTH ::
  -- | Typed splice?
  Bool ->
  -- | Splice expression
  LHsExpr GhcPs ->
  -- | Splice decoration
  SpliceDecoration ->
  R ()
p_hsSpliceTH :: Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH isTyped :: Bool
isTyped expr :: LHsExpr GhcPs
expr = \case
  HasParens -> do
    Text -> R ()
txt Text
decoSymbol
    BracketStyle -> R () -> R ()
parens BracketStyle
N (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr (R () -> R ()
sitcc (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr))
  HasDollar -> do
    Text -> R ()
txt Text
decoSymbol
    LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr (R () -> R ()
sitcc (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
  NoParens ->
    LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr (R () -> R ()
sitcc (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
  where
    decoSymbol :: Text
decoSymbol = if Bool
isTyped then "$$" else "$"

p_hsBracket :: HsBracket GhcPs -> R ()
p_hsBracket :: HsBracket GhcPs -> R ()
p_hsBracket = \case
  ExpBr NoExtField expr :: LHsExpr GhcPs
expr -> do
    [AnnKeywordId]
anns <- R [AnnKeywordId]
getEnclosingAnns
    let name :: Text
name = case [AnnKeywordId]
anns of
          AnnOpenEQ : _ -> ""
          _ -> "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 NoExtField pat :: 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 "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 NoExtField decls :: [LHsDecl GhcPs]
decls -> Text -> R () -> R ()
quote "d" (FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDecls FamilyStyle
Free [LHsDecl GhcPs]
decls)
  DecBrG NoExtField _ -> String -> R ()
forall a. String -> a
notImplemented "DecBrG" -- result of renamer
  TypBr NoExtField ty :: LHsType GhcPs
ty -> Text -> R () -> R ()
quote "t" (LHsType GhcPs -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsType GhcPs
ty HsType GhcPs -> R ()
p_hsType)
  VarBr NoExtField isSingleQuote :: Bool
isSingleQuote name :: IdP GhcPs
name -> do
    Text -> R ()
txt (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool "''" "'" 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
            (\i :: 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 RdrName
IdP GhcPs
name))
            Bool -> Bool -> Bool
&& Bool -> Bool
not (RdrName -> Bool
doesNotNeedExtraParens RdrName
IdP GhcPs
name)
        wrapper :: R () -> R ()
wrapper = if Bool
isOperator then BracketStyle -> R () -> R ()
parens BracketStyle
N else R () -> R ()
forall a. a -> a
id
    R () -> R ()
wrapper (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> R ()
p_rdrName (SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc IdP GhcPs
SrcSpanLess (Located RdrName)
name)
  TExpBr NoExtField expr :: LHsExpr GhcPs
expr -> do
    Text -> R ()
txt "[||"
    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 "||]"
  XBracket x :: XXBracket GhcPs
x -> NoExtCon -> R ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXBracket GhcPs
x
  where
    quote :: Text -> R () -> R ()
    quote :: Text -> R () -> R ()
quote name :: Text
name body :: R ()
body = do
      Text -> R ()
txt "["
      Text -> R ()
txt Text
name
      Text -> R ()
txt "|"
      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 "|]"

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

p_stringLit :: String -> R ()
p_stringLit :: String -> R ()
p_stringLit src :: 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 "" = []
    splitGaps s :: String
s =
      let -- A backslash and a whitespace starts a "gap"
          p :: (Maybe Char, Char, Maybe Char) -> Bool
p (Just '\\', _, _) = Bool
True
          p (_, '\\', Just c :: Char
c) | Char -> Bool
ghcSpace Char
c = Bool
False
          p _ = 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
            (l :: [(Maybe Char, Char, Maybe Char)]
l, r :: [(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 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 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 c :: Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\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 (x :: String
x : y :: String
y : xs :: [String]
xs) = (String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\\") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
backslashes (('\\' Char -> ShowS
forall a. a -> [a] -> [a]
: String
y) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs)
    backslashes xs :: [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 xs :: [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 (\((p :: Maybe a
p, x :: a
x), n :: Maybe a
n) -> (Maybe a
p, a
x, Maybe a
n)) [((Maybe a, a), Maybe a)]
z
    orig :: (a, b, c) -> b
orig (_, x :: b
x, _) = 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
  SingleLine -> R () -> R ()
useBraces
  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 [] (y :: a
y : ys :: [a]
ys) = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys
liftAppend (x :: a
x : xs :: [a]
xs) [] = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
liftAppend (x :: a
x : xs :: [a]
xs) (y :: a
y : ys :: [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 NoExtField guards :: [GuardLStmt GhcPs]
guards body :: Located body
body) =
  NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ Located body -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located body
body SrcSpan -> [SrcSpan] -> NonEmpty SrcSpan
forall a. a -> [a] -> NonEmpty a
:| (GuardLStmt GhcPs -> SrcSpan) -> [GuardLStmt GhcPs] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GuardLStmt GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc [GuardLStmt GhcPs]
guards
getGRHSSpan (XGRHS x :: XXGRHS GhcPs (Located body)
x) = NoExtCon -> SrcSpan
forall a. NoExtCon -> a
noExtCon NoExtCon
XXGRHS GhcPs (Located body)
x

-- | Place a thing that may have a hanging form. This function handles how
-- to separate it from preceding expressions and whether to bump indentation
-- depending on what sort of expression we have.
placeHanging :: Placement -> R () -> R ()
placeHanging :: Placement -> R () -> R ()
placeHanging placement :: Placement
placement m :: R ()
m =
  case Placement
placement of
    Hanging -> do
      R ()
space
      R ()
m
    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 placer :: body -> Placement
placer [L _ (GRHS NoExtField _ (L _ x :: body
x))] = body -> Placement
placer body
x
blockPlacement _ _ = Placement
Normal

-- | Check if given command has a hanging form.
cmdPlacement :: HsCmd GhcPs -> Placement
cmdPlacement :: HsCmd GhcPs -> Placement
cmdPlacement = \case
  HsCmdLam NoExtField _ -> Placement
Hanging
  HsCmdCase NoExtField _ _ -> Placement
Hanging
  HsCmdDo NoExtField _ -> Placement
Hanging
  _ -> Placement
Normal

cmdTopPlacement :: HsCmdTop GhcPs -> Placement
cmdTopPlacement :: HsCmdTop GhcPs -> Placement
cmdTopPlacement = \case
  HsCmdTop NoExtField (L _ x :: HsCmd GhcPs
x) -> HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs
x
  XCmdTop x :: XXCmdTop GhcPs
x -> NoExtCon -> Placement
forall a. NoExtCon -> a
noExtCon NoExtCon
XXCmdTop GhcPs
x

-- | Check if given expression has a hanging form.
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement = \case
  -- Only hang lambdas with single line parameter lists
  HsLam NoExtField mg :: MatchGroup GhcPs (LHsExpr GhcPs)
mg -> case MatchGroup GhcPs (LHsExpr GhcPs)
mg of
    MG _ (L _ [L _ (Match NoExtField _ (x :: LPat GhcPs
x : xs :: [LPat GhcPs]
xs) _)]) _
      | SrcSpan -> Bool
isOneLineSpan (NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ (Located (Pat GhcPs) -> SrcSpan)
-> NonEmpty (Located (Pat GhcPs)) -> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LPat GhcPs
Located (Pat GhcPs)
x Located (Pat GhcPs)
-> [Located (Pat GhcPs)] -> NonEmpty (Located (Pat GhcPs))
forall a. a -> [a] -> NonEmpty a
:| [LPat GhcPs]
[Located (Pat GhcPs)]
xs)) ->
        Placement
Hanging
    _ -> Placement
Normal
  HsLamCase NoExtField _ -> Placement
Hanging
  HsCase NoExtField _ _ -> Placement
Hanging
  HsDo NoExtField DoExpr _ -> Placement
Hanging
  HsDo NoExtField MDoExpr _ -> Placement
Hanging
  OpApp NoExtField _ op :: LHsExpr GhcPs
op y :: 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 a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) LHsExpr GhcPs
op of
      Just "$" -> HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
y)
      _ -> Placement
Normal
  HsApp NoExtField _ y :: LHsExpr GhcPs
y -> HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
y)
  HsProc NoExtField p :: LPat GhcPs
p _ ->
    -- Indentation breaks if pattern is longer than one line and left
    -- hanging. Consequently, only apply hanging when it is safe.
    if SrcSpan -> Bool
isOneLineSpan (Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LPat GhcPs
Located (Pat GhcPs)
p)
      then Placement
Hanging
      else Placement
Normal
  _ -> Placement
Normal

withGuards :: [LGRHS GhcPs (Located body)] -> Bool
withGuards :: [LGRHS GhcPs (Located body)] -> Bool
withGuards = (LGRHS GhcPs (Located body) -> Bool)
-> [LGRHS GhcPs (Located body)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GRHS GhcPs (Located body) -> Bool
forall body. GRHS GhcPs (Located body) -> Bool
checkOne (GRHS GhcPs (Located body) -> Bool)
-> (LGRHS GhcPs (Located body) -> GRHS GhcPs (Located body))
-> LGRHS GhcPs (Located body)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LGRHS GhcPs (Located body) -> GRHS GhcPs (Located body)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
  where
    checkOne :: GRHS GhcPs (Located body) -> Bool
    checkOne :: GRHS GhcPs (Located body) -> Bool
checkOne (GRHS NoExtField [] _) = Bool
False
    checkOne _ = Bool
True

exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree (L _ (OpApp NoExtField x :: LHsExpr GhcPs
x op :: LHsExpr GhcPs
op y :: 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 n :: 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 NoExtField (L _ a :: IdP GhcPs
a) -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just RdrName
IdP GhcPs
a
  _ -> 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 s :: BracketStyle
s (OpNode x :: 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 s :: BracketStyle
s (OpBranch x :: OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x op :: LHsExpr GhcPs
op y :: OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y) = do
  -- If the beginning of the first argument and the second argument are on
  -- the same line, and the second argument has a hanging form, use hanging
  -- placement.
  let placement :: Placement
placement =
        if SrcSpan -> Bool
isOneLineSpan
          (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (SrcSpan -> SrcLoc
srcSpanStart (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x)) (SrcSpan -> SrcLoc
srcSpanStart (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y)))
          then case OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y of
            OpNode (L _ n :: HsExpr GhcPs
n) -> HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs
n
            _ -> Placement
Normal
          else Placement
Normal
      -- Distinguish holes used in infix notation.
      -- eg. '1 _foo 2' and '1 `_foo` 2'
      opWrapper :: R () -> R ()
opWrapper = case LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
op of
        HsUnboundVar NoExtField _ -> R () -> R ()
backticks
        _ -> R () -> R ()
forall a. a -> a
id
  Layout
layout <- R Layout
getLayout
  let ub :: R () -> R ()
ub = case Layout
layout of
        SingleLine -> R () -> R ()
useBraces
        MultiLine -> case Placement
placement of
          Hanging -> R () -> R ()
useBraces
          Normal -> R () -> R ()
dontUseBraces
      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 a. HasSrcSpan a => a -> SrcSpanLess a
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 "$"
      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 ":"
      gotRecordDot :: Bool
gotRecordDot = HsExpr GhcPs -> SrcSpan -> Bool
isRecordDot (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
op) (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y)
      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 a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr GhcPs
op) of
        (RealSrcSpan treeSpan :: RealSrcSpan
treeSpan, RealSrcSpan opSpan :: RealSrcSpan
opSpan) ->
          RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
treeSpan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
opSpan
        _ -> Bool
False
      isDoBlock :: OpTree (GenLocated l (HsExpr p)) op -> Bool
isDoBlock = \case
        OpNode (L _ HsDo {}) -> Bool
True
        _ -> Bool
False
  Bool
useRecordDot' <- R Bool
useRecordDot
  if
      | Bool
gotColon -> do
        R ()
lhs
        R ()
space
        R ()
p_op
        case Placement
placement of
          Hanging -> do
            R ()
space
            R ()
p_y
          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

-- | 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 op :: HsExpr GhcPs
op (RealSrcSpan ySpan :: RealSrcSpan
ySpan) = case HsExpr GhcPs
op of
  HsVar NoExtField (L (RealSrcSpan opSpan :: RealSrcSpan
opSpan) opName :: IdP GhcPs
opName) ->
    (RdrName -> String
getOpNameStr RdrName
IdP GhcPs
opName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ".") Bool -> Bool -> Bool
&& (RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
opSpan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
ySpan)
  _ -> Bool
False
isRecordDot _ _ = 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
    Nothing -> [AnnKeywordId] -> R [AnnKeywordId]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just e' :: RealSrcSpan
e' -> SrcSpan -> R [AnnKeywordId]
getAnns (RealSrcSpan -> SrcSpan
RealSrcSpan RealSrcSpan
e')