{-# LANGUAGE CPP #-}
module GHC.SourceGen.Expr
( HsExpr'
, overLabel
, let'
, case'
, lambda
, lambdaCase
, if'
, multiIf
, do'
, Stmt'
, (@::@)
, tyApp
, recordConE
, recordUpd
) where
import HsExpr
import HsPat (HsRecField'(..), HsRecFields(..))
import HsTypes (FieldOcc(..), AmbiguousFieldOcc(..))
import Data.String (fromString)
import SrcLoc (unLoc, GenLocated(..), Located)
import GHC.SourceGen.Binds.Internal
import GHC.SourceGen.Binds
import GHC.SourceGen.Expr.Internal
import GHC.SourceGen.Name.Internal
import GHC.SourceGen.Syntax.Internal
import GHC.SourceGen.Type.Internal
( parenthesizeTypeForApp
, sigWcType
, wcType
)
overLabel :: String -> HsExpr'
overLabel = noExt HsOverLabel Nothing . fromString
let' :: [RawValBind] -> HsExpr' -> HsExpr'
let' binds e = noExt HsLet (builtLoc $ valBinds binds) $ builtLoc e
case' :: HsExpr' -> [RawMatch] -> HsExpr'
case' e matches = noExt HsCase (builtLoc e)
$ matchGroup CaseAlt matches
lambda :: [Pat'] -> HsExpr' -> HsExpr'
lambda ps e = noExt HsLam $ matchGroup LambdaExpr [match ps e]
lambdaCase :: [RawMatch] -> HsExpr'
lambdaCase = noExt HsLamCase . matchGroup CaseAlt
if' :: HsExpr' -> HsExpr' -> HsExpr' -> HsExpr'
if' x y z = noExt HsIf Nothing (builtLoc x) (builtLoc y) (builtLoc z)
multiIf :: [GuardedExpr] -> HsExpr'
multiIf = noExtOrPlaceHolder HsMultiIf . map builtLoc
do' :: [Stmt'] -> HsExpr'
do' = withPlaceHolder . noExt HsDo DoExpr
. builtLoc . map (builtLoc . parenthesizeIfLet)
where
#if MIN_VERSION_ghc(8,6,0)
parenthesizeIfLet (BodyStmt ext e@(L _ HsLet{}) x y)
= BodyStmt ext (parExpr e) x y
#else
parenthesizeIfLet (BodyStmt e@(L _ HsLet{}) x y tc)
= BodyStmt (parExpr e) x y tc
#endif
parenthesizeIfLet s = s
(@::@) :: HsExpr' -> HsType' -> HsExpr'
#if MIN_VERSION_ghc(8,8,0)
e @::@ t = noExt ExprWithTySig (builtLoc e) (sigWcType t)
#elif MIN_VERSION_ghc(8,6,0)
e @::@ t = ExprWithTySig (sigWcType t) (builtLoc e)
#else
e @::@ t = ExprWithTySig (builtLoc e) (sigWcType t)
#endif
tyApp :: HsExpr' -> HsType' -> HsExpr'
#if MIN_VERSION_ghc(8,8,0)
tyApp e t = noExt HsAppType e' t'
#elif MIN_VERSION_ghc(8,6,0)
tyApp e t = HsAppType t' e'
#else
tyApp e t = HsAppType e' t'
#endif
where
t' = wcType $ unLoc $ parenthesizeTypeForApp $ builtLoc t
e' = builtLoc e
recordConE :: RdrNameStr -> [(RdrNameStr, HsExpr')] -> HsExpr'
recordConE c fs = (withPlaceHolder $ noExt RecordCon (valueRdrName c))
#if !MIN_VERSION_ghc(8,6,0)
noPostTcExpr
#endif
$ HsRecFields (map recField fs)
Nothing
where
recField :: (RdrNameStr, HsExpr') -> LHsRecField' (Located HsExpr')
recField (f, e) =
builtLoc HsRecField
{ hsRecFieldLbl =
builtLoc $ withPlaceHolder $ noExt FieldOcc $ valueRdrName f
, hsRecFieldArg = builtLoc e
, hsRecPun = False
}
recordUpd :: HsExpr' -> [(RdrNameStr, HsExpr')] -> HsExpr'
recordUpd e fs =
withPlaceHolder4
$ noExt RecordUpd (parenthesizeExprForApp $ builtLoc e)
$ map mkField fs
where
mkField :: (RdrNameStr, HsExpr') -> LHsRecUpdField'
mkField (f, e') =
builtLoc HsRecField
{ hsRecFieldLbl =
builtLoc $ withPlaceHolder $ noExt Ambiguous $ valueRdrName f
, hsRecFieldArg = builtLoc e'
, hsRecPun = False
}
withPlaceHolder4 = withPlaceHolder . withPlaceHolder . withPlaceHolder
. withPlaceHolder