-- Copyright 2019 Google LLC
--
-- Use of this source code is governed by a BSD-style
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd

{-# LANGUAGE CPP #-}
-- | This module provides combinators for constructing Haskell expressions.
module GHC.SourceGen.Expr
    ( HsExpr'
    , overLabel
    , let'
    , case'
    , lambda
    , lambdaCase
    , if'
    , multiIf
    , do'
    , listComp
    , Stmt'
    , (@::@)
    , tyApp
    , recordConE
    , recordUpd
    , from
    , fromThen
    , fromTo
    , fromThenTo
    ) where

import GHC.Hs.Expr
import GHC.Hs.Extension (GhcPs)
import GHC.Hs.Pat (HsRecField'(..), HsRecFields(..))
import GHC.Hs.Type (FieldOcc(..), AmbiguousFieldOcc(..))
import GHC.Hs.Utils (mkHsIf)
import Data.String (fromString)
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.SrcLoc (unLoc, GenLocated(..))
#else
import SrcLoc (unLoc, GenLocated(..))
#endif

#if MIN_VERSION_ghc(9,2,0)
import GHC.Parser.Annotation (EpAnn(..))
#endif

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
    )

-- | An overloaded label, as used with the @OverloadedLabels@ extension.
--
-- > #foo
-- > =====
-- > overLabel "foo"
overLabel :: String -> HsExpr'
overLabel :: String -> HsExpr'
overLabel = FastString -> HsExpr'
hsOverLabel (FastString -> HsExpr')
-> (String -> FastString) -> String -> HsExpr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
forall a. IsString a => String -> a
fromString
  where
#if MIN_VERSION_ghc(9,2,0)
    hsOverLabel = withEpAnnNotUsed HsOverLabel
#else
    hsOverLabel :: FastString -> HsExpr'
hsOverLabel = (NoExtField -> Maybe (IdP GhcPs) -> FastString -> HsExpr')
-> Maybe (IdP GhcPs) -> FastString -> HsExpr'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> Maybe (IdP GhcPs) -> FastString -> HsExpr'
forall p. XOverLabel p -> Maybe (IdP p) -> FastString -> HsExpr p
HsOverLabel Maybe (IdP GhcPs)
forall a. Maybe a
Nothing
#endif

let' :: [RawValBind] -> HsExpr' -> HsExpr'
let' :: [RawValBind] -> HsExpr' -> HsExpr'
let' [RawValBind]
binds HsExpr'
e = (NoExtField -> LHsLocalBinds GhcPs -> LHsExpr GhcPs -> HsExpr')
-> LHsLocalBinds GhcPs -> LHsExpr GhcPs -> HsExpr'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> LHsLocalBinds GhcPs -> LHsExpr GhcPs -> HsExpr'
forall p. XLet p -> LHsLocalBinds p -> LHsExpr p -> HsExpr p
HsLet (HsLocalBinds' -> LHsLocalBinds GhcPs
forall e. e -> Located e
toHsLocalBinds (HsLocalBinds' -> LHsLocalBinds GhcPs)
-> HsLocalBinds' -> LHsLocalBinds GhcPs
forall a b. (a -> b) -> a -> b
$ [RawValBind] -> HsLocalBinds'
valBinds [RawValBind]
binds) (LHsExpr GhcPs -> HsExpr') -> LHsExpr GhcPs -> HsExpr'
forall a b. (a -> b) -> a -> b
$ HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
e
  where
#if MIN_VERSION_ghc(9,2,0)
    toHsLocalBinds = id
#else
    toHsLocalBinds :: e -> Located e
toHsLocalBinds = e -> Located e
forall e. e -> Located e
builtLoc
#endif

case' :: HsExpr' -> [RawMatch] -> HsExpr'
case' :: HsExpr' -> [RawMatch] -> HsExpr'
case' HsExpr'
e [RawMatch]
matches = (NoExtField
 -> LHsExpr GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr')
-> LHsExpr GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField
-> LHsExpr GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr'
forall p.
XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsCase (HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
e)
                    (MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr')
-> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr'
forall a b. (a -> b) -> a -> b
$ HsMatchContext' -> [RawMatch] -> MatchGroup GhcPs (LHsExpr GhcPs)
matchGroup HsMatchContext'
forall id. HsMatchContext id
CaseAlt [RawMatch]
matches

lambda :: [Pat'] -> HsExpr' -> HsExpr'
lambda :: [Pat'] -> HsExpr' -> HsExpr'
lambda [Pat']
ps HsExpr'
e = (NoExtField -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr')
-> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr'
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam (MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr')
-> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr'
forall a b. (a -> b) -> a -> b
$ HsMatchContext' -> [RawMatch] -> MatchGroup GhcPs (LHsExpr GhcPs)
matchGroup HsMatchContext'
forall id. HsMatchContext id
LambdaExpr [[Pat'] -> HsExpr' -> RawMatch
match [Pat']
ps HsExpr'
e]

lambdaCase :: [RawMatch] -> HsExpr'
lambdaCase :: [RawMatch] -> HsExpr'
lambdaCase = (NoExtField -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr')
-> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr'
forall p. XLamCase p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase (MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr')
-> ([RawMatch] -> MatchGroup GhcPs (LHsExpr GhcPs))
-> [RawMatch]
-> HsExpr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsMatchContext' -> [RawMatch] -> MatchGroup GhcPs (LHsExpr GhcPs)
matchGroup HsMatchContext'
forall id. HsMatchContext id
CaseAlt

if' :: HsExpr' -> HsExpr' -> HsExpr' -> HsExpr'
if' :: HsExpr' -> HsExpr' -> HsExpr' -> HsExpr'
if' HsExpr'
x HsExpr'
y HsExpr'
z = LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr'
forall (p :: Pass).
LHsExpr (GhcPass p)
-> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> HsExpr (GhcPass p)
mkHsIf
                (HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
x)
                (HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
y)
                (HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
z)
#if MIN_VERSION_ghc(9,2,0)
                EpAnnNotUsed
#endif

-- | A MultiWayIf expression.
--
-- > if | f x = "f"
-- >    | g x = "g"
-- >    | otherwise = "h"
-- > =====
-- > multiIf
-- >     [ guardedStmt (var "f" @@ var "x") $ rhs (string "f")
-- >     , guardedStmt (var "g" @@ var "x") $ rhs (string "g")
-- >     , guardedStmt (var "otherwise") $ rhs (string "h")
-- >     ]
multiIf :: [GuardedExpr] -> HsExpr'
multiIf :: [GuardedExpr] -> HsExpr'
multiIf = ([LGRHS GhcPs (LHsExpr GhcPs)] -> HsExpr')
-> [LGRHS GhcPs (LHsExpr GhcPs)] -> HsExpr'
forall a. a -> a
withPlaceHolder ((NoExtField -> [LGRHS GhcPs (LHsExpr GhcPs)] -> HsExpr')
-> [LGRHS GhcPs (LHsExpr GhcPs)] -> HsExpr'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> [LGRHS GhcPs (LHsExpr GhcPs)] -> HsExpr'
forall p. XMultiIf p -> [LGRHS p (LHsExpr p)] -> HsExpr p
HsMultiIf) ([LGRHS GhcPs (LHsExpr GhcPs)] -> HsExpr')
-> ([GuardedExpr] -> [LGRHS GhcPs (LHsExpr GhcPs)])
-> [GuardedExpr]
-> HsExpr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GuardedExpr -> LGRHS GhcPs (LHsExpr GhcPs))
-> [GuardedExpr] -> [LGRHS GhcPs (LHsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map GuardedExpr -> LGRHS GhcPs (LHsExpr GhcPs)
forall e. e -> Located e
builtLoc

-- | A do-expression.
--
-- Individual statements may be constructed with '<--' and/or 'stmt'.
--
-- > do
-- >   x <- act
-- >   return x
-- > =====
-- > do' [bvar "x" <-- var "act", stmt $ var "return" @@ var "x"]
do' :: [Stmt'] -> HsExpr'
do' :: [Stmt'] -> HsExpr'
do' = HsExpr' -> HsExpr'
forall a. a -> a
withPlaceHolder
#if MIN_VERSION_ghc(9,0,0)
        . withEpAnnNotUsed HsDo (DoExpr Nothing)
#else
        (HsExpr' -> HsExpr') -> ([Stmt'] -> HsExpr') -> [Stmt'] -> HsExpr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NoExtField
 -> HsStmtContext Name -> Located [ExprLStmt GhcPs] -> HsExpr')
-> HsStmtContext Name -> Located [ExprLStmt GhcPs] -> HsExpr'
forall a. (NoExtField -> a) -> a
noExt NoExtField
-> HsStmtContext Name -> Located [ExprLStmt GhcPs] -> HsExpr'
forall p.
XDo p -> HsStmtContext Name -> Located [ExprLStmt p] -> HsExpr p
HsDo HsStmtContext Name
forall id. HsStmtContext id
DoExpr
#endif
        (Located [ExprLStmt GhcPs] -> HsExpr')
-> ([Stmt'] -> Located [ExprLStmt GhcPs]) -> [Stmt'] -> HsExpr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ExprLStmt GhcPs] -> Located [ExprLStmt GhcPs]
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated ([ExprLStmt GhcPs] -> Located [ExprLStmt GhcPs])
-> ([Stmt'] -> [ExprLStmt GhcPs])
-> [Stmt']
-> Located [ExprLStmt GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt' -> ExprLStmt GhcPs) -> [Stmt'] -> [ExprLStmt GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map (Stmt' -> ExprLStmt GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated (Stmt' -> ExprLStmt GhcPs)
-> (Stmt' -> Stmt') -> Stmt' -> ExprLStmt GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stmt' -> Stmt'
forall idL idR.
StmtLR idL idR (LHsExpr GhcPs) -> StmtLR idL idR (LHsExpr GhcPs)
parenthesizeIfLet)
  where
  -- Put parentheses around a "let" in a do-binding, to avoid:
  --   do let x = ...
  --      in x
  -- which is not valid Haskell.
#if MIN_VERSION_ghc(8,6,0)
    parenthesizeIfLet :: StmtLR idL idR (LHsExpr GhcPs) -> StmtLR idL idR (LHsExpr GhcPs)
parenthesizeIfLet (BodyStmt XBodyStmt idL idR (LHsExpr GhcPs)
ext e :: LHsExpr GhcPs
e@(L SrcSpanAnn ann
_ HsLet{}) SyntaxExpr idR
x SyntaxExpr idR
y)
        = XBodyStmt idL idR (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> SyntaxExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR (LHsExpr GhcPs)
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt idL idR (LHsExpr GhcPs)
ext (LHsExpr GhcPs -> LHsExpr GhcPs
parExpr LHsExpr GhcPs
e) SyntaxExpr idR
x SyntaxExpr idR
y
#else
    parenthesizeIfLet (BodyStmt e@(L _ HsLet{}) x y tc)
        = BodyStmt (parExpr e) x y tc
#endif
    parenthesizeIfLet StmtLR idL idR (LHsExpr GhcPs)
s = StmtLR idL idR (LHsExpr GhcPs)
s

-- | A list comprehension expression.
--
-- > [x * 2 | x <- [1 .. 10], even x]
-- > =====
-- > listComp (op (bvar "x") "*" (int 2))
-- >          [ bvar "x" <-- fromTo (int 1) (int 10)
-- >          , stmt $ var "even" @@ bvar "x"
-- >          ]
listComp :: HsExpr' -> [Stmt'] -> HsExpr'
listComp :: HsExpr' -> [Stmt'] -> HsExpr'
listComp HsExpr'
lastExpr [Stmt']
stmts =
    let lastStmt :: Stmt'
lastStmt = (NoExtField -> LHsExpr GhcPs -> Bool -> SyntaxExpr GhcPs -> Stmt')
-> LHsExpr GhcPs -> Bool -> SyntaxExpr GhcPs -> Stmt'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> LHsExpr GhcPs -> Bool -> SyntaxExpr GhcPs -> Stmt'
forall idL idR body.
XLastStmt idL idR body
-> body -> Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt (HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
lastExpr) Bool
ret SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr
#if MIN_VERSION_ghc(9,0,0)
        ret = Nothing
#else
        ret :: Bool
ret = Bool
False
#endif
     in HsExpr' -> HsExpr'
forall a. a -> a
withPlaceHolder (HsExpr' -> HsExpr') -> ([Stmt'] -> HsExpr') -> [Stmt'] -> HsExpr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NoExtField
 -> HsStmtContext Name -> Located [ExprLStmt GhcPs] -> HsExpr')
-> HsStmtContext Name -> Located [ExprLStmt GhcPs] -> HsExpr'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField
-> HsStmtContext Name -> Located [ExprLStmt GhcPs] -> HsExpr'
forall p.
XDo p -> HsStmtContext Name -> Located [ExprLStmt p] -> HsExpr p
HsDo HsStmtContext Name
forall id. HsStmtContext id
ListComp (Located [ExprLStmt GhcPs] -> HsExpr')
-> ([Stmt'] -> Located [ExprLStmt GhcPs]) -> [Stmt'] -> HsExpr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ExprLStmt GhcPs] -> Located [ExprLStmt GhcPs]
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated ([ExprLStmt GhcPs] -> Located [ExprLStmt GhcPs])
-> ([Stmt'] -> [ExprLStmt GhcPs])
-> [Stmt']
-> Located [ExprLStmt GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt' -> ExprLStmt GhcPs) -> [Stmt'] -> [ExprLStmt GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map Stmt' -> ExprLStmt GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated ([Stmt'] -> HsExpr') -> [Stmt'] -> HsExpr'
forall a b. (a -> b) -> a -> b
$
            [Stmt']
stmts [Stmt'] -> [Stmt'] -> [Stmt']
forall a. [a] -> [a] -> [a]
++ [Stmt'
lastStmt]

-- | A type constraint on an expression.
--
-- > e :: t
-- > =====
-- > var "e" @::@ var "t"
(@::@) :: HsExpr' -> HsType' -> HsExpr'
#if MIN_VERSION_ghc(8,8,0)
HsExpr'
e @::@ :: HsExpr' -> HsType' -> HsExpr'
@::@ HsType'
t = (NoExtField -> LHsExpr GhcPs -> LHsSigWcType' -> HsExpr')
-> LHsExpr GhcPs -> LHsSigWcType' -> HsExpr'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> LHsExpr GhcPs -> LHsSigWcType' -> HsExpr'
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig (HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
e) (HsType' -> LHsSigWcType'
sigWcType HsType'
t)
#elif MIN_VERSION_ghc(8,6,0)
e @::@ t = ExprWithTySig (sigWcType t) (builtLoc e)
#else
e @::@ t = ExprWithTySig (builtLoc e) (sigWcType t)
#endif
-- TODO: The Outputable instance prepends extra spaces; I'm not sure why.

-- | Explicit type application.
--
-- > f @ Int
-- > =====
-- > var "f" @@ var "Int"
tyApp :: HsExpr' -> HsType' -> HsExpr'
#if MIN_VERSION_ghc(9,2,0)
tyApp e t = HsAppType builtSpan e' t'
#elif MIN_VERSION_ghc(8,8,0)
tyApp :: HsExpr' -> HsType' -> HsExpr'
tyApp HsExpr'
e HsType'
t = (NoExtField -> LHsExpr GhcPs -> LHsWcType' -> HsExpr')
-> LHsExpr GhcPs -> LHsWcType' -> HsExpr'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> LHsExpr GhcPs -> LHsWcType' -> HsExpr'
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType LHsExpr GhcPs
forall ann. LHsExpr GhcPs
e' LHsWcType'
t'
#elif MIN_VERSION_ghc(8,6,0)
tyApp e t = HsAppType t' e'
#else
tyApp e t = HsAppType e' t'
#endif
  where
    t' :: LHsWcType'
t' = HsType' -> LHsWcType'
wcType (HsType' -> LHsWcType') -> HsType' -> LHsWcType'
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsType GhcPs -> SrcSpanLess (LHsType GhcPs))
-> LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> LHsType GhcPs
parenthesizeTypeForApp (LHsType GhcPs -> LHsType GhcPs) -> LHsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ HsType' -> LHsType GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsType'
t
    e' :: LHsExpr GhcPs
e' = HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
e

-- | Constructs a record with explicit field names.
--
-- > A { x = y }
-- > =====
-- > recordConE "A" [("x", var "y")]
recordConE :: RdrNameStr -> [(RdrNameStr, HsExpr')] -> HsExpr'
recordConE :: RdrNameStr -> [(RdrNameStr, HsExpr')] -> HsExpr'
recordConE RdrNameStr
c [(RdrNameStr, HsExpr')]
fs = ((HsRecFields GhcPs (LHsExpr GhcPs) -> HsExpr')
-> HsRecFields GhcPs (LHsExpr GhcPs) -> HsExpr'
forall a. a -> a
withPlaceHolder ((HsRecFields GhcPs (LHsExpr GhcPs) -> HsExpr')
 -> HsRecFields GhcPs (LHsExpr GhcPs) -> HsExpr')
-> (HsRecFields GhcPs (LHsExpr GhcPs) -> HsExpr')
-> HsRecFields GhcPs (LHsExpr GhcPs)
-> HsExpr'
forall a b. (a -> b) -> a -> b
$ (NoExtField
 -> LocatedN RdrName
 -> HsRecFields GhcPs (LHsExpr GhcPs)
 -> HsExpr')
-> LocatedN RdrName -> HsRecFields GhcPs (LHsExpr GhcPs) -> HsExpr'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField
-> LocatedN RdrName -> HsRecFields GhcPs (LHsExpr GhcPs) -> HsExpr'
forall p.
XRecordCon p -> Located (IdP p) -> HsRecordBinds p -> HsExpr p
RecordCon (RdrNameStr -> LocatedN RdrName
valueRdrName RdrNameStr
c))
#if !MIN_VERSION_ghc(8,6,0)
                    noPostTcExpr
#endif
                    (HsRecFields GhcPs (LHsExpr GhcPs) -> HsExpr')
-> HsRecFields GhcPs (LHsExpr GhcPs) -> HsExpr'
forall a b. (a -> b) -> a -> b
$ [LHsRecField GhcPs (LHsExpr GhcPs)]
-> Maybe (Located Int) -> HsRecFields GhcPs (LHsExpr GhcPs)
forall p arg.
[LHsRecField p arg] -> Maybe (Located Int) -> HsRecFields p arg
HsRecFields (((RdrNameStr, HsExpr') -> LHsRecField GhcPs (LHsExpr GhcPs))
-> [(RdrNameStr, HsExpr')] -> [LHsRecField GhcPs (LHsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (RdrNameStr, HsExpr') -> LHsRecField GhcPs (LHsExpr GhcPs)
recField [(RdrNameStr, HsExpr')]
fs)
                        Maybe (Located Int)
forall a. Maybe a
Nothing -- No ".."
  where
    recField :: (RdrNameStr, HsExpr') -> LHsRecField' LHsExpr'
    recField :: (RdrNameStr, HsExpr') -> LHsRecField GhcPs (LHsExpr GhcPs)
recField (RdrNameStr
f, HsExpr'
e) =
        HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)
-> LHsRecField GhcPs (LHsExpr GhcPs)
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsRecField :: forall id arg. Located id -> arg -> Bool -> HsRecField' id arg
HsRecField
            { hsRecFieldLbl :: Located (FieldOcc GhcPs)
hsRecFieldLbl =
                  FieldOcc GhcPs -> Located (FieldOcc GhcPs)
forall e. e -> Located e
builtLoc (FieldOcc GhcPs -> Located (FieldOcc GhcPs))
-> FieldOcc GhcPs -> Located (FieldOcc GhcPs)
forall a b. (a -> b) -> a -> b
$ FieldOcc GhcPs -> FieldOcc GhcPs
forall a. a -> a
withPlaceHolder (FieldOcc GhcPs -> FieldOcc GhcPs)
-> FieldOcc GhcPs -> FieldOcc GhcPs
forall a b. (a -> b) -> a -> b
$ (NoExtField -> LocatedN RdrName -> FieldOcc GhcPs)
-> LocatedN RdrName -> FieldOcc GhcPs
forall a. (NoExtField -> a) -> a
noExt NoExtField -> LocatedN RdrName -> FieldOcc GhcPs
forall pass. XCFieldOcc pass -> LocatedN RdrName -> FieldOcc pass
FieldOcc (LocatedN RdrName -> FieldOcc GhcPs)
-> LocatedN RdrName -> FieldOcc GhcPs
forall a b. (a -> b) -> a -> b
$ RdrNameStr -> LocatedN RdrName
valueRdrName RdrNameStr
f
            , hsRecFieldArg :: LHsExpr GhcPs
hsRecFieldArg = HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
e
            , hsRecPun :: Bool
hsRecPun = Bool
False
#if MIN_VERSION_ghc(9,2,0)
            , hsRecFieldAnn = EpAnnNotUsed
#endif
            }

-- | Updates a record expression with explicit field names.
--
-- > r {a = b, c = d}
-- > =====
-- > recordUpd (var "x") [("a", var "b", ("c", var "d"))]
--
-- > (f x) {a = b}
-- > =====
-- > recordUpd (var "f" @@ var "x") [("a", var "b")]
--
-- > f x {a = b} -- equivalent to f (x {a = b})
-- > =====
-- > var "f" @@ recordUpd (var "x") [("a", var "b")]
recordUpd :: HsExpr' -> [(RdrNameStr, HsExpr')] -> HsExpr'
recordUpd :: HsExpr' -> [(RdrNameStr, HsExpr')] -> HsExpr'
recordUpd HsExpr'
e [(RdrNameStr, HsExpr')]
fs =
    HsExpr' -> HsExpr'
forall a. a -> a
withPlaceHolder4
       (HsExpr' -> HsExpr') -> HsExpr' -> HsExpr'
forall a b. (a -> b) -> a -> b
$ (NoExtField -> LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr')
-> LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField -> LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr'
forall p.
XRecordUpd p -> LHsExpr p -> [LHsRecUpdField p] -> HsExpr p
RecordUpd (LHsExpr GhcPs -> LHsExpr GhcPs
parenthesizeExprForApp (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
e)
       ([LHsRecUpdField GhcPs] -> HsExpr')
-> [LHsRecUpdField GhcPs] -> HsExpr'
forall a b. (a -> b) -> a -> b
$ [LHsRecUpdField GhcPs] -> [LHsRecUpdField GhcPs]
forall a. a -> a
toRecordUpdFields ([LHsRecUpdField GhcPs] -> [LHsRecUpdField GhcPs])
-> [LHsRecUpdField GhcPs] -> [LHsRecUpdField GhcPs]
forall a b. (a -> b) -> a -> b
$ ((RdrNameStr, HsExpr') -> LHsRecUpdField GhcPs)
-> [(RdrNameStr, HsExpr')] -> [LHsRecUpdField GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map (RdrNameStr, HsExpr') -> LHsRecUpdField GhcPs
mkField [(RdrNameStr, HsExpr')]
fs
  where
    mkField :: (RdrNameStr, HsExpr') -> LHsRecUpdField'
    mkField :: (RdrNameStr, HsExpr') -> LHsRecUpdField GhcPs
mkField (RdrNameStr
f, HsExpr'
e') =
        HsRecField' (AmbiguousFieldOcc GhcPs) (LHsExpr GhcPs)
-> LHsRecUpdField GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsRecField :: forall id arg. Located id -> arg -> Bool -> HsRecField' id arg
HsRecField
            { hsRecFieldLbl :: Located (AmbiguousFieldOcc GhcPs)
hsRecFieldLbl =
                AmbiguousFieldOcc GhcPs -> Located (AmbiguousFieldOcc GhcPs)
forall e. e -> Located e
builtLoc (AmbiguousFieldOcc GhcPs -> Located (AmbiguousFieldOcc GhcPs))
-> AmbiguousFieldOcc GhcPs -> Located (AmbiguousFieldOcc GhcPs)
forall a b. (a -> b) -> a -> b
$ AmbiguousFieldOcc GhcPs -> AmbiguousFieldOcc GhcPs
forall a. a -> a
withPlaceHolder (AmbiguousFieldOcc GhcPs -> AmbiguousFieldOcc GhcPs)
-> AmbiguousFieldOcc GhcPs -> AmbiguousFieldOcc GhcPs
forall a b. (a -> b) -> a -> b
$ (NoExtField -> LocatedN RdrName -> AmbiguousFieldOcc GhcPs)
-> LocatedN RdrName -> AmbiguousFieldOcc GhcPs
forall a. (NoExtField -> a) -> a
noExt NoExtField -> LocatedN RdrName -> AmbiguousFieldOcc GhcPs
forall pass.
XAmbiguous pass -> LocatedN RdrName -> AmbiguousFieldOcc pass
Ambiguous (LocatedN RdrName -> AmbiguousFieldOcc GhcPs)
-> LocatedN RdrName -> AmbiguousFieldOcc GhcPs
forall a b. (a -> b) -> a -> b
$ RdrNameStr -> LocatedN RdrName
valueRdrName RdrNameStr
f
            , hsRecFieldArg :: LHsExpr GhcPs
hsRecFieldArg = HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
e'
            , hsRecPun :: Bool
hsRecPun = Bool
False
#if MIN_VERSION_ghc(9,2,0)
            , hsRecFieldAnn = EpAnnNotUsed
#endif
            }
    withPlaceHolder4 :: c -> c
withPlaceHolder4 = c -> c
forall a. a -> a
withPlaceHolder (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> c
forall a. a -> a
withPlaceHolder (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> c
forall a. a -> a
withPlaceHolder
                            (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> c
forall a. a -> a
withPlaceHolder
#if MIN_VERSION_ghc(9,2,0)
    toRecordUpdFields = Left
#else
    toRecordUpdFields :: a -> a
toRecordUpdFields = a -> a
forall a. a -> a
id
#endif

arithSeq :: ArithSeqInfo GhcPs -> HsExpr'
arithSeq :: ArithSeqInfo GhcPs -> HsExpr'
arithSeq =
#if MIN_VERSION_ghc(8,6,0)
    (NoExtField
 -> Maybe (SyntaxExpr GhcPs) -> ArithSeqInfo GhcPs -> HsExpr')
-> Maybe (SyntaxExpr GhcPs) -> ArithSeqInfo GhcPs -> HsExpr'
forall a. (NoExtField -> a) -> a
withEpAnnNotUsed NoExtField
-> Maybe (SyntaxExpr GhcPs) -> ArithSeqInfo GhcPs -> HsExpr'
forall p.
XArithSeq p -> Maybe (SyntaxExpr p) -> ArithSeqInfo p -> HsExpr p
ArithSeq Maybe (SyntaxExpr GhcPs)
forall a. Maybe a
Nothing
#else
    ArithSeq noPostTcExpr Nothing
#endif

-- | An arithmetic sequence expression with a start value.
--
-- > [a ..]
-- > =====
-- > from (var "a")
from :: HsExpr' -> HsExpr'
from :: HsExpr' -> HsExpr'
from HsExpr'
from' = ArithSeqInfo GhcPs -> HsExpr'
arithSeq (ArithSeqInfo GhcPs -> HsExpr') -> ArithSeqInfo GhcPs -> HsExpr'
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> ArithSeqInfo GhcPs
forall id. LHsExpr id -> ArithSeqInfo id
From (HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
from')

-- | An arithmetic sequence expression with a start and a step values.
--
-- > [a, b ..]
-- > =====
-- > fromThen (var "a") (var "b")
fromThen :: HsExpr' -> HsExpr' -> HsExpr'
fromThen :: HsExpr' -> HsExpr' -> HsExpr'
fromThen HsExpr'
from' HsExpr'
then' = ArithSeqInfo GhcPs -> HsExpr'
arithSeq (ArithSeqInfo GhcPs -> HsExpr') -> ArithSeqInfo GhcPs -> HsExpr'
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs -> ArithSeqInfo GhcPs
forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThen (HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
from') (HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
then')

-- | An arithmetic sequence expression with a start and an end values.
--
-- > [a .. b]
-- > =====
-- > fromTo (var "a") (var "b")
fromTo :: HsExpr' -> HsExpr' -> HsExpr'
fromTo :: HsExpr' -> HsExpr' -> HsExpr'
fromTo HsExpr'
from' HsExpr'
to = ArithSeqInfo GhcPs -> HsExpr'
arithSeq (ArithSeqInfo GhcPs -> HsExpr') -> ArithSeqInfo GhcPs -> HsExpr'
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs -> ArithSeqInfo GhcPs
forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromTo (HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
from') (HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
to)

-- | An arithmetic sequence expression with a start, a step, and an end values.
--
-- > [a, b .. c]
-- > =====
-- > fromThenTo (var "a") (var "b") (var "c")
fromThenTo :: HsExpr' -> HsExpr' -> HsExpr' -> HsExpr'
fromThenTo :: HsExpr' -> HsExpr' -> HsExpr' -> HsExpr'
fromThenTo HsExpr'
from' HsExpr'
then' HsExpr'
to =
    ArithSeqInfo GhcPs -> HsExpr'
arithSeq (ArithSeqInfo GhcPs -> HsExpr') -> ArithSeqInfo GhcPs -> HsExpr'
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> ArithSeqInfo GhcPs
forall id.
LHsExpr id -> LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThenTo (HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
from') (HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
then') (HsExpr' -> LHsExpr GhcPs
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
to)