{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Ormolu.Printer.Meat.Declaration.Value
( p_valDecl,
p_pat,
p_hsExpr,
p_hsSplice,
p_stringLit,
)
where
import Bag (bagToList)
import BasicTypes
import Control.Monad
import Ctype (is_space)
import Data.Bool (bool)
import Data.Char (isPunctuation, isSymbol)
import Data.Data hiding (Infix, Prefix)
import Data.Functor ((<&>))
import Data.List (intersperse, sortOn)
import Data.List.NonEmpty ((<|), NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NE
import Data.Text (Text)
import qualified Data.Text as Text
import GHC
import OccName (mkVarOcc)
import Ormolu.Printer.Combinators
import Ormolu.Printer.Internal
import Ormolu.Printer.Meat.Common
import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration
import Ormolu.Printer.Meat.Declaration.Signature
import Ormolu.Printer.Meat.Type
import Ormolu.Printer.Operators
import Ormolu.Utils
import RdrName (RdrName (..), rdrNameOcc)
import SrcLoc (combineSrcSpans, isOneLineSpan)
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)
p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
p_valDecl = \case
FunBind NoExt funId :: Located (IdP GhcPs)
funId funMatches :: MatchGroup GhcPs (LHsExpr GhcPs)
funMatches _ _ -> Located RdrName -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_funBind Located (IdP GhcPs)
Located RdrName
funId MatchGroup GhcPs (LHsExpr GhcPs)
funMatches
PatBind NoExt pat :: LPat GhcPs
pat grhss :: GRHSs GhcPs (LHsExpr GhcPs)
grhss _ -> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (LHsExpr GhcPs)
-> R ()
p_match MatchGroupStyle
PatternBind Bool
False SrcStrictness
NoSrcStrict [LPat GhcPs
pat] GRHSs GhcPs (LHsExpr GhcPs)
grhss
VarBind {} -> String -> R ()
forall a. String -> a
notImplemented "VarBinds"
AbsBinds {} -> String -> R ()
forall a. String -> a
notImplemented "AbsBinds"
PatSynBind NoExt psb :: PatSynBind GhcPs GhcPs
psb -> PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PatSynBind GhcPs GhcPs
psb
XHsBindsLR NoExt -> String -> R ()
forall a. String -> a
notImplemented "XHsBindsLR"
p_funBind ::
Located RdrName ->
MatchGroup GhcPs (LHsExpr GhcPs) ->
R ()
p_funBind :: Located RdrName -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_funBind name :: Located RdrName
name = MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup (Located RdrName -> MatchGroupStyle
Function Located RdrName
name)
p_matchGroup ::
MatchGroupStyle ->
MatchGroup GhcPs (LHsExpr GhcPs) ->
R ()
p_matchGroup :: MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup = (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
p_matchGroup' HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr
p_matchGroup' ::
Data body =>
(body -> Placement) ->
(body -> R ()) ->
MatchGroupStyle ->
MatchGroup GhcPs (Located body) ->
R ()
p_matchGroup' :: (body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
p_matchGroup' placer :: body -> Placement
placer render :: body -> R ()
render style :: MatchGroupStyle
style MG {..} = do
let ob :: R () -> R ()
ob = case MatchGroupStyle
style of
Case -> R () -> R ()
forall a. a -> a
id
LambdaCase -> R () -> R ()
forall a. a -> a
id
_ -> R () -> R ()
dontUseBraces
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. Data a => (a -> R ()) -> Located a -> R ()
located' (R () -> R ()
ub (R () -> R ())
-> (Match GhcPs (Located body) -> R ())
-> Match GhcPs (Located body)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs (Located body) -> R ()
p_Match)) (Located [LMatch GhcPs (Located body)]
-> SrcSpanLess (Located [LMatch GhcPs (Located body)])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LMatch GhcPs (Located body)]
mg_alts)
where
p_Match :: Match GhcPs (Located body) -> R ()
p_Match m :: Match GhcPs (Located body)
m@Match {..} =
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (Located body)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> Bool
-> SrcStrictness
-> [LPat GhcPs]
-> GRHSs GhcPs (Located body)
-> R ()
p_match'
body -> Placement
placer
body -> R ()
render
(Match GhcPs (Located body) -> MatchGroupStyle -> MatchGroupStyle
forall body. Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle Match GhcPs (Located body)
m MatchGroupStyle
style)
(Match GhcPs (Located body) -> Bool
forall id body. Match id body -> Bool
isInfixMatch Match GhcPs (Located body)
m)
(Match GhcPs (Located body) -> SrcStrictness
forall id body. Match id body -> SrcStrictness
matchStrictness Match GhcPs (Located body)
m)
[LPat GhcPs]
m_pats
GRHSs GhcPs (Located body)
m_grhss
p_Match _ = String -> R ()
forall a. String -> a
notImplemented "XMatch"
p_matchGroup' _ _ _ (XMatchGroup NoExt) = String -> R ()
forall a. String -> a
notImplemented "XMatchGroup"
adjustMatchGroupStyle ::
Match GhcPs body ->
MatchGroupStyle ->
MatchGroupStyle
adjustMatchGroupStyle :: Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle
adjustMatchGroupStyle m :: Match GhcPs body
m = \case
Function _ -> (Located RdrName -> MatchGroupStyle
Function (Located RdrName -> MatchGroupStyle)
-> (Match GhcPs body -> Located RdrName)
-> Match GhcPs body
-> MatchGroupStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsMatchContext RdrName -> Located RdrName
forall id. HsMatchContext id -> Located id
mc_fun (HsMatchContext RdrName -> Located RdrName)
-> (Match GhcPs body -> HsMatchContext RdrName)
-> Match GhcPs body
-> Located RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match GhcPs body -> HsMatchContext RdrName
forall p body.
Match p body -> HsMatchContext (NameOrRdrName (IdP p))
m_ctxt) Match GhcPs body
m
style :: MatchGroupStyle
style -> MatchGroupStyle
style
matchStrictness :: Match id body -> SrcStrictness
matchStrictness :: Match id body -> SrcStrictness
matchStrictness match :: Match id body
match =
case Match id body -> HsMatchContext (NameOrRdrName (IdP id))
forall p body.
Match p body -> HsMatchContext (NameOrRdrName (IdP p))
m_ctxt Match id body
match of
FunRhs {mc_strictness :: forall id. HsMatchContext id -> SrcStrictness
mc_strictness = SrcStrictness
s} -> SrcStrictness
s
_ -> SrcStrictness
NoSrcStrict
p_match ::
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' placer :: body -> Placement
placer render :: body -> R ()
render style :: MatchGroupStyle
style isInfix :: Bool
isInfix strictness :: SrcStrictness
strictness m_pats :: [LPat GhcPs]
m_pats GRHSs {..} = do
case SrcStrictness
strictness of
NoSrcStrict -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
SrcStrict -> Text -> R ()
txt "!"
SrcLazy -> Text -> R ()
txt "~"
R () -> R ()
inci' <- case [LPat GhcPs] -> Maybe (NonEmpty (LPat GhcPs))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
m_pats of
Nothing -> R () -> R ()
forall a. a -> a
id (R () -> R ()) -> R () -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ case MatchGroupStyle
style of
Function name :: Located RdrName
name -> Located RdrName -> R ()
p_rdrName Located RdrName
name
_ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ne_pats :: NonEmpty (LPat GhcPs)
ne_pats -> do
let combinedSpans :: SrcSpan
combinedSpans =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$
LPat GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LPat GhcPs -> SrcSpan)
-> NonEmpty (LPat GhcPs) -> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (LPat GhcPs)
ne_pats
inci' :: R () -> R ()
inci' =
if SrcSpan -> Bool
isOneLineSpan SrcSpan
combinedSpans
then R () -> R ()
forall a. a -> a
id
else R () -> R ()
inci
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
combinedSpans] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
let stdCase :: R ()
stdCase = R () -> (LPat GhcPs -> R ()) -> [LPat GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint LPat GhcPs -> R ()
p_pat [LPat GhcPs]
m_pats
case MatchGroupStyle
style of
Function name :: Located RdrName
name ->
Bool -> (R () -> R ()) -> R () -> [R ()] -> R ()
p_infixDefHelper
Bool
isInfix
R () -> R ()
inci'
(Located RdrName -> R ()
p_rdrName Located RdrName
name)
(LPat GhcPs -> R ()
p_pat (LPat GhcPs -> R ()) -> [LPat GhcPs] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs]
m_pats)
PatternBind -> R ()
stdCase
Case -> R ()
stdCase
Lambda -> do
let needsSpace :: Bool
needsSpace = case LPat GhcPs -> SrcSpanLess (LPat GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (NonEmpty (LPat GhcPs) -> LPat GhcPs
forall a. NonEmpty a -> a
NE.head NonEmpty (LPat GhcPs)
ne_pats) of
LazyPat _ _ -> Bool
True
BangPat _ _ -> Bool
True
SplicePat _ _ -> Bool
True
_ -> Bool
False
Text -> R ()
txt "\\"
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsSpace R ()
space
R () -> R ()
sitcc R ()
stdCase
LambdaCase -> R ()
stdCase
(R () -> R ()) -> R (R () -> R ())
forall (m :: * -> *) a. Monad m => a -> m a
return R () -> R ()
inci'
let
endOfPats :: Maybe SrcLoc
endOfPats = case [LPat GhcPs] -> Maybe (NonEmpty (LPat GhcPs))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [LPat GhcPs]
m_pats of
Nothing -> case MatchGroupStyle
style of
Function name :: Located RdrName
name -> (SrcLoc -> Maybe SrcLoc
forall a. a -> Maybe a
Just (SrcLoc -> Maybe SrcLoc)
-> (Located RdrName -> SrcLoc) -> Located RdrName -> Maybe SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanEnd (SrcSpan -> SrcLoc)
-> (Located RdrName -> SrcSpan) -> Located RdrName -> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc) Located RdrName
name
_ -> Maybe SrcLoc
forall a. Maybe a
Nothing
Just pats :: NonEmpty (LPat GhcPs)
pats -> (SrcLoc -> Maybe SrcLoc
forall a. a -> Maybe a
Just (SrcLoc -> Maybe SrcLoc)
-> (NonEmpty (LPat GhcPs) -> SrcLoc)
-> NonEmpty (LPat GhcPs)
-> Maybe SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanEnd (SrcSpan -> SrcLoc)
-> (NonEmpty (LPat GhcPs) -> SrcSpan)
-> NonEmpty (LPat GhcPs)
-> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LPat GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LPat GhcPs -> SrcSpan)
-> (NonEmpty (LPat GhcPs) -> LPat GhcPs)
-> NonEmpty (LPat GhcPs)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (LPat GhcPs) -> LPat GhcPs
forall a. NonEmpty a -> a
NE.last) NonEmpty (LPat GhcPs)
pats
isCase :: MatchGroupStyle -> Bool
isCase = \case
Case -> Bool
True
LambdaCase -> Bool
True
_ -> Bool
False
let hasGuards :: Bool
hasGuards = [LGRHS GhcPs (Located body)] -> Bool
forall body. [LGRHS GhcPs (Located body)] -> Bool
withGuards [LGRHS GhcPs (Located body)]
grhssGRHSs
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LGRHS GhcPs (Located body)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LGRHS GhcPs (Located body)]
grhssGRHSs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
case MatchGroupStyle
style of
Function _ | Bool
hasGuards -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Function _ -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt "="
PatternBind -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt "="
s :: MatchGroupStyle
s | MatchGroupStyle -> Bool
isCase MatchGroupStyle
s Bool -> Bool -> Bool
&& Bool
hasGuards -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> R ()
space R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt "->"
let grhssSpan :: SrcSpan
grhssSpan =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$
GRHS GhcPs (Located body) -> SrcSpan
forall body. GRHS GhcPs (Located body) -> SrcSpan
getGRHSSpan (GRHS GhcPs (Located body) -> SrcSpan)
-> (LGRHS GhcPs (Located body) -> GRHS GhcPs (Located body))
-> LGRHS GhcPs (Located body)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LGRHS GhcPs (Located body) -> GRHS GhcPs (Located body)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LGRHS GhcPs (Located body) -> SrcSpan)
-> NonEmpty (LGRHS GhcPs (Located body)) -> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LGRHS GhcPs (Located body)]
-> NonEmpty (LGRHS GhcPs (Located body))
forall a. [a] -> NonEmpty a
NE.fromList [LGRHS GhcPs (Located body)]
grhssGRHSs
patGrhssSpan :: SrcSpan
patGrhssSpan =
SrcSpan -> (SrcLoc -> SrcSpan) -> Maybe SrcLoc -> SrcSpan
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
SrcSpan
grhssSpan
(SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
grhssSpan (SrcSpan -> SrcSpan) -> (SrcLoc -> SrcSpan) -> SrcLoc -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcLoc -> SrcSpan
srcLocSpan)
Maybe SrcLoc
endOfPats
placement :: Placement
placement =
case Maybe SrcLoc
endOfPats of
Nothing -> (body -> Placement) -> [LGRHS GhcPs (Located body)] -> Placement
forall body.
(body -> Placement) -> [LGRHS GhcPs (Located body)] -> Placement
blockPlacement body -> Placement
placer [LGRHS GhcPs (Located body)]
grhssGRHSs
Just spn :: SrcLoc
spn ->
if SrcSpan -> Bool
isOneLineSpan
(SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
spn (SrcSpan -> SrcLoc
srcSpanStart 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. Data a => (a -> R ()) -> Located a -> R ()
located' ((body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (Located body)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> GroupStyle
-> GRHS GhcPs (Located body)
-> R ()
p_grhs' body -> Placement
placer body -> R ()
render GroupStyle
groupStyle)) [LGRHS GhcPs (Located body)]
grhssGRHSs
p_where :: R ()
p_where = do
let whereIsEmpty :: Bool
whereIsEmpty = HsLocalBindsLR GhcPs GhcPs -> Bool
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b) -> Bool
GHC.isEmptyLocalBindsPR (LHsLocalBinds GhcPs -> SrcSpanLess (LHsLocalBinds GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsLocalBinds GhcPs
grhssLocalBinds)
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HsLocalBindsLR GhcPs GhcPs -> Bool
forall a b. HsLocalBindsLR a b -> Bool
GHC.eqEmptyLocalBinds (LHsLocalBinds GhcPs -> SrcSpanLess (LHsLocalBinds GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsLocalBinds GhcPs
grhssLocalBinds)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
breakpoint
Text -> R ()
txt "where"
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
whereIsEmpty R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsLocalBinds GhcPs -> (HsLocalBindsLR GhcPs GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsLocalBinds GhcPs
grhssLocalBinds HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds
R () -> R ()
inci' (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
patGrhssSpan] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body
R () -> R ()
inci R ()
p_where
p_match' _ _ _ _ _ _ XGRHSs {} = String -> R ()
forall a. String -> a
notImplemented "XGRHSs"
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' placer :: body -> Placement
placer render :: body -> R ()
render style :: GroupStyle
style (GRHS NoExt guards :: [GuardLStmt GhcPs]
guards body :: Located body
body) =
case [GuardLStmt GhcPs]
guards of
[] -> R ()
p_body
xs :: [GuardLStmt GhcPs]
xs -> do
Text -> R ()
txt "|"
R ()
space
R () -> R ()
sitcc (R () -> (GuardLStmt GhcPs -> R ()) -> [GuardLStmt GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) (R () -> R ()
sitcc (R () -> R ())
-> (GuardLStmt GhcPs -> R ()) -> GuardLStmt GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt GhcPs (LHsExpr GhcPs) -> R ()) -> GuardLStmt GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt) [GuardLStmt GhcPs]
xs)
R ()
space
Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ case GroupStyle
style of
EqualSign -> "="
RightArrow -> "->"
Placement -> R () -> R ()
placeHanging Placement
placement R ()
p_body
where
placement :: Placement
placement =
case Maybe SrcLoc
endOfGuards of
Nothing -> body -> Placement
placer (Located body -> SrcSpanLess (Located body)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located body
body)
Just spn :: SrcLoc
spn ->
if SrcSpan -> Bool
isOneLineSpan (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
spn (SrcSpan -> SrcLoc
srcSpanStart (Located body -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located body
body)))
then body -> Placement
placer (Located body -> SrcSpanLess (Located body)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located body
body)
else Placement
Normal
endOfGuards :: Maybe SrcLoc
endOfGuards =
case [GuardLStmt GhcPs] -> Maybe (NonEmpty (GuardLStmt GhcPs))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [GuardLStmt GhcPs]
guards of
Nothing -> Maybe SrcLoc
forall a. Maybe a
Nothing
Just gs :: NonEmpty (GuardLStmt GhcPs)
gs -> (SrcLoc -> Maybe SrcLoc
forall a. a -> Maybe a
Just (SrcLoc -> Maybe SrcLoc)
-> (NonEmpty (GuardLStmt GhcPs) -> SrcLoc)
-> NonEmpty (GuardLStmt GhcPs)
-> Maybe SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanEnd (SrcSpan -> SrcLoc)
-> (NonEmpty (GuardLStmt GhcPs) -> SrcSpan)
-> NonEmpty (GuardLStmt GhcPs)
-> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (GuardLStmt GhcPs -> SrcSpan)
-> (NonEmpty (GuardLStmt GhcPs) -> GuardLStmt GhcPs)
-> NonEmpty (GuardLStmt GhcPs)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (GuardLStmt GhcPs) -> GuardLStmt GhcPs
forall a. NonEmpty a -> a
NE.last) NonEmpty (GuardLStmt GhcPs)
gs
p_body :: R ()
p_body = Located body -> (body -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located body
body body -> R ()
render
p_grhs' _ _ _ (XGRHS NoExt) = String -> R ()
forall a. String -> a
notImplemented "XGRHS"
p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd = \case
HsCmdArrApp NoExt body :: LHsExpr GhcPs
body input :: LHsExpr GhcPs
input arrType :: HsArrAppType
arrType _ -> do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
body HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
case HsArrAppType
arrType of
HsFirstOrderApp -> Text -> R ()
txt "-<"
HsHigherOrderApp -> Text -> R ()
txt "-<<"
Placement -> R () -> R ()
placeHanging (HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
input)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
input HsExpr GhcPs -> R ()
p_hsExpr
HsCmdArrForm NoExt form :: LHsExpr GhcPs
form Prefix _ cmds :: [LHsCmdTop GhcPs]
cmds -> R () -> R ()
banana (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data 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. Data 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 NoExt form :: LHsExpr GhcPs
form Infix _ [left :: LHsCmdTop GhcPs
left, right :: LHsCmdTop GhcPs
right] -> do
LHsCmdTop GhcPs -> (HsCmdTop GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
left HsCmdTop GhcPs -> R ()
p_hsCmdTop
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
form HsExpr GhcPs -> R ()
p_hsExpr
Placement -> R () -> R ()
placeHanging (HsCmdTop GhcPs -> Placement
cmdTopPlacement (LHsCmdTop GhcPs -> SrcSpanLess (LHsCmdTop GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsCmdTop GhcPs
right)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
LHsCmdTop GhcPs -> (HsCmdTop GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
right HsCmdTop GhcPs -> R ()
p_hsCmdTop
HsCmdArrForm NoExt _ Infix _ _ -> String -> R ()
forall a. String -> a
notImplemented "HsCmdArrForm"
HsCmdApp {} ->
String -> R ()
forall a. String -> a
notImplemented "HsCmdApp"
HsCmdLam NoExt mgroup :: MatchGroup GhcPs (LHsCmd GhcPs)
mgroup -> (HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (LHsCmd GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
p_matchGroup' HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd MatchGroupStyle
Lambda MatchGroup GhcPs (LHsCmd GhcPs)
mgroup
HsCmdPar NoExt c :: LHsCmd GhcPs
c -> BracketStyle -> R () -> R ()
parens BracketStyle
N (LHsCmd GhcPs -> (HsCmd GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
c HsCmd GhcPs -> R ()
p_hsCmd)
HsCmdCase NoExt e :: LHsExpr GhcPs
e mgroup :: MatchGroup GhcPs (LHsCmd GhcPs)
mgroup ->
(HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LHsCmd GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (Located body)
-> R ()
p_case HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd LHsExpr GhcPs
e MatchGroup GhcPs (LHsCmd GhcPs)
mgroup
HsCmdIf NoExt _ if' :: LHsExpr GhcPs
if' then' :: LHsCmd GhcPs
then' else' :: LHsCmd GhcPs
else' ->
(HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ())
-> LHsExpr GhcPs
-> LHsCmd GhcPs
-> LHsCmd GhcPs
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> Located body
-> Located body
-> R ()
p_if HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd LHsExpr GhcPs
if' LHsCmd GhcPs
then' LHsCmd GhcPs
else'
HsCmdLet NoExt localBinds :: LHsLocalBinds GhcPs
localBinds c :: LHsCmd GhcPs
c ->
(HsCmd GhcPs -> R ())
-> LHsLocalBinds GhcPs -> LHsCmd GhcPs -> R ()
forall body.
Data body =>
(body -> R ()) -> LHsLocalBinds GhcPs -> Located body -> R ()
p_let HsCmd GhcPs -> R ()
p_hsCmd LHsLocalBinds GhcPs
localBinds LHsCmd GhcPs
c
HsCmdDo NoExt es :: Located [CmdLStmt GhcPs]
es -> do
Text -> R ()
txt "do"
R ()
newline
R () -> R ()
inci (R () -> R ())
-> (([CmdLStmt GhcPs] -> R ()) -> R ())
-> ([CmdLStmt GhcPs] -> R ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located [CmdLStmt GhcPs] -> ([CmdLStmt GhcPs] -> R ()) -> R ()
forall a. Data 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 ((Stmt GhcPs (LHsCmd GhcPs) -> R ()) -> CmdLStmt GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' (R () -> R ()
sitcc (R () -> R ())
-> (Stmt GhcPs (LHsCmd GhcPs) -> R ())
-> Stmt GhcPs (LHsCmd GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsCmd GhcPs -> Placement)
-> (HsCmd GhcPs -> R ()) -> Stmt GhcPs (LHsCmd GhcPs) -> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
p_stmt' HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs -> R ()
p_hsCmd))
HsCmdWrap {} -> String -> R ()
forall a. String -> a
notImplemented "HsCmdWrap"
XCmd {} -> String -> R ()
forall a. String -> a
notImplemented "XCmd"
p_hsCmdTop :: HsCmdTop GhcPs -> R ()
p_hsCmdTop :: HsCmdTop GhcPs -> R ()
p_hsCmdTop = \case
HsCmdTop NoExt cmd :: LHsCmd GhcPs
cmd -> LHsCmd GhcPs -> (HsCmd GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsCmd GhcPs
cmd HsCmd GhcPs -> R ()
p_hsCmd
XCmdTop {} -> String -> R ()
forall a. String -> a
notImplemented "XHsCmdTop"
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' placer :: body -> Placement
placer render :: body -> R ()
render = \case
LastStmt NoExt body :: Located body
body _ _ -> Located body -> (body -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located body
body body -> R ()
render
BindStmt NoExt p :: LPat GhcPs
p f :: Located body
f _ _ -> do
LPat GhcPs -> R ()
p_pat LPat GhcPs
p
R ()
space
Text -> R ()
txt "<-"
let loc :: SrcSpan
loc = case LPat GhcPs
p of
XPat pat :: XXPat GhcPs
pat -> Located (LPat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc XXPat GhcPs
Located (LPat GhcPs)
pat
_ -> String -> SrcSpan
forall a. HasCallStack => String -> a
error "p_stmt': BindStmt: Pat does not contain a location"
let placement :: Placement
placement =
case Located body
f of
L l' :: SrcSpan
l' x :: body
x ->
if SrcSpan -> Bool
isOneLineSpan
(SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (SrcSpan -> SrcLoc
srcSpanEnd SrcSpan
loc) (SrcSpan -> SrcLoc
srcSpanStart SrcSpan
l'))
then body -> Placement
placer body
x
else Placement
Normal
[SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
loc, Located body -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located body
f] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
Placement -> R () -> R ()
placeHanging Placement
placement (Located body -> (body -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located body
f body -> R ()
render)
ApplicativeStmt {} -> String -> R ()
forall a. String -> a
notImplemented "ApplicativeStmt"
BodyStmt NoExt body :: Located body
body _ _ -> Located body -> (body -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located body
body body -> R ()
render
LetStmt NoExt binds :: LHsLocalBinds GhcPs
binds -> do
Text -> R ()
txt "let"
R ()
space
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsLocalBinds GhcPs -> (HsLocalBindsLR GhcPs GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsLocalBinds GhcPs
binds HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds
ParStmt {} ->
String -> R ()
forall a. String -> a
notImplemented "ParStmt"
TransStmt {..} ->
case (TransForm
trS_form, Maybe (LHsExpr GhcPs)
trS_by) of
(ThenForm, Nothing) -> do
Text -> R ()
txt "then"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
trS_using HsExpr GhcPs -> R ()
p_hsExpr
(ThenForm, Just e :: LHsExpr GhcPs
e) -> do
Text -> R ()
txt "then"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
trS_using HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt "by"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr
(GroupForm, Nothing) -> do
Text -> R ()
txt "then group using"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
trS_using HsExpr GhcPs -> R ()
p_hsExpr
(GroupForm, Just e :: LHsExpr GhcPs
e) -> do
Text -> R ()
txt "then group by"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt "using"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
trS_using HsExpr GhcPs -> R ()
p_hsExpr
RecStmt {..} -> do
Text -> R ()
txt "rec"
R ()
space
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ (LStmtLR GhcPs GhcPs (Located body) -> R ())
-> [LStmtLR GhcPs GhcPs (Located body)] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((Stmt GhcPs (Located body) -> R ())
-> LStmtLR GhcPs GhcPs (Located body) -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' ((body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
p_stmt' body -> Placement
placer body -> R ()
render)) [LStmtLR GhcPs GhcPs (Located body)]
recS_stmts
XStmtLR {} -> String -> R ()
forall a. String -> a
notImplemented "XStmtLR"
gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]
gatherStmt :: GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt (L _ (ParStmt NoExt block :: [ParStmtBlock GhcPs GhcPs]
block _ _)) =
(ParStmtBlock GhcPs GhcPs
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> [[GuardLStmt GhcPs]]
-> [ParStmtBlock GhcPs GhcPs]
-> [[GuardLStmt GhcPs]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]]
forall a. Semigroup a => a -> a -> a
(<>) ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> (ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]])
-> ParStmtBlock GhcPs GhcPs
-> [[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]]
gatherStmtBlock) [] [ParStmtBlock GhcPs GhcPs]
block
gatherStmt (L s :: SrcSpan
s stmt :: Stmt GhcPs (LHsExpr GhcPs)
stmt@TransStmt {..}) =
([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> [[GuardLStmt GhcPs]]
-> [[[GuardLStmt GhcPs]]]
-> [[GuardLStmt GhcPs]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend [] ((GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt (GuardLStmt GhcPs -> [[GuardLStmt GhcPs]])
-> [GuardLStmt GhcPs] -> [[[GuardLStmt GhcPs]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuardLStmt GhcPs]
trS_stmts) [[[GuardLStmt GhcPs]]]
-> [[[GuardLStmt GhcPs]]] -> [[[GuardLStmt GhcPs]]]
forall a. Semigroup a => a -> a -> a
<> [[GuardLStmt GhcPs]] -> [[[GuardLStmt GhcPs]]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[SrcSpan -> Stmt GhcPs (LHsExpr GhcPs) -> GuardLStmt GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
s Stmt GhcPs (LHsExpr GhcPs)
stmt]])
gatherStmt stmt :: GuardLStmt GhcPs
stmt = [[GuardLStmt GhcPs
stmt]]
gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[ExprLStmt GhcPs]]
gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[GuardLStmt GhcPs]]
gatherStmtBlock (ParStmtBlock _ stmts :: [GuardLStmt GhcPs]
stmts _ _) =
(GuardLStmt GhcPs -> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> [[GuardLStmt GhcPs]]
-> [GuardLStmt GhcPs]
-> [[GuardLStmt GhcPs]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend ([[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]] -> [[GuardLStmt GhcPs]])
-> (GuardLStmt GhcPs -> [[GuardLStmt GhcPs]])
-> GuardLStmt GhcPs
-> [[GuardLStmt GhcPs]]
-> [[GuardLStmt GhcPs]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuardLStmt GhcPs -> [[GuardLStmt GhcPs]]
gatherStmt) [] [GuardLStmt GhcPs]
stmts
gatherStmtBlock XParStmtBlock {} = String -> [[GuardLStmt GhcPs]]
forall a. String -> a
notImplemented "XParStmtBlock"
p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds = \case
HsValBinds NoExt (ValBinds NoExt bag :: LHsBindsLR GhcPs GhcPs
bag lsigs :: [LSig GhcPs]
lsigs) -> do
let ssStart :: Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs) -> SrcLoc
ssStart =
(LHsBindLR GhcPs GhcPs -> SrcLoc)
-> (LSig GhcPs -> SrcLoc)
-> Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)
-> SrcLoc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc)
-> (LHsBindLR GhcPs GhcPs -> SrcSpan)
-> LHsBindLR GhcPs GhcPs
-> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsBindLR GhcPs GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc)
(SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc)
-> (LSig GhcPs -> SrcSpan) -> LSig GhcPs -> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSig GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc)
items :: [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
items =
(LHsBindLR GhcPs GhcPs
-> Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)
forall a b. a -> Either a b
Left (LHsBindLR GhcPs GhcPs
-> Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs))
-> [LHsBindLR GhcPs GhcPs]
-> [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsBindsLR GhcPs GhcPs -> [LHsBindLR GhcPs GhcPs]
forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
bag) [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
-> [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
-> [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
forall a. [a] -> [a] -> [a]
++ (LSig GhcPs -> Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)
forall a b. b -> Either a b
Right (LSig GhcPs -> Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs))
-> [LSig GhcPs] -> [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LSig GhcPs]
lsigs)
p_item :: Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs) -> R ()
p_item (Left x :: LHsBindLR GhcPs GhcPs
x) = LHsBindLR GhcPs GhcPs -> (HsBindLR GhcPs GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsBindLR GhcPs GhcPs
x HsBindLR GhcPs GhcPs -> R ()
p_valDecl
p_item (Right x :: LSig GhcPs
x) = LSig GhcPs -> (Sig GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LSig GhcPs
x Sig GhcPs -> R ()
p_sigDecl
markInit :: [a] -> [(Bool, a)]
markInit :: [a] -> [(Bool, a)]
markInit [] = []
markInit [x :: a
x] = [(Bool
False, a
x)]
markInit (x :: a
x : xs :: [a]
xs) = (Bool
True, a
x) (Bool, a) -> [(Bool, a)] -> [(Bool, a)]
forall a. a -> [a] -> [a]
: [a] -> [(Bool, a)]
forall a. [a] -> [(Bool, a)]
markInit [a]
xs
R () -> R ()
br <- Layout -> R () -> R ()
layoutToBraces (Layout -> R () -> R ()) -> R Layout -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Layout
getLayout
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
((Bool, Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)) -> R ())
-> [(Bool, Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs))] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi
(\(m :: Bool
m, i :: Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)
i) -> (if Bool
m then R () -> R ()
br else R () -> R ()
forall a. a -> a
id) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs) -> R ()
p_item Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)
i)
([Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
-> [(Bool, Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs))]
forall a. [a] -> [(Bool, a)]
markInit ([Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
-> [(Bool, Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs))])
-> [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
-> [(Bool, Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs))]
forall a b. (a -> b) -> a -> b
$ (Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs) -> SrcLoc)
-> [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
-> [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs) -> SrcLoc
ssStart [Either (LHsBindLR GhcPs GhcPs) (LSig GhcPs)]
items)
HsValBinds NoExt _ -> String -> R ()
forall a. String -> a
notImplemented "HsValBinds"
HsIPBinds NoExt (IPBinds NoExt xs :: [LIPBind GhcPs]
xs) ->
let p_ipBind :: IPBind GhcPs -> R ()
p_ipBind (IPBind NoExt (Left name :: Located HsIPName
name) expr :: LHsExpr GhcPs
expr) = do
Located HsIPName -> R ()
forall a. Outputable a => a -> R ()
atom Located HsIPName
name
R ()
space
Text -> R ()
txt "="
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. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr HsExpr GhcPs -> R ()
p_hsExpr
p_ipBind _ = String -> R ()
forall a. String -> a
notImplemented "XHsIPBinds"
in (LIPBind GhcPs -> R ()) -> [LIPBind GhcPs] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi ((IPBind GhcPs -> R ()) -> LIPBind GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' IPBind GhcPs -> R ()
p_ipBind) [LIPBind GhcPs]
xs
HsIPBinds NoExt _ -> String -> R ()
forall a. String -> a
notImplemented "HsIpBinds"
EmptyLocalBinds NoExt -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
XHsLocalBindsLR _ -> String -> R ()
forall a. String -> a
notImplemented "XHsLocalBindsLR"
p_hsRecField ::
HsRecField' RdrName (LHsExpr GhcPs) ->
R ()
p_hsRecField :: HsRecField' RdrName (LHsExpr GhcPs) -> R ()
p_hsRecField HsRecField {..} = do
Located RdrName -> R ()
p_rdrName Located RdrName
hsRecFieldLbl
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hsRecPun (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
space
Text -> R ()
txt "="
let placement :: Placement
placement = HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
hsRecFieldArg)
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. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
hsRecFieldArg HsExpr GhcPs -> R ()
p_hsExpr
p_hsTupArg :: HsTupArg GhcPs -> R ()
p_hsTupArg :: HsTupArg GhcPs -> R ()
p_hsTupArg = \case
Present NoExt x :: LHsExpr GhcPs
x -> LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr
Missing NoExt -> () -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
XTupArg {} -> String -> R ()
forall a. String -> a
notImplemented "XTupArg"
p_hsExpr :: HsExpr GhcPs -> R ()
p_hsExpr :: HsExpr GhcPs -> R ()
p_hsExpr = BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
N
p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' s :: BracketStyle
s = \case
HsVar NoExt name :: Located (IdP GhcPs)
name -> Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
name
HsUnboundVar NoExt _ -> String -> R ()
forall a. String -> a
notImplemented "HsUnboundVar"
HsConLikeOut NoExt _ -> String -> R ()
forall a. String -> a
notImplemented "HsConLikeOut"
HsRecFld NoExt x :: AmbiguousFieldOcc GhcPs
x ->
case AmbiguousFieldOcc GhcPs
x of
Unambiguous NoExt name :: Located RdrName
name -> Located RdrName -> R ()
p_rdrName Located RdrName
name
Ambiguous NoExt name :: Located RdrName
name -> Located RdrName -> R ()
p_rdrName Located RdrName
name
XAmbiguousFieldOcc NoExt -> String -> R ()
forall a. String -> a
notImplemented "XAmbiguousFieldOcc"
HsOverLabel NoExt _ v :: FastString
v -> do
Text -> R ()
txt "#"
FastString -> R ()
forall a. Outputable a => a -> R ()
atom FastString
v
HsIPVar NoExt (HsIPName name :: FastString
name) -> do
Text -> R ()
txt "?"
FastString -> R ()
forall a. Outputable a => a -> R ()
atom FastString
name
HsOverLit NoExt v :: HsOverLit GhcPs
v -> OverLitVal -> R ()
forall a. Outputable a => a -> R ()
atom (HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit GhcPs
v)
HsLit NoExt lit :: HsLit GhcPs
lit ->
case HsLit GhcPs
lit of
HsString (SourceText stxt) _ -> String -> R ()
p_stringLit String
stxt
HsStringPrim (SourceText stxt) _ -> String -> R ()
p_stringLit String
stxt
r :: HsLit GhcPs
r -> HsLit GhcPs -> R ()
forall a. Outputable a => a -> R ()
atom HsLit GhcPs
r
HsLam NoExt mgroup :: MatchGroup GhcPs (LHsExpr GhcPs)
mgroup ->
MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup MatchGroupStyle
Lambda MatchGroup GhcPs (LHsExpr GhcPs)
mgroup
HsLamCase NoExt mgroup :: MatchGroup GhcPs (LHsExpr GhcPs)
mgroup -> do
Text -> R ()
txt "\\case"
R ()
breakpoint
R () -> R ()
inci (MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup MatchGroupStyle
LambdaCase MatchGroup GhcPs (LHsExpr GhcPs)
mgroup)
HsApp NoExt f :: LHsExpr GhcPs
f x :: LHsExpr GhcPs
x -> do
let
gatherArgs :: LHsExpr p
-> NonEmpty (LHsExpr p) -> (LHsExpr p, NonEmpty (LHsExpr p))
gatherArgs f' :: LHsExpr p
f' knownArgs :: NonEmpty (LHsExpr p)
knownArgs =
case LHsExpr p
f' of
L _ (HsApp _ l :: LHsExpr p
l r :: LHsExpr p
r) -> LHsExpr p
-> NonEmpty (LHsExpr p) -> (LHsExpr p, NonEmpty (LHsExpr p))
gatherArgs LHsExpr p
l (LHsExpr p
r LHsExpr p -> NonEmpty (LHsExpr p) -> NonEmpty (LHsExpr p)
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty (LHsExpr p)
knownArgs)
_ -> (LHsExpr p
f', NonEmpty (LHsExpr p)
knownArgs)
(func :: LHsExpr GhcPs
func, args :: NonEmpty (LHsExpr GhcPs)
args) = LHsExpr GhcPs
-> NonEmpty (LHsExpr GhcPs)
-> (LHsExpr GhcPs, NonEmpty (LHsExpr GhcPs))
forall p.
LHsExpr p
-> NonEmpty (LHsExpr p) -> (LHsExpr p, NonEmpty (LHsExpr p))
gatherArgs LHsExpr GhcPs
f (LHsExpr GhcPs
x LHsExpr GhcPs -> [LHsExpr GhcPs] -> NonEmpty (LHsExpr GhcPs)
forall a. a -> [a] -> NonEmpty a
:| [])
(initp :: [LHsExpr GhcPs]
initp, lastp :: LHsExpr GhcPs
lastp) = (NonEmpty (LHsExpr GhcPs) -> [LHsExpr GhcPs]
forall a. NonEmpty a -> [a]
NE.init NonEmpty (LHsExpr GhcPs)
args, NonEmpty (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. NonEmpty a -> a
NE.last NonEmpty (LHsExpr GhcPs)
args)
initSpan :: SrcSpan
initSpan =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$
LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr GhcPs
f SrcSpan -> [SrcSpan] -> NonEmpty SrcSpan
forall a. a -> [a] -> NonEmpty a
:| [(SrcLoc -> SrcSpan
srcLocSpan (SrcLoc -> SrcSpan)
-> (LHsExpr GhcPs -> SrcLoc) -> LHsExpr GhcPs -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanStart (SrcSpan -> SrcLoc)
-> (LHsExpr GhcPs -> SrcSpan) -> LHsExpr GhcPs -> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc) LHsExpr GhcPs
lastp]
placement :: Placement
placement =
if SrcSpan -> Bool
isOneLineSpan SrcSpan
initSpan
then HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
lastp)
else Placement
Normal
case Placement
placement of
Normal -> do
let
indent :: R () -> R ()
indent =
case LHsExpr GhcPs
func of
L _ (HsPar NoExt _) -> R () -> R ()
inci
L _ (HsAppType NoExt _ _) -> R () -> R ()
inci
L _ (HsMultiIf NoExt _) -> R () -> R ()
inci
L spn :: SrcSpan
spn _ ->
if SrcSpan -> Bool
isOneLineSpan SrcSpan
spn
then R () -> R ()
inci
else R () -> R ()
forall a. a -> a
id
R () -> R ()
ub <- R Layout
getLayout R Layout -> (Layout -> R () -> R ()) -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
SingleLine -> R () -> R ()
useBraces
MultiLine -> R () -> R ()
forall a. a -> a
id
R () -> R ()
ub (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
func (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
R ()
breakpoint
R () -> R ()
indent (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint ((HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs]
initp
R () -> R ()
indent (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LHsExpr GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsExpr GhcPs]
initp) R ()
breakpoint
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
lastp HsExpr GhcPs -> R ()
p_hsExpr
Hanging -> do
R () -> R ()
useBraces (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan
initSpan] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data 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. Data 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. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
lastp HsExpr GhcPs -> R ()
p_hsExpr
HsAppType NoExt e :: LHsExpr GhcPs
e a :: LHsWcType (NoGhcTc GhcPs)
a -> do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data 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 "@"
Located (HsType GhcPs) -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located (HsWildCardBndrs GhcPs (Located (HsType GhcPs))
-> Located (HsType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (Located (HsType GhcPs))
LHsWcType (NoGhcTc GhcPs)
a) HsType GhcPs -> R ()
p_hsType
OpApp NoExt x :: LHsExpr GhcPs
x op :: LHsExpr GhcPs
op y :: LHsExpr GhcPs
y -> do
let opTree :: OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
opTree = OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
x) LHsExpr GhcPs
op (LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
y)
Bool
-> BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree Bool
True BracketStyle
s ((HsExpr GhcPs -> Maybe RdrName)
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
forall op ty.
(op -> Maybe RdrName)
-> OpTree (Located ty) (Located op)
-> OpTree (Located ty) (Located op)
reassociateOpTree HsExpr GhcPs -> Maybe RdrName
getOpName OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
opTree)
NegApp NoExt e :: LHsExpr GhcPs
e _ -> do
Text -> R ()
txt "-"
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr
HsPar NoExt e :: LHsExpr GhcPs
e ->
BracketStyle -> R () -> R ()
parens BracketStyle
s (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data 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 NoExt x :: LHsExpr GhcPs
x op :: LHsExpr GhcPs
op -> do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data 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. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
op HsExpr GhcPs -> R ()
p_hsExpr)
SectionR NoExt op :: LHsExpr GhcPs
op x :: LHsExpr GhcPs
x -> do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
op HsExpr GhcPs -> R ()
p_hsExpr
Bool
useRecordDot' <- R Bool
useRecordDot
let isRecordDot' :: Bool
isRecordDot' = HsExpr GhcPs -> SrcSpan -> Bool
isRecordDot (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
op) (LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr GhcPs
x)
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
useRecordDot' Bool -> Bool -> Bool
&& Bool
isRecordDot') R ()
breakpoint
R () -> R ()
inci (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr)
ExplicitTuple NoExt args :: [LHsTupArg GhcPs]
args boxity :: Boxity
boxity -> do
let isSection :: Bool
isSection = (LHsTupArg GhcPs -> Bool) -> [LHsTupArg GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (HsTupArg GhcPs -> Bool
isMissing (HsTupArg GhcPs -> Bool)
-> (LHsTupArg GhcPs -> HsTupArg GhcPs) -> LHsTupArg GhcPs -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTupArg GhcPs -> HsTupArg GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LHsTupArg GhcPs]
args
isMissing :: HsTupArg GhcPs -> Bool
isMissing = \case
Missing NoExt -> Bool
True
_ -> Bool
False
let parens' :: BracketStyle -> R () -> R ()
parens' =
case Boxity
boxity of
Boxed -> BracketStyle -> R () -> R ()
parens
Unboxed -> BracketStyle -> R () -> R ()
parensHash
if Bool
isSection
then
[SrcSpan] -> R () -> R ()
switchLayout [] (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> (LHsTupArg GhcPs -> R ()) -> [LHsTupArg GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
comma ((HsTupArg GhcPs -> R ()) -> LHsTupArg GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' HsTupArg GhcPs -> R ()
p_hsTupArg) [LHsTupArg GhcPs]
args
else
[SrcSpan] -> R () -> R ()
switchLayout (LHsTupArg GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LHsTupArg GhcPs -> SrcSpan) -> [LHsTupArg GhcPs] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsTupArg GhcPs]
args) (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
parens' BracketStyle
s (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> (LHsTupArg GhcPs -> R ()) -> [LHsTupArg GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) (R () -> R ()
sitcc (R () -> R ())
-> (LHsTupArg GhcPs -> R ()) -> LHsTupArg GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsTupArg GhcPs -> R ()) -> LHsTupArg GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' HsTupArg GhcPs -> R ()
p_hsTupArg) [LHsTupArg GhcPs]
args
ExplicitSum NoExt tag :: Int
tag arity :: Int
arity e :: LHsExpr GhcPs
e ->
BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum BracketStyle
N Int
tag Int
arity (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr)
HsCase NoExt e :: LHsExpr GhcPs
e mgroup :: MatchGroup GhcPs (LHsExpr GhcPs)
mgroup ->
(HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> MatchGroup GhcPs (Located body)
-> R ()
p_case HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr LHsExpr GhcPs
e MatchGroup GhcPs (LHsExpr GhcPs)
mgroup
HsIf NoExt _ if' :: LHsExpr GhcPs
if' then' :: LHsExpr GhcPs
then' else' :: LHsExpr GhcPs
else' ->
(HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ())
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> LHsExpr GhcPs
-> Located body
-> Located body
-> R ()
p_if HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs -> R ()
p_hsExpr LHsExpr GhcPs
if' LHsExpr GhcPs
then' LHsExpr GhcPs
else'
HsMultiIf NoExt guards :: [LGRHS GhcPs (LHsExpr GhcPs)]
guards -> do
Text -> R ()
txt "if "
R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> (LGRHS GhcPs (LHsExpr GhcPs) -> R ())
-> [LGRHS GhcPs (LHsExpr GhcPs)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline ((GRHS GhcPs (LHsExpr GhcPs) -> R ())
-> LGRHS GhcPs (LHsExpr GhcPs) -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' (GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
p_grhs GroupStyle
RightArrow)) [LGRHS GhcPs (LHsExpr GhcPs)]
guards
HsLet NoExt localBinds :: LHsLocalBinds GhcPs
localBinds e :: LHsExpr GhcPs
e ->
(HsExpr GhcPs -> R ())
-> LHsLocalBinds GhcPs -> LHsExpr GhcPs -> R ()
forall body.
Data body =>
(body -> R ()) -> LHsLocalBinds GhcPs -> Located body -> R ()
p_let HsExpr GhcPs -> R ()
p_hsExpr LHsLocalBinds GhcPs
localBinds LHsExpr GhcPs
e
HsDo NoExt ctx :: HsStmtContext Name
ctx es :: Located [GuardLStmt GhcPs]
es -> do
let doBody :: Text -> R ()
doBody header :: Text
header = do
Text -> R ()
txt Text
header
R ()
breakpoint
R () -> R ()
ub <- Layout -> R () -> R ()
layoutToBraces (Layout -> R () -> R ()) -> R Layout -> R (R () -> R ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> R Layout
getLayout
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
(GuardLStmt GhcPs -> R ()) -> [GuardLStmt GhcPs] -> R ()
forall a. (a -> R ()) -> [a] -> R ()
sepSemi
((Stmt GhcPs (LHsExpr GhcPs) -> R ()) -> GuardLStmt GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' (R () -> R ()
ub (R () -> R ())
-> (Stmt GhcPs (LHsExpr GhcPs) -> R ())
-> Stmt GhcPs (LHsExpr GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsExpr GhcPs -> Placement)
-> (HsExpr GhcPs -> R ()) -> Stmt GhcPs (LHsExpr GhcPs) -> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ()) -> Stmt GhcPs (Located body) -> R ()
p_stmt' HsExpr GhcPs -> Placement
exprPlacement (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
S)))
(Located [GuardLStmt GhcPs]
-> SrcSpanLess (Located [GuardLStmt GhcPs])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [GuardLStmt GhcPs]
es)
compBody :: R ()
compBody = BracketStyle -> R () -> R ()
brackets BracketStyle
N (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ Located [GuardLStmt GhcPs] -> ([GuardLStmt GhcPs] -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located [GuardLStmt GhcPs]
es (([GuardLStmt GhcPs] -> R ()) -> R ())
-> ([GuardLStmt GhcPs] -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \xs :: [GuardLStmt GhcPs]
xs -> do
let p_parBody :: [[GuardLStmt GhcPs]] -> R ()
p_parBody =
R ()
-> ([GuardLStmt GhcPs] -> R ()) -> [[GuardLStmt GhcPs]] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
(R ()
breakpoint R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt "| ")
[GuardLStmt GhcPs] -> R ()
p_seqBody
p_seqBody :: [GuardLStmt GhcPs] -> R ()
p_seqBody =
R () -> R ()
sitcc
(R () -> R ())
-> ([GuardLStmt GhcPs] -> R ()) -> [GuardLStmt GhcPs] -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> (GuardLStmt GhcPs -> R ()) -> [GuardLStmt GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
(R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint)
((Stmt GhcPs (LHsExpr GhcPs) -> R ()) -> GuardLStmt GhcPs -> R ()
forall a. Data 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. Data a => Located a -> (a -> R ()) -> R ()
located GuardLStmt GhcPs
yield Stmt GhcPs (LHsExpr GhcPs) -> R ()
p_stmt
R ()
breakpoint
Text -> R ()
txt "|"
R ()
space
[[GuardLStmt GhcPs]] -> R ()
p_parBody [[GuardLStmt GhcPs]]
lists
case HsStmtContext Name
ctx of
DoExpr -> Text -> R ()
doBody "do"
MDoExpr -> Text -> R ()
doBody "mdo"
ListComp -> R ()
compBody
MonadComp -> String -> R ()
forall a. String -> a
notImplemented "MonadComp"
ArrowExpr -> String -> R ()
forall a. String -> a
notImplemented "ArrowExpr"
GhciStmtCtxt -> String -> R ()
forall a. String -> a
notImplemented "GhciStmtCtxt"
PatGuard _ -> String -> R ()
forall a. String -> a
notImplemented "PatGuard"
ParStmtCtxt _ -> String -> R ()
forall a. String -> a
notImplemented "ParStmtCtxt"
TransStmtCtxt _ -> String -> R ()
forall a. String -> a
notImplemented "TransStmtCtxt"
ExplicitList _ _ xs :: [LHsExpr GhcPs]
xs ->
BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) (R () -> R ()
sitcc (R () -> R ()) -> (LHsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs]
xs
RecordCon {..} -> do
Located RdrName -> (RdrName -> R ()) -> R ()
forall a. Data 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 {..} = HsRecordBinds GhcPs
rcon_flds
updName :: HsRecField' (FieldOcc pass) arg -> HsRecField' RdrName arg
updName f :: HsRecField' (FieldOcc pass) arg
f =
HsRecField' (FieldOcc pass) arg
f
{ hsRecFieldLbl :: Located RdrName
hsRecFieldLbl = case Located (FieldOcc pass) -> SrcSpanLess (Located (FieldOcc pass))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located (FieldOcc pass) -> SrcSpanLess (Located (FieldOcc pass)))
-> Located (FieldOcc pass) -> SrcSpanLess (Located (FieldOcc pass))
forall a b. (a -> b) -> a -> b
$ HsRecField' (FieldOcc pass) arg -> Located (FieldOcc pass)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl HsRecField' (FieldOcc pass) arg
f of
FieldOcc _ n -> Located RdrName
n
XFieldOcc _ -> String -> Located RdrName
forall a. String -> a
notImplemented "XFieldOcc"
}
fields :: [R ()]
fields = (HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs) -> R ())
-> LHsRecField GhcPs (LHsExpr GhcPs) -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' (HsRecField' RdrName (LHsExpr GhcPs) -> R ()
p_hsRecField (HsRecField' RdrName (LHsExpr GhcPs) -> R ())
-> (HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)
-> HsRecField' RdrName (LHsExpr GhcPs))
-> HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)
-> HsRecField' RdrName (LHsExpr GhcPs)
forall pass arg.
HsRecField' (FieldOcc pass) arg -> HsRecField' RdrName arg
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 Int
rec_dotdot of
Just {} -> [Text -> R ()
txt ".."]
Nothing -> []
R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R () -> (R () -> R ()) -> [R ()] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) R () -> R ()
sitcc ([R ()]
fields [R ()] -> [R ()] -> [R ()]
forall a. Semigroup a => a -> a -> a
<> [R ()]
dotdot)
RecordUpd {..} -> do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
rupd_expr HsExpr GhcPs -> R ()
p_hsExpr
Bool
useRecordDot' <- R Bool
useRecordDot
let mrs :: a -> Maybe RealSrcSpan
mrs sp :: a
sp = case a -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc a
sp of
RealSrcSpan r :: RealSrcSpan
r -> RealSrcSpan -> Maybe RealSrcSpan
forall a. a -> Maybe a
Just RealSrcSpan
r
_ -> Maybe RealSrcSpan
forall a. Maybe a
Nothing
let isPluginForm :: Bool
isPluginForm =
((1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (RealSrcSpan -> Int) -> RealSrcSpan -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcSpan -> Int
srcSpanEndCol (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsExpr GhcPs -> Maybe RealSrcSpan
forall a. HasSrcSpan a => a -> Maybe RealSrcSpan
mrs LHsExpr GhcPs
rupd_expr)
Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== (RealSrcSpan -> Int
srcSpanStartCol (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsRecUpdField GhcPs -> Maybe RealSrcSpan
forall a. HasSrcSpan a => a -> Maybe RealSrcSpan
mrs ([LHsRecUpdField GhcPs] -> LHsRecUpdField GhcPs
forall a. [a] -> a
head [LHsRecUpdField GhcPs]
rupd_flds))
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
useRecordDot' Bool -> Bool -> Bool
&& Bool
isPluginForm) R ()
breakpoint
let updName :: HsRecField' (AmbiguousFieldOcc pass) arg -> HsRecField' RdrName arg
updName f :: HsRecField' (AmbiguousFieldOcc pass) arg
f =
HsRecField' (AmbiguousFieldOcc pass) arg
f
{ hsRecFieldLbl :: Located RdrName
hsRecFieldLbl = case Located (AmbiguousFieldOcc pass)
-> SrcSpanLess (Located (AmbiguousFieldOcc pass))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located (AmbiguousFieldOcc pass)
-> SrcSpanLess (Located (AmbiguousFieldOcc pass)))
-> Located (AmbiguousFieldOcc pass)
-> SrcSpanLess (Located (AmbiguousFieldOcc pass))
forall a b. (a -> b) -> a -> b
$ HsRecField' (AmbiguousFieldOcc pass) arg
-> Located (AmbiguousFieldOcc pass)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl HsRecField' (AmbiguousFieldOcc pass) arg
f of
Ambiguous _ n -> Located RdrName
n
Unambiguous _ n -> Located RdrName
n
XAmbiguousFieldOcc _ -> String -> Located RdrName
forall a. String -> a
notImplemented "XAmbiguousFieldOcc"
}
R () -> R ()
inci (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R ()
-> (LHsRecUpdField GhcPs -> R ()) -> [LHsRecUpdField GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep
(R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint)
(R () -> R ()
sitcc (R () -> R ())
-> (LHsRecUpdField GhcPs -> R ()) -> LHsRecUpdField GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsRecField' (AmbiguousFieldOcc GhcPs) (LHsExpr GhcPs) -> R ())
-> LHsRecUpdField GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' (HsRecField' RdrName (LHsExpr GhcPs) -> R ()
p_hsRecField (HsRecField' RdrName (LHsExpr GhcPs) -> R ())
-> (HsRecField' (AmbiguousFieldOcc GhcPs) (LHsExpr GhcPs)
-> HsRecField' RdrName (LHsExpr GhcPs))
-> HsRecField' (AmbiguousFieldOcc GhcPs) (LHsExpr GhcPs)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecField' (AmbiguousFieldOcc GhcPs) (LHsExpr GhcPs)
-> HsRecField' RdrName (LHsExpr GhcPs)
forall pass arg.
HsRecField' (AmbiguousFieldOcc pass) arg -> HsRecField' RdrName arg
updName))
[LHsRecUpdField GhcPs]
rupd_flds
ExprWithTySig NoExt x :: LHsExpr GhcPs
x HsWC {hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = HsIB {..}} -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
Text -> R ()
txt "::"
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ Located (HsType GhcPs) -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located (HsType GhcPs)
LHsType (NoGhcTc GhcPs)
hsib_body HsType GhcPs -> R ()
p_hsType
ExprWithTySig NoExt _ HsWC {hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = XHsImplicitBndrs {}} ->
String -> R ()
forall a. String -> a
notImplemented "XHsImplicitBndrs"
ExprWithTySig NoExt _ XHsWildCardBndrs {} -> String -> R ()
forall a. String -> a
notImplemented "XHsWildCardBndrs"
ArithSeq NoExt _ x :: ArithSeqInfo GhcPs
x ->
case ArithSeqInfo GhcPs
x of
From from :: LHsExpr GhcPs
from -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
from HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt ".."
FromThen from :: LHsExpr GhcPs
from next :: LHsExpr GhcPs
next -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) ((HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs
from, LHsExpr GhcPs
next]
R ()
breakpoint
Text -> R ()
txt ".."
FromTo from :: LHsExpr GhcPs
from to :: LHsExpr GhcPs
to -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
from HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
Text -> R ()
txt ".."
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
to HsExpr GhcPs -> R ()
p_hsExpr
FromThenTo from :: LHsExpr GhcPs
from next :: LHsExpr GhcPs
next to :: LHsExpr GhcPs
to -> BracketStyle -> R () -> R ()
brackets BracketStyle
s (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (LHsExpr GhcPs -> R ()) -> [LHsExpr GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) ((HsExpr GhcPs -> R ()) -> LHsExpr GhcPs -> R ()
forall a. Data a => (a -> R ()) -> Located a -> R ()
located' HsExpr GhcPs -> R ()
p_hsExpr) [LHsExpr GhcPs
from, LHsExpr GhcPs
next]
R ()
breakpoint
Text -> R ()
txt ".."
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
to HsExpr GhcPs -> R ()
p_hsExpr
HsSCC NoExt _ name :: StringLiteral
name x :: LHsExpr GhcPs
x -> do
Text -> R ()
txt "{-# SCC "
StringLiteral -> R ()
forall a. Outputable a => a -> R ()
atom StringLiteral
name
Text -> R ()
txt " #-}"
R ()
breakpoint
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr
HsCoreAnn NoExt _ value :: StringLiteral
value x :: LHsExpr GhcPs
x -> do
Text -> R ()
txt "{-# CORE "
StringLiteral -> R ()
forall a. Outputable a => a -> R ()
atom StringLiteral
value
Text -> R ()
txt " #-}"
R ()
breakpoint
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x HsExpr GhcPs -> R ()
p_hsExpr
HsBracket NoExt x :: HsBracket GhcPs
x -> HsBracket GhcPs -> R ()
p_hsBracket HsBracket GhcPs
x
HsRnBracketOut {} -> String -> R ()
forall a. String -> a
notImplemented "HsRnBracketOut"
HsTcBracketOut {} -> String -> R ()
forall a. String -> a
notImplemented "HsTcBracketOut"
HsSpliceE NoExt splice :: HsSplice GhcPs
splice -> HsSplice GhcPs -> R ()
p_hsSplice HsSplice GhcPs
splice
HsProc NoExt p :: LPat GhcPs
p e :: LHsCmdTop GhcPs
e -> do
Text -> R ()
txt "proc"
LPat GhcPs -> (LPat GhcPs -> R ()) -> R ()
forall pass.
(Data (Pat pass), XXPat pass ~ Located (Pat pass)) =>
Pat pass -> (Pat pass -> R ()) -> R ()
locatedPat LPat GhcPs
p ((LPat GhcPs -> R ()) -> R ()) -> (LPat GhcPs -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \x :: LPat GhcPs
x -> do
R ()
breakpoint
R () -> R ()
inci (LPat GhcPs -> R ()
p_pat LPat GhcPs
x)
R ()
breakpoint
Text -> R ()
txt "->"
Placement -> R () -> R ()
placeHanging (HsCmdTop GhcPs -> Placement
cmdTopPlacement (LHsCmdTop GhcPs -> SrcSpanLess (LHsCmdTop GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsCmdTop GhcPs
e)) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
LHsCmdTop GhcPs -> (HsCmdTop GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsCmdTop GhcPs
e HsCmdTop GhcPs -> R ()
p_hsCmdTop
HsStatic _ e :: LHsExpr GhcPs
e -> do
Text -> R ()
txt "static"
R ()
breakpoint
R () -> R ()
inci (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr)
HsArrApp NoExt body :: LHsExpr GhcPs
body input :: LHsExpr GhcPs
input arrType :: HsArrAppType
arrType cond :: Bool
cond ->
HsCmd GhcPs -> R ()
p_hsCmd (XCmdArrApp GhcPs
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> HsArrAppType
-> Bool
-> HsCmd GhcPs
forall id.
XCmdArrApp id
-> LHsExpr id -> LHsExpr id -> HsArrAppType -> Bool -> HsCmd id
HsCmdArrApp NoExt
XCmdArrApp GhcPs
NoExt LHsExpr GhcPs
body LHsExpr GhcPs
input HsArrAppType
arrType Bool
cond)
HsArrForm NoExt form :: LHsExpr GhcPs
form mfixity :: Maybe Fixity
mfixity cmds :: [LHsCmdTop GhcPs]
cmds ->
HsCmd GhcPs -> R ()
p_hsCmd (XCmdArrForm GhcPs
-> LHsExpr GhcPs
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop GhcPs]
-> HsCmd GhcPs
forall id.
XCmdArrForm id
-> LHsExpr id
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop id]
-> HsCmd id
HsCmdArrForm NoExt
XCmdArrForm GhcPs
NoExt LHsExpr GhcPs
form LexicalFixity
Prefix Maybe Fixity
mfixity [LHsCmdTop GhcPs]
cmds)
HsTick {} -> String -> R ()
forall a. String -> a
notImplemented "HsTick"
HsBinTick {} -> String -> R ()
forall a. String -> a
notImplemented "HsBinTick"
HsTickPragma {} -> String -> R ()
forall a. String -> a
notImplemented "HsTickPragma"
EWildPat NoExt -> Text -> R ()
txt "_"
EAsPat NoExt n :: Located (IdP GhcPs)
n p :: LHsExpr GhcPs
p -> do
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
n
Text -> R ()
txt "@"
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
p HsExpr GhcPs -> R ()
p_hsExpr
EViewPat NoExt p :: LHsExpr GhcPs
p e :: LHsExpr GhcPs
e -> do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
p HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
Text -> R ()
txt "->"
R ()
breakpoint
R () -> R ()
inci (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr)
ELazyPat NoExt p :: LHsExpr GhcPs
p -> do
Text -> R ()
txt "~"
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
p HsExpr GhcPs -> R ()
p_hsExpr
HsWrap {} -> String -> R ()
forall a. String -> a
notImplemented "HsWrap"
XExpr {} -> String -> R ()
forall a. String -> a
notImplemented "XExpr"
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()
p_patSynBind PSB {..} = do
let rhs :: R ()
rhs = do
R ()
space
case HsPatSynDir GhcPs
psb_dir of
Unidirectional -> do
Text -> R ()
txt "<-"
R ()
breakpoint
LPat GhcPs -> R ()
p_pat LPat GhcPs
psb_def
ImplicitBidirectional -> do
Text -> R ()
txt "="
R ()
breakpoint
LPat GhcPs -> R ()
p_pat LPat GhcPs
psb_def
ExplicitBidirectional mgroup :: MatchGroup GhcPs (LHsExpr GhcPs)
mgroup -> do
Text -> R ()
txt "<-"
R ()
breakpoint
LPat GhcPs -> R ()
p_pat LPat GhcPs
psb_def
R ()
newline
Text -> R ()
txt "where"
R ()
newline
R () -> R ()
inci (MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R ()
p_matchGroup (Located RdrName -> MatchGroupStyle
Function Located (IdP GhcPs)
Located RdrName
psb_id) MatchGroup GhcPs (LHsExpr GhcPs)
mgroup)
Text -> R ()
txt "pattern"
case HsPatSynDetails (Located (IdP GhcPs))
psb_args of
PrefixCon xs :: [Located (IdP GhcPs)]
xs -> do
R ()
space
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
psb_id
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
[SrcSpan] -> R () -> R ()
switchLayout (Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located RdrName -> SrcSpan) -> [Located RdrName] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located (IdP GhcPs)]
[Located RdrName]
xs) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Located RdrName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Located (IdP GhcPs)]
[Located RdrName]
xs) R ()
breakpoint
R () -> R ()
sitcc (R () -> (Located RdrName -> R ()) -> [Located RdrName] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint Located RdrName -> R ()
p_rdrName [Located (IdP GhcPs)]
[Located RdrName]
xs)
R ()
rhs
RecCon xs :: [RecordPatSynField (Located (IdP GhcPs))]
xs -> do
R ()
space
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
psb_id
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
[SrcSpan] -> R () -> R ()
switchLayout (Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located RdrName -> SrcSpan)
-> (RecordPatSynField (Located RdrName) -> Located RdrName)
-> RecordPatSynField (Located RdrName)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField (Located RdrName) -> Located RdrName
forall a. RecordPatSynField a -> a
recordPatSynPatVar (RecordPatSynField (Located RdrName) -> SrcSpan)
-> [RecordPatSynField (Located RdrName)] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RecordPatSynField (Located (IdP GhcPs))]
[RecordPatSynField (Located RdrName)]
xs) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([RecordPatSynField (Located RdrName)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RecordPatSynField (Located (IdP GhcPs))]
[RecordPatSynField (Located RdrName)]
xs) R ()
breakpoint
BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
R ()
-> (RecordPatSynField (Located RdrName) -> R ())
-> [RecordPatSynField (Located RdrName)]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) (Located RdrName -> R ()
p_rdrName (Located RdrName -> R ())
-> (RecordPatSynField (Located RdrName) -> Located RdrName)
-> RecordPatSynField (Located RdrName)
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField (Located RdrName) -> Located RdrName
forall a. RecordPatSynField a -> a
recordPatSynPatVar) [RecordPatSynField (Located (IdP GhcPs))]
[RecordPatSynField (Located RdrName)]
xs
R ()
rhs
InfixCon l :: Located (IdP GhcPs)
l r :: Located (IdP GhcPs)
r -> do
[SrcSpan] -> R () -> R ()
switchLayout [Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located (IdP GhcPs)
Located RdrName
l, Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located (IdP GhcPs)
Located RdrName
r] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
space
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
l
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
psb_id
R ()
space
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
r
R () -> R ()
inci R ()
rhs
p_patSynBind (XPatSynBind NoExt) = String -> R ()
forall a. String -> a
notImplemented "XPatSynBind"
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 placer :: body -> Placement
placer render :: body -> R ()
render e :: LHsExpr GhcPs
e mgroup :: MatchGroup GhcPs (Located body)
mgroup = do
Text -> R ()
txt "case"
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
e HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
Text -> R ()
txt "of"
R ()
breakpoint
R () -> R ()
inci ((body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
forall body.
Data body =>
(body -> Placement)
-> (body -> R ())
-> MatchGroupStyle
-> MatchGroup GhcPs (Located body)
-> R ()
p_matchGroup' body -> Placement
placer body -> R ()
render MatchGroupStyle
Case MatchGroup GhcPs (Located body)
mgroup)
p_if ::
Data body =>
(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 placer :: body -> Placement
placer render :: body -> R ()
render if' :: LHsExpr GhcPs
if' then' :: Located body
then' else' :: Located body
else' = do
Text -> R ()
txt "if"
R ()
space
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
if' HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt "then"
Located body -> (body -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located body
then' ((body -> R ()) -> R ()) -> (body -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \x :: body
x ->
Placement -> R () -> R ()
placeHanging (body -> Placement
placer body
x) (body -> R ()
render body
x)
R ()
breakpoint
Text -> R ()
txt "else"
Located body -> (body -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located body
else' ((body -> R ()) -> R ()) -> (body -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \x :: body
x ->
Placement -> R () -> R ()
placeHanging (body -> Placement
placer body
x) (body -> R ()
render body
x)
p_let ::
Data body =>
(body -> R ()) ->
Located (HsLocalBindsLR GhcPs GhcPs) ->
Located body ->
R ()
p_let :: (body -> R ()) -> LHsLocalBinds GhcPs -> Located body -> R ()
p_let render :: body -> R ()
render localBinds :: LHsLocalBinds GhcPs
localBinds e :: Located body
e = R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Text -> R ()
txt "let"
R ()
space
R () -> R ()
dontUseBraces (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> R ()
sitcc (LHsLocalBinds GhcPs -> (HsLocalBindsLR GhcPs GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsLocalBinds GhcPs
localBinds HsLocalBindsLR GhcPs GhcPs -> R ()
p_hsLocalBinds)
R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout R ()
space (R ()
newline R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> R ()
txt " ")
Text -> R ()
txt "in"
R ()
space
R () -> R ()
sitcc (Located body -> (body -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located body
e body -> R ()
render)
p_pat :: Pat GhcPs -> R ()
p_pat :: LPat GhcPs -> R ()
p_pat = \case
XPat pat :: XXPat GhcPs
pat -> Located (LPat GhcPs) -> (LPat GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located XXPat GhcPs
Located (LPat GhcPs)
pat LPat GhcPs -> R ()
p_pat
WildPat NoExt -> Text -> R ()
txt "_"
VarPat NoExt name :: Located (IdP GhcPs)
name -> Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
name
LazyPat NoExt pat :: LPat GhcPs
pat -> do
Text -> R ()
txt "~"
LPat GhcPs -> R ()
p_pat LPat GhcPs
pat
AsPat NoExt name :: Located (IdP GhcPs)
name pat :: LPat GhcPs
pat -> do
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
name
Text -> R ()
txt "@"
LPat GhcPs -> R ()
p_pat LPat GhcPs
pat
ParPat NoExt pat :: LPat GhcPs
pat ->
LPat GhcPs -> (LPat GhcPs -> R ()) -> R ()
forall pass.
(Data (Pat pass), XXPat pass ~ Located (Pat pass)) =>
Pat pass -> (Pat pass -> R ()) -> R ()
locatedPat LPat GhcPs
pat (BracketStyle -> R () -> R ()
parens BracketStyle
S (R () -> R ()) -> (LPat GhcPs -> R ()) -> LPat GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LPat GhcPs -> R ()
p_pat)
BangPat NoExt pat :: LPat GhcPs
pat -> do
Text -> R ()
txt "!"
LPat GhcPs -> R ()
p_pat LPat GhcPs
pat
ListPat NoExt pats :: [LPat GhcPs]
pats ->
BracketStyle -> R () -> R ()
brackets BracketStyle
S (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (LPat GhcPs -> R ()) -> [LPat GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) LPat GhcPs -> R ()
p_pat [LPat GhcPs]
pats
TuplePat NoExt pats :: [LPat GhcPs]
pats boxing :: Boxity
boxing -> do
let f :: R () -> R ()
f =
case Boxity
boxing of
Boxed -> BracketStyle -> R () -> R ()
parens BracketStyle
S
Unboxed -> BracketStyle -> R () -> R ()
parensHash BracketStyle
S
R () -> R ()
f (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (LPat GhcPs -> R ()) -> [LPat GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) (R () -> R ()
sitcc (R () -> R ()) -> (LPat GhcPs -> R ()) -> LPat GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LPat GhcPs -> R ()
p_pat) [LPat GhcPs]
pats
SumPat NoExt pat :: LPat GhcPs
pat tag :: Int
tag arity :: Int
arity ->
BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum BracketStyle
S Int
tag Int
arity (LPat GhcPs -> R ()
p_pat LPat GhcPs
pat)
ConPatIn pat :: Located (IdP GhcPs)
pat details :: HsConPatDetails GhcPs
details ->
case HsConPatDetails GhcPs
details of
PrefixCon xs :: [LPat GhcPs]
xs -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
pat
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LPat GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat 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 () -> (LPat GhcPs -> R ()) -> [LPat GhcPs] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (R () -> R ()
sitcc (R () -> R ()) -> (LPat GhcPs -> R ()) -> LPat GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LPat GhcPs -> R ()
p_pat) [LPat GhcPs]
xs
RecCon (HsRecFields fields :: [LHsRecField GhcPs (LPat GhcPs)]
fields dotdot :: Maybe Int
dotdot) -> do
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
pat
R ()
breakpoint
let f :: Maybe (LHsRecField GhcPs (LPat GhcPs)) -> R ()
f = \case
Nothing -> Text -> R ()
txt ".."
Just x :: LHsRecField GhcPs (LPat GhcPs)
x -> LHsRecField GhcPs (LPat GhcPs)
-> (HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsRecField GhcPs (LPat GhcPs)
x HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
p_pat_hsRecField
R () -> R ()
inci (R () -> R ())
-> ([Maybe (LHsRecField GhcPs (LPat GhcPs))] -> R ())
-> [Maybe (LHsRecField GhcPs (LPat GhcPs))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BracketStyle -> R () -> R ()
braces BracketStyle
N (R () -> R ())
-> ([Maybe (LHsRecField GhcPs (LPat GhcPs))] -> R ())
-> [Maybe (LHsRecField GhcPs (LPat GhcPs))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
sitcc (R () -> R ())
-> ([Maybe (LHsRecField GhcPs (LPat GhcPs))] -> R ())
-> [Maybe (LHsRecField GhcPs (LPat GhcPs))]
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R ()
-> (Maybe (LHsRecField GhcPs (LPat GhcPs)) -> R ())
-> [Maybe (LHsRecField GhcPs (LPat GhcPs))]
-> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (R ()
comma R () -> R () -> R ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint) Maybe (LHsRecField GhcPs (LPat GhcPs)) -> R ()
f ([Maybe (LHsRecField GhcPs (LPat GhcPs))] -> R ())
-> [Maybe (LHsRecField GhcPs (LPat GhcPs))] -> R ()
forall a b. (a -> b) -> a -> b
$
case Maybe Int
dotdot of
Nothing -> LHsRecField GhcPs (LPat GhcPs)
-> Maybe (LHsRecField GhcPs (LPat GhcPs))
forall a. a -> Maybe a
Just (LHsRecField GhcPs (LPat GhcPs)
-> Maybe (LHsRecField GhcPs (LPat GhcPs)))
-> [LHsRecField GhcPs (LPat GhcPs)]
-> [Maybe (LHsRecField GhcPs (LPat GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsRecField GhcPs (LPat GhcPs)]
fields
Just n :: Int
n -> (LHsRecField GhcPs (LPat GhcPs)
-> Maybe (LHsRecField GhcPs (LPat GhcPs))
forall a. a -> Maybe a
Just (LHsRecField GhcPs (LPat GhcPs)
-> Maybe (LHsRecField GhcPs (LPat GhcPs)))
-> [LHsRecField GhcPs (LPat GhcPs)]
-> [Maybe (LHsRecField GhcPs (LPat GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> [LHsRecField GhcPs (LPat GhcPs)]
-> [LHsRecField GhcPs (LPat GhcPs)]
forall a. Int -> [a] -> [a]
take Int
n [LHsRecField GhcPs (LPat GhcPs)]
fields) [Maybe (LHsRecField GhcPs (LPat GhcPs))]
-> [Maybe (LHsRecField GhcPs (LPat GhcPs))]
-> [Maybe (LHsRecField GhcPs (LPat GhcPs))]
forall a. [a] -> [a] -> [a]
++ [Maybe (LHsRecField GhcPs (LPat GhcPs))
forall a. Maybe a
Nothing]
InfixCon x :: LPat GhcPs
x y :: LPat GhcPs
y -> do
LPat GhcPs -> R ()
p_pat LPat GhcPs
x
R ()
space
Located RdrName -> R ()
p_rdrName Located (IdP GhcPs)
Located RdrName
pat
R ()
breakpoint
R () -> R ()
inci (LPat GhcPs -> R ()
p_pat LPat GhcPs
y)
ConPatOut {} -> String -> R ()
forall a. String -> a
notImplemented "ConPatOut"
ViewPat NoExt expr :: LHsExpr GhcPs
expr pat :: LPat GhcPs
pat -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr HsExpr GhcPs -> R ()
p_hsExpr
R ()
space
Text -> R ()
txt "->"
R ()
breakpoint
R () -> R ()
inci (LPat GhcPs -> R ()
p_pat LPat GhcPs
pat)
SplicePat NoExt splice :: HsSplice GhcPs
splice -> HsSplice GhcPs -> R ()
p_hsSplice HsSplice GhcPs
splice
LitPat NoExt p :: HsLit GhcPs
p -> HsLit GhcPs -> R ()
forall a. Outputable a => a -> R ()
atom HsLit GhcPs
p
NPat NoExt v :: Located (HsOverLit GhcPs)
v _ _ -> Located (HsOverLit GhcPs) -> (HsOverLit GhcPs -> R ()) -> R ()
forall a. Data 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 NoExt n :: Located (IdP GhcPs)
n k :: Located (HsOverLit GhcPs)
k _ _ _ -> R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Located RdrName -> R ()
p_rdrName Located (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 "+"
R ()
space
Located (HsOverLit GhcPs) -> (HsOverLit GhcPs -> R ()) -> R ()
forall a. Data 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 NoExt pat :: LPat GhcPs
pat hswc :: LHsSigWcType (NoGhcTc GhcPs)
hswc -> do
LPat GhcPs -> R ()
p_pat LPat GhcPs
pat
LHsSigWcType GhcPs -> R ()
p_typeAscription LHsSigWcType GhcPs
LHsSigWcType (NoGhcTc GhcPs)
hswc
CoPat {} -> String -> R ()
forall a. String -> a
notImplemented "CoPat"
p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
p_pat_hsRecField HsRecField {..} = do
Located (FieldOcc GhcPs) -> (FieldOcc GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located (FieldOcc GhcPs)
hsRecFieldLbl ((FieldOcc GhcPs -> R ()) -> R ())
-> (FieldOcc GhcPs -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \x :: FieldOcc GhcPs
x ->
Located RdrName -> R ()
p_rdrName (FieldOcc GhcPs -> Located RdrName
forall pass. FieldOcc pass -> Located RdrName
rdrNameFieldOcc FieldOcc GhcPs
x)
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hsRecPun (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R ()
space
Text -> R ()
txt "="
R ()
breakpoint
R () -> R ()
inci (LPat GhcPs -> R ()
p_pat LPat GhcPs
hsRecFieldArg)
p_unboxedSum :: BracketStyle -> ConTag -> Arity -> R () -> R ()
p_unboxedSum :: BracketStyle -> Int -> Int -> R () -> R ()
p_unboxedSum s :: BracketStyle
s tag :: Int
tag arity :: Int
arity m :: R ()
m = do
let before :: Int
before = Int
tag Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
after :: Int
after = Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
before Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
args :: [Maybe (R ())]
args = Int -> Maybe (R ()) -> [Maybe (R ())]
forall a. Int -> a -> [a]
replicate Int
before Maybe (R ())
forall a. Maybe a
Nothing [Maybe (R ())] -> [Maybe (R ())] -> [Maybe (R ())]
forall a. Semigroup a => a -> a -> a
<> [R () -> Maybe (R ())
forall a. a -> Maybe a
Just R ()
m] [Maybe (R ())] -> [Maybe (R ())] -> [Maybe (R ())]
forall a. Semigroup a => a -> a -> a
<> Int -> Maybe (R ()) -> [Maybe (R ())]
forall a. Int -> a -> [a]
replicate Int
after Maybe (R ())
forall a. Maybe a
Nothing
f :: (Maybe (R ()), Int) -> R ()
f (x :: Maybe (R ())
x, i :: Int
i) = do
let isFirst :: Bool
isFirst = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
isLast :: Bool
isLast = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
case Maybe (R ())
x :: Maybe (R ()) of
Nothing ->
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
isFirst Bool -> Bool -> Bool
|| Bool
isLast) R ()
space
Just m' :: R ()
m' -> do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isFirst R ()
space
R ()
m'
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isLast R ()
space
BracketStyle -> R () -> R ()
parensHash BracketStyle
s (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
-> ((Maybe (R ()), Int) -> R ()) -> [(Maybe (R ()), Int)] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt "|") (Maybe (R ()), Int) -> R ()
f ([Maybe (R ())] -> [Int] -> [(Maybe (R ()), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe (R ())]
args [0 ..])
p_hsSplice :: HsSplice GhcPs -> R ()
p_hsSplice :: HsSplice GhcPs -> R ()
p_hsSplice = \case
HsTypedSplice NoExt deco :: SpliceDecoration
deco _ expr :: LHsExpr GhcPs
expr -> Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
True LHsExpr GhcPs
expr SpliceDecoration
deco
HsUntypedSplice NoExt deco :: SpliceDecoration
deco _ expr :: LHsExpr GhcPs
expr -> Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH Bool
False LHsExpr GhcPs
expr SpliceDecoration
deco
HsQuasiQuote NoExt _ quoterName :: IdP GhcPs
quoterName srcSpan :: SrcSpan
srcSpan str :: FastString
str -> do
Text -> R ()
txt "["
Located RdrName -> R ()
p_rdrName (SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
srcSpan IdP GhcPs
RdrName
quoterName)
Text -> R ()
txt "|"
FastString -> R ()
forall a. Outputable a => a -> R ()
atom FastString
str
Text -> R ()
txt "|]"
HsSpliced {} -> String -> R ()
forall a. String -> a
notImplemented "HsSpliced"
HsSplicedT {} -> String -> R ()
forall a. String -> a
notImplemented "HsSplicedT"
XSplice {} -> String -> R ()
forall a. String -> a
notImplemented "XSplice"
p_hsSpliceTH ::
Bool ->
LHsExpr GhcPs ->
SpliceDecoration ->
R ()
p_hsSpliceTH :: Bool -> LHsExpr GhcPs -> SpliceDecoration -> R ()
p_hsSpliceTH isTyped :: Bool
isTyped expr :: LHsExpr GhcPs
expr = \case
HasParens -> do
Text -> R ()
txt Text
decoSymbol
BracketStyle -> R () -> R ()
parens BracketStyle
N (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr (R () -> R ()
sitcc (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr))
HasDollar -> do
Text -> R ()
txt Text
decoSymbol
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr (R () -> R ()
sitcc (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
NoParens ->
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr (R () -> R ()
sitcc (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
where
decoSymbol :: Text
decoSymbol = if Bool
isTyped then "$$" else "$"
p_hsBracket :: HsBracket GhcPs -> R ()
p_hsBracket :: HsBracket GhcPs -> R ()
p_hsBracket = \case
ExpBr NoExt expr :: LHsExpr GhcPs
expr -> do
[AnnKeywordId]
anns <- R [AnnKeywordId]
getEnclosingAnns
let name :: Text
name = case [AnnKeywordId]
anns of
AnnOpenEQ : _ -> ""
_ -> "e"
Text -> R () -> R ()
quote Text
name (LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr HsExpr GhcPs -> R ()
p_hsExpr)
PatBr NoExt pat :: LPat GhcPs
pat -> Text -> R () -> R ()
quote "p" (LPat GhcPs -> R ()
p_pat LPat GhcPs
pat)
DecBrL NoExt decls :: [LHsDecl GhcPs]
decls -> Text -> R () -> R ()
quote "d" (FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDecls FamilyStyle
Free [LHsDecl GhcPs]
decls)
DecBrG NoExt _ -> String -> R ()
forall a. String -> a
notImplemented "DecBrG"
TypBr NoExt ty :: Located (HsType GhcPs)
ty -> Text -> R () -> R ()
quote "t" (Located (HsType GhcPs) -> (HsType GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located Located (HsType GhcPs)
ty HsType GhcPs -> R ()
p_hsType)
VarBr NoExt isSingleQuote :: Bool
isSingleQuote name :: IdP GhcPs
name -> do
Text -> R ()
txt (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool "''" "'" Bool
isSingleQuote)
let isOperator :: Bool
isOperator =
(Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
(\i :: Char
i -> Char -> Bool
isPunctuation Char
i Bool -> Bool -> Bool
|| Char -> Bool
isSymbol Char
i)
(OccName -> String
forall o. Outputable o => o -> String
showOutputable (RdrName -> OccName
rdrNameOcc IdP GhcPs
RdrName
name))
Bool -> Bool -> Bool
&& Bool -> Bool
not (RdrName -> Bool
doesNotNeedExtraParens IdP GhcPs
RdrName
name)
wrapper :: R () -> R ()
wrapper = if Bool
isOperator then BracketStyle -> R () -> R ()
parens BracketStyle
N else R () -> R ()
forall a. a -> a
id
R () -> R ()
wrapper (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> R ()
p_rdrName (SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc IdP GhcPs
SrcSpanLess (Located RdrName)
name)
TExpBr NoExt expr :: LHsExpr GhcPs
expr -> do
Text -> R ()
txt "[||"
R ()
breakpoint'
LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
expr HsExpr GhcPs -> R ()
p_hsExpr
R ()
breakpoint'
Text -> R ()
txt "||]"
XBracket {} -> String -> R ()
forall a. String -> a
notImplemented "XBracket"
where
quote :: Text -> R () -> R ()
quote :: Text -> R () -> R ()
quote name :: Text
name body :: R ()
body = do
Text -> R ()
txt "["
Text -> R ()
txt Text
name
Text -> R ()
txt "|"
R ()
breakpoint'
R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
R () -> R ()
dontUseBraces R ()
body
R ()
breakpoint'
Text -> R ()
txt "|]"
p_stringLit :: String -> R ()
p_stringLit :: String -> R ()
p_stringLit src :: String
src =
let s :: [String]
s = String -> [String]
splitGaps String
src
singleLine :: R ()
singleLine =
Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack ([String] -> String
forall a. Monoid a => [a] -> a
mconcat [String]
s)
multiLine :: R ()
multiLine =
R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R () -> (String -> R ()) -> [String] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
breakpoint (Text -> R ()
txt (Text -> R ()) -> (String -> Text) -> String -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) ([String] -> [String]
backslashes [String]
s)
in R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout R ()
singleLine R ()
multiLine
where
splitGaps :: String -> [String]
splitGaps :: String -> [String]
splitGaps "" = []
splitGaps s :: String
s =
let
p :: (Maybe Char, Char, Maybe Char) -> Bool
p (Just '\\', _, _) = Bool
True
p (_, '\\', Just c :: Char
c) | Char -> Bool
ghcSpace Char
c = Bool
False
p _ = Bool
True
in case ((Maybe Char, Char, Maybe Char) -> Bool)
-> [(Maybe Char, Char, Maybe Char)]
-> ([(Maybe Char, Char, Maybe Char)],
[(Maybe Char, Char, Maybe Char)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Maybe Char, Char, Maybe Char) -> Bool
p (String -> [(Maybe Char, Char, Maybe Char)]
forall a. [a] -> [(Maybe a, a, Maybe a)]
zipPrevNext String
s) of
(l :: [(Maybe Char, Char, Maybe Char)]
l, r :: [(Maybe Char, Char, Maybe Char)]
r) ->
let
r' :: String
r' = Int -> String -> String
forall a. Int -> [a] -> [a]
drop 1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
ghcSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop 1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ((Maybe Char, Char, Maybe Char) -> Char)
-> [(Maybe Char, Char, Maybe Char)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Char, Char, Maybe Char) -> Char
forall a b c. (a, b, c) -> b
orig [(Maybe Char, Char, Maybe Char)]
r
in ((Maybe Char, Char, Maybe Char) -> Char)
-> [(Maybe Char, Char, Maybe Char)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Char, Char, Maybe Char) -> Char
forall a b c. (a, b, c) -> b
orig [(Maybe Char, Char, Maybe Char)]
l String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
splitGaps String
r'
ghcSpace :: Char -> Bool
ghcSpace :: Char -> Bool
ghcSpace c :: Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x7f' Bool -> Bool -> Bool
&& Char -> Bool
is_space Char
c
backslashes :: [String] -> [String]
backslashes :: [String] -> [String]
backslashes (x :: String
x : y :: String
y : xs :: [String]
xs) = (String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\\") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
backslashes (('\\' Char -> String -> String
forall a. a -> [a] -> [a]
: String
y) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs)
backslashes xs :: [String]
xs = [String]
xs
zipPrevNext :: [a] -> [(Maybe a, a, Maybe a)]
zipPrevNext :: [a] -> [(Maybe a, a, Maybe a)]
zipPrevNext xs :: [a]
xs =
let z :: [((Maybe a, a), Maybe a)]
z =
[(Maybe a, a)] -> [Maybe a] -> [((Maybe a, a), Maybe a)]
forall a b. [a] -> [b] -> [(a, b)]
zip
([Maybe a] -> [a] -> [(Maybe a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Maybe a
forall a. Maybe a
Nothing Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: (a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just [a]
xs) [a]
xs)
((a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just ([a] -> [a]
forall a. [a] -> [a]
tail [a]
xs) [Maybe a] -> [Maybe a] -> [Maybe a]
forall a. [a] -> [a] -> [a]
++ Maybe a -> [Maybe a]
forall a. a -> [a]
repeat Maybe a
forall a. Maybe a
Nothing)
in (((Maybe a, a), Maybe a) -> (Maybe a, a, Maybe a))
-> [((Maybe a, a), Maybe a)] -> [(Maybe a, a, Maybe a)]
forall a b. (a -> b) -> [a] -> [b]
map (\((p :: Maybe a
p, x :: a
x), n :: Maybe a
n) -> (Maybe a
p, a
x, Maybe a
n)) [((Maybe a, a), Maybe a)]
z
orig :: (a, b, c) -> b
orig (_, x :: b
x, _) = b
x
layoutToBraces :: Layout -> R () -> R ()
layoutToBraces :: Layout -> R () -> R ()
layoutToBraces = \case
SingleLine -> R () -> R ()
useBraces
MultiLine -> R () -> R ()
forall a. a -> a
id
liftAppend :: Semigroup a => [a] -> [a] -> [a]
liftAppend :: [a] -> [a] -> [a]
liftAppend [] [] = []
liftAppend [] (y :: a
y : ys :: [a]
ys) = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys
liftAppend (x :: a
x : xs :: [a]
xs) [] = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
liftAppend (x :: a
x : xs :: [a]
xs) (y :: a
y : ys :: [a]
ys) = a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Semigroup a => [a] -> [a] -> [a]
liftAppend [a]
xs [a]
ys
getGRHSSpan :: GRHS GhcPs (Located body) -> SrcSpan
getGRHSSpan :: GRHS GhcPs (Located body) -> SrcSpan
getGRHSSpan (GRHS NoExt guards :: [GuardLStmt GhcPs]
guards body :: Located body
body) =
NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ Located body -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located body
body SrcSpan -> [SrcSpan] -> NonEmpty SrcSpan
forall a. a -> [a] -> NonEmpty a
:| (GuardLStmt GhcPs -> SrcSpan) -> [GuardLStmt GhcPs] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GuardLStmt GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc [GuardLStmt GhcPs]
guards
getGRHSSpan (XGRHS NoExt) = String -> SrcSpan
forall a. String -> a
notImplemented "XGRHS"
placeHanging :: Placement -> R () -> R ()
placeHanging :: Placement -> R () -> R ()
placeHanging placement :: Placement
placement m :: R ()
m =
case Placement
placement of
Hanging -> do
R ()
space
R ()
m
Normal -> do
R ()
breakpoint
R () -> R ()
inci R ()
m
blockPlacement ::
(body -> Placement) ->
[LGRHS GhcPs (Located body)] ->
Placement
blockPlacement :: (body -> Placement) -> [LGRHS GhcPs (Located body)] -> Placement
blockPlacement placer :: body -> Placement
placer [L _ (GRHS NoExt _ (L _ x :: body
x))] = body -> Placement
placer body
x
blockPlacement _ _ = Placement
Normal
cmdPlacement :: HsCmd GhcPs -> Placement
cmdPlacement :: HsCmd GhcPs -> Placement
cmdPlacement = \case
HsCmdLam NoExt _ -> Placement
Hanging
HsCmdCase NoExt _ _ -> Placement
Hanging
HsCmdDo NoExt _ -> Placement
Hanging
_ -> Placement
Normal
cmdTopPlacement :: HsCmdTop GhcPs -> Placement
cmdTopPlacement :: HsCmdTop GhcPs -> Placement
cmdTopPlacement = \case
HsCmdTop NoExt (L _ x :: HsCmd GhcPs
x) -> HsCmd GhcPs -> Placement
cmdPlacement HsCmd GhcPs
x
XCmdTop {} -> String -> Placement
forall a. String -> a
notImplemented "XCmdTop"
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement :: HsExpr GhcPs -> Placement
exprPlacement = \case
HsLam NoExt mg :: MatchGroup GhcPs (LHsExpr GhcPs)
mg -> case MatchGroup GhcPs (LHsExpr GhcPs)
mg of
MG _ (L _ [L _ (Match NoExt _ (x :: LPat GhcPs
x : xs :: [LPat GhcPs]
xs) _)]) _
| SrcSpan -> Bool
isOneLineSpan (NonEmpty SrcSpan -> SrcSpan
combineSrcSpans' (NonEmpty SrcSpan -> SrcSpan) -> NonEmpty SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ (LPat GhcPs -> SrcSpan)
-> NonEmpty (LPat GhcPs) -> NonEmpty SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LPat GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (LPat GhcPs
x LPat GhcPs -> [LPat GhcPs] -> NonEmpty (LPat GhcPs)
forall a. a -> [a] -> NonEmpty a
:| [LPat GhcPs]
xs)) ->
Placement
Hanging
_ -> Placement
Normal
HsLamCase NoExt _ -> Placement
Hanging
HsCase NoExt _ _ -> Placement
Hanging
HsDo NoExt DoExpr _ -> Placement
Hanging
HsDo NoExt MDoExpr _ -> Placement
Hanging
OpApp NoExt _ _ y :: LHsExpr GhcPs
y -> HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
y)
HsApp NoExt _ y :: LHsExpr GhcPs
y -> HsExpr GhcPs -> Placement
exprPlacement (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
y)
HsProc NoExt p :: LPat GhcPs
p _ ->
let loc :: SrcSpan
loc = case LPat GhcPs
p of
XPat pat :: XXPat GhcPs
pat -> Located (LPat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc XXPat GhcPs
Located (LPat GhcPs)
pat
_ -> String -> SrcSpan
forall a. HasCallStack => String -> a
error "exprPlacement: HsProc: Pat does not contain a location"
in
if SrcSpan -> Bool
isOneLineSpan SrcSpan
loc
then Placement
Hanging
else Placement
Normal
_ -> Placement
Normal
withGuards :: [LGRHS GhcPs (Located body)] -> Bool
withGuards :: [LGRHS GhcPs (Located body)] -> Bool
withGuards = (LGRHS GhcPs (Located body) -> Bool)
-> [LGRHS GhcPs (Located body)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GRHS GhcPs (Located body) -> Bool
forall body. GRHS GhcPs (Located body) -> Bool
checkOne (GRHS GhcPs (Located body) -> Bool)
-> (LGRHS GhcPs (Located body) -> GRHS GhcPs (Located body))
-> LGRHS GhcPs (Located body)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LGRHS GhcPs (Located body) -> GRHS GhcPs (Located body)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
where
checkOne :: GRHS GhcPs (Located body) -> Bool
checkOne :: GRHS GhcPs (Located body) -> Bool
checkOne (GRHS NoExt [] _) = Bool
False
checkOne _ = Bool
True
exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree (L _ (OpApp NoExt x :: LHsExpr GhcPs
x op :: LHsExpr GhcPs
op y :: LHsExpr GhcPs
y)) = OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
-> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
forall ty op. OpTree ty op -> op -> OpTree ty op -> OpTree ty op
OpBranch (LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
x) LHsExpr GhcPs
op (LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree LHsExpr GhcPs
y)
exprOpTree n :: LHsExpr GhcPs
n = LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
forall ty op. ty -> OpTree ty op
OpNode LHsExpr GhcPs
n
getOpName :: HsExpr GhcPs -> Maybe RdrName
getOpName :: HsExpr GhcPs -> Maybe RdrName
getOpName = \case
HsVar NoExt (L _ a :: IdP GhcPs
a) -> RdrName -> Maybe RdrName
forall a. a -> Maybe a
Just IdP GhcPs
RdrName
a
_ -> Maybe RdrName
forall a. Maybe a
Nothing
p_exprOpTree ::
Bool ->
BracketStyle ->
OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->
R ()
p_exprOpTree :: Bool
-> BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree _ s :: BracketStyle
s (OpNode x :: LHsExpr GhcPs
x) = LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
x (BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' BracketStyle
s)
p_exprOpTree isDollarSpecial :: Bool
isDollarSpecial s :: BracketStyle
s (OpBranch x :: OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x op :: LHsExpr GhcPs
op y :: 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 _ n :: HsExpr GhcPs
n) -> HsExpr GhcPs -> Placement
exprPlacement HsExpr GhcPs
n
_ -> Placement
Normal
else Placement
Normal
opWrapper :: R () -> R ()
opWrapper = case LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
op of
EWildPat NoExt -> R () -> R ()
backticks
_ -> R () -> R ()
forall a. a -> a
id
Layout
layout <- R Layout
getLayout
let ub :: R () -> R ()
ub = case Layout
layout of
SingleLine -> R () -> R ()
useBraces
MultiLine -> case Placement
placement of
Hanging -> R () -> R ()
useBraces
Normal -> R () -> R ()
dontUseBraces
gotDollar :: Bool
gotDollar = case HsExpr GhcPs -> Maybe RdrName
getOpName (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
op) of
Just rname :: RdrName
rname -> String -> OccName
mkVarOcc "$" OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName -> OccName
rdrNameOcc RdrName
rname
_ -> Bool
False
lhs :: R ()
lhs =
[SrcSpan] -> R () -> R ()
switchLayout [OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x] (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
Bool
-> BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree (Bool -> Bool
not Bool
gotDollar) BracketStyle
s OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x
let p_op :: R ()
p_op = LHsExpr GhcPs -> (HsExpr GhcPs -> R ()) -> R ()
forall a. Data a => Located a -> (a -> R ()) -> R ()
located LHsExpr GhcPs
op (R () -> R ()
opWrapper (R () -> R ()) -> (HsExpr GhcPs -> R ()) -> HsExpr GhcPs -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> R ()
p_hsExpr)
p_y :: R ()
p_y = [SrcSpan] -> R () -> R ()
switchLayout [OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y] (Bool
-> BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree Bool
True BracketStyle
N OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y)
isSection :: Bool
isSection = case (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x, LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc LHsExpr GhcPs
op) of
(RealSrcSpan treeSpan :: RealSrcSpan
treeSpan, RealSrcSpan opSpan :: RealSrcSpan
opSpan) ->
RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
treeSpan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
opSpan
_ -> Bool
False
Bool
useRecordDot' <- R Bool
useRecordDot
let isRecordDot' :: Bool
isRecordDot' = HsExpr GhcPs -> SrcSpan -> Bool
isRecordDot (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
op) (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
y)
if Bool
useRecordDot' Bool -> Bool -> Bool
&& Bool
isRecordDot'
then do
R ()
lhs
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isSection R ()
space
R ()
p_op
R ()
p_y
else
if Bool
isDollarSpecial
Bool -> Bool -> Bool
&& Bool
gotDollar
Bool -> Bool -> Bool
&& Placement
placement
Placement -> Placement -> Bool
forall a. Eq a => a -> a -> Bool
== Placement
Normal
Bool -> Bool -> Bool
&& SrcSpan -> Bool
isOneLineSpan (OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> SrcSpan
forall a b. OpTree (Located a) b -> SrcSpan
opTreeLoc OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
x)
then do
R () -> R ()
useBraces R ()
lhs
R ()
space
R ()
p_op
R ()
breakpoint
R () -> R ()
inci R ()
p_y
else do
R () -> R ()
ub R ()
lhs
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 op :: HsExpr GhcPs
op (RealSrcSpan ySpan :: RealSrcSpan
ySpan) = case HsExpr GhcPs
op of
HsVar NoExt (L (RealSrcSpan opSpan :: RealSrcSpan
opSpan) opName :: IdP GhcPs
opName) ->
RdrName -> Bool
isDot IdP GhcPs
RdrName
opName Bool -> Bool -> Bool
&& (RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
opSpan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
ySpan)
_ -> Bool
False
isRecordDot _ _ = Bool
False
isDot :: RdrName -> Bool
isDot :: RdrName -> Bool
isDot name :: RdrName
name = RdrName -> OccName
rdrNameOcc RdrName
name OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== String -> OccName
mkVarOcc "."
getEnclosingAnns :: R [AnnKeywordId]
getEnclosingAnns :: R [AnnKeywordId]
getEnclosingAnns = do
Maybe RealSrcSpan
e <- (RealSrcSpan -> Bool) -> R (Maybe RealSrcSpan)
getEnclosingSpan (Bool -> RealSrcSpan -> Bool
forall a b. a -> b -> a
const Bool
True)
case Maybe RealSrcSpan
e of
Nothing -> [AnnKeywordId] -> R [AnnKeywordId]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just e' :: RealSrcSpan
e' -> SrcSpan -> R [AnnKeywordId]
getAnns (RealSrcSpan -> SrcSpan
RealSrcSpan RealSrcSpan
e')