-- 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.Types (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
    )

-- | An overloaded label, as used with the @OverloadedLabels@ extension.
--
-- > #foo
-- > =====
-- > overLabel "foo"
overLabel :: String -> HsExpr'
overLabel :: String -> HsExpr'
overLabel = (NoExtField -> Maybe RdrName -> FastString -> HsExpr')
-> Maybe RdrName -> FastString -> HsExpr'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> Maybe RdrName -> FastString -> HsExpr'
forall p. XOverLabel p -> Maybe (IdP p) -> FastString -> HsExpr p
HsOverLabel Maybe RdrName
forall a. Maybe a
Nothing (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

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
noExt 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
builtLoc (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 e. e -> Located e
builtLoc HsExpr'
e

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
noExt 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 e. e -> Located e
builtLoc 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
noExt 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 = (NoExtField
 -> Maybe (SyntaxExpr GhcPs)
 -> LHsExpr GhcPs
 -> LHsExpr GhcPs
 -> LHsExpr GhcPs
 -> HsExpr')
-> Maybe (SyntaxExpr GhcPs)
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> HsExpr'
forall a. (NoExtField -> a) -> a
noExt NoExtField
-> Maybe (SyntaxExpr GhcPs)
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> HsExpr'
forall p.
XIf p
-> Maybe (SyntaxExpr p)
-> LHsExpr p
-> LHsExpr p
-> LHsExpr p
-> HsExpr p
HsIf Maybe (SyntaxExpr GhcPs)
forall a. Maybe a
Nothing (HsExpr' -> LHsExpr GhcPs
forall e. e -> Located e
builtLoc HsExpr'
x) (HsExpr' -> LHsExpr GhcPs
forall e. e -> Located e
builtLoc HsExpr'
y) (HsExpr' -> LHsExpr GhcPs
forall e. e -> Located e
builtLoc HsExpr'
z)

-- | 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 = (NoExtField -> [LGRHS GhcPs (LHsExpr GhcPs)] -> HsExpr')
-> [LGRHS GhcPs (LHsExpr GhcPs)] -> HsExpr'
forall a. (NoExtField -> a) -> a
noExtOrPlaceHolder 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 (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
        (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 e. e -> Located e
builtLoc ([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 e. e -> Located e
builtLoc (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 SrcSpan
_ 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 e. e -> Located e
builtLoc HsExpr'
lastExpr) Bool
False SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr
     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
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
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 e. e -> Located e
builtLoc ([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 e. e -> Located e
builtLoc ([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
noExt NoExtField -> LHsExpr GhcPs -> LHsSigWcType' -> HsExpr'
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig (HsExpr' -> LHsExpr GhcPs
forall e. e -> Located e
builtLoc 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(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
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
$ Located HsType' -> SrcSpanLess (Located HsType')
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located HsType' -> SrcSpanLess (Located HsType'))
-> Located HsType' -> SrcSpanLess (Located HsType')
forall a b. (a -> b) -> a -> b
$ Located HsType' -> Located HsType'
parenthesizeTypeForApp (Located HsType' -> Located HsType')
-> Located HsType' -> Located HsType'
forall a b. (a -> b) -> a -> b
$ HsType' -> Located HsType'
forall e. e -> Located e
builtLoc HsType'
t
    e' :: LHsExpr GhcPs
e' = HsExpr' -> LHsExpr GhcPs
forall e. e -> Located e
builtLoc 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
 -> Located RdrName -> HsRecFields GhcPs (LHsExpr GhcPs) -> HsExpr')
-> Located RdrName -> HsRecFields GhcPs (LHsExpr GhcPs) -> HsExpr'
forall a. (NoExtField -> a) -> a
noExt NoExtField
-> Located RdrName -> HsRecFields GhcPs (LHsExpr GhcPs) -> HsExpr'
forall p.
XRecordCon p -> Located (IdP p) -> HsRecordBinds p -> HsExpr p
RecordCon (RdrNameStr -> Located 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' (Located HsExpr')
    recField :: (RdrNameStr, HsExpr') -> LHsRecField GhcPs (LHsExpr GhcPs)
recField (RdrNameStr
f, HsExpr'
e) =
        HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)
-> LHsRecField GhcPs (LHsExpr GhcPs)
forall e. e -> Located e
builtLoc 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 -> Located RdrName -> FieldOcc GhcPs)
-> Located RdrName -> FieldOcc GhcPs
forall a. (NoExtField -> a) -> a
noExt NoExtField -> Located RdrName -> FieldOcc GhcPs
forall pass. XCFieldOcc pass -> Located RdrName -> FieldOcc pass
FieldOcc (Located RdrName -> FieldOcc GhcPs)
-> Located RdrName -> FieldOcc GhcPs
forall a b. (a -> b) -> a -> b
$ RdrNameStr -> Located RdrName
valueRdrName RdrNameStr
f
            , hsRecFieldArg :: LHsExpr GhcPs
hsRecFieldArg = HsExpr' -> LHsExpr GhcPs
forall e. e -> Located e
builtLoc HsExpr'
e
            , hsRecPun :: Bool
hsRecPun = Bool
False
            }

-- | 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
noExt 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 e. e -> Located e
builtLoc HsExpr'
e)
       ([LHsRecUpdField GhcPs] -> HsExpr')
-> [LHsRecUpdField GhcPs] -> HsExpr'
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 e. e -> Located e
builtLoc 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 -> Located RdrName -> AmbiguousFieldOcc GhcPs)
-> Located RdrName -> AmbiguousFieldOcc GhcPs
forall a. (NoExtField -> a) -> a
noExt NoExtField -> Located RdrName -> AmbiguousFieldOcc GhcPs
forall pass.
XAmbiguous pass -> Located RdrName -> AmbiguousFieldOcc pass
Ambiguous (Located RdrName -> AmbiguousFieldOcc GhcPs)
-> Located RdrName -> AmbiguousFieldOcc GhcPs
forall a b. (a -> b) -> a -> b
$ RdrNameStr -> Located RdrName
valueRdrName RdrNameStr
f
            , hsRecFieldArg :: LHsExpr GhcPs
hsRecFieldArg = HsExpr' -> LHsExpr GhcPs
forall e. e -> Located e
builtLoc HsExpr'
e'
            , hsRecPun :: Bool
hsRecPun = Bool
False
            }
    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

arithSeq :: ArithSeqInfo GhcPs -> HsExpr'
arithSeq :: ArithSeqInfo GhcPs -> HsExpr'
arithSeq =
#if !MIN_VERSION_ghc(8,6,0)
    ArithSeq noPostTcExpr Nothing
#else
    (NoExtField
 -> Maybe (SyntaxExpr GhcPs) -> ArithSeqInfo GhcPs -> HsExpr')
-> Maybe (SyntaxExpr GhcPs) -> ArithSeqInfo GhcPs -> HsExpr'
forall a. (NoExtField -> a) -> a
noExt 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
#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 e. e -> Located e
builtLoc 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 e. e -> Located e
builtLoc HsExpr'
from') (HsExpr' -> LHsExpr GhcPs
forall e. e -> Located e
builtLoc 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 e. e -> Located e
builtLoc HsExpr'
from') (HsExpr' -> LHsExpr GhcPs
forall e. e -> Located e
builtLoc 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 e. e -> Located e
builtLoc HsExpr'
from') (HsExpr' -> LHsExpr GhcPs
forall e. e -> Located e
builtLoc HsExpr'
then') (HsExpr' -> LHsExpr GhcPs
forall e. e -> Located e
builtLoc HsExpr'
to)