{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Ormolu.Printer.Meat.Declaration.Value
( p_valDecl,
p_pat,
p_hsExpr,
p_hsSplice,
p_stringLit,
)
where
import Control.Monad
import Data.Bool (bool)
import Data.Char (isPunctuation, isSymbol)
import Data.Data hiding (Infix, Prefix)
import Data.Function (on)
import Data.Functor ((<&>))
import Data.Generics.Schemes (everything)
import Data.List (intersperse, sortBy)
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Data.Bag (bagToList)
import GHC.Hs.Binds
import GHC.Hs.Expr
import GHC.Hs.Extension
import GHC.Hs.Lit
import GHC.Hs.Pat
import GHC.Hs.Type
import GHC.LanguageExtensions.Type (Extension (NegativeLiterals))
import GHC.Parser.Annotation
import GHC.Parser.CharClass (is_space)
import GHC.Types.Basic
import GHC.Types.Name.Occurrence (occNameString)
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
import Ormolu.Printer.Combinators
import Ormolu.Printer.Internal
import Ormolu.Printer.Meat.Common
import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration
import Ormolu.Printer.Meat.Declaration.Signature
import Ormolu.Printer.Meat.Type
import Ormolu.Printer.Operators
import Ormolu.Utils
data MatchGroupStyle
= Function (Located RdrName)
| PatternBind
| Case
| Lambda
| LambdaCase
data GroupStyle
= EqualSign
| RightArrow
data Placement
=
Normal
|
Hanging
deriving (Placement -> Placement -> Bool
(Placement -> Placement -> Bool)
-> (Placement -> Placement -> Bool) -> Eq Placement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Placement -> Placement -> Bool
$c/= :: Placement -> Placement -> Bool
== :: Placement -> Placement -> Bool
$c== :: Placement -> Placement -> Bool
Eq, Int -> Placement -> ShowS
[Placement] -> ShowS
Placement -> String
(Int -> Placement -> ShowS)
-> (Placement -> String)
-> ([Placement] -> ShowS)
-> Show Placement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Placement] -> ShowS
$cshowList :: [Placement] -> ShowS
show :: Placement -> String
$cshow :: Placement -> String
showsPrec :: Int -> Placement -> ShowS
$cshowsPrec :: Int -> Placement -> ShowS
Show)
p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
p_valDecl = \case
FunBind XFunBind GhcPs GhcPs
NoExtField Located (IdP GhcPs)
funId MatchGroup GhcPs (LHsExpr GhcPs)
funMatches [Tickish Id]
_ -> Located RdrName -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_funBind Located (IdP GhcPs)
Located RdrName
funId MatchGroup GhcPs (LHsExpr GhcPs)
funMatches
PatBind XPatBind GhcPs GhcPs
NoExtField LPat GhcPs
pat GRHSs GhcPs (LHsExpr GhcPs)
grhss ([Tickish Id], [[Tickish Id]])
_ -> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LHsExpr GhcPs)
-> R ()
p_match MatchGroupStyle
PatternBind Bool
False SrcStrictness
NoSrcStrict [LPat GhcPs
pat] GRHSs GhcPs (LHsExpr GhcPs)
grhss
VarBind {} -> String -> R ()
forall a. String -> a
notImplemented String
"VarBinds"
AbsBinds {} -> String -> R ()
forall a. String -> a
notImplemented String
"AbsBinds"
PatSynBind XPatSynBind GhcPs GhcPs
NoExtField PatSynBind GhcPs GhcPs
psb -> PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PatSynBind GhcPs GhcPs
psb
p_funBind ::
Located RdrName ->
MatchGroup GhcPs (LHsExpr GhcPs) ->
R ()
p_funBind :: Located RdrName -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_funBind Located RdrName
name = MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup (Located RdrName -> MatchGroupStyle
Function Located RdrName
name)
p_matchGroup ::
MatchGroupStyle ->
MatchGroup GhcPs (LHsExpr GhcPs) ->
R ()
p_matchGroup :: MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup = (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
p_matchGroup' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_matchGroup' ::
Data body =>
(body -> Placement) ->
(body -> R ()) ->
MatchGroupStyle ->
MatchGroup GhcPs (Located body) ->
R ()
p_matchGroup' :: (body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
style MG {XMG GhcPs (Located body)
Origin
Located [LMatch GhcPs (Located body)]
mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_origin :: forall p body. MatchGroup p body -> Origin
mg_origin :: Origin
mg_alts :: Located [LMatch GhcPs (Located body)]
mg_ext :: XMG GhcPs (Located body)
..} = do
let ob :: R () -> R ()
ob = case MatchGroupStyle
style of
MatchGroupStyle
Case -> R () -> R ()
forall a. a -> a
id
MatchGroupStyle
LambdaCase -> R () -> R ()
forall a. a -> a
id
MatchGroupStyle
_ -> R () -> R ()
dontUseBraces
R () -> R ()
ub <- (R () -> R ()) -> (R () -> R ()) -> Bool -> R () -> R ()
forall a. a -> a -> Bool -> a
bool R () -> R ()
dontUseBraces R () -> R ()
useBraces (Bool -> R () -> R ()) -> R Bool -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Bool
canUseBraces
R () -> R ()
ob (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ (LMatch GhcPs (Located body) -> R ())
-> [LMatch GhcPs (Located body)] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((Match GhcPs (Located body) -> R ())
-> LMatch GhcPs (Located body) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (R () -> R ()
ub (R () -> R ())
-> (Match GhcPs (Located body) -> R ())
-> Match GhcPs (Located body)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs (Located body) -> R ()
p_Match)) (Located [LMatch GhcPs (Located body)]
-> [LMatch GhcPs (Located body)]
forall l e. GenLocated l e -> e
unLoc Located [LMatch GhcPs (Located body)]
mg_alts)
where
p_Match :: Match GhcPs (Located body) -> R ()
p_Match m :: Match GhcPs (Located body)
m@Match {[LPat GhcPs]
HsMatchContext (NoGhcTc GhcPs)
GRHSs GhcPs (Located body)
XCMatch GhcPs (Located body)
m_ext :: forall p body. Match p body -> XCMatch p body
m_ctxt :: forall p body. Match p body -> HsMatchContext (NoGhcTc p)
m_pats :: forall p body. Match p body -> [LPat p]
m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss :: GRHSs GhcPs (Located body)
m_pats :: [LPat GhcPs]
m_ctxt :: HsMatchContext (NoGhcTc GhcPs)
m_ext :: XCMatch GhcPs (Located body)
..} =
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (Located body)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (Located body)
-> R ()
p_match'
body -> Placement
placer
body -> R ()
render
(Match GhcPs (Located body) -> MatchGroupStyle -> MatchGroupStyle
forall body. Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle Match GhcPs (Located body)
m MatchGroupStyle
style)
(Match GhcPs (Located body) -> Bool
forall id body. Match id body -> Bool
isInfixMatch Match GhcPs (Located body)
m)
(Match GhcPs (Located body) -> SrcStrictness
forall id body. Match id body -> SrcStrictness
matchStrictness Match GhcPs (Located body)
m)
[LPat GhcPs]
m_pats
GRHSs GhcPs (Located body)
m_grhss
adjustMatchGroupStyle ::
Match GhcPs body ->
MatchGroupStyle ->
MatchGroupStyle
adjustMatchGroupStyle :: Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle Match GhcPs body
m = \case
Function Located RdrName
_ -> (Located RdrName -> MatchGroupStyle
Function (Located RdrName -> MatchGroupStyle)
-> (Match GhcPs body -> Located RdrName)
-> Match GhcPs body
-> MatchGroupStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsMatchContext GhcPs -> Located RdrName
forall p. HsMatchContext p -> LIdP p
mc_fun (HsMatchContext GhcPs -> Located RdrName)
-> (Match GhcPs body -> HsMatchContext GhcPs)
-> Match GhcPs body
-> Located RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs body -> HsMatchContext GhcPs
forall p body. Match p body -> HsMatchContext (NoGhcTc p)
m_ctxt) Match GhcPs body
m
MatchGroupStyle
style -> MatchGroupStyle
style
matchStrictness :: Match id body -> SrcStrictness
matchStrictness :: Match id body -> SrcStrictness
matchStrictness Match id body
match =
case Match id body -> HsMatchContext (NoGhcTc id)
forall p body. Match p body -> HsMatchContext (NoGhcTc p)
m_ctxt Match id body
match of
FunRhs {mc_strictness :: forall p. HsMatchContext p -> SrcStrictness
mc_strictness = SrcStrictness
s} -> SrcStrictness
s
HsMatchContext (NoGhcTc id)
_ -> SrcStrictness
NoSrcStrict
p_match ::
MatchGroupStyle ->
Bool ->
SrcStrictness ->
[LPat GhcPs] ->
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 =>
(body -> Placement) ->
(body -> R ()) ->
MatchGroupStyle ->
Bool ->
SrcStrictness ->
[LPat GhcPs] ->
GRHSs GhcPs (Located body) ->
R ()
p_match' :: (body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (Located body)
-> R ()
p_match' body -> Placement
placer body -> R ()
render MatchGroupStyle
style Bool
isInfix SrcStrictness
strictness [LPat GhcPs]
m_pats GRHSs {[LGRHS GhcPs (Located body)]
XCGRHSs GhcPs (Located body)
LHsLocalBinds GhcPs
grhssExt :: forall p body. GRHSs p body -> XCGRHSs p body
grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssLocalBinds :: forall p body. GRHSs p body -> LHsLocalBinds p
grhssLocalBinds :: LHsLocalBinds GhcPs
grhssGRHSs :: [LGRHS GhcPs (Located body)]
grhssExt :: XCGRHSs GhcPs (Located body)
..} = do
case SrcStrictness
strictness of
SrcStrictness
NoSrcStrict -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
SrcStrictness
SrcStrict -> Text -> R ()
txt Text
"!"
SrcStrictness
SrcLazy -> Text -> R ()
txt Text
"~"
Bool
indentBody <- case [Located (Pat GhcPs)] -> Maybe (NonEmpty (Located (Pat GhcPs)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
[Located (Pat GhcPs)]
m_pats of
Maybe (NonEmpty (Located (Pat GhcPs)))
Nothing ->
Bool
False Bool -> R () -> R Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ case MatchGroupStyle
style of
Function Located RdrName
name -> Located RdrName -> R ()
p_rdrName Located RdrName
name
MatchGroupStyle
_ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just NonEmpty (Located (Pat GhcPs))
ne_pats -> do
let combinedSpans :: SrcSpan
combinedSpans = case MatchGroupStyle
style of
Function Located RdrName
name -> SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (Located RdrName -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located RdrName
name) SrcSpan
patSpans
MatchGroupStyle
_ -> SrcSpan
patSpans
patSpans :: SrcSpan
patSpans = NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (Located (Pat GhcPs) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (Located (Pat GhcPs) -> SrcSpan)
-> NonEmpty (Located (Pat GhcPs)) -> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Located (Pat GhcPs))
ne_pats)
indentBody :: Bool
indentBody = Bool -> Bool
not (SrcSpan -> Bool
isOneLineSpan SrcSpan
combinedSpans)
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
combinedSpans] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
let stdCase :: R ()
stdCase = R ()
-> (Located (Pat GhcPs) -> R ()) -> [Located (Pat GhcPs)] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((Pat GhcPs -> R ()) -> Located (Pat GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[Located (Pat GhcPs)]
m_pats
case MatchGroupStyle
style of
Function Located RdrName
name ->
Bool -> Bool -> R () -> [R ()] -> R ()
p_infixDefHelper
Bool
isInfix
Bool
indentBody
(Located RdrName -> R ()
p_rdrName Located RdrName
name)
((Pat GhcPs -> R ()) -> Located (Pat GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Pat GhcPs -> R ()
p_pat (Located (Pat GhcPs) -> R ()) -> [Located (Pat GhcPs)] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs]
[Located (Pat GhcPs)]
m_pats)
MatchGroupStyle
PatternBind -> R ()
stdCase
MatchGroupStyle
Case -> R ()
stdCase
MatchGroupStyle
Lambda -> do
let needsSpace :: Bool
needsSpace = case Located (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc (NonEmpty (Located (Pat GhcPs)) -> Located (Pat GhcPs)
forall a. NonEmpty a -> a
NE.head NonEmpty (Located (Pat GhcPs))
ne_pats) of
LazyPat XLazyPat GhcPs
_ LPat GhcPs
_ -> Bool
True
BangPat XBangPat GhcPs
_ LPat GhcPs
_ -> Bool
True
SplicePat XSplicePat GhcPs
_ HsSplice GhcPs
_ -> Bool
True
Pat GhcPs
_ -> Bool
False
Text -> R ()
txt Text
"\\"
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsSpace R ()
space
R () -> R ()
sitcc R ()
stdCase
MatchGroupStyle
LambdaCase -> R ()
stdCase
Bool -> R Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
indentBody
let
endOfPats :: Maybe SrcSpan
endOfPats = case [Located (Pat GhcPs)] -> Maybe (NonEmpty (Located (Pat GhcPs)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
[Located (Pat GhcPs)]
m_pats of
Maybe (NonEmpty (Located (Pat GhcPs)))
Nothing -> case MatchGroupStyle
style of
Function Located RdrName
name -> SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (Located RdrName -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located RdrName
name)
MatchGroupStyle
_ -> Maybe SrcSpan
forall a. Maybe a
Nothing
Just NonEmpty (Located (Pat GhcPs))
pats -> (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (SrcSpan -> Maybe SrcSpan)
-> (NonEmpty (Located (Pat GhcPs)) -> SrcSpan)
-> NonEmpty (Located (Pat GhcPs))
-> Maybe SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Pat GhcPs) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (Located (Pat GhcPs) -> SrcSpan)
-> (NonEmpty (Located (Pat GhcPs)) -> Located (Pat GhcPs))
-> NonEmpty (Located (Pat GhcPs))
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Located (Pat GhcPs)) -> Located (Pat GhcPs)
forall a. NonEmpty a -> a
NE.last) NonEmpty (Located (Pat GhcPs))
pats
isCase :: MatchGroupStyle -> Bool
isCase = \case
MatchGroupStyle
Case -> Bool
True
MatchGroupStyle
LambdaCase -> Bool
True
MatchGroupStyle
_ -> Bool
False
hasGuards :: Bool
hasGuards = [LGRHS GhcPs (Located body)] -> Bool
forall body. [LGRHS GhcPs (Located body)] -> Bool
withGuards [LGRHS GhcPs (Located body)]
grhssGRHSs
grhssSpan :: SrcSpan
grhssSpan =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$
GRHS GhcPs (Located body) -> SrcSpan
forall body. GRHS GhcPs (Located body) -> SrcSpan
getGRHSSpan (GRHS GhcPs (Located body) -> SrcSpan)
-> (LGRHS GhcPs (Located body) -> GRHS GhcPs (Located body))
-> LGRHS GhcPs (Located body)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LGRHS GhcPs (Located body) -> GRHS GhcPs (Located body)
forall l e. GenLocated l e -> e
unLoc (LGRHS GhcPs (Located body) -> SrcSpan)
-> NonEmpty (LGRHS GhcPs (Located body)) -> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LGRHS GhcPs (Located body)]
-> NonEmpty (LGRHS GhcPs (Located body))
forall a. [a] -> NonEmpty a
NE.fromList [LGRHS GhcPs (Located body)]
grhssGRHSs
patGrhssSpan :: SrcSpan
patGrhssSpan =
SrcSpan -> (SrcSpan -> SrcSpan) -> Maybe SrcSpan -> SrcSpan
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
SrcSpan
grhssSpan
(SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
grhssSpan (SrcSpan -> SrcSpan) -> (SrcSpan -> SrcSpan) -> SrcSpan -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcLoc -> SrcSpan
srcLocSpan (SrcLoc -> SrcSpan) -> (SrcSpan -> SrcLoc) -> SrcSpan -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanEnd)
Maybe SrcSpan
endOfPats
placement :: Placement
placement =
case Maybe SrcSpan
endOfPats of
Maybe SrcSpan
Nothing -> (body -> Placement) -> [LGRHS GhcPs (Located body)] -> Placement
forall body.
(body -> Placement) -> [LGRHS GhcPs (Located body)] -> Placement
blockPlacement body -> Placement
placer [LGRHS GhcPs (Located body)]
grhssGRHSs
Just SrcSpan
spn ->
if SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn SrcSpan
grhssSpan
then (body -> Placement) -> [LGRHS GhcPs (Located body)] -> Placement
forall body.
(body -> Placement) -> [LGRHS GhcPs (Located body)] -> Placement
blockPlacement body -> Placement
placer [LGRHS GhcPs (Located body)]
grhssGRHSs
else Placement
Normal
p_body :: R ()
p_body = do
let groupStyle :: GroupStyle
groupStyle =
if MatchGroupStyle -> Bool
isCase MatchGroupStyle
style Bool -> Bool -> Bool
&& Bool
hasGuards
then GroupStyle
RightArrow
else GroupStyle
EqualSign
R ()
-> (LGRHS GhcPs (Located body) -> R ())
-> [LGRHS GhcPs (Located body)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline ((GRHS GhcPs (Located body) -> R ())
-> LGRHS GhcPs (Located body) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' ((body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (Located body)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (Located body)
-> R ()
p_grhs' body -> Placement
placer body -> R ()
render GroupStyle
groupStyle)) [LGRHS GhcPs (Located body)]
grhssGRHSs
p_where :: R ()
p_where = do
let whereIsEmpty :: Bool
whereIsEmpty = HsLocalBindsLR GhcPs GhcPs -> Bool
forall a b. HsLocalBindsLR a b -> Bool
eqEmptyLocalBinds (LHsLocalBinds GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall l e. GenLocated l e -> e
unLoc LHsLocalBinds GhcPs
grhssLocalBinds)
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HsLocalBindsLR GhcPs GhcPs -> Bool
forall a b. HsLocalBindsLR a b -> Bool
eqEmptyLocalBinds (LHsLocalBinds GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall l e. GenLocated l e -> e
unLoc LHsLocalBinds GhcPs
grhssLocalBinds)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
Text -> R ()
txt Text
"where"
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
whereIsEmpty R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsLocalBinds GhcPs -> (HsLocalBindsLR GhcPs GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsLocalBinds GhcPs
grhssLocalBinds HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds
Bool -> R () -> R ()
inciIf Bool
indentBody (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LGRHS GhcPs (Located body)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LGRHS GhcPs (Located body)]
grhssGRHSs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
case MatchGroupStyle
style of
Function Located RdrName
_ | Bool
hasGuards -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Function Located RdrName
_ -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
equals
MatchGroupStyle
PatternBind -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
equals
MatchGroupStyle
s | MatchGroupStyle -> Bool
isCase MatchGroupStyle
s Bool -> Bool -> Bool
&& Bool
hasGuards -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MatchGroupStyle
_ -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"->"
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
patGrhssSpan] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body
R () -> R ()
inci R ()
p_where
p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
p_grhs = (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> GroupStyle
-> GRHS GhcPs (LHsExpr GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (Located body)
-> R ()
p_grhs' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_grhs' ::
Data body =>
(body -> Placement) ->
(body -> R ()) ->
GroupStyle ->
GRHS GhcPs (Located body) ->
R ()
p_grhs' :: (body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (Located body)
-> R ()
p_grhs' body -> Placement
placer body -> R ()
render GroupStyle
style (GRHS XCGRHS GhcPs (Located body)
NoExtField [GuardLStmt GhcPs]
guards Located body
body) =
case [GuardLStmt GhcPs]
guards of
[] -> R ()
p_body
[GuardLStmt GhcPs]
xs -> do
Text -> R ()
txt Text
"|"
R ()
space
R () -> R ()
sitcc (R () -> (GuardLStmt GhcPs -> R ()) -> [GuardLStmt GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (GuardLStmt GhcPs -> R ()) -> GuardLStmt GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt GhcPs (LHsExpr GhcPs) -> R ()) -> GuardLStmt GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt) [GuardLStmt GhcPs]
xs)
R ()
space
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ case GroupStyle
style of
GroupStyle
EqualSign -> R ()
equals
GroupStyle
RightArrow -> Text -> R ()
txt Text
"->"
Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body
where
placement :: Placement
placement =
case Maybe SrcSpan
endOfGuards of
Maybe SrcSpan
Nothing -> body -> Placement
placer (Located body -> body
forall l e. GenLocated l e -> e
unLoc Located body
body)
Just SrcSpan
spn ->
if SrcSpan -> SrcSpan -> Bool
onTheSameLine SrcSpan
spn (Located body -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located body
body)
then body -> Placement
placer (Located body -> body
forall l e. GenLocated l e -> e
unLoc Located body
body)
else Placement
Normal
endOfGuards :: Maybe SrcSpan
endOfGuards =
case [GuardLStmt GhcPs] -> Maybe (NonEmpty (GuardLStmt GhcPs))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [GuardLStmt GhcPs]
guards of
Maybe (NonEmpty (GuardLStmt GhcPs))
Nothing -> Maybe SrcSpan
forall a. Maybe a
Nothing
Just NonEmpty (GuardLStmt GhcPs)
gs -> (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (SrcSpan -> Maybe SrcSpan)
-> (NonEmpty (GuardLStmt GhcPs) -> SrcSpan)
-> NonEmpty (GuardLStmt GhcPs)
-> Maybe SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (GuardLStmt GhcPs -> SrcSpan)
-> (NonEmpty (GuardLStmt GhcPs) -> GuardLStmt GhcPs)
-> NonEmpty (GuardLStmt GhcPs)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (GuardLStmt GhcPs) -> GuardLStmt GhcPs
forall a. NonEmpty a -> a
NE.last) NonEmpty (GuardLStmt GhcPs)
gs
p_body :: R ()
p_body = Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located body
body body -> R ()
render
p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd = BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
N
p_hsCmd' :: BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' :: BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
s = \case
HsCmdArrApp XCmdArrApp GhcPs
NoExtField LHsExpr GhcPs
body LHsExpr GhcPs
input HsArrAppType
arrType Bool
rightToLeft -> do
let (LHsExpr GhcPs
l, LHsExpr GhcPs
r) = if Bool
rightToLeft then (LHsExpr GhcPs
body, LHsExpr GhcPs
input) else (LHsExpr GhcPs
input, LHsExpr GhcPs
body)
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
l HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
case (HsArrAppType
arrType, Bool
rightToLeft) of
(HsArrAppType
HsFirstOrderApp, Bool
True) -> Text -> R ()
txt Text
"-<"
(HsArrAppType
HsHigherOrderApp, Bool
True) -> Text -> R ()
txt Text
"-<<"
(HsArrAppType
HsFirstOrderApp, Bool
False) -> Text -> R ()
txt Text
">-"
(HsArrAppType
HsHigherOrderApp, Bool
False) -> Text -> R ()
txt Text
">>-"
Placement -> R () -> R ()
placeHanging (HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
input)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
r HsExpr GhcPs -> R ()
p_hsExpr
HsCmdArrForm XCmdArrForm GhcPs
NoExtField LHsExpr GhcPs
form LexicalFixity
Prefix Maybe Fixity
_ [LHsCmdTop GhcPs]
cmds -> BracketStyle -> R () -> R ()
banana BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
form HsExpr GhcPs -> R ()
p_hsExpr
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LHsCmdTop GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsCmdTop GhcPs]
cmds) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
R () -> R ()
inci ([R ()] -> R ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (R () -> [R ()] -> [R ()]
forall a. a -> [a] -> [a]
intersperse R ()
breakpoint ((HsCmdTop GhcPs -> R ()) -> LHsCmdTop GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsCmdTop GhcPs -> R ()
p_hsCmdTop (LHsCmdTop GhcPs -> R ()) -> [LHsCmdTop GhcPs] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsCmdTop GhcPs]
cmds)))
HsCmdArrForm XCmdArrForm GhcPs
NoExtField LHsExpr GhcPs
form LexicalFixity
Infix Maybe Fixity
_ [LHsCmdTop GhcPs
left, LHsCmdTop GhcPs
right] -> do
LHsCmdTop GhcPs -> (HsCmdTop GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
left HsCmdTop GhcPs -> R ()
p_hsCmdTop
case LHsCmdTop GhcPs -> HsCmdTop GhcPs
forall l e. GenLocated l e -> e
unLoc LHsCmdTop GhcPs
left of
HsCmdTop XCmdTop GhcPs
NoExtField (L SrcSpan
_ HsCmdPar {}) -> R ()
space
HsCmdTop GhcPs
_ -> R ()
breakpoint
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 -> HsCmdTop GhcPs
forall l e. GenLocated l e -> e
unLoc LHsCmdTop GhcPs
right)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
LHsCmdTop GhcPs -> (HsCmdTop GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
right HsCmdTop GhcPs -> R ()
p_hsCmdTop
HsCmdArrForm XCmdArrForm GhcPs
NoExtField LHsExpr GhcPs
_ LexicalFixity
Infix Maybe Fixity
_ [LHsCmdTop GhcPs]
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsCmdArrForm"
HsCmdApp XCmdApp GhcPs
NoExtField GenLocated SrcSpan (HsCmd GhcPs)
cmd LHsExpr GhcPs
expr -> do
GenLocated SrcSpan (HsCmd GhcPs) -> (HsCmd GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located GenLocated SrcSpan (HsCmd GhcPs)
cmd (BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
s)
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr HsExpr GhcPs -> R ()
p_hsExpr
HsCmdLam XCmdLam GhcPs
NoExtField MatchGroup GhcPs (GenLocated SrcSpan (HsCmd GhcPs))
mgroup -> (HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (GenLocated SrcSpan (HsCmd 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 (GenLocated SrcSpan (HsCmd GhcPs))
mgroup
HsCmdPar XCmdPar GhcPs
NoExtField GenLocated SrcSpan (HsCmd GhcPs)
c -> BracketStyle -> R () -> R ()
parens BracketStyle
N (GenLocated SrcSpan (HsCmd GhcPs) -> (HsCmd GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located GenLocated SrcSpan (HsCmd GhcPs)
c HsCmd GhcPs -> R ()
p_hsCmd)
HsCmdCase XCmdCase GhcPs
NoExtField LHsExpr GhcPs
e MatchGroup GhcPs (GenLocated SrcSpan (HsCmd GhcPs))
mgroup ->
(HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (GenLocated SrcSpan (HsCmd 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 (GenLocated SrcSpan (HsCmd GhcPs))
mgroup
HsCmdLamCase XCmdLamCase GhcPs
NoExtField MatchGroup GhcPs (GenLocated SrcSpan (HsCmd GhcPs))
mgroup ->
(HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> MatchGroup GhcPs (GenLocated SrcSpan (HsCmd GhcPs))
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> MatchGroup GhcPs (Located body) -> R ()
p_lamcase HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd MatchGroup GhcPs (GenLocated SrcSpan (HsCmd GhcPs))
mgroup
HsCmdIf XCmdIf GhcPs
NoExtField SyntaxExpr GhcPs
_ LHsExpr GhcPs
if' GenLocated SrcSpan (HsCmd GhcPs)
then' GenLocated SrcSpan (HsCmd GhcPs)
else' ->
(HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> LHsExpr GhcPs
-> GenLocated SrcSpan (HsCmd GhcPs)
-> GenLocated SrcSpan (HsCmd 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' GenLocated SrcSpan (HsCmd GhcPs)
then' GenLocated SrcSpan (HsCmd GhcPs)
else'
HsCmdLet XCmdLet GhcPs
NoExtField LHsLocalBinds GhcPs
localBinds GenLocated SrcSpan (HsCmd GhcPs)
c ->
(HsCmd GhcPs -> R ())
-> LHsLocalBinds GhcPs -> GenLocated SrcSpan (HsCmd GhcPs) -> R ()
forall body.
Data body =>
(body -> R ()) -> LHsLocalBinds GhcPs -> Located body -> R ()
p_let HsCmd GhcPs -> R ()
p_hsCmd LHsLocalBinds GhcPs
localBinds GenLocated SrcSpan (HsCmd GhcPs)
c
HsCmdDo XCmdDo GhcPs
NoExtField Located [CmdLStmt GhcPs]
es -> do
Text -> R ()
txt Text
"do"
R ()
newline
R () -> R ()
inci (R () -> R ())
-> (([CmdLStmt GhcPs] -> R ()) -> R ())
-> ([CmdLStmt GhcPs] -> R ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located [CmdLStmt GhcPs] -> ([CmdLStmt GhcPs] -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located [CmdLStmt GhcPs]
es (([CmdLStmt GhcPs] -> R ()) -> R ())
-> ([CmdLStmt GhcPs] -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> R ()
sitcc (R () -> R ())
-> ([CmdLStmt GhcPs] -> R ()) -> [CmdLStmt GhcPs] -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> (CmdLStmt GhcPs -> R ()) -> [CmdLStmt GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline (R () -> R ()
sitcc (R () -> R ())
-> (CmdLStmt GhcPs -> R ()) -> CmdLStmt GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt GhcPs (GenLocated SrcSpan (HsCmd GhcPs)) -> R ())
-> CmdLStmt GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
withSpacing ((HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> Stmt GhcPs (GenLocated SrcSpan (HsCmd GhcPs))
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
p_stmt' HsCmd GhcPs -> Placement
cmdPlacement (BracketStyle -> HsCmd GhcPs -> R ()
p_hsCmd' BracketStyle
S)))
p_hsCmdTop :: HsCmdTop GhcPs -> R ()
p_hsCmdTop :: HsCmdTop GhcPs -> R ()
p_hsCmdTop (HsCmdTop XCmdTop GhcPs
NoExtField GenLocated SrcSpan (HsCmd GhcPs)
cmd) = GenLocated SrcSpan (HsCmd GhcPs) -> (HsCmd GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located GenLocated SrcSpan (HsCmd GhcPs)
cmd HsCmd GhcPs -> R ()
p_hsCmd
withSpacing ::
(a -> R ()) ->
Located a ->
R ()
withSpacing :: (a -> R ()) -> Located a -> R ()
withSpacing a -> R ()
f Located a
l = Located a -> (a -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located a
l ((a -> R ()) -> R ()) -> (a -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
case Located a -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located a
l of
UnhelpfulSpan UnhelpfulSpanReason
_ -> a -> R ()
f a
x
RealSrcSpan RealSrcSpan
currentSpn Maybe BufSpan
_ -> do
R (Maybe SpanMark)
getSpanMark R (Maybe SpanMark) -> (Maybe SpanMark -> R ()) -> R ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (StatementSpan RealSrcSpan
lastSpn) ->
if RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
currentSpn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
lastSpn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
then R ()
newline
else () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe SpanMark
_ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
a -> R ()
f a
x
R (Maybe SpanMark)
getSpanMark R (Maybe SpanMark) -> (Maybe SpanMark -> R ()) -> R ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (HaddockSpan HaddockStyle
_ RealSrcSpan
_) -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (CommentSpan RealSrcSpan
_) -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe SpanMark
_ -> SpanMark -> R ()
setSpanMark (RealSrcSpan -> SpanMark
StatementSpan RealSrcSpan
currentSpn)
p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt = (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ()) -> Stmt GhcPs (LHsExpr GhcPs) -> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
p_stmt' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_stmt' ::
Data body =>
(body -> Placement) ->
(body -> R ()) ->
Stmt GhcPs (Located body) ->
R ()
p_stmt' :: (body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render = \case
LastStmt XLastStmt GhcPs GhcPs (Located body)
NoExtField Located body
body Maybe Bool
_ SyntaxExpr GhcPs
_ -> Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located body
body body -> R ()
render
BindStmt XBindStmt GhcPs GhcPs (Located body)
NoExtField LPat GhcPs
p f :: Located body
f@(L SrcSpan
l body
x) -> do
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
p Pat GhcPs -> R ()
p_pat
R ()
space
Text -> R ()
txt Text
"<-"
let loc :: SrcSpan
loc = Located (Pat GhcPs) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LPat GhcPs
Located (Pat GhcPs)
p
placement :: Placement
placement
| SrcSpan -> Bool
isOneLineSpan (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (SrcSpan -> SrcLoc
srcSpanEnd SrcSpan
loc) (SrcSpan -> SrcLoc
srcSpanStart SrcSpan
l)) = body -> Placement
placer body
x
| Bool
otherwise = Placement
Normal
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
loc, SrcSpan
l] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
Placement -> R () -> R ()
placeHanging Placement
placement (Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located body
f body -> R ()
render)
ApplicativeStmt {} -> String -> R ()
forall a. String -> a
notImplemented String
"ApplicativeStmt"
BodyStmt XBodyStmt GhcPs GhcPs (Located body)
NoExtField Located body
body SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ -> Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located body
body body -> R ()
render
LetStmt XLetStmt GhcPs GhcPs (Located body)
NoExtField LHsLocalBinds GhcPs
binds -> do
Text -> R ()
txt Text
"let"
R ()
space
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsLocalBinds GhcPs -> (HsLocalBindsLR GhcPs GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsLocalBinds GhcPs
binds HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds
ParStmt {} ->
String -> R ()
forall a. String -> a
notImplemented String
"ParStmt"
TransStmt {[(IdP GhcPs, IdP GhcPs)]
[GuardLStmt GhcPs]
Maybe (LHsExpr GhcPs)
TransForm
HsExpr GhcPs
SyntaxExpr GhcPs
XTransStmt GhcPs GhcPs (Located body)
LHsExpr GhcPs
trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
trS_fmap :: HsExpr GhcPs
trS_bind :: SyntaxExpr GhcPs
trS_ret :: SyntaxExpr GhcPs
trS_by :: Maybe (LHsExpr GhcPs)
trS_using :: LHsExpr GhcPs
trS_bndrs :: [(IdP GhcPs, IdP GhcPs)]
trS_stmts :: [GuardLStmt GhcPs]
trS_form :: TransForm
trS_ext :: XTransStmt GhcPs GhcPs (Located body)
..} ->
case (TransForm
trS_form, Maybe (LHsExpr GhcPs)
trS_by) of
(TransForm
ThenForm, Maybe (LHsExpr GhcPs)
Nothing) -> do
Text -> R ()
txt Text
"then"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
trS_using HsExpr GhcPs -> R ()
p_hsExpr
(TransForm
ThenForm, Just LHsExpr GhcPs
e) -> do
Text -> R ()
txt Text
"then"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
trS_using HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt Text
"by"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr
(TransForm
GroupForm, Maybe (LHsExpr GhcPs)
Nothing) -> do
Text -> R ()
txt Text
"then group using"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
trS_using HsExpr GhcPs -> R ()
p_hsExpr
(TransForm
GroupForm, Just LHsExpr GhcPs
e) -> do
Text -> R ()
txt Text
"then group by"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt Text
"using"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
trS_using HsExpr GhcPs -> R ()
p_hsExpr
RecStmt {[IdP GhcPs]
[LStmtLR GhcPs GhcPs (Located body)]
SyntaxExpr GhcPs
XRecStmt GhcPs GhcPs (Located body)
recS_ext :: forall idL idR body. StmtLR idL idR body -> XRecStmt idL idR body
recS_stmts :: forall idL idR body. StmtLR idL idR body -> [LStmtLR idL idR body]
recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_bind_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_ret_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_mfix_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_mfix_fn :: SyntaxExpr GhcPs
recS_ret_fn :: SyntaxExpr GhcPs
recS_bind_fn :: SyntaxExpr GhcPs
recS_rec_ids :: [IdP GhcPs]
recS_later_ids :: [IdP GhcPs]
recS_stmts :: [LStmtLR GhcPs GhcPs (Located body)]
recS_ext :: XRecStmt GhcPs GhcPs (Located body)
..} -> do
Text -> R ()
txt Text
"rec"
R ()
space
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ (LStmtLR GhcPs GhcPs (Located body) -> R ())
-> [LStmtLR GhcPs GhcPs (Located body)] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((Stmt GhcPs (Located body) -> R ())
-> LStmtLR GhcPs GhcPs (Located body) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
withSpacing ((body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render)) [LStmtLR GhcPs GhcPs (Located body)]
recS_stmts
gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]
gatherStmt :: GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt (L SrcSpan
_ (ParStmt XParStmt GhcPs GhcPs (LHsExpr GhcPs)
NoExtField [ParStmtBlock GhcPs GhcPs]
block HsExpr GhcPs
_ SyntaxExpr GhcPs
_)) =
(ParStmtBlock GhcPs GhcPs
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> [[GuardLStmt GhcPs]]
-> [ParStmtBlock GhcPs GhcPs]
-> [[GuardLStmt GhcPs]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]]
forall a. Semigroup a => a -> a -> a
(<>) ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> (ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]])
-> ParStmtBlock GhcPs GhcPs
-> [[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]]
gatherStmtBlock) [] [ParStmtBlock GhcPs GhcPs]
block
gatherStmt (L SrcSpan
s stmt :: Stmt GhcPs (LHsExpr GhcPs)
stmt@TransStmt {[(IdP GhcPs, IdP GhcPs)]
[GuardLStmt GhcPs]
Maybe (LHsExpr GhcPs)
TransForm
HsExpr GhcPs
SyntaxExpr GhcPs
XTransStmt GhcPs GhcPs (LHsExpr GhcPs)
LHsExpr GhcPs
trS_fmap :: HsExpr GhcPs
trS_bind :: SyntaxExpr GhcPs
trS_ret :: SyntaxExpr GhcPs
trS_by :: Maybe (LHsExpr GhcPs)
trS_using :: LHsExpr GhcPs
trS_bndrs :: [(IdP GhcPs, IdP GhcPs)]
trS_stmts :: [GuardLStmt GhcPs]
trS_form :: TransForm
trS_ext :: XTransStmt GhcPs GhcPs (LHsExpr GhcPs)
trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
..}) =
([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> [[GuardLStmt GhcPs]]
-> [[[GuardLStmt GhcPs]]]
-> [[GuardLStmt GhcPs]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend [] ((GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt (GuardLStmt GhcPs -> [[GuardLStmt GhcPs]])
-> [GuardLStmt GhcPs] -> [[[GuardLStmt GhcPs]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuardLStmt GhcPs]
trS_stmts) [[[GuardLStmt GhcPs]]]
-> [[[GuardLStmt GhcPs]]] -> [[[GuardLStmt GhcPs]]]
forall a. Semigroup a => a -> a -> a
<> [[GuardLStmt GhcPs]] -> [[[GuardLStmt GhcPs]]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[SrcSpan -> Stmt GhcPs (LHsExpr GhcPs) -> GuardLStmt GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
s Stmt GhcPs (LHsExpr GhcPs)
stmt]])
gatherStmt GuardLStmt GhcPs
stmt = [[GuardLStmt GhcPs
stmt]]
gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[ExprLStmt GhcPs]]
gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]]
gatherStmtBlock (ParStmtBlock XParStmtBlock GhcPs GhcPs
_ [GuardLStmt GhcPs]
stmts [IdP GhcPs]
_ SyntaxExpr GhcPs
_) =
(GuardLStmt GhcPs -> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> [[GuardLStmt GhcPs]]
-> [GuardLStmt GhcPs]
-> [[GuardLStmt GhcPs]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> (GuardLStmt GhcPs -> [[GuardLStmt GhcPs]])
-> GuardLStmt GhcPs
-> [[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt) [] [GuardLStmt GhcPs]
stmts
p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds = \case
HsValBinds XHsValBinds GhcPs GhcPs
NoExtField (ValBinds XValBinds GhcPs GhcPs
NoExtField LHsBindsLR GhcPs GhcPs
bag [LSig GhcPs]
lsigs) -> do
R () -> R ()
br <- Layout -> R () -> R ()
layoutToBraces (Layout -> R () -> R ()) -> R Layout -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Layout
getLayout
let items :: [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
items =
let injectLeft :: GenLocated l a -> GenLocated l (Either a b)
injectLeft (L l
l a
x) = l -> Either a b -> GenLocated l (Either a b)
forall l e. l -> e -> GenLocated l e
L l
l (a -> Either a b
forall a b. a -> Either a b
Left a
x)
injectRight :: GenLocated l b -> GenLocated l (Either a b)
injectRight (L l
l b
x) = l -> Either a b -> GenLocated l (Either a b)
forall l e. l -> e -> GenLocated l e
L l
l (b -> Either a b
forall a b. b -> Either a b
Right b
x)
in (GenLocated SrcSpan (HsBindLR GhcPs GhcPs)
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
forall l a b. GenLocated l a -> GenLocated l (Either a b)
injectLeft (GenLocated SrcSpan (HsBindLR GhcPs GhcPs)
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> [GenLocated SrcSpan (HsBindLR GhcPs GhcPs)]
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsBindsLR GhcPs GhcPs
-> [GenLocated SrcSpan (HsBindLR GhcPs GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
bag) [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall a. [a] -> [a] -> [a]
++ (LSig GhcPs
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
forall l b a. GenLocated l b -> GenLocated l (Either a b)
injectRight (LSig GhcPs
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> [LSig GhcPs]
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LSig GhcPs]
lsigs)
positionToBracing :: RelativePos -> R () -> R ()
positionToBracing = \case
RelativePos
SinglePos -> R () -> R ()
forall a. a -> a
id
RelativePos
FirstPos -> R () -> R ()
br
RelativePos
MiddlePos -> R () -> R ()
br
RelativePos
LastPos -> R () -> R ()
forall a. a -> a
id
p_item' :: (RelativePos,
GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> R ()
p_item' (RelativePos
p, GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
item) =
RelativePos -> R () -> R ()
positionToBracing RelativePos
p (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
(Either (HsBindLR GhcPs GhcPs) (Sig GhcPs) -> R ())
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> R ()
forall a. (a -> R ()) -> Located a -> R ()
withSpacing ((HsBindLR GhcPs GhcPs -> R ())
-> (Sig GhcPs -> R ())
-> Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)
-> R ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsBindLR GhcPs GhcPs -> R ()
p_valDecl Sig GhcPs -> R ()
p_sigDecl) GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
item
binds :: [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
binds = (GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> Ordering)
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> SrcSpan)
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))
-> SrcSpan
forall l e. GenLocated l e -> l
getLoc) [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
items
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ ((RelativePos,
GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> R ())
-> [(RelativePos,
GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))]
-> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi (RelativePos,
GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))
-> R ()
p_item' ([GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
-> [(RelativePos,
GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs)))]
forall a. [a] -> [(RelativePos, a)]
attachRelativePos [GenLocated SrcSpan (Either (HsBindLR GhcPs GhcPs) (Sig GhcPs))]
binds)
HsValBinds XHsValBinds GhcPs GhcPs
NoExtField HsValBindsLR GhcPs GhcPs
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsValBinds"
HsIPBinds XHsIPBinds GhcPs GhcPs
NoExtField (IPBinds XIPBinds GhcPs
NoExtField [LIPBind GhcPs]
xs) ->
let p_ipBind :: IPBind GhcPs -> R ()
p_ipBind (IPBind XCIPBind GhcPs
NoExtField (Left Located HsIPName
name) LHsExpr GhcPs
expr) = do
Located HsIPName -> R ()
forall a. Outputable a => a -> R ()
atom Located HsIPName
name
R ()
space
R ()
equals
R ()
breakpoint
R () -> R ()
useBraces (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr HsExpr GhcPs -> R ()
p_hsExpr
p_ipBind (IPBind XCIPBind GhcPs
NoExtField (Right IdP GhcPs
_) LHsExpr GhcPs
_) =
String -> R ()
forall a. String -> a
notImplemented String
"IPBind _ (Right _) _"
in (LIPBind GhcPs -> R ()) -> [LIPBind GhcPs] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((IPBind GhcPs -> R ()) -> LIPBind GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' IPBind GhcPs -> R ()
p_ipBind) [LIPBind GhcPs]
xs
EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
NoExtField -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
p_hsRecField ::
HsRecField' RdrName (LHsExpr GhcPs) ->
R ()
p_hsRecField :: HsRecField' RdrName (LHsExpr GhcPs) -> R ()
p_hsRecField HsRecField {Bool
LHsExpr GhcPs
Located RdrName
hsRecFieldLbl :: forall id arg. HsRecField' id arg -> Located id
hsRecFieldArg :: forall id arg. HsRecField' id arg -> arg
hsRecPun :: forall id arg. HsRecField' id arg -> Bool
hsRecPun :: Bool
hsRecFieldArg :: LHsExpr GhcPs
hsRecFieldLbl :: Located RdrName
..} = do
Located RdrName -> R ()
p_rdrName Located RdrName
hsRecFieldLbl
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hsRecPun (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
space
R ()
equals
let placement :: Placement
placement =
if SrcSpan -> SrcSpan -> Bool
onTheSameLine (Located RdrName -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located RdrName
hsRecFieldLbl) (LHsExpr GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LHsExpr GhcPs
hsRecFieldArg)
then HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
hsRecFieldArg)
else Placement
Normal
Placement -> R () -> R ()
placeHanging Placement
placement (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
hsRecFieldArg HsExpr GhcPs -> R ()
p_hsExpr)
p_hsExpr :: HsExpr GhcPs -> R ()
p_hsExpr :: HsExpr GhcPs -> R ()
p_hsExpr = BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
N
p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s = \case
HsVar XVar GhcPs
NoExtField Located (IdP GhcPs)
name -> Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
name
HsUnboundVar XUnboundVar GhcPs
NoExtField OccName
occ -> OccName -> R ()
forall a. Outputable a => a -> R ()
atom OccName
occ
HsConLikeOut XConLikeOut GhcPs
NoExtField ConLike
_ -> String -> R ()
forall a. String -> a
notImplemented String
"HsConLikeOut"
HsRecFld XRecFld GhcPs
NoExtField AmbiguousFieldOcc GhcPs
x ->
case AmbiguousFieldOcc GhcPs
x of
Unambiguous XUnambiguous GhcPs
NoExtField Located RdrName
name -> Located RdrName -> R ()
p_rdrName Located RdrName
name
Ambiguous XAmbiguous GhcPs
NoExtField Located RdrName
name -> Located RdrName -> R ()
p_rdrName Located RdrName
name
HsOverLabel XOverLabel GhcPs
NoExtField Maybe (IdP GhcPs)
_ FastString
v -> do
Text -> R ()
txt Text
"#"
FastString -> R ()
forall a. Outputable a => a -> R ()
atom FastString
v
HsIPVar XIPVar GhcPs
NoExtField (HsIPName FastString
name) -> do
Text -> R ()
txt Text
"?"
FastString -> R ()
forall a. Outputable a => a -> R ()
atom FastString
name
HsOverLit XOverLitE GhcPs
NoExtField HsOverLit GhcPs
v -> OverLitVal -> R ()
forall a. Outputable a => a -> R ()
atom (HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit GhcPs
v)
HsLit XLitE GhcPs
NoExtField HsLit GhcPs
lit ->
case HsLit GhcPs
lit of
HsString (SourceText stxt) FastString
_ -> String -> R ()
p_stringLit String
stxt
HsStringPrim (SourceText stxt) ByteString
_ -> String -> R ()
p_stringLit String
stxt
HsLit GhcPs
r -> HsLit GhcPs -> R ()
forall a. Outputable a => a -> R ()
atom HsLit GhcPs
r
HsLam XLam GhcPs
NoExtField MatchGroup GhcPs (LHsExpr GhcPs)
mgroup ->
MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup MatchGroupStyle
Lambda MatchGroup GhcPs (LHsExpr GhcPs)
mgroup
HsLamCase XLamCase GhcPs
NoExtField MatchGroup GhcPs (LHsExpr GhcPs)
mgroup ->
(HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> MatchGroup GhcPs (Located body) -> R ()
p_lamcase HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr MatchGroup GhcPs (LHsExpr GhcPs)
mgroup
HsApp XApp GhcPs
NoExtField LHsExpr GhcPs
f LHsExpr GhcPs
x -> do
let
gatherArgs :: LHsExpr p
-> NonEmpty (LHsExpr p) -> (LHsExpr p, NonEmpty (LHsExpr p))
gatherArgs LHsExpr p
f' NonEmpty (LHsExpr p)
knownArgs =
case LHsExpr p
f' of
L SrcSpan
_ (HsApp XApp p
_ LHsExpr p
l LHsExpr p
r) -> LHsExpr p
-> NonEmpty (LHsExpr p) -> (LHsExpr p, NonEmpty (LHsExpr p))
gatherArgs LHsExpr p
l (LHsExpr p
r LHsExpr p -> NonEmpty (LHsExpr p) -> NonEmpty (LHsExpr p)
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty (LHsExpr p)
knownArgs)
LHsExpr p
_ -> (LHsExpr p
f', NonEmpty (LHsExpr p)
knownArgs)
(LHsExpr GhcPs
func, NonEmpty (LHsExpr GhcPs)
args) = LHsExpr GhcPs
-> NonEmpty (LHsExpr GhcPs)
-> (LHsExpr GhcPs, NonEmpty (LHsExpr GhcPs))
forall p.
LHsExpr p
-> NonEmpty (LHsExpr p) -> (LHsExpr p, NonEmpty (LHsExpr p))
gatherArgs LHsExpr GhcPs
f (LHsExpr GhcPs
x LHsExpr GhcPs -> [LHsExpr GhcPs] -> NonEmpty (LHsExpr GhcPs)
forall a. a -> [a] -> NonEmpty a
:| [])
([LHsExpr GhcPs]
initp, LHsExpr GhcPs
lastp) = (NonEmpty (LHsExpr GhcPs) -> [LHsExpr GhcPs]
forall a. NonEmpty a -> [a]
NE.init NonEmpty (LHsExpr GhcPs)
args, NonEmpty (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. NonEmpty a -> a
NE.last NonEmpty (LHsExpr GhcPs)
args)
initSpan :: SrcSpan
initSpan =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$
LHsExpr GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LHsExpr GhcPs
f SrcSpan -> [SrcSpan] -> NonEmpty SrcSpan
forall a. a -> [a] -> NonEmpty a
:| [(SrcLoc -> SrcSpan
srcLocSpan (SrcLoc -> SrcSpan)
-> (LHsExpr GhcPs -> SrcLoc) -> LHsExpr GhcPs -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc)
-> (LHsExpr GhcPs -> SrcSpan) -> LHsExpr GhcPs -> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc) LHsExpr GhcPs
lastp]
placement :: Placement
placement =
if SrcSpan -> Bool
isOneLineSpan SrcSpan
initSpan
then HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
lastp)
else Placement
Normal
case Placement
placement of
Placement
Normal -> do
let
indentArg :: R () -> R ()
indentArg
| SrcSpan -> Bool
isOneLineSpan (LHsExpr GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LHsExpr GhcPs
func) = R () -> R ()
inci
| Bool
otherwise = case LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
func of
HsDo {} -> R () -> R ()
inciHalf
HsCase {} -> R () -> R ()
inciHalf
HsLamCase {} -> R () -> R ()
inciHalf
HsExpr GhcPs
_ -> R () -> R ()
inci
R () -> R ()
ub <-
R Layout
getLayout R Layout -> (Layout -> R () -> R ()) -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Layout
SingleLine -> R () -> R ()
useBraces
Layout
MultiLine -> R () -> R ()
forall a. a -> a
id
R () -> R ()
ub (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
func (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
R ()
breakpoint
R () -> R ()
indentArg (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs]
initp
R () -> R ()
indentArg (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LHsExpr GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsExpr GhcPs]
initp) R ()
breakpoint
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
lastp HsExpr GhcPs -> R ()
p_hsExpr
Placement
Hanging -> do
R () -> R ()
useBraces (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
initSpan] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
func (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
R ()
breakpoint
R () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs]
initp
Placement -> R () -> R ()
placeHanging Placement
placement (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
lastp HsExpr GhcPs -> R ()
p_hsExpr
HsAppType XAppTypeE GhcPs
NoExtField LHsExpr GhcPs
e LHsWcType (NoGhcTc GhcPs)
a -> do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"@"
case GenLocated SrcSpan (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc (HsWildCardBndrs GhcPs (GenLocated SrcSpan (HsType GhcPs))
-> GenLocated SrcSpan (HsType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (GenLocated SrcSpan (HsType GhcPs))
LHsWcType (NoGhcTc GhcPs)
a) of
HsSpliceTy {} -> R ()
space
HsType GhcPs
_ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
GenLocated SrcSpan (HsType GhcPs) -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located (HsWildCardBndrs GhcPs (GenLocated SrcSpan (HsType GhcPs))
-> GenLocated SrcSpan (HsType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (GenLocated SrcSpan (HsType GhcPs))
LHsWcType (NoGhcTc GhcPs)
a) HsType GhcPs -> R ()
p_hsType
OpApp XOpApp GhcPs
NoExtField LHsExpr GhcPs
x LHsExpr GhcPs
op LHsExpr GhcPs
y -> do
let opTree :: OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
opTree = OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
x) LHsExpr GhcPs
op (LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
y)
BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree BracketStyle
s ((HsExpr GhcPs -> Maybe RdrName)
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
forall op ty.
(op -> Maybe RdrName)
-> OpTree (Located ty) (Located op)
-> OpTree (Located ty) (Located op)
reassociateOpTree HsExpr GhcPs -> Maybe RdrName
getOpName OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
opTree)
NegApp XNegApp GhcPs
NoExtField LHsExpr GhcPs
e SyntaxExpr GhcPs
NoExtField -> do
Bool
negativeLiterals <- Extension -> R Bool
isExtensionEnabled Extension
NegativeLiterals
let isLiteral :: Bool
isLiteral = case LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
e of
HsLit {} -> Bool
True
HsOverLit {} -> Bool
True
HsExpr GhcPs
_ -> Bool
False
Text -> R ()
txt Text
"-"
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
negativeLiterals Bool -> Bool -> Bool
&& Bool
isLiteral) R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr
HsPar XPar GhcPs
NoExtField LHsExpr GhcPs
e ->
BracketStyle -> R () -> R ()
parens BracketStyle
s (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e (R () -> R ()
dontUseBraces (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr))
SectionL XSectionL GhcPs
NoExtField LHsExpr GhcPs
x LHsExpr GhcPs
op -> do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
op HsExpr GhcPs -> R ()
p_hsExpr)
SectionR XSectionR GhcPs
NoExtField LHsExpr GhcPs
op LHsExpr GhcPs
x -> do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
op HsExpr GhcPs -> R ()
p_hsExpr
Bool
useRecordDot' <- R Bool
useRecordDot
let isRecordDot' :: Bool
isRecordDot' = HsExpr GhcPs -> SrcSpan -> Bool
isRecordDot (LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
op) (LHsExpr GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LHsExpr GhcPs
x)
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
useRecordDot' Bool -> Bool -> Bool
&& Bool
isRecordDot') R ()
breakpoint
R () -> R ()
inci (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr)
ExplicitTuple XExplicitTuple GhcPs
NoExtField [LHsTupArg GhcPs]
args Boxity
boxity ->
let isSection :: Bool
isSection = (LHsTupArg GhcPs -> Bool) -> [LHsTupArg GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (HsTupArg GhcPs -> Bool
isMissing (HsTupArg GhcPs -> Bool)
-> (LHsTupArg GhcPs -> HsTupArg GhcPs) -> LHsTupArg GhcPs -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTupArg GhcPs -> HsTupArg GhcPs
forall l e. GenLocated l e -> e
unLoc) [LHsTupArg GhcPs]
args
isMissing :: HsTupArg GhcPs -> Bool
isMissing = \case
Missing XMissing GhcPs
NoExtField -> Bool
True
HsTupArg GhcPs
_ -> Bool
False
p_arg :: HsTupArg GhcPs -> R ()
p_arg = \case
Present XPresent GhcPs
NoExtField LHsExpr GhcPs
x -> LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr
Missing XMissing GhcPs
NoExtField -> () -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
p_larg :: LHsTupArg GhcPs -> R ()
p_larg = R () -> R ()
sitcc (R () -> R ())
-> (LHsTupArg GhcPs -> R ()) -> LHsTupArg GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsTupArg GhcPs -> R ()) -> LHsTupArg GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsTupArg GhcPs -> R ()
p_arg
parens' :: BracketStyle -> R () -> R ()
parens' =
case Boxity
boxity of
Boxity
Boxed -> BracketStyle -> R () -> R ()
parens
Boxity
Unboxed -> BracketStyle -> R () -> R ()
parensHash
in if Bool
isSection
then
[SrcSpan] -> R () -> R ()
switchLayout [] (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> (LHsTupArg GhcPs -> R ()) -> [LHsTupArg GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
comma LHsTupArg GhcPs -> R ()
p_larg [LHsTupArg GhcPs]
args
else
[SrcSpan] -> R () -> R ()
switchLayout (LHsTupArg GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (LHsTupArg GhcPs -> SrcSpan) -> [LHsTupArg GhcPs] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsTupArg GhcPs]
args) (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> (LHsTupArg GhcPs -> R ()) -> [LHsTupArg GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel LHsTupArg GhcPs -> R ()
p_larg [LHsTupArg GhcPs]
args
ExplicitSum XExplicitSum GhcPs
NoExtField Int
tag Int
arity LHsExpr GhcPs
e ->
BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum BracketStyle
N Int
tag Int
arity (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr)
HsCase XCase GhcPs
NoExtField LHsExpr GhcPs
e MatchGroup GhcPs (LHsExpr GhcPs)
mgroup ->
(HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (Located body)
-> R ()
p_case HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr LHsExpr GhcPs
e MatchGroup GhcPs (LHsExpr GhcPs)
mgroup
HsIf XIf GhcPs
NoExtField LHsExpr GhcPs
if' LHsExpr GhcPs
then' LHsExpr GhcPs
else' ->
(HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> Located body
-> Located body
-> R ()
p_if HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr LHsExpr GhcPs
if' LHsExpr GhcPs
then' LHsExpr GhcPs
else'
HsMultiIf XMultiIf GhcPs
NoExtField [LGRHS GhcPs (LHsExpr GhcPs)]
guards -> do
Text -> R ()
txt Text
"if"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (LGRHS GhcPs (LHsExpr GhcPs) -> R ())
-> [LGRHS GhcPs (LHsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline ((GRHS GhcPs (LHsExpr GhcPs) -> R ())
-> LGRHS GhcPs (LHsExpr GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
p_grhs GroupStyle
RightArrow)) [LGRHS GhcPs (LHsExpr GhcPs)]
guards
HsLet XLet GhcPs
NoExtField LHsLocalBinds GhcPs
localBinds LHsExpr GhcPs
e ->
(HsExpr GhcPs -> R ())
-> LHsLocalBinds GhcPs -> LHsExpr GhcPs -> R ()
forall body.
Data body =>
(body -> R ()) -> LHsLocalBinds GhcPs -> Located body -> R ()
p_let HsExpr GhcPs -> R ()
p_hsExpr LHsLocalBinds GhcPs
localBinds LHsExpr GhcPs
e
HsDo XDo GhcPs
NoExtField HsStmtContext GhcRn
ctx Located [GuardLStmt GhcPs]
es -> do
let doBody :: t a -> Text -> R ()
doBody t a
moduleName Text
header = do
t a -> (a -> R ()) -> R ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t a
moduleName ((a -> R ()) -> R ()) -> (a -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \a
m -> a -> R ()
forall a. Outputable a => a -> R ()
atom a
m R () -> R () -> R ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> R ()
txt Text
"."
Text -> R ()
txt Text
header
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] -> [GuardLStmt GhcPs]
forall l e. GenLocated l e -> e
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
$ \[GuardLStmt GhcPs]
xs -> do
let p_parBody :: [[GuardLStmt GhcPs]] -> R ()
p_parBody =
R ()
-> ([GuardLStmt GhcPs] -> R ()) -> [[GuardLStmt GhcPs]] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
(R ()
breakpoint R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
"|" R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space)
[GuardLStmt GhcPs] -> R ()
p_seqBody
p_seqBody :: [GuardLStmt GhcPs] -> R ()
p_seqBody =
R () -> R ()
sitcc
(R () -> R ())
-> ([GuardLStmt GhcPs] -> R ()) -> [GuardLStmt GhcPs] -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> (GuardLStmt GhcPs -> R ()) -> [GuardLStmt GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
R ()
commaDel
((Stmt GhcPs (LHsExpr GhcPs) -> R ()) -> GuardLStmt GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (R () -> R ()
sitcc (R () -> R ())
-> (Stmt GhcPs (LHsExpr GhcPs) -> R ())
-> Stmt GhcPs (LHsExpr GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt))
stmts :: [GuardLStmt GhcPs]
stmts = [GuardLStmt GhcPs] -> [GuardLStmt GhcPs]
forall a. [a] -> [a]
init [GuardLStmt GhcPs]
xs
yield :: GuardLStmt GhcPs
yield = [GuardLStmt GhcPs] -> GuardLStmt GhcPs
forall a. [a] -> a
last [GuardLStmt GhcPs]
xs
lists :: [[GuardLStmt GhcPs]]
lists = (GuardLStmt GhcPs -> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> [[GuardLStmt GhcPs]]
-> [GuardLStmt GhcPs]
-> [[GuardLStmt GhcPs]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> (GuardLStmt GhcPs -> [[GuardLStmt GhcPs]])
-> GuardLStmt GhcPs
-> [[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt) [] [GuardLStmt GhcPs]
stmts
GuardLStmt GhcPs -> (Stmt GhcPs (LHsExpr GhcPs) -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located GuardLStmt GhcPs
yield Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt
R ()
breakpoint
Text -> R ()
txt Text
"|"
R ()
space
[[GuardLStmt GhcPs]] -> R ()
p_parBody [[GuardLStmt GhcPs]]
lists
case HsStmtContext GhcRn
ctx of
DoExpr Maybe ModuleName
moduleName -> Maybe ModuleName -> Text -> R ()
forall (t :: * -> *) a.
(Foldable t, Outputable a) =>
t a -> Text -> R ()
doBody Maybe ModuleName
moduleName Text
"do"
MDoExpr Maybe ModuleName
moduleName -> Maybe ModuleName -> Text -> R ()
forall (t :: * -> *) a.
(Foldable t, Outputable a) =>
t a -> Text -> R ()
doBody Maybe ModuleName
moduleName Text
"mdo"
HsStmtContext GhcRn
ListComp -> R ()
compBody
HsStmtContext GhcRn
MonadComp -> R ()
compBody
HsStmtContext GhcRn
ArrowExpr -> String -> R ()
forall a. String -> a
notImplemented String
"ArrowExpr"
HsStmtContext GhcRn
GhciStmtCtxt -> String -> R ()
forall a. String -> a
notImplemented String
"GhciStmtCtxt"
PatGuard HsMatchContext GhcRn
_ -> String -> R ()
forall a. String -> a
notImplemented String
"PatGuard"
ParStmtCtxt HsStmtContext GhcRn
_ -> String -> R ()
forall a. String -> a
notImplemented String
"ParStmtCtxt"
TransStmtCtxt HsStmtContext GhcRn
_ -> String -> R ()
forall a. String -> a
notImplemented String
"TransStmtCtxt"
ExplicitList XExplicitList GhcPs
_ Maybe (SyntaxExpr GhcPs)
_ [LHsExpr GhcPs]
xs ->
BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ()) -> (LHsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs]
xs
RecordCon {HsRecordBinds GhcPs
XRecordCon GhcPs
Located (IdP GhcPs)
rcon_ext :: forall p. HsExpr p -> XRecordCon p
rcon_con_name :: forall p. HsExpr p -> Located (IdP p)
rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_flds :: HsRecordBinds GhcPs
rcon_con_name :: Located (IdP GhcPs)
rcon_ext :: XRecordCon GhcPs
..} -> do
Located RdrName -> (RdrName -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located (IdP GhcPs)
Located RdrName
rcon_con_name RdrName -> R ()
forall a. Outputable a => a -> R ()
atom
R ()
breakpoint
let HsRecFields {[LHsRecField GhcPs (LHsExpr GhcPs)]
Maybe (Located Int)
rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (Located Int)
rec_dotdot :: Maybe (Located Int)
rec_flds :: [LHsRecField GhcPs (LHsExpr GhcPs)]
..} = HsRecordBinds GhcPs
rcon_flds
updName :: HsRecField GhcPs (LHsExpr GhcPs)
-> HsRecField' RdrName (LHsExpr GhcPs)
updName HsRecField GhcPs (LHsExpr GhcPs)
f =
(HsRecField GhcPs (LHsExpr GhcPs)
f :: HsRecField GhcPs (LHsExpr GhcPs))
{ hsRecFieldLbl :: Located RdrName
hsRecFieldLbl = case GenLocated SrcSpan (FieldOcc GhcPs) -> FieldOcc GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (FieldOcc GhcPs) -> FieldOcc GhcPs)
-> GenLocated SrcSpan (FieldOcc GhcPs) -> FieldOcc GhcPs
forall a b. (a -> b) -> a -> b
$ HsRecField GhcPs (LHsExpr GhcPs)
-> GenLocated SrcSpan (FieldOcc GhcPs)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl HsRecField GhcPs (LHsExpr GhcPs)
f of
FieldOcc XCFieldOcc GhcPs
_ Located RdrName
n -> Located RdrName
n
}
fields :: [R ()]
fields = (HsRecField GhcPs (LHsExpr GhcPs) -> R ())
-> LHsRecField GhcPs (LHsExpr GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (HsRecField' RdrName (LHsExpr GhcPs) -> R ()
p_hsRecField (HsRecField' RdrName (LHsExpr GhcPs) -> R ())
-> (HsRecField GhcPs (LHsExpr GhcPs)
-> HsRecField' RdrName (LHsExpr GhcPs))
-> HsRecField GhcPs (LHsExpr GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecField GhcPs (LHsExpr GhcPs)
-> HsRecField' RdrName (LHsExpr GhcPs)
updName) (LHsRecField GhcPs (LHsExpr GhcPs) -> R ())
-> [LHsRecField GhcPs (LHsExpr GhcPs)] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (LHsExpr GhcPs)]
rec_flds
dotdot :: [R ()]
dotdot =
case Maybe (Located Int)
rec_dotdot of
Just {} -> [Text -> R ()
txt Text
".."]
Maybe (Located Int)
Nothing -> []
R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> (R () -> R ()) -> [R ()] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel R () -> R ()
sitcc ([R ()]
fields [R ()] -> [R ()] -> [R ()]
forall a. Semigroup a => a -> a -> a
<> [R ()]
dotdot)
RecordUpd {[LHsRecUpdField GhcPs]
XRecordUpd GhcPs
LHsExpr GhcPs
rupd_ext :: forall p. HsExpr p -> XRecordUpd p
rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_flds :: forall p. HsExpr p -> [LHsRecUpdField p]
rupd_flds :: [LHsRecUpdField GhcPs]
rupd_expr :: LHsExpr GhcPs
rupd_ext :: XRecordUpd GhcPs
..} -> do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
rupd_expr HsExpr GhcPs -> R ()
p_hsExpr
Bool
useRecordDot' <- R Bool
useRecordDot
let mrs :: GenLocated SrcSpan e -> Maybe RealSrcSpan
mrs GenLocated SrcSpan e
sp = case GenLocated SrcSpan e -> SrcSpan
forall l e. GenLocated l e -> l
getLoc GenLocated SrcSpan e
sp of
RealSrcSpan RealSrcSpan
r Maybe BufSpan
_ -> RealSrcSpan -> Maybe RealSrcSpan
forall a. a -> Maybe a
Just RealSrcSpan
r
SrcSpan
_ -> Maybe RealSrcSpan
forall a. Maybe a
Nothing
let isPluginForm :: Bool
isPluginForm =
((Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (RealSrcSpan -> Int) -> RealSrcSpan -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcSpan -> Int
srcSpanEndCol (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsExpr GhcPs -> Maybe RealSrcSpan
forall e. GenLocated SrcSpan e -> Maybe RealSrcSpan
mrs LHsExpr GhcPs
rupd_expr)
Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== (RealSrcSpan -> Int
srcSpanStartCol (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsRecUpdField GhcPs -> Maybe RealSrcSpan
forall e. GenLocated SrcSpan e -> Maybe RealSrcSpan
mrs ([LHsRecUpdField GhcPs] -> LHsRecUpdField GhcPs
forall a. [a] -> a
head [LHsRecUpdField GhcPs]
rupd_flds))
Bool -> Bool -> Bool
&& SrcSpan -> SrcSpan -> Bool
onTheSameLine (LHsExpr GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LHsExpr GhcPs
rupd_expr) (LHsRecUpdField GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (LHsRecUpdField GhcPs -> SrcSpan)
-> LHsRecUpdField GhcPs -> SrcSpan
forall a b. (a -> b) -> a -> b
$ [LHsRecUpdField GhcPs] -> LHsRecUpdField GhcPs
forall a. [a] -> a
head [LHsRecUpdField GhcPs]
rupd_flds)
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
useRecordDot' Bool -> Bool -> Bool
&& Bool
isPluginForm) R ()
breakpoint
let updName :: HsRecUpdField GhcPs -> HsRecField' RdrName (LHsExpr GhcPs)
updName HsRecUpdField GhcPs
f =
(HsRecUpdField GhcPs
f :: HsRecUpdField GhcPs)
{ hsRecFieldLbl :: Located RdrName
hsRecFieldLbl = case GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)
-> AmbiguousFieldOcc GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)
-> AmbiguousFieldOcc GhcPs)
-> GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)
-> AmbiguousFieldOcc GhcPs
forall a b. (a -> b) -> a -> b
$ HsRecUpdField GhcPs -> GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl HsRecUpdField GhcPs
f of
Ambiguous XAmbiguous GhcPs
_ Located RdrName
n -> Located RdrName
n
Unambiguous XUnambiguous GhcPs
_ Located RdrName
n -> Located RdrName
n
}
updBraces :: R () -> R ()
updBraces =
if Bool
useRecordDot' Bool -> Bool -> Bool
&& Bool
isPluginForm
then R () -> R ()
recordDotBraces
else R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N
R () -> R ()
updBraces (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R ()
-> (LHsRecUpdField GhcPs -> R ()) -> [LHsRecUpdField GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
R ()
commaDel
(R () -> R ()
sitcc (R () -> R ())
-> (LHsRecUpdField GhcPs -> R ()) -> LHsRecUpdField GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsRecUpdField GhcPs -> R ()) -> LHsRecUpdField GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' (HsRecField' RdrName (LHsExpr GhcPs) -> R ()
p_hsRecField (HsRecField' RdrName (LHsExpr GhcPs) -> R ())
-> (HsRecUpdField GhcPs -> HsRecField' RdrName (LHsExpr GhcPs))
-> HsRecUpdField GhcPs
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecUpdField GhcPs -> HsRecField' RdrName (LHsExpr GhcPs)
updName))
[LHsRecUpdField GhcPs]
rupd_flds
ExprWithTySig XExprWithTySig GhcPs
NoExtField LHsExpr GhcPs
x HsWC {hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = HsIB {XHsIB (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs))
LHsType (NoGhcTc GhcPs)
hsib_ext :: forall pass thing. HsImplicitBndrs pass thing -> XHsIB pass thing
hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body :: LHsType (NoGhcTc GhcPs)
hsib_ext :: XHsIB (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs))
..}} -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
Text -> R ()
txt Text
"::"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan (HsType GhcPs) -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located GenLocated SrcSpan (HsType GhcPs)
LHsType (NoGhcTc GhcPs)
hsib_body HsType GhcPs -> R ()
p_hsType
ArithSeq XArithSeq GhcPs
NoExtField Maybe (SyntaxExpr GhcPs)
_ ArithSeqInfo GhcPs
x ->
case ArithSeqInfo GhcPs
x of
From LHsExpr GhcPs
from -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
from HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt Text
".."
FromThen LHsExpr GhcPs
from LHsExpr GhcPs
next -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs
from, LHsExpr GhcPs
next]
R ()
breakpoint
Text -> R ()
txt Text
".."
FromTo LHsExpr GhcPs
from LHsExpr GhcPs
to -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
from HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt Text
".."
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
to HsExpr GhcPs -> R ()
p_hsExpr
FromThenTo LHsExpr GhcPs
from LHsExpr GhcPs
next LHsExpr GhcPs
to -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs
from, LHsExpr GhcPs
next]
R ()
breakpoint
Text -> R ()
txt Text
".."
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
to HsExpr GhcPs -> R ()
p_hsExpr
HsBracket XBracket GhcPs
NoExtField HsBracket GhcPs
x -> HsBracket GhcPs -> R ()
p_hsBracket HsBracket GhcPs
x
HsRnBracketOut {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsRnBracketOut"
HsTcBracketOut {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsTcBracketOut"
HsSpliceE XSpliceE GhcPs
NoExtField HsSplice GhcPs
splice -> HsSplice GhcPs -> R ()
p_hsSplice HsSplice GhcPs
splice
HsProc XProc GhcPs
NoExtField LPat GhcPs
p LHsCmdTop GhcPs
e -> do
Text -> R ()
txt Text
"proc"
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
p ((Pat GhcPs -> R ()) -> R ()) -> (Pat GhcPs -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \Pat GhcPs
x -> do
R ()
breakpoint
R () -> R ()
inci (Pat GhcPs -> R ()
p_pat Pat GhcPs
x)
R ()
breakpoint
Text -> R ()
txt Text
"->"
Placement -> R () -> R ()
placeHanging (HsCmdTop GhcPs -> Placement
cmdTopPlacement (LHsCmdTop GhcPs -> HsCmdTop GhcPs
forall l e. GenLocated l e -> e
unLoc LHsCmdTop GhcPs
e)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
LHsCmdTop GhcPs -> (HsCmdTop GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
e HsCmdTop GhcPs -> R ()
p_hsCmdTop
HsStatic XStatic GhcPs
_ LHsExpr GhcPs
e -> do
Text -> R ()
txt Text
"static"
R ()
breakpoint
R () -> R ()
inci (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr)
HsTick {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsTick"
HsBinTick {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsBinTick"
HsPragE XPragE GhcPs
NoExtField HsPragE GhcPs
prag LHsExpr GhcPs
x -> case HsPragE GhcPs
prag of
HsPragSCC XSCC GhcPs
NoExtField SourceText
_ StringLiteral
name -> do
Text -> R ()
txt Text
"{-# SCC "
StringLiteral -> R ()
forall a. Outputable a => a -> R ()
atom StringLiteral
name
Text -> R ()
txt Text
" #-}"
R ()
breakpoint
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr
HsPragTick {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsTickPragma"
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PSB {HsPatSynDir GhcPs
HsPatSynDetails (Located (IdP GhcPs))
LPat GhcPs
XPSB GhcPs GhcPs
Located (IdP GhcPs)
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_id :: forall idL idR. PatSynBind idL idR -> Located (IdP idL)
psb_args :: forall idL idR.
PatSynBind idL idR -> HsPatSynDetails (Located (IdP idR))
psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_dir :: HsPatSynDir GhcPs
psb_def :: LPat GhcPs
psb_args :: HsPatSynDetails (Located (IdP GhcPs))
psb_id :: Located (IdP GhcPs)
psb_ext :: XPSB GhcPs GhcPs
..} = do
let rhs :: R ()
rhs = do
R ()
space
case HsPatSynDir GhcPs
psb_dir of
HsPatSynDir GhcPs
Unidirectional -> do
Text -> R ()
txt Text
"<-"
R ()
breakpoint
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
psb_def Pat GhcPs -> R ()
p_pat
HsPatSynDir GhcPs
ImplicitBidirectional -> do
R ()
equals
R ()
breakpoint
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
psb_def Pat GhcPs -> R ()
p_pat
ExplicitBidirectional MatchGroup GhcPs (LHsExpr GhcPs)
mgroup -> do
Text -> R ()
txt Text
"<-"
R ()
breakpoint
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
psb_def Pat GhcPs -> R ()
p_pat
R ()
breakpoint
Text -> R ()
txt Text
"where"
R ()
breakpoint
R () -> R ()
inci (MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup (Located RdrName -> MatchGroupStyle
Function Located (IdP GhcPs)
Located RdrName
psb_id) MatchGroup GhcPs (LHsExpr GhcPs)
mgroup)
Text -> R ()
txt Text
"pattern"
case HsPatSynDetails (Located (IdP GhcPs))
psb_args of
PrefixCon [Located (IdP GhcPs)]
xs -> do
R ()
space
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
psb_id
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
[SrcSpan] -> R () -> R ()
switchLayout (Located RdrName -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (Located RdrName -> SrcSpan) -> [Located RdrName] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located (IdP GhcPs)]
[Located RdrName]
xs) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Located RdrName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Located (IdP GhcPs)]
[Located RdrName]
xs) R ()
breakpoint
R () -> R ()
sitcc (R () -> (Located RdrName -> R ()) -> [Located RdrName] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint Located RdrName -> R ()
p_rdrName [Located (IdP GhcPs)]
[Located RdrName]
xs)
R ()
rhs
RecCon [RecordPatSynField (Located (IdP GhcPs))]
xs -> do
R ()
space
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
psb_id
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
[SrcSpan] -> R () -> R ()
switchLayout (Located RdrName -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (Located RdrName -> SrcSpan)
-> (RecordPatSynField (Located RdrName) -> Located RdrName)
-> RecordPatSynField (Located RdrName)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField (Located RdrName) -> Located RdrName
forall a. RecordPatSynField a -> a
recordPatSynPatVar (RecordPatSynField (Located RdrName) -> SrcSpan)
-> [RecordPatSynField (Located RdrName)] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RecordPatSynField (Located (IdP GhcPs))]
[RecordPatSynField (Located RdrName)]
xs) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([RecordPatSynField (Located RdrName)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RecordPatSynField (Located (IdP GhcPs))]
[RecordPatSynField (Located RdrName)]
xs) R ()
breakpoint
BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R ()
-> (RecordPatSynField (Located RdrName) -> R ())
-> [RecordPatSynField (Located RdrName)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (Located RdrName -> R ()
p_rdrName (Located RdrName -> R ())
-> (RecordPatSynField (Located RdrName) -> Located RdrName)
-> RecordPatSynField (Located RdrName)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField (Located RdrName) -> Located RdrName
forall a. RecordPatSynField a -> a
recordPatSynPatVar) [RecordPatSynField (Located (IdP GhcPs))]
[RecordPatSynField (Located RdrName)]
xs
R ()
rhs
InfixCon Located (IdP GhcPs)
l Located (IdP GhcPs)
r -> do
[SrcSpan] -> R () -> R ()
switchLayout [Located RdrName -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located (IdP GhcPs)
Located RdrName
l, Located RdrName -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located (IdP GhcPs)
Located RdrName
r] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
space
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
l
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
psb_id
R ()
space
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
r
R () -> R ()
inci R ()
rhs
p_case ::
Data body =>
(body -> Placement) ->
(body -> R ()) ->
LHsExpr GhcPs ->
MatchGroup GhcPs (Located body) ->
R ()
p_case :: (body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (Located body)
-> R ()
p_case body -> Placement
placer body -> R ()
render LHsExpr GhcPs
e MatchGroup GhcPs (Located body)
mgroup = do
Text -> R ()
txt Text
"case"
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
Text -> R ()
txt Text
"of"
R ()
breakpoint
R () -> R ()
inci ((body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
Case MatchGroup GhcPs (Located body)
mgroup)
p_lamcase ::
Data body =>
(body -> Placement) ->
(body -> R ()) ->
MatchGroup GhcPs (Located body) ->
R ()
p_lamcase :: (body -> Placement)
-> (body -> R ()) -> MatchGroup GhcPs (Located body) -> R ()
p_lamcase body -> Placement
placer body -> R ()
render MatchGroup GhcPs (Located body)
mgroup = do
Text -> R ()
txt Text
"\\case"
R ()
breakpoint
R () -> R ()
inci ((body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
LambdaCase MatchGroup GhcPs (Located body)
mgroup)
p_if ::
Data body =>
(body -> Placement) ->
(body -> R ()) ->
LHsExpr GhcPs ->
Located body ->
Located body ->
R ()
p_if :: (body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> Located body
-> Located body
-> R ()
p_if body -> Placement
placer body -> R ()
render LHsExpr GhcPs
if' Located body
then' Located body
else' = do
Text -> R ()
txt Text
"if"
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
if' HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"then"
R ()
space
Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located body
then' ((body -> R ()) -> R ()) -> (body -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \body
x ->
Placement -> R () -> R ()
placeHanging (body -> Placement
placer body
x) (body -> R ()
render body
x)
R ()
breakpoint
Text -> R ()
txt Text
"else"
R ()
space
Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located body
else' ((body -> R ()) -> R ()) -> (body -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \body
x ->
Placement -> R () -> R ()
placeHanging (body -> Placement
placer body
x) (body -> R ()
render body
x)
p_let ::
Data body =>
(body -> R ()) ->
Located (HsLocalBindsLR GhcPs GhcPs) ->
Located body ->
R ()
p_let :: (body -> R ()) -> LHsLocalBinds GhcPs -> Located body -> R ()
p_let body -> R ()
render LHsLocalBinds GhcPs
localBinds Located body
e = R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"let"
R ()
space
R () -> R ()
dontUseBraces (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> R ()
sitcc (LHsLocalBinds GhcPs -> (HsLocalBindsLR GhcPs GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsLocalBinds GhcPs
localBinds HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds)
R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout R ()
space (R ()
newline R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt Text
" ")
Text -> R ()
txt Text
"in"
R ()
space
R () -> R ()
sitcc (Located body -> (body -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located body
e body -> R ()
render)
p_pat :: Pat GhcPs -> R ()
p_pat :: Pat GhcPs -> R ()
p_pat = \case
WildPat XWildPat GhcPs
NoExtField -> Text -> R ()
txt Text
"_"
VarPat XVarPat GhcPs
NoExtField Located (IdP GhcPs)
name -> Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
name
LazyPat XLazyPat GhcPs
NoExtField LPat GhcPs
pat -> do
Text -> R ()
txt Text
"~"
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
AsPat XAsPat GhcPs
NoExtField Located (IdP GhcPs)
name LPat GhcPs
pat -> do
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
name
Text -> R ()
txt Text
"@"
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
ParPat XParPat GhcPs
NoExtField LPat GhcPs
pat ->
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat (BracketStyle -> R () -> R ()
parens BracketStyle
S (R () -> R ()) -> (Pat GhcPs -> R ()) -> Pat GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat GhcPs -> R ()
p_pat)
BangPat XBangPat GhcPs
NoExtField LPat GhcPs
pat -> do
Text -> R ()
txt Text
"!"
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
ListPat XListPat GhcPs
NoExtField [LPat GhcPs]
pats ->
BracketStyle -> R () -> R ()
brackets BracketStyle
S (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (Located (Pat GhcPs) -> R ()) -> [Located (Pat GhcPs)] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel ((Pat GhcPs -> R ()) -> Located (Pat GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[Located (Pat GhcPs)]
pats
TuplePat XTuplePat GhcPs
NoExtField [LPat GhcPs]
pats Boxity
boxing -> do
let parens' :: R () -> R ()
parens' =
case Boxity
boxing of
Boxity
Boxed -> BracketStyle -> R () -> R ()
parens BracketStyle
S
Boxity
Unboxed -> BracketStyle -> R () -> R ()
parensHash BracketStyle
S
R () -> R ()
parens' (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (Located (Pat GhcPs) -> R ()) -> [Located (Pat GhcPs)] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel (R () -> R ()
sitcc (R () -> R ())
-> (Located (Pat GhcPs) -> R ()) -> Located (Pat GhcPs) -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat GhcPs -> R ()) -> Located (Pat GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[Located (Pat GhcPs)]
pats
SumPat XSumPat GhcPs
NoExtField LPat GhcPs
pat Int
tag Int
arity ->
BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum BracketStyle
S Int
tag Int
arity (Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat)
ConPat XConPat GhcPs
NoExtField Located (ConLikeP GhcPs)
pat HsConPatDetails GhcPs
details ->
case HsConPatDetails GhcPs
details of
PrefixCon [LPat GhcPs]
xs -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Located RdrName -> R ()
p_rdrName Located (ConLikeP GhcPs)
Located RdrName
pat
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Located (Pat GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
[Located (Pat GhcPs)]
xs) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (Located (Pat GhcPs) -> R ()) -> [Located (Pat GhcPs)] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc (R () -> R ())
-> (Located (Pat GhcPs) -> R ()) -> Located (Pat GhcPs) -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat GhcPs -> R ()) -> Located (Pat GhcPs) -> R ()
forall a. (a -> R ()) -> Located a -> R ()
located' Pat GhcPs -> R ()
p_pat) [LPat GhcPs]
[Located (Pat GhcPs)]
xs
RecCon (HsRecFields [LHsRecField GhcPs (LPat GhcPs)]
fields Maybe (Located Int)
dotdot) -> do
Located RdrName -> R ()
p_rdrName Located (ConLikeP GhcPs)
Located RdrName
pat
R ()
breakpoint
let f :: Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
-> R ()
f = \case
Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
Nothing -> Text -> R ()
txt Text
".."
Just Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
x -> Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
-> (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)) -> R ())
-> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
x HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)) -> R ()
p_pat_hsRecField
R () -> R ()
inci (R () -> R ())
-> ([Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ())
-> [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ())
-> ([Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ())
-> [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R ()
-> (Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
-> R ())
-> [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
commaDel Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
-> R ()
f ([Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ())
-> [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> R ()
forall a b. (a -> b) -> a -> b
$
case Maybe (Located Int)
dotdot of
Maybe (Located Int)
Nothing -> Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
-> Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
forall a. a -> Maybe a
Just (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
-> Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))))
-> [Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
-> [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (LPat GhcPs)]
[Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
fields
Just (L SrcSpan
_ Int
n) -> (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
-> Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
forall a. a -> Maybe a
Just (Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))
-> Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))))
-> [Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
-> [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> [Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
-> [Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
forall a. Int -> [a] -> [a]
take Int
n [LHsRecField GhcPs (LPat GhcPs)]
[Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs)))]
fields) [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
-> [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))]
forall a. [a] -> [a] -> [a]
++ [Maybe
(Located (HsRecField' (FieldOcc GhcPs) (Located (Pat GhcPs))))
forall a. Maybe a
Nothing]
InfixCon LPat GhcPs
l LPat GhcPs
r -> do
[SrcSpan] -> R () -> R ()
switchLayout [Located (Pat GhcPs) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LPat GhcPs
Located (Pat GhcPs)
l, Located (Pat GhcPs) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LPat GhcPs
Located (Pat GhcPs)
r] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
l Pat GhcPs -> R ()
p_pat
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Located RdrName -> R ()
p_rdrName Located (ConLikeP GhcPs)
Located RdrName
pat
R ()
space
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
r Pat GhcPs -> R ()
p_pat
ViewPat XViewPat GhcPs
NoExtField LHsExpr GhcPs
expr LPat GhcPs
pat -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
Text -> R ()
txt Text
"->"
R ()
breakpoint
R () -> R ()
inci (Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat)
SplicePat XSplicePat GhcPs
NoExtField HsSplice GhcPs
splice -> HsSplice GhcPs -> R ()
p_hsSplice HsSplice GhcPs
splice
LitPat XLitPat GhcPs
NoExtField HsLit GhcPs
p -> HsLit GhcPs -> R ()
forall a. Outputable a => a -> R ()
atom HsLit GhcPs
p
NPat XNPat GhcPs
NoExtField Located (HsOverLit GhcPs)
v (Maybe (SyntaxExpr GhcPs) -> Bool
forall a. Maybe a -> Bool
isJust -> Bool
isNegated) SyntaxExpr GhcPs
NoExtField -> do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isNegated (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"-"
Bool
negativeLiterals <- Extension -> R Bool
isExtensionEnabled Extension
NegativeLiterals
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
negativeLiterals R ()
space
Located (HsOverLit GhcPs) -> (HsOverLit GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located (HsOverLit GhcPs)
v (OverLitVal -> R ()
forall a. Outputable a => a -> R ()
atom (OverLitVal -> R ())
-> (HsOverLit GhcPs -> OverLitVal) -> HsOverLit GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val)
NPlusKPat XNPlusKPat GhcPs
NoExtField Located (IdP GhcPs)
n Located (HsOverLit GhcPs)
k HsOverLit GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
n
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt Text
"+"
R ()
space
Located (HsOverLit GhcPs) -> (HsOverLit GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located Located (HsOverLit GhcPs)
k (OverLitVal -> R ()
forall a. Outputable a => a -> R ()
atom (OverLitVal -> R ())
-> (HsOverLit GhcPs -> OverLitVal) -> HsOverLit GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val)
SigPat XSigPat GhcPs
NoExtField LPat GhcPs
pat HsPS {XHsPS (NoGhcTc GhcPs)
LHsType (NoGhcTc GhcPs)
hsps_ext :: forall pass. HsPatSigType pass -> XHsPS pass
hsps_body :: forall pass. HsPatSigType pass -> LHsType pass
hsps_body :: LHsType (NoGhcTc GhcPs)
hsps_ext :: XHsPS (NoGhcTc GhcPs)
..} -> do
Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat Pat GhcPs -> R ()
p_pat
LHsSigWcType GhcPs -> R ()
p_typeAscription (XHsWC
GhcPs (HsImplicitBndrs GhcPs (GenLocated SrcSpan (HsType GhcPs)))
-> HsImplicitBndrs GhcPs (GenLocated SrcSpan (HsType GhcPs))
-> LHsSigWcType GhcPs
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC NoExtField
XHsWC
GhcPs (HsImplicitBndrs GhcPs (GenLocated SrcSpan (HsType GhcPs)))
NoExtField (XHsIB GhcPs (GenLocated SrcSpan (HsType GhcPs))
-> GenLocated SrcSpan (HsType GhcPs)
-> HsImplicitBndrs GhcPs (GenLocated SrcSpan (HsType GhcPs))
forall pass thing.
XHsIB pass thing -> thing -> HsImplicitBndrs pass thing
HsIB NoExtField
XHsIB GhcPs (GenLocated SrcSpan (HsType GhcPs))
NoExtField GenLocated SrcSpan (HsType GhcPs)
LHsType (NoGhcTc GhcPs)
hsps_body))
p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
p_pat_hsRecField HsRecField {Bool
LPat GhcPs
GenLocated SrcSpan (FieldOcc GhcPs)
hsRecPun :: Bool
hsRecFieldArg :: LPat GhcPs
hsRecFieldLbl :: GenLocated SrcSpan (FieldOcc GhcPs)
hsRecFieldLbl :: forall id arg. HsRecField' id arg -> Located id
hsRecFieldArg :: forall id arg. HsRecField' id arg -> arg
hsRecPun :: forall id arg. HsRecField' id arg -> Bool
..} = do
GenLocated SrcSpan (FieldOcc GhcPs)
-> (FieldOcc GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located GenLocated SrcSpan (FieldOcc GhcPs)
hsRecFieldLbl ((FieldOcc GhcPs -> R ()) -> R ())
-> (FieldOcc GhcPs -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \FieldOcc GhcPs
x ->
Located RdrName -> R ()
p_rdrName (FieldOcc GhcPs -> Located RdrName
forall pass. FieldOcc pass -> Located RdrName
rdrNameFieldOcc FieldOcc GhcPs
x)
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hsRecPun (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
space
R ()
equals
R ()
breakpoint
R () -> R ()
inci (Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
hsRecFieldArg Pat GhcPs -> R ()
p_pat)
p_unboxedSum :: BracketStyle -> ConTag -> Arity -> R () -> R ()
p_unboxedSum :: BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum BracketStyle
s Int
tag Int
arity R ()
m = do
let before :: Int
before = Int
tag Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
after :: Int
after = Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
before Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
args :: [Maybe (R ())]
args = Int -> Maybe (R ()) -> [Maybe (R ())]
forall a. Int -> a -> [a]
replicate Int
before Maybe (R ())
forall a. Maybe a
Nothing [Maybe (R ())] -> [Maybe (R ())] -> [Maybe (R ())]
forall a. Semigroup a => a -> a -> a
<> [R () -> Maybe (R ())
forall a. a -> Maybe a
Just R ()
m] [Maybe (R ())] -> [Maybe (R ())] -> [Maybe (R ())]
forall a. Semigroup a => a -> a -> a
<> Int -> Maybe (R ()) -> [Maybe (R ())]
forall a. Int -> a -> [a]
replicate Int
after Maybe (R ())
forall a. Maybe a
Nothing
f :: Maybe (R ()) -> R ()
f Maybe (R ())
x =
case Maybe (R ())
x :: Maybe (R ()) of
Maybe (R ())
Nothing ->
R ()
space
Just R ()
m' -> do
R ()
space
R ()
m'
R ()
space
BracketStyle -> R () -> R ()
parensHash BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (Maybe (R ()) -> R ()) -> [Maybe (R ())] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt Text
"|") Maybe (R ()) -> R ()
f [Maybe (R ())]
args
p_hsSplice :: HsSplice GhcPs -> R ()
p_hsSplice :: HsSplice GhcPs -> R ()
p_hsSplice = \case
HsTypedSplice XTypedSplice GhcPs
NoExtField SpliceDecoration
deco IdP GhcPs
_ LHsExpr GhcPs
expr -> Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
True LHsExpr GhcPs
expr SpliceDecoration
deco
HsUntypedSplice XUntypedSplice GhcPs
NoExtField SpliceDecoration
deco IdP GhcPs
_ LHsExpr GhcPs
expr -> Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
False LHsExpr GhcPs
expr SpliceDecoration
deco
HsQuasiQuote XQuasiQuote GhcPs
NoExtField IdP GhcPs
_ IdP GhcPs
quoterName SrcSpan
srcSpan FastString
str -> do
Text -> R ()
txt Text
"["
Located RdrName -> R ()
p_rdrName (SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcSpan IdP GhcPs
RdrName
quoterName)
Text -> R ()
txt Text
"|"
FastString -> R ()
forall a. Outputable a => a -> R ()
atom FastString
str
Text -> R ()
txt Text
"|]"
HsSpliced {} -> String -> R ()
forall a. String -> a
notImplemented String
"HsSpliced"
p_hsSpliceTH ::
Bool ->
LHsExpr GhcPs ->
SpliceDecoration ->
R ()
p_hsSpliceTH :: Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
isTyped LHsExpr GhcPs
expr = \case
SpliceDecoration
DollarSplice -> do
Text -> R ()
txt Text
decoSymbol
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr (R () -> R ()
sitcc (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
SpliceDecoration
BareSplice ->
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr (R () -> R ()
sitcc (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
where
decoSymbol :: Text
decoSymbol = if Bool
isTyped then Text
"$$" else Text
"$"
p_hsBracket :: HsBracket GhcPs -> R ()
p_hsBracket :: HsBracket GhcPs -> R ()
p_hsBracket = \case
ExpBr XExpBr GhcPs
NoExtField LHsExpr GhcPs
expr -> do
[AnnKeywordId]
anns <- R [AnnKeywordId]
getEnclosingAnns
let name :: Text
name = case [AnnKeywordId]
anns of
AnnKeywordId
AnnOpenEQ : [AnnKeywordId]
_ -> Text
""
[AnnKeywordId]
_ -> Text
"e"
Text -> R () -> R ()
quote Text
name (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr HsExpr GhcPs -> R ()
p_hsExpr)
PatBr XPatBr GhcPs
NoExtField LPat GhcPs
pat -> Located (Pat GhcPs) -> (Pat GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LPat GhcPs
Located (Pat GhcPs)
pat (Text -> R () -> R ()
quote Text
"p" (R () -> R ()) -> (Pat GhcPs -> R ()) -> Pat GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat GhcPs -> R ()
p_pat)
DecBrL XDecBrL GhcPs
NoExtField [LHsDecl GhcPs]
decls -> Text -> R () -> R ()
quote Text
"d" ([LHsDecl GhcPs] -> R () -> R ()
forall a. Data a => a -> R () -> R ()
handleStarIsType [LHsDecl GhcPs]
decls (FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDecls FamilyStyle
Free [LHsDecl GhcPs]
decls))
DecBrG XDecBrG GhcPs
NoExtField HsGroup GhcPs
_ -> String -> R ()
forall a. String -> a
notImplemented String
"DecBrG"
TypBr XTypBr GhcPs
NoExtField GenLocated SrcSpan (HsType GhcPs)
ty -> Text -> R () -> R ()
quote Text
"t" (GenLocated SrcSpan (HsType GhcPs) -> (HsType GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located GenLocated SrcSpan (HsType GhcPs)
ty (GenLocated SrcSpan (HsType GhcPs) -> R () -> R ()
forall a. Data a => a -> R () -> R ()
handleStarIsType GenLocated SrcSpan (HsType GhcPs)
ty (R () -> R ()) -> (HsType GhcPs -> R ()) -> HsType GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType GhcPs -> R ()
p_hsType))
VarBr XVarBr GhcPs
NoExtField Bool
isSingleQuote IdP GhcPs
name -> do
Text -> R ()
txt (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"''" Text
"'" Bool
isSingleQuote)
let isOperator :: Bool
isOperator =
(Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
(\Char
i -> Char -> Bool
isPunctuation Char
i Bool -> Bool -> Bool
|| Char -> Bool
isSymbol Char
i)
(OccName -> String
forall o. Outputable o => o -> String
showOutputable (RdrName -> OccName
rdrNameOcc IdP GhcPs
RdrName
name))
Bool -> Bool -> Bool
&& Bool -> Bool
not (RdrName -> Bool
doesNotNeedExtraParens IdP GhcPs
RdrName
name)
wrapper :: R () -> R ()
wrapper = if Bool
isOperator then BracketStyle -> R () -> R ()
parens BracketStyle
N else R () -> R ()
forall a. a -> a
id
R () -> R ()
wrapper (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> R ()
p_rdrName (RdrName -> Located RdrName
forall e. e -> Located e
noLoc IdP GhcPs
RdrName
name)
TExpBr XTExpBr GhcPs
NoExtField LHsExpr GhcPs
expr -> do
Text -> R ()
txt Text
"[||"
R ()
breakpoint'
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint'
Text -> R ()
txt Text
"||]"
where
quote :: Text -> R () -> R ()
quote :: Text -> R () -> R ()
quote Text
name R ()
body = do
Text -> R ()
txt Text
"["
Text -> R ()
txt Text
name
Text -> R ()
txt Text
"|"
R ()
breakpoint'
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R () -> R ()
dontUseBraces R ()
body
R ()
breakpoint'
Text -> R ()
txt Text
"|]"
handleStarIsType :: Data a => a -> R () -> R ()
handleStarIsType :: a -> R () -> R ()
handleStarIsType a
a R ()
p
| a -> Bool
containsHsStarTy a
a = R ()
space R () -> R () -> R ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> R ()
p R () -> R () -> R ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* R ()
space
| Bool
otherwise = R ()
p
where
containsHsStarTy :: a -> Bool
containsHsStarTy = (Bool -> Bool -> Bool) -> GenericQ Bool -> GenericQ Bool
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything Bool -> Bool -> Bool
(||) (GenericQ Bool -> GenericQ Bool) -> GenericQ Bool -> GenericQ Bool
forall a b. (a -> b) -> a -> b
$ \a
b -> case a -> Maybe (HsType GhcPs)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast @_ @(HsType GhcPs) a
b of
Just HsStarTy {} -> Bool
True
Maybe (HsType GhcPs)
_ -> Bool
False
p_stringLit :: String -> R ()
p_stringLit :: String -> R ()
p_stringLit String
src =
let s :: [String]
s = String -> [String]
splitGaps String
src
singleLine :: R ()
singleLine =
Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack ([String] -> String
forall a. Monoid a => [a] -> a
mconcat [String]
s)
multiLine :: R ()
multiLine =
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (String -> R ()) -> [String] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (Text -> R ()
txt (Text -> R ()) -> (String -> Text) -> String -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) ([String] -> [String]
backslashes [String]
s)
in R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout R ()
singleLine R ()
multiLine
where
splitGaps :: String -> [String]
splitGaps :: String -> [String]
splitGaps String
"" = []
splitGaps String
s =
let
p :: (Maybe Char, Char, Maybe Char) -> Bool
p (Just Char
'\\', Char
_, Maybe Char
_) = Bool
True
p (Maybe Char
_, Char
'\\', Just Char
c) | Char -> Bool
ghcSpace Char
c = Bool
False
p (Maybe Char, Char, Maybe Char)
_ = Bool
True
in case ((Maybe Char, Char, Maybe Char) -> Bool)
-> [(Maybe Char, Char, Maybe Char)]
-> ([(Maybe Char, Char, Maybe Char)],
[(Maybe Char, Char, Maybe Char)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Maybe Char, Char, Maybe Char) -> Bool
p (String -> [(Maybe Char, Char, Maybe Char)]
forall a. [a] -> [(Maybe a, a, Maybe a)]
zipPrevNext String
s) of
([(Maybe Char, Char, Maybe Char)]
l, [(Maybe Char, Char, Maybe Char)]
r) ->
let
r' :: String
r' = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
ghcSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ((Maybe Char, Char, Maybe Char) -> Char)
-> [(Maybe Char, Char, Maybe Char)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Char, Char, Maybe Char) -> Char
forall a b c. (a, b, c) -> b
orig [(Maybe Char, Char, Maybe Char)]
r
in ((Maybe Char, Char, Maybe Char) -> Char)
-> [(Maybe Char, Char, Maybe Char)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Char, Char, Maybe Char) -> Char
forall a b c. (a, b, c) -> b
orig [(Maybe Char, Char, Maybe Char)]
l String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
splitGaps String
r'
ghcSpace :: Char -> Bool
ghcSpace :: Char -> Bool
ghcSpace Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x7f' Bool -> Bool -> Bool
&& Char -> Bool
is_space Char
c
backslashes :: [String] -> [String]
backslashes :: [String] -> [String]
backslashes (String
x : String
y : [String]
xs) = (String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
backslashes ((Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: String
y) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs)
backslashes [String]
xs = [String]
xs
zipPrevNext :: [a] -> [(Maybe a, a, Maybe a)]
zipPrevNext :: [a] -> [(Maybe a, a, Maybe a)]
zipPrevNext [a]
xs =
let z :: [((Maybe a, a), Maybe a)]
z =
[(Maybe a, a)] -> [Maybe a] -> [((Maybe a, a), Maybe a)]
forall a b. [a] -> [b] -> [(a, b)]
zip
([Maybe a] -> [a] -> [(Maybe a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Maybe a
forall a. Maybe a
Nothing Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: (a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just [a]
xs) [a]
xs)
((a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just ([a] -> [a]
forall a. [a] -> [a]
tail [a]
xs) [Maybe a] -> [Maybe a] -> [Maybe a]
forall a. [a] -> [a] -> [a]
++ Maybe a -> [Maybe a]
forall a. a -> [a]
repeat Maybe a
forall a. Maybe a
Nothing)
in (((Maybe a, a), Maybe a) -> (Maybe a, a, Maybe a))
-> [((Maybe a, a), Maybe a)] -> [(Maybe a, a, Maybe a)]
forall a b. (a -> b) -> [a] -> [b]
map (\((Maybe a
p, a
x), Maybe a
n) -> (Maybe a
p, a
x, Maybe a
n)) [((Maybe a, a), Maybe a)]
z
orig :: (a, b, c) -> b
orig (a
_, b
x, c
_) = b
x
layoutToBraces :: Layout -> R () -> R ()
layoutToBraces :: Layout -> R () -> R ()
layoutToBraces = \case
Layout
SingleLine -> R () -> R ()
useBraces
Layout
MultiLine -> R () -> R ()
forall a. a -> a
id
liftAppend :: Semigroup a => [a] -> [a] -> [a]
liftAppend :: [a] -> [a] -> [a]
liftAppend [] [] = []
liftAppend [] (a
y : [a]
ys) = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys
liftAppend (a
x : [a]
xs) [] = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
liftAppend (a
x : [a]
xs) (a
y : [a]
ys) = a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend [a]
xs [a]
ys
getGRHSSpan :: GRHS GhcPs (Located body) -> SrcSpan
getGRHSSpan :: GRHS GhcPs (Located body) -> SrcSpan
getGRHSSpan (GRHS XCGRHS GhcPs (Located body)
NoExtField [GuardLStmt GhcPs]
guards Located body
body) =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ Located body -> SrcSpan
forall l e. GenLocated l e -> l
getLoc Located body
body SrcSpan -> [SrcSpan] -> NonEmpty SrcSpan
forall a. a -> [a] -> NonEmpty a
:| (GuardLStmt GhcPs -> SrcSpan) -> [GuardLStmt GhcPs] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GuardLStmt GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc [GuardLStmt GhcPs]
guards
placeHanging :: Placement -> R () -> R ()
placeHanging :: Placement -> R () -> R ()
placeHanging Placement
placement R ()
m =
case Placement
placement of
Placement
Hanging -> do
R ()
space
R ()
m
Placement
Normal -> do
R ()
breakpoint
R () -> R ()
inci R ()
m
blockPlacement ::
(body -> Placement) ->
[LGRHS GhcPs (Located body)] ->
Placement
blockPlacement :: (body -> Placement) -> [LGRHS GhcPs (Located body)] -> Placement
blockPlacement body -> Placement
placer [L SrcSpan
_ (GRHS XCGRHS GhcPs (Located body)
NoExtField [GuardLStmt GhcPs]
_ (L SrcSpan
_ body
x))] = body -> Placement
placer body
x
blockPlacement body -> Placement
_ [LGRHS GhcPs (Located body)]
_ = Placement
Normal
cmdPlacement :: HsCmd GhcPs -> Placement
cmdPlacement :: HsCmd GhcPs -> Placement
cmdPlacement = \case
HsCmdLam XCmdLam GhcPs
NoExtField MatchGroup GhcPs (GenLocated SrcSpan (HsCmd GhcPs))
_ -> Placement
Hanging
HsCmdCase XCmdCase GhcPs
NoExtField LHsExpr GhcPs
_ MatchGroup GhcPs (GenLocated SrcSpan (HsCmd GhcPs))
_ -> Placement
Hanging
HsCmdLamCase XCmdLamCase GhcPs
NoExtField MatchGroup GhcPs (GenLocated SrcSpan (HsCmd GhcPs))
_ -> Placement
Hanging
HsCmdDo XCmdDo GhcPs
NoExtField Located [CmdLStmt GhcPs]
_ -> Placement
Hanging
HsCmd GhcPs
_ -> Placement
Normal
cmdTopPlacement :: HsCmdTop GhcPs -> Placement
cmdTopPlacement :: HsCmdTop GhcPs -> Placement
cmdTopPlacement (HsCmdTop XCmdTop GhcPs
NoExtField (L SrcSpan
_ HsCmd GhcPs
x)) = HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs
x
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement = \case
HsLam XLam GhcPs
NoExtField MatchGroup GhcPs (LHsExpr GhcPs)
mg -> case MatchGroup GhcPs (LHsExpr GhcPs)
mg of
MG XMG GhcPs (LHsExpr GhcPs)
_ (L SrcSpan
_ [L SrcSpan
_ (Match XCMatch GhcPs (LHsExpr GhcPs)
NoExtField HsMatchContext (NoGhcTc GhcPs)
_ (LPat GhcPs
x : [LPat GhcPs]
xs) GRHSs GhcPs (LHsExpr GhcPs)
_)]) Origin
_
| SrcSpan -> Bool
isOneLineSpan (NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ (Located (Pat GhcPs) -> SrcSpan)
-> NonEmpty (Located (Pat GhcPs)) -> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located (Pat GhcPs) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (LPat GhcPs
Located (Pat GhcPs)
x Located (Pat GhcPs)
-> [Located (Pat GhcPs)] -> NonEmpty (Located (Pat GhcPs))
forall a. a -> [a] -> NonEmpty a
:| [LPat GhcPs]
[Located (Pat GhcPs)]
xs)) ->
Placement
Hanging
MatchGroup GhcPs (LHsExpr GhcPs)
_ -> Placement
Normal
HsLamCase XLamCase GhcPs
NoExtField MatchGroup GhcPs (LHsExpr GhcPs)
_ -> Placement
Hanging
HsCase XCase GhcPs
NoExtField LHsExpr GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
_ -> Placement
Hanging
HsDo XDo GhcPs
NoExtField (DoExpr Maybe ModuleName
_) Located [GuardLStmt GhcPs]
_ -> Placement
Hanging
HsDo XDo GhcPs
NoExtField (MDoExpr Maybe ModuleName
_) Located [GuardLStmt GhcPs]
_ -> Placement
Hanging
OpApp XOpApp GhcPs
NoExtField LHsExpr GhcPs
_ LHsExpr GhcPs
op LHsExpr GhcPs
y ->
case ((RdrName -> String) -> Maybe RdrName -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> String
getOpNameStr (Maybe RdrName -> Maybe String)
-> (LHsExpr GhcPs -> Maybe RdrName)
-> LHsExpr GhcPs
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> Maybe RdrName
getOpName (HsExpr GhcPs -> Maybe RdrName)
-> (LHsExpr GhcPs -> HsExpr GhcPs)
-> LHsExpr GhcPs
-> Maybe RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc) LHsExpr GhcPs
op of
Just String
"$" -> HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
y)
Maybe String
_ -> Placement
Normal
HsApp XApp GhcPs
NoExtField LHsExpr GhcPs
_ LHsExpr GhcPs
y -> HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
y)
HsProc XProc GhcPs
NoExtField LPat GhcPs
p LHsCmdTop GhcPs
_ ->
if SrcSpan -> Bool
isOneLineSpan (Located (Pat GhcPs) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LPat GhcPs
Located (Pat GhcPs)
p)
then Placement
Hanging
else Placement
Normal
HsExpr GhcPs
_ -> Placement
Normal
withGuards :: [LGRHS GhcPs (Located body)] -> Bool
withGuards :: [LGRHS GhcPs (Located body)] -> Bool
withGuards = (LGRHS GhcPs (Located body) -> Bool)
-> [LGRHS GhcPs (Located body)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GRHS GhcPs (Located body) -> Bool
forall body. GRHS GhcPs (Located body) -> Bool
checkOne (GRHS GhcPs (Located body) -> Bool)
-> (LGRHS GhcPs (Located body) -> GRHS GhcPs (Located body))
-> LGRHS GhcPs (Located body)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LGRHS GhcPs (Located body) -> GRHS GhcPs (Located body)
forall l e. GenLocated l e -> e
unLoc)
where
checkOne :: GRHS GhcPs (Located body) -> Bool
checkOne :: GRHS GhcPs (Located body) -> Bool
checkOne (GRHS XCGRHS GhcPs (Located body)
NoExtField [] Located body
_) = Bool
False
checkOne GRHS GhcPs (Located body)
_ = Bool
True
exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree (L SrcSpan
_ (OpApp XOpApp GhcPs
NoExtField LHsExpr GhcPs
x LHsExpr GhcPs
op LHsExpr GhcPs
y)) = OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
x) LHsExpr GhcPs
op (LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
y)
exprOpTree LHsExpr GhcPs
n = LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
forall ty op. ty -> OpTree ty op
OpNode LHsExpr GhcPs
n
getOpName :: HsExpr GhcPs -> Maybe RdrName
getOpName :: HsExpr GhcPs -> Maybe RdrName
getOpName = \case
HsVar XVar GhcPs
NoExtField (L SrcSpan
_ IdP GhcPs
a) -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just IdP GhcPs
RdrName
a
HsExpr GhcPs
_ -> Maybe RdrName
forall a. Maybe a
Nothing
getOpNameStr :: RdrName -> String
getOpNameStr :: RdrName -> String
getOpNameStr = OccName -> String
occNameString (OccName -> String) -> (RdrName -> OccName) -> RdrName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc
p_exprOpTree ::
BracketStyle ->
OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->
R ()
p_exprOpTree :: BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree BracketStyle
s (OpNode LHsExpr GhcPs
x) = LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
p_exprOpTree BracketStyle
s (OpBranch OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x LHsExpr GhcPs
op OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y) = do
let placement :: Placement
placement =
if SrcSpan -> Bool
isOneLineSpan
(SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (SrcSpan -> SrcLoc
srcSpanStart (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x)) (SrcSpan -> SrcLoc
srcSpanStart (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y)))
then case OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y of
OpNode (L SrcSpan
_ HsExpr GhcPs
n) -> HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs
n
OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
_ -> Placement
Normal
else Placement
Normal
opWrapper :: R () -> R ()
opWrapper = case LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
op of
HsUnboundVar XUnboundVar GhcPs
NoExtField OccName
_ -> R () -> R ()
backticks
HsExpr GhcPs
_ -> R () -> R ()
forall a. a -> a
id
Layout
layout <- R Layout
getLayout
let ub :: R () -> R ()
ub = case Layout
layout of
Layout
SingleLine -> R () -> R ()
useBraces
Layout
MultiLine -> case Placement
placement of
Placement
Hanging -> R () -> R ()
useBraces
Placement
Normal -> R () -> R ()
dontUseBraces
opNameStr :: Maybe String
opNameStr = ((RdrName -> String) -> Maybe RdrName -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> String
getOpNameStr (Maybe RdrName -> Maybe String)
-> (LHsExpr GhcPs -> Maybe RdrName)
-> LHsExpr GhcPs
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> Maybe RdrName
getOpName (HsExpr GhcPs -> Maybe RdrName)
-> (LHsExpr GhcPs -> HsExpr GhcPs)
-> LHsExpr GhcPs
-> Maybe RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc) LHsExpr GhcPs
op
gotDollar :: Bool
gotDollar = Maybe String
opNameStr Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"$"
gotColon :: Bool
gotColon = Maybe String
opNameStr Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
":"
gotRecordDot :: Bool
gotRecordDot = HsExpr GhcPs -> SrcSpan -> Bool
isRecordDot (LHsExpr GhcPs -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
op) (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y)
lhs :: R ()
lhs =
[SrcSpan] -> R () -> R ()
switchLayout [OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree BracketStyle
s OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x
p_op :: R ()
p_op = LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
op (R () -> R ()
opWrapper (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
p_y :: R ()
p_y = [SrcSpan] -> R () -> R ()
switchLayout [OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y] (BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree BracketStyle
N OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y)
isSection :: Bool
isSection = case (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x, LHsExpr GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LHsExpr GhcPs
op) of
(RealSrcSpan RealSrcSpan
treeSpan Maybe BufSpan
_, RealSrcSpan RealSrcSpan
opSpan Maybe BufSpan
_) ->
RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
treeSpan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
opSpan
(SrcSpan, SrcSpan)
_ -> Bool
False
isDoBlock :: OpTree (GenLocated l (HsExpr p)) op -> Bool
isDoBlock = \case
OpNode (L l
_ HsDo {}) -> Bool
True
OpTree (GenLocated l (HsExpr p)) op
_ -> Bool
False
Bool
useRecordDot' <- R Bool
useRecordDot
if
| Bool
gotColon -> do
R ()
lhs
R ()
space
R ()
p_op
case Placement
placement of
Placement
Hanging -> do
R ()
space
R ()
p_y
Placement
Normal -> do
R ()
breakpoint
Bool -> R () -> R ()
inciIf (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> Bool
forall l p op. OpTree (GenLocated l (HsExpr p)) op -> Bool
isDoBlock OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y) R ()
p_y
| Bool
gotDollar
Bool -> Bool -> Bool
&& SrcSpan -> Bool
isOneLineSpan (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x)
Bool -> Bool -> Bool
&& Placement
placement Placement -> Placement -> Bool
forall a. Eq a => a -> a -> Bool
== Placement
Normal -> do
R () -> R ()
useBraces R ()
lhs
R ()
space
R ()
p_op
R ()
breakpoint
R () -> R ()
inci R ()
p_y
| Bool
useRecordDot' Bool -> Bool -> Bool
&& Bool
gotRecordDot -> do
R ()
lhs
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isSection R ()
space
R ()
p_op
R ()
p_y
| Bool
otherwise -> do
R () -> R ()
ub R ()
lhs
Placement -> R () -> R ()
placeHanging Placement
placement (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
p_op
R ()
space
R ()
p_y
isRecordDot ::
HsExpr GhcPs ->
SrcSpan ->
Bool
isRecordDot :: HsExpr GhcPs -> SrcSpan -> Bool
isRecordDot HsExpr GhcPs
op (RealSrcSpan RealSrcSpan
ySpan Maybe BufSpan
_) = case HsExpr GhcPs
op of
HsVar XVar GhcPs
NoExtField (L (RealSrcSpan RealSrcSpan
opSpan Maybe BufSpan
_) IdP GhcPs
opName) ->
(RdrName -> String
getOpNameStr IdP GhcPs
RdrName
opName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".") Bool -> Bool -> Bool
&& (RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
opSpan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
ySpan)
HsExpr GhcPs
_ -> Bool
False
isRecordDot HsExpr GhcPs
_ SrcSpan
_ = Bool
False
getEnclosingAnns :: R [AnnKeywordId]
getEnclosingAnns :: R [AnnKeywordId]
getEnclosingAnns = do
Maybe RealSrcSpan
e <- (RealSrcSpan -> Bool) -> R (Maybe RealSrcSpan)
getEnclosingSpan (Bool -> RealSrcSpan -> Bool
forall a b. a -> b -> a
const Bool
True)
case Maybe RealSrcSpan
e of
Maybe RealSrcSpan
Nothing -> [AnnKeywordId] -> R [AnnKeywordId]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just RealSrcSpan
e' -> SrcSpan -> R [AnnKeywordId]
getAnns (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
e' Maybe BufSpan
forall a. Maybe a
Nothing)