{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Database.Esqueleto.Record
( deriveEsqueletoRecord
, deriveEsqueletoRecordWith
, DeriveEsqueletoRecordSettings(..)
, defaultDeriveEsqueletoRecordSettings
) where
import Control.Monad.Trans.State.Strict (StateT(..), evalStateT)
import Data.Proxy (Proxy(..))
import Database.Esqueleto.Experimental
(Entity, PersistValue, SqlExpr, Value(..), (:&)(..))
import Database.Esqueleto.Experimental.ToAlias (ToAlias(..))
import Database.Esqueleto.Experimental.ToAliasReference (ToAliasReference(..))
import Database.Esqueleto.Internal.Internal (SqlSelect(..))
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Data.Bifunctor (first)
import Data.Text (Text)
import Control.Monad (forM)
import Data.Foldable (foldl')
import GHC.Exts (IsString(fromString))
import Data.Maybe (mapMaybe, fromMaybe, listToMaybe)
deriveEsqueletoRecord :: Name -> Q [Dec]
deriveEsqueletoRecord :: Name -> Q [Dec]
deriveEsqueletoRecord = DeriveEsqueletoRecordSettings -> Name -> Q [Dec]
deriveEsqueletoRecordWith DeriveEsqueletoRecordSettings
defaultDeriveEsqueletoRecordSettings
data DeriveEsqueletoRecordSettings = DeriveEsqueletoRecordSettings
{ DeriveEsqueletoRecordSettings -> String -> String
sqlNameModifier :: String -> String
, DeriveEsqueletoRecordSettings -> String -> String
sqlFieldModifier :: String -> String
}
defaultDeriveEsqueletoRecordSettings :: DeriveEsqueletoRecordSettings
defaultDeriveEsqueletoRecordSettings :: DeriveEsqueletoRecordSettings
defaultDeriveEsqueletoRecordSettings = DeriveEsqueletoRecordSettings :: (String -> String)
-> (String -> String) -> DeriveEsqueletoRecordSettings
DeriveEsqueletoRecordSettings
{ sqlNameModifier :: String -> String
sqlNameModifier = (String
"Sql" String -> String -> String
forall a. [a] -> [a] -> [a]
++)
, sqlFieldModifier :: String -> String
sqlFieldModifier = String -> String
forall a. a -> a
id
}
deriveEsqueletoRecordWith :: DeriveEsqueletoRecordSettings -> Name -> Q [Dec]
deriveEsqueletoRecordWith :: DeriveEsqueletoRecordSettings -> Name -> Q [Dec]
deriveEsqueletoRecordWith DeriveEsqueletoRecordSettings
settings Name
originalName = do
RecordInfo
info <- DeriveEsqueletoRecordSettings -> Name -> Q RecordInfo
getRecordInfo DeriveEsqueletoRecordSettings
settings Name
originalName
Dec
recordDec <- RecordInfo -> Q Dec
makeSqlRecord RecordInfo
info
Dec
sqlSelectInstanceDec <- RecordInfo -> Q Dec
makeSqlSelectInstance RecordInfo
info
Dec
toAliasInstanceDec <- RecordInfo -> Q Dec
makeToAliasInstance RecordInfo
info
Dec
toAliasReferenceInstanceDec <- RecordInfo -> Q Dec
makeToAliasReferenceInstance RecordInfo
info
[Dec] -> Q [Dec]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
[ Dec
recordDec
, Dec
sqlSelectInstanceDec
, Dec
toAliasInstanceDec
, Dec
toAliasReferenceInstanceDec
]
data RecordInfo = RecordInfo
{
RecordInfo -> Name
name :: Name
,
RecordInfo -> Name
sqlName :: Name
,
RecordInfo -> Cxt
constraints :: Cxt
,
#if MIN_VERSION_template_haskell(2,17,0)
RecordInfo -> [TyVarBndr ()]
typeVarBinders :: [TyVarBndr ()]
#else
typeVarBinders :: [TyVarBndr]
#endif
,
RecordInfo -> Maybe Type
kind :: Maybe Kind
,
RecordInfo -> Name
constructorName :: Name
,
RecordInfo -> Name
sqlConstructorName :: Name
,
RecordInfo -> [(Name, Type)]
fields :: [(Name, Type)]
,
RecordInfo -> [(Name, Type)]
sqlFields :: [(Name, Type)]
}
getRecordInfo :: DeriveEsqueletoRecordSettings -> Name -> Q RecordInfo
getRecordInfo :: DeriveEsqueletoRecordSettings -> Name -> Q RecordInfo
getRecordInfo DeriveEsqueletoRecordSettings
settings Name
name = do
TyConI Dec
dec <- Name -> Q Info
reify Name
name
(Cxt
constraints, [TyVarBndr ()]
typeVarBinders, Maybe Type
kind, [Con]
constructors) <-
case Dec
dec of
DataD Cxt
constraints' Name
_name [TyVarBndr ()]
typeVarBinders' Maybe Type
kind' [Con]
constructors' [DerivClause]
_derivingClauses ->
(Cxt, [TyVarBndr ()], Maybe Type, [Con])
-> Q (Cxt, [TyVarBndr ()], Maybe Type, [Con])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cxt
constraints', [TyVarBndr ()]
typeVarBinders', Maybe Type
kind', [Con]
constructors')
NewtypeD Cxt
constraints' Name
_name [TyVarBndr ()]
typeVarBinders' Maybe Type
kind' Con
constructor' [DerivClause]
_derivingClauses ->
(Cxt, [TyVarBndr ()], Maybe Type, [Con])
-> Q (Cxt, [TyVarBndr ()], Maybe Type, [Con])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cxt
constraints', [TyVarBndr ()]
typeVarBinders', Maybe Type
kind', [Con
constructor'])
Dec
_ -> String -> Q (Cxt, [TyVarBndr ()], Maybe Type, [Con])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q (Cxt, [TyVarBndr ()], Maybe Type, [Con]))
-> String -> Q (Cxt, [TyVarBndr ()], Maybe Type, [Con])
forall a b. (a -> b) -> a -> b
$ String
"Esqueleto records can only be derived for records and newtypes, but " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is neither"
Con
constructor <- case [Con]
constructors of
(Con
c : [Con]
_) -> Con -> Q Con
forall (f :: * -> *) a. Applicative f => a -> f a
pure Con
c
[] -> String -> Q Con
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Con) -> String -> Q Con
forall a b. (a -> b) -> a -> b
$ String
"Cannot derive Esqueleto record for a type with no constructors: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
name
let constructorName :: Name
constructorName =
case [Con] -> Con
forall a. [a] -> a
head [Con]
constructors of
RecC Name
name' [VarBangType]
_fields -> Name
name'
Con
con -> String -> Name
forall a. HasCallStack => String -> a
error (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Con -> String
nonRecordConstructorMessage Con
con
fields :: [(Name, Type)]
fields = Con -> [(Name, Type)]
getFields Con
constructor
sqlName :: Name
sqlName = DeriveEsqueletoRecordSettings -> Name -> Name
makeSqlName DeriveEsqueletoRecordSettings
settings Name
name
sqlConstructorName :: Name
sqlConstructorName = DeriveEsqueletoRecordSettings -> Name -> Name
makeSqlName DeriveEsqueletoRecordSettings
settings Name
constructorName
[(Name, Type)]
sqlFields <- ((Name, Type) -> Q (Name, Type))
-> [(Name, Type)] -> Q [(Name, Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name, Type) -> Q (Name, Type)
toSqlField [(Name, Type)]
fields
RecordInfo -> Q RecordInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure RecordInfo :: Name
-> Name
-> Cxt
-> [TyVarBndr ()]
-> Maybe Type
-> Name
-> Name
-> [(Name, Type)]
-> [(Name, Type)]
-> RecordInfo
RecordInfo {Cxt
[(Name, Type)]
[TyVarBndr ()]
Maybe Type
Name
sqlFields :: [(Name, Type)]
sqlConstructorName :: Name
sqlName :: Name
fields :: [(Name, Type)]
constructorName :: Name
kind :: Maybe Type
typeVarBinders :: [TyVarBndr ()]
constraints :: Cxt
name :: Name
sqlFields :: [(Name, Type)]
fields :: [(Name, Type)]
sqlConstructorName :: Name
constructorName :: Name
kind :: Maybe Type
typeVarBinders :: [TyVarBndr ()]
constraints :: Cxt
sqlName :: Name
name :: Name
..}
where
getFields :: Con -> [(Name, Type)]
getFields :: Con -> [(Name, Type)]
getFields (RecC Name
_name [VarBangType]
fields) = [(Name
fieldName', Type
fieldType') | (Name
fieldName', Bang
_bang, Type
fieldType') <- [VarBangType]
fields]
getFields Con
con = String -> [(Name, Type)]
forall a. HasCallStack => String -> a
error (String -> [(Name, Type)]) -> String -> [(Name, Type)]
forall a b. (a -> b) -> a -> b
$ Con -> String
nonRecordConstructorMessage Con
con
toSqlField :: (Name, Type) -> Q (Name, Type)
toSqlField (Name
fieldName', Type
ty) = do
let modifier :: Name -> Name
modifier = String -> Name
mkName (String -> Name) -> (Name -> String) -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeriveEsqueletoRecordSettings -> String -> String
sqlFieldModifier DeriveEsqueletoRecordSettings
settings (String -> String) -> (Name -> String) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase
Type
sqlTy <- Type -> Q Type
sqlFieldType Type
ty
(Name, Type) -> Q (Name, Type)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Name
modifier Name
fieldName', Type
sqlTy)
makeSqlName :: DeriveEsqueletoRecordSettings -> Name -> Name
makeSqlName :: DeriveEsqueletoRecordSettings -> Name -> Name
makeSqlName DeriveEsqueletoRecordSettings
settings Name
name = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ DeriveEsqueletoRecordSettings -> String -> String
sqlNameModifier DeriveEsqueletoRecordSettings
settings (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Name -> String
nameBase Name
name
sqlFieldType :: Type -> Q Type
sqlFieldType :: Type -> Q Type
sqlFieldType Type
fieldType = do
Maybe Type
maybeSqlType <- Type -> Q (Maybe Type)
reifySqlSelectType Type
fieldType
Type -> Q Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$
(Type -> Maybe Type -> Type) -> Maybe Type -> Type -> Type
forall a b c. (a -> b -> c) -> b -> a -> c
flip Type -> Maybe Type -> Type
forall a. a -> Maybe a -> a
fromMaybe Maybe Type
maybeSqlType (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
case Type
fieldType of
AppT (ConT (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
(==) ''Entity -> Bool
True)) Type
_innerType -> Type -> Type -> Type
AppT (Name -> Type
ConT ''SqlExpr) Type
fieldType
(ConT (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
(==) ''Maybe -> Bool
True))
`AppT` ((ConT (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
(==) ''Entity -> Bool
True))
`AppT` Type
_innerType) -> Type -> Type -> Type
AppT (Name -> Type
ConT ''SqlExpr) Type
fieldType
Type
_ -> (Name -> Type
ConT ''SqlExpr)
Type -> Type -> Type
`AppT` ((Name -> Type
ConT ''Value)
Type -> Type -> Type
`AppT` Type
fieldType)
makeSqlRecord :: RecordInfo -> Q Dec
makeSqlRecord :: RecordInfo -> Q Dec
makeSqlRecord RecordInfo {Cxt
[(Name, Type)]
[TyVarBndr ()]
Maybe Type
Name
sqlFields :: [(Name, Type)]
fields :: [(Name, Type)]
sqlConstructorName :: Name
constructorName :: Name
kind :: Maybe Type
typeVarBinders :: [TyVarBndr ()]
constraints :: Cxt
sqlName :: Name
name :: Name
sqlFields :: RecordInfo -> [(Name, Type)]
fields :: RecordInfo -> [(Name, Type)]
sqlConstructorName :: RecordInfo -> Name
constructorName :: RecordInfo -> Name
kind :: RecordInfo -> Maybe Type
typeVarBinders :: RecordInfo -> [TyVarBndr ()]
constraints :: RecordInfo -> Cxt
sqlName :: RecordInfo -> Name
name :: RecordInfo -> Name
..} = do
let newConstructor :: Con
newConstructor = Name -> [VarBangType] -> Con
RecC Name
sqlConstructorName ((Name, Type) -> VarBangType
forall {a} {c}. (a, c) -> (a, Bang, c)
makeField ((Name, Type) -> VarBangType) -> [(Name, Type)] -> [VarBangType]
forall a b. (a -> b) -> [a] -> [b]
`map` [(Name, Type)]
sqlFields)
derivingClauses :: [a]
derivingClauses = []
Dec -> Q Dec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$ Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataD Cxt
constraints Name
sqlName [TyVarBndr ()]
typeVarBinders Maybe Type
kind [Con
newConstructor] [DerivClause]
forall a. [a]
derivingClauses
where
makeField :: (a, c) -> (a, Bang, c)
makeField (a
fieldName', c
fieldType) =
(a
fieldName', SourceUnpackedness -> SourceStrictness -> Bang
Bang SourceUnpackedness
NoSourceUnpackedness SourceStrictness
NoSourceStrictness, c
fieldType)
makeSqlSelectInstance :: RecordInfo -> Q Dec
makeSqlSelectInstance :: RecordInfo -> Q Dec
makeSqlSelectInstance info :: RecordInfo
info@RecordInfo {Cxt
[(Name, Type)]
[TyVarBndr ()]
Maybe Type
Name
sqlFields :: [(Name, Type)]
fields :: [(Name, Type)]
sqlConstructorName :: Name
constructorName :: Name
kind :: Maybe Type
typeVarBinders :: [TyVarBndr ()]
constraints :: Cxt
sqlName :: Name
name :: Name
sqlFields :: RecordInfo -> [(Name, Type)]
fields :: RecordInfo -> [(Name, Type)]
sqlConstructorName :: RecordInfo -> Name
constructorName :: RecordInfo -> Name
kind :: RecordInfo -> Maybe Type
typeVarBinders :: RecordInfo -> [TyVarBndr ()]
constraints :: RecordInfo -> Cxt
sqlName :: RecordInfo -> Name
name :: RecordInfo -> Name
..} = do
Dec
sqlSelectColsDec' <- RecordInfo -> Q Dec
sqlSelectColsDec RecordInfo
info
Dec
sqlSelectColCountDec' <- RecordInfo -> Q Dec
sqlSelectColCountDec RecordInfo
info
Dec
sqlSelectProcessRowDec' <- RecordInfo -> Q Dec
sqlSelectProcessRowDec RecordInfo
info
let overlap :: Maybe a
overlap = Maybe a
forall a. Maybe a
Nothing
instanceConstraints :: [a]
instanceConstraints = []
instanceType :: Type
instanceType =
(Name -> Type
ConT ''SqlSelect)
Type -> Type -> Type
`AppT` (Name -> Type
ConT Name
sqlName)
Type -> Type -> Type
`AppT` (Name -> Type
ConT Name
name)
Dec -> Q Dec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$ Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
InstanceD Maybe Overlap
forall a. Maybe a
overlap Cxt
forall a. [a]
instanceConstraints Type
instanceType [Dec
sqlSelectColsDec', Dec
sqlSelectColCountDec', Dec
sqlSelectProcessRowDec']
sqlSelectColsDec :: RecordInfo -> Q Dec
sqlSelectColsDec :: RecordInfo -> Q Dec
sqlSelectColsDec RecordInfo {Cxt
[(Name, Type)]
[TyVarBndr ()]
Maybe Type
Name
sqlFields :: [(Name, Type)]
fields :: [(Name, Type)]
sqlConstructorName :: Name
constructorName :: Name
kind :: Maybe Type
typeVarBinders :: [TyVarBndr ()]
constraints :: Cxt
sqlName :: Name
name :: Name
sqlFields :: RecordInfo -> [(Name, Type)]
fields :: RecordInfo -> [(Name, Type)]
sqlConstructorName :: RecordInfo -> Name
constructorName :: RecordInfo -> Name
kind :: RecordInfo -> Maybe Type
typeVarBinders :: RecordInfo -> [TyVarBndr ()]
constraints :: RecordInfo -> Cxt
sqlName :: RecordInfo -> Name
name :: RecordInfo -> Name
..} = do
[(Name, Name)]
fieldNames <- [(Name, Type)]
-> ((Name, Type) -> Q (Name, Name)) -> Q [(Name, Name)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Name, Type)]
sqlFields (\(Name
name', Type
_type) -> do
Name
var <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName (String -> Q Name) -> String -> Q Name
forall a b. (a -> b) -> a -> b
$ Name -> String
nameBase Name
name'
(Name, Name) -> Q (Name, Name)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
name', Name
var))
let fieldPatterns :: [FieldPat]
fieldPatterns :: [FieldPat]
fieldPatterns = [(Name
name', Name -> Pat
VarP Name
var) | (Name
name', Name
var) <- [(Name, Name)]
fieldNames]
joinedFields :: Exp
joinedFields :: Exp
joinedFields =
case (Name, Name) -> Name
forall a b. (a, b) -> b
snd ((Name, Name) -> Name) -> [(Name, Name)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
`map` [(Name, Name)]
fieldNames of
[] -> [Maybe Exp] -> Exp
TupE []
[Name
f1] -> Name -> Exp
VarE Name
f1
Name
f1 : [Name]
rest ->
let helper :: Exp -> Name -> Exp
helper Exp
lhs Name
field =
Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE
(Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
lhs)
(Name -> Exp
ConE '(:&))
(Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE Name
field)
in (Exp -> Name -> Exp) -> Exp -> [Name] -> Exp
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Exp -> Name -> Exp
helper (Name -> Exp
VarE Name
f1) [Name]
rest
Name
identInfo <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"identInfo"
Dec -> Q Dec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$
Name -> [Clause] -> Dec
FunD
'sqlSelectCols
[ [Pat] -> Body -> [Dec] -> Clause
Clause
[ Name -> Pat
VarP Name
identInfo
, Name -> [FieldPat] -> Pat
RecP Name
sqlName [FieldPat]
fieldPatterns
]
( Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$
(Name -> Exp
VarE 'sqlSelectCols)
Exp -> Exp -> Exp
`AppE` (Name -> Exp
VarE Name
identInfo)
Exp -> Exp -> Exp
`AppE` (Exp -> Exp
ParensE Exp
joinedFields)
)
[]
]
sqlSelectColCountDec :: RecordInfo -> Q Dec
sqlSelectColCountDec :: RecordInfo -> Q Dec
sqlSelectColCountDec RecordInfo {Cxt
[(Name, Type)]
[TyVarBndr ()]
Maybe Type
Name
sqlFields :: [(Name, Type)]
fields :: [(Name, Type)]
sqlConstructorName :: Name
constructorName :: Name
kind :: Maybe Type
typeVarBinders :: [TyVarBndr ()]
constraints :: Cxt
sqlName :: Name
name :: Name
sqlFields :: RecordInfo -> [(Name, Type)]
fields :: RecordInfo -> [(Name, Type)]
sqlConstructorName :: RecordInfo -> Name
constructorName :: RecordInfo -> Name
kind :: RecordInfo -> Maybe Type
typeVarBinders :: RecordInfo -> [TyVarBndr ()]
constraints :: RecordInfo -> Cxt
sqlName :: RecordInfo -> Name
name :: RecordInfo -> Name
..} = do
let joinedTypes :: Type
joinedTypes =
case (Name, Type) -> Type
forall a b. (a, b) -> b
snd ((Name, Type) -> Type) -> [(Name, Type)] -> Cxt
forall a b. (a -> b) -> [a] -> [b]
`map` [(Name, Type)]
sqlFields of
[] -> Int -> Type
TupleT Int
0
Type
t1 : Cxt
rest ->
let helper :: Type -> Type -> Type
helper Type
lhs Type
ty =
Type -> Name -> Type -> Type
InfixT Type
lhs ''(:&) Type
ty
in (Type -> Type -> Type) -> Type -> Cxt -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type -> Type -> Type
helper Type
t1 Cxt
rest
Dec -> Q Dec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$
Name -> [Clause] -> Dec
FunD
'sqlSelectColCount
[ [Pat] -> Body -> [Dec] -> Clause
Clause
[Pat
WildP]
( Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$
Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'sqlSelectColCount) (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$
Exp -> Exp
ParensE (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$
Exp -> Type -> Exp
AppTypeE
(Name -> Exp
ConE 'Proxy)
Type
joinedTypes
)
[]
]
sqlSelectProcessRowDec :: RecordInfo -> Q Dec
sqlSelectProcessRowDec :: RecordInfo -> Q Dec
sqlSelectProcessRowDec RecordInfo {Cxt
[(Name, Type)]
[TyVarBndr ()]
Maybe Type
Name
sqlFields :: [(Name, Type)]
fields :: [(Name, Type)]
sqlConstructorName :: Name
constructorName :: Name
kind :: Maybe Type
typeVarBinders :: [TyVarBndr ()]
constraints :: Cxt
sqlName :: Name
name :: Name
sqlFields :: RecordInfo -> [(Name, Type)]
fields :: RecordInfo -> [(Name, Type)]
sqlConstructorName :: RecordInfo -> Name
constructorName :: RecordInfo -> Name
kind :: RecordInfo -> Maybe Type
typeVarBinders :: RecordInfo -> [TyVarBndr ()]
constraints :: RecordInfo -> Cxt
sqlName :: RecordInfo -> Name
name :: RecordInfo -> Name
..} = do
([Stmt]
statements, [(Name, Exp)]
fieldExps) <-
[(Stmt, (Name, Exp))] -> ([Stmt], [(Name, Exp)])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Stmt, (Name, Exp))] -> ([Stmt], [(Name, Exp)]))
-> Q [(Stmt, (Name, Exp))] -> Q ([Stmt], [(Name, Exp)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [((Name, Type), (Name, Type))]
-> (((Name, Type), (Name, Type)) -> Q (Stmt, (Name, Exp)))
-> Q [(Stmt, (Name, Exp))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([(Name, Type)] -> [(Name, Type)] -> [((Name, Type), (Name, Type))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Name, Type)]
fields [(Name, Type)]
sqlFields) (\((Name
fieldName', Type
fieldType), (Name
_, Type
sqlType')) -> do
Name
valueName <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName (Name -> String
nameBase Name
fieldName')
Pat
pattern <- Type -> Name -> Q Pat
sqlSelectProcessRowPat Type
fieldType Name
valueName
(Stmt, (Name, Exp)) -> Q (Stmt, (Name, Exp))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Pat -> Exp -> Stmt
BindS
Pat
pattern
(Exp -> Type -> Exp
AppTypeE (Name -> Exp
VarE 'takeColumns) Type
sqlType')
, (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Name -> String
nameBase Name
fieldName', Name -> Exp
VarE Name
valueName)
))
Name
colsName <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"columns"
Name
processName <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"process"
Exp
bodyExp <- [e|
first (fromString ("Failed to parse " ++ $(lift $ nameBase name) ++ ": ") <>)
(evalStateT $(varE processName) $(varE colsName))
|]
Dec -> Q Dec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$
Name -> [Clause] -> Dec
FunD
'sqlSelectProcessRow
[ [Pat] -> Body -> [Dec] -> Clause
Clause
[Name -> Pat
VarP Name
colsName]
(Exp -> Body
NormalB Exp
bodyExp)
[ Pat -> Body -> [Dec] -> Dec
ValD
(Name -> Pat
VarP Name
processName)
( Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$
Maybe ModName -> [Stmt] -> Exp
DoE
#if MIN_VERSION_template_haskell(2,17,0)
Maybe ModName
forall a. Maybe a
Nothing
#endif
([Stmt]
statements [Stmt] -> [Stmt] -> [Stmt]
forall a. [a] -> [a] -> [a]
++ [Exp -> Stmt
NoBindS (Exp -> Stmt) -> Exp -> Stmt
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'pure) (Name -> [(Name, Exp)] -> Exp
RecConE Name
constructorName [(Name, Exp)]
fieldExps)])
)
[]
]
]
sqlSelectProcessRowPat :: Type -> Name -> Q Pat
sqlSelectProcessRowPat :: Type -> Name -> Q Pat
sqlSelectProcessRowPat Type
fieldType Name
var = do
Maybe Type
maybeSqlType <- Type -> Q (Maybe Type)
reifySqlSelectType Type
fieldType
case Maybe Type
maybeSqlType of
Just Type
_ -> Pat -> Q Pat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pat -> Q Pat) -> Pat -> Q Pat
forall a b. (a -> b) -> a -> b
$ Name -> Pat
VarP Name
var
Maybe Type
Nothing -> case Type
fieldType of
AppT (ConT (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
(==) ''Entity -> Bool
True)) Type
_innerType -> Pat -> Q Pat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pat -> Q Pat) -> Pat -> Q Pat
forall a b. (a -> b) -> a -> b
$ Name -> Pat
VarP Name
var
(ConT (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
(==) ''Maybe -> Bool
True))
`AppT` ((ConT (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
(==) ''Entity -> Bool
True))
`AppT` Type
_innerType) -> Pat -> Q Pat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pat -> Q Pat) -> Pat -> Q Pat
forall a b. (a -> b) -> a -> b
$ Name -> Pat
VarP Name
var
#if MIN_VERSION_template_haskell(2,18,0)
_ -> pure $ ConP 'Value [] [VarP var]
#else
Type
_ -> Pat -> Q Pat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pat -> Q Pat) -> Pat -> Q Pat
forall a b. (a -> b) -> a -> b
$ Name -> [Pat] -> Pat
ConP 'Value [Name -> Pat
VarP Name
var]
#endif
reifySqlSelectType :: Type -> Q (Maybe Type)
reifySqlSelectType :: Type -> Q (Maybe Type)
reifySqlSelectType Type
originalType = do
Name
tyVarName <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"a"
[Dec]
instances <- Name -> Cxt -> Q [Dec]
reifyInstances ''SqlSelect [Name -> Type
VarT Name
tyVarName, Type
originalType]
let extractSqlRecord :: Type -> Type -> Maybe Type
extractSqlRecord :: Type -> Type -> Maybe Type
extractSqlRecord Type
originalTy Type
instanceTy =
case Type
instanceTy of
(ConT (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
(==) ''SqlSelect -> Bool
True))
`AppT` Type
sqlTy
`AppT` (Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
(==) Type
originalTy -> Bool
True) -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
sqlTy
Type
_ -> Maybe Type
forall a. Maybe a
Nothing
filteredInstances :: [Type]
filteredInstances :: Cxt
filteredInstances =
((Dec -> Maybe Type) -> [Dec] -> Cxt)
-> [Dec] -> (Dec -> Maybe Type) -> Cxt
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Dec -> Maybe Type) -> [Dec] -> Cxt
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Dec]
instances
(\case InstanceD Maybe Overlap
_overlap
Cxt
_constraints
(Type -> Type -> Maybe Type
extractSqlRecord Type
originalType -> Just Type
sqlRecord)
[Dec]
_decs ->
Type -> Maybe Type
forall a. a -> Maybe a
Just Type
sqlRecord
Dec
_ -> Maybe Type
forall a. Maybe a
Nothing)
Maybe Type -> Q (Maybe Type)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Type -> Q (Maybe Type)) -> Maybe Type -> Q (Maybe Type)
forall a b. (a -> b) -> a -> b
$ Cxt -> Maybe Type
forall a. [a] -> Maybe a
listToMaybe Cxt
filteredInstances
takeColumns ::
forall a b.
SqlSelect a b =>
StateT [PersistValue] (Either Text) b
takeColumns :: forall a b. SqlSelect a b => StateT [PersistValue] (Either Text) b
takeColumns = ([PersistValue] -> Either Text (b, [PersistValue]))
-> StateT [PersistValue] (Either Text) b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (\[PersistValue]
pvs ->
let targetColCount :: Int
targetColCount =
Proxy a -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
([PersistValue]
target, [PersistValue]
other) =
Int -> [PersistValue] -> ([PersistValue], [PersistValue])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
targetColCount [PersistValue]
pvs
in if [PersistValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PersistValue]
target Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
targetColCount
then do
b
value <- [PersistValue] -> Either Text b
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow [PersistValue]
target
(b, [PersistValue]) -> Either Text (b, [PersistValue])
forall a b. b -> Either a b
Right (b
value, [PersistValue]
other)
else Text -> Either Text (b, [PersistValue])
forall a b. a -> Either a b
Left Text
"Insufficient columns when trying to parse a column")
nonRecordConstructorMessage :: Con -> String
nonRecordConstructorMessage :: Con -> String
nonRecordConstructorMessage Con
con =
case Con
con of
(RecC {}) -> String -> String
forall a. HasCallStack => String -> a
error String
"Record constructors are not an error"
(NormalC {}) -> String -> String
helper String
"non-record data constructor"
(InfixC {}) -> String -> String
helper String
"infix constructor"
(ForallC {}) -> String -> String
helper String
"constructor qualified by type variables / class contexts"
(GadtC {}) -> String -> String
helper String
"GADT constructor"
(RecGadtC {}) -> String -> String
helper String
"record GADT constructor"
where
helper :: String -> String
helper String
constructorType =
String
"Esqueleto records can only be derived for record constructors, but "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show (Con -> Name
constructorName Con
con)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is a "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
constructorType
constructorName :: Con -> Name
constructorName Con
constructor =
case Con
constructor of
(RecC Name
name [VarBangType]
_) -> Name
name
(NormalC Name
name [BangType]
_fields) -> Name
name
(InfixC BangType
_ty1 Name
name BangType
_ty2) -> Name
name
(ForallC [TyVarBndr Specificity]
_vars Cxt
_constraints Con
innerConstructor) -> Con -> Name
constructorName Con
innerConstructor
(GadtC [Name]
names [BangType]
_fields Type
_ret) -> [Name] -> Name
forall a. [a] -> a
head [Name]
names
(RecGadtC [Name]
names [VarBangType]
_fields Type
_ret) -> [Name] -> Name
forall a. [a] -> a
head [Name]
names
makeToAliasInstance :: RecordInfo -> Q Dec
makeToAliasInstance :: RecordInfo -> Q Dec
makeToAliasInstance info :: RecordInfo
info@RecordInfo {Cxt
[(Name, Type)]
[TyVarBndr ()]
Maybe Type
Name
sqlFields :: [(Name, Type)]
fields :: [(Name, Type)]
sqlConstructorName :: Name
constructorName :: Name
kind :: Maybe Type
typeVarBinders :: [TyVarBndr ()]
constraints :: Cxt
sqlName :: Name
name :: Name
sqlFields :: RecordInfo -> [(Name, Type)]
fields :: RecordInfo -> [(Name, Type)]
sqlConstructorName :: RecordInfo -> Name
constructorName :: RecordInfo -> Name
kind :: RecordInfo -> Maybe Type
typeVarBinders :: RecordInfo -> [TyVarBndr ()]
constraints :: RecordInfo -> Cxt
sqlName :: RecordInfo -> Name
name :: RecordInfo -> Name
..} = do
Dec
toAliasDec' <- RecordInfo -> Q Dec
toAliasDec RecordInfo
info
let overlap :: Maybe a
overlap = Maybe a
forall a. Maybe a
Nothing
instanceConstraints :: [a]
instanceConstraints = []
instanceType :: Type
instanceType =
(Name -> Type
ConT ''ToAlias)
Type -> Type -> Type
`AppT` (Name -> Type
ConT Name
sqlName)
Dec -> Q Dec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$ Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
InstanceD Maybe Overlap
forall a. Maybe a
overlap Cxt
forall a. [a]
instanceConstraints Type
instanceType [Dec
toAliasDec']
toAliasDec :: RecordInfo -> Q Dec
toAliasDec :: RecordInfo -> Q Dec
toAliasDec RecordInfo {Cxt
[(Name, Type)]
[TyVarBndr ()]
Maybe Type
Name
sqlFields :: [(Name, Type)]
fields :: [(Name, Type)]
sqlConstructorName :: Name
constructorName :: Name
kind :: Maybe Type
typeVarBinders :: [TyVarBndr ()]
constraints :: Cxt
sqlName :: Name
name :: Name
sqlFields :: RecordInfo -> [(Name, Type)]
fields :: RecordInfo -> [(Name, Type)]
sqlConstructorName :: RecordInfo -> Name
constructorName :: RecordInfo -> Name
kind :: RecordInfo -> Maybe Type
typeVarBinders :: RecordInfo -> [TyVarBndr ()]
constraints :: RecordInfo -> Cxt
sqlName :: RecordInfo -> Name
name :: RecordInfo -> Name
..} = do
([Stmt]
statements, [FieldPat]
fieldPatterns, [(Name, Exp)]
fieldExps) <-
[(Stmt, FieldPat, (Name, Exp))]
-> ([Stmt], [FieldPat], [(Name, Exp)])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(Stmt, FieldPat, (Name, Exp))]
-> ([Stmt], [FieldPat], [(Name, Exp)]))
-> Q [(Stmt, FieldPat, (Name, Exp))]
-> Q ([Stmt], [FieldPat], [(Name, Exp)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Name, Type)]
-> ((Name, Type) -> Q (Stmt, FieldPat, (Name, Exp)))
-> Q [(Stmt, FieldPat, (Name, Exp))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Name, Type)]
sqlFields (\(Name
fieldName', Type
_) -> do
Name
fieldPatternName <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName (Name -> String
nameBase Name
fieldName')
Name
boundValueName <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName (Name -> String
nameBase Name
fieldName')
(Stmt, FieldPat, (Name, Exp)) -> Q (Stmt, FieldPat, (Name, Exp))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Pat -> Exp -> Stmt
BindS
(Name -> Pat
VarP Name
boundValueName)
(Name -> Exp
VarE 'toAlias Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
fieldPatternName)
, (Name
fieldName', Name -> Pat
VarP Name
fieldPatternName)
, (Name
fieldName', Name -> Exp
VarE Name
boundValueName)
))
Dec -> Q Dec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$
Name -> [Clause] -> Dec
FunD
'toAlias
[ [Pat] -> Body -> [Dec] -> Clause
Clause
[ Name -> [FieldPat] -> Pat
RecP Name
sqlName [FieldPat]
fieldPatterns
]
( Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$
Maybe ModName -> [Stmt] -> Exp
DoE
#if MIN_VERSION_template_haskell(2,17,0)
Maybe ModName
forall a. Maybe a
Nothing
#endif
([Stmt]
statements [Stmt] -> [Stmt] -> [Stmt]
forall a. [a] -> [a] -> [a]
++ [Exp -> Stmt
NoBindS (Exp -> Stmt) -> Exp -> Stmt
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'pure) (Name -> [(Name, Exp)] -> Exp
RecConE Name
sqlName [(Name, Exp)]
fieldExps)])
)
[]
]
makeToAliasReferenceInstance :: RecordInfo -> Q Dec
makeToAliasReferenceInstance :: RecordInfo -> Q Dec
makeToAliasReferenceInstance info :: RecordInfo
info@RecordInfo {Cxt
[(Name, Type)]
[TyVarBndr ()]
Maybe Type
Name
sqlFields :: [(Name, Type)]
fields :: [(Name, Type)]
sqlConstructorName :: Name
constructorName :: Name
kind :: Maybe Type
typeVarBinders :: [TyVarBndr ()]
constraints :: Cxt
sqlName :: Name
name :: Name
sqlFields :: RecordInfo -> [(Name, Type)]
fields :: RecordInfo -> [(Name, Type)]
sqlConstructorName :: RecordInfo -> Name
constructorName :: RecordInfo -> Name
kind :: RecordInfo -> Maybe Type
typeVarBinders :: RecordInfo -> [TyVarBndr ()]
constraints :: RecordInfo -> Cxt
sqlName :: RecordInfo -> Name
name :: RecordInfo -> Name
..} = do
Dec
toAliasReferenceDec' <- RecordInfo -> Q Dec
toAliasReferenceDec RecordInfo
info
let overlap :: Maybe a
overlap = Maybe a
forall a. Maybe a
Nothing
instanceConstraints :: [a]
instanceConstraints = []
instanceType :: Type
instanceType =
(Name -> Type
ConT ''ToAliasReference)
Type -> Type -> Type
`AppT` (Name -> Type
ConT Name
sqlName)
Dec -> Q Dec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$ Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
InstanceD Maybe Overlap
forall a. Maybe a
overlap Cxt
forall a. [a]
instanceConstraints Type
instanceType [Dec
toAliasReferenceDec']
toAliasReferenceDec :: RecordInfo -> Q Dec
toAliasReferenceDec :: RecordInfo -> Q Dec
toAliasReferenceDec RecordInfo {Cxt
[(Name, Type)]
[TyVarBndr ()]
Maybe Type
Name
sqlFields :: [(Name, Type)]
fields :: [(Name, Type)]
sqlConstructorName :: Name
constructorName :: Name
kind :: Maybe Type
typeVarBinders :: [TyVarBndr ()]
constraints :: Cxt
sqlName :: Name
name :: Name
sqlFields :: RecordInfo -> [(Name, Type)]
fields :: RecordInfo -> [(Name, Type)]
sqlConstructorName :: RecordInfo -> Name
constructorName :: RecordInfo -> Name
kind :: RecordInfo -> Maybe Type
typeVarBinders :: RecordInfo -> [TyVarBndr ()]
constraints :: RecordInfo -> Cxt
sqlName :: RecordInfo -> Name
name :: RecordInfo -> Name
..} = do
Name
identInfo <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"identInfo"
([Stmt]
statements, [FieldPat]
fieldPatterns, [(Name, Exp)]
fieldExps) <-
[(Stmt, FieldPat, (Name, Exp))]
-> ([Stmt], [FieldPat], [(Name, Exp)])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(Stmt, FieldPat, (Name, Exp))]
-> ([Stmt], [FieldPat], [(Name, Exp)]))
-> Q [(Stmt, FieldPat, (Name, Exp))]
-> Q ([Stmt], [FieldPat], [(Name, Exp)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Name, Type)]
-> ((Name, Type) -> Q (Stmt, FieldPat, (Name, Exp)))
-> Q [(Stmt, FieldPat, (Name, Exp))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Name, Type)]
sqlFields (\(Name
fieldName', Type
_) -> do
Name
fieldPatternName <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName (Name -> String
nameBase Name
fieldName')
Name
boundValueName <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName (Name -> String
nameBase Name
fieldName')
(Stmt, FieldPat, (Name, Exp)) -> Q (Stmt, FieldPat, (Name, Exp))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Pat -> Exp -> Stmt
BindS
(Name -> Pat
VarP Name
boundValueName)
(Name -> Exp
VarE 'toAliasReference Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
identInfo Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
fieldPatternName)
, (Name
fieldName', Name -> Pat
VarP Name
fieldPatternName)
, (Name
fieldName', Name -> Exp
VarE Name
boundValueName)
))
Dec -> Q Dec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$
Name -> [Clause] -> Dec
FunD
'toAliasReference
[ [Pat] -> Body -> [Dec] -> Clause
Clause
[ Name -> Pat
VarP Name
identInfo
, Name -> [FieldPat] -> Pat
RecP Name
sqlName [FieldPat]
fieldPatterns
]
( Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$
Maybe ModName -> [Stmt] -> Exp
DoE
#if MIN_VERSION_template_haskell(2,17,0)
Maybe ModName
forall a. Maybe a
Nothing
#endif
([Stmt]
statements [Stmt] -> [Stmt] -> [Stmt]
forall a. [a] -> [a] -> [a]
++ [Exp -> Stmt
NoBindS (Exp -> Stmt) -> Exp -> Stmt
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'pure) (Name -> [(Name, Exp)] -> Exp
RecConE Name
sqlName [(Name, Exp)]
fieldExps)])
)
[]
]