haskell/esqueleto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Remove ESet

Browse Source
This commit is contained in:
belevy 2021-01-19 12:35:19 -06:00
parent c9eb845568
commit ec853664aa
2 changed files with 23 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
src/Database/Esqueleto/Internal/Internal.hs
View File

@ -959,24 +959,24 @@ notExists q = ERaw noMeta $ \p info ->
-- | @SET@ clause used on @UPDATE@s. Note that while it's not -- | @SET@ clause used on @UPDATE@s. Note that while it's not
-- a type error to use this function on a @SELECT@, it will -- a type error to use this function on a @SELECT@, it will
-- most certainly result in a runtime error. -- most certainly result in a runtime error.
set :: PersistEntity val => SqlExpr (Entity val) -> [SqlExpr (Update val)] -> SqlQuery () set :: PersistEntity val => SqlExpr (Entity val) -> [SqlExpr (Entity val) -> SqlExpr Update] -> SqlQuery ()
set ent upds = Q $ W.tell mempty { sdSetClause = map apply upds } set ent upds = Q $ W.tell mempty { sdSetClause = map apply upds }
where where
apply (ESet f) = SetClause (f ent) apply f = SetClause (f ent)
(=.) :: (PersistEntity val, PersistField typ) => EntityField val typ -> SqlExpr (Value typ) -> SqlExpr (Update val) (=.) :: (PersistEntity val, PersistField typ) => EntityField val typ -> SqlExpr (Value typ) -> (SqlExpr (Entity val) -> SqlExpr Update )
field =. expr = setAux field (const expr) field =. expr = setAux field (const expr)
(+=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Update val) (+=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> (SqlExpr (Entity val) -> SqlExpr Update)
field +=. expr = setAux field (\ent -> ent ^. field +. expr) field +=. expr = setAux field (\ent -> ent ^. field +. expr)
(-=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Update val) (-=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> (SqlExpr (Entity val) -> SqlExpr Update)
field -=. expr = setAux field (\ent -> ent ^. field -. expr) field -=. expr = setAux field (\ent -> ent ^. field -. expr)
(*=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Update val) (*=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> (SqlExpr (Entity val) -> SqlExpr Update)
field *=. expr = setAux field (\ent -> ent ^. field *. expr) field *=. expr = setAux field (\ent -> ent ^. field *. expr)
(/=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Update val) (/=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> (SqlExpr (Entity val) -> SqlExpr Update)
field /=. expr = setAux field (\ent -> ent ^. field /. expr) field /=. expr = setAux field (\ent -> ent ^. field /. expr)
-- | Apply a 'PersistField' constructor to @SqlExpr Value@ arguments. -- | Apply a 'PersistField' constructor to @SqlExpr Value@ arguments.
@ -1284,15 +1284,15 @@ toUniqueDef uniqueConstructor = uniqueDef
renderUpdates renderUpdates
:: (BackendCompatible SqlBackend backend) :: (BackendCompatible SqlBackend backend)
=> backend => backend
-> [SqlExpr (Update val)] -> [SqlExpr (Entity val) -> SqlExpr Update]
-> (TLB.Builder, [PersistValue]) -> (TLB.Builder, [PersistValue])
renderUpdates conn = uncommas' . concatMap renderUpdate renderUpdates conn = uncommas' . concatMap renderUpdate
where where
mk :: SqlExpr (Value ()) -> [(TLB.Builder, [PersistValue])] mk :: SqlExpr Update -> [(TLB.Builder, [PersistValue])]
mk (ERaw _ f) = [f Never info] mk (ERaw _ f) = [f Never info]
renderUpdate :: SqlExpr (Update val) -> [(TLB.Builder, [PersistValue])] renderUpdate :: (SqlExpr (Entity val) -> SqlExpr Update) -> [(TLB.Builder, [PersistValue])]
renderUpdate (ESet f) = mk (f undefined) -- second parameter of f is always unused renderUpdate f = mk (f undefined) -- second parameter of f is always unused
info = (projectBackend conn, initialIdentState) info = (projectBackend conn, initialIdentState)
-- | Data type that represents an @INNER JOIN@ (see 'LeftOuterJoin' for an example). -- | Data type that represents an @INNER JOIN@ (see 'LeftOuterJoin' for an example).
@ -1379,7 +1379,7 @@ data DistinctOn
-- | Phantom type for a @SET@ operation on an entity of the given -- | Phantom type for a @SET@ operation on an entity of the given
-- type (see 'set' and '(=.)'). -- type (see 'set' and '(=.)').
data Update typ data Update
-- | Phantom type used by 'insertSelect'. -- | Phantom type used by 'insertSelect'.
data Insertion a data Insertion a
@ -1798,7 +1798,7 @@ instance Show FromClause where
render' = T.unpack . renderExpr dummy render' = T.unpack . renderExpr dummy
-- | A part of a @SET@ clause. -- | A part of a @SET@ clause.
newtype SetClause = SetClause (SqlExpr (Value ())) newtype SetClause = SetClause (SqlExpr Update)
-- | Collect 'OnClause's on 'FromJoin's. Returns the first -- | Collect 'OnClause's on 'FromJoin's. Returns the first
-- unmatched 'OnClause's data on error. Returns a list without -- unmatched 'OnClause's data on error. Returns a list without
@ -2069,9 +2069,6 @@ data SqlExpr a where
-- interpolated by the SQL backend. -- interpolated by the SQL backend.
ERaw :: SqlExprMeta -> (NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr a ERaw :: SqlExprMeta -> (NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr a
-- A 'SqlExpr' accepted only by 'set'.
ESet :: (SqlExpr (Entity val) -> SqlExpr (Value ())) -> SqlExpr (Update val)
-- Used by 'insertSelect'. -- Used by 'insertSelect'.
EInsert :: Proxy a -> (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Insertion a) EInsert :: Proxy a -> (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Insertion a)
EInsertFinal :: PersistEntity a => SqlExpr (Insertion a) -> SqlExpr InsertFinal EInsertFinal :: PersistEntity a => SqlExpr (Insertion a) -> SqlExpr InsertFinal
@ -2103,10 +2100,12 @@ setAux
:: (PersistEntity val, PersistField typ) :: (PersistEntity val, PersistField typ)
=> EntityField val typ => EntityField val typ
-> (SqlExpr (Entity val) -> SqlExpr (Value typ)) -> (SqlExpr (Entity val) -> SqlExpr (Value typ))
-> SqlExpr (Update val) -> (SqlExpr (Entity val) -> SqlExpr Update)
setAux field mkVal = ESet $ \ent -> unsafeSqlBinOp " = " name (mkVal ent) setAux field value = \ent -> ERaw noMeta $ \_ info ->
where let (valueToSet, valueVals) =
name = ERaw noMeta $ \_ info -> (fieldName info field, mempty) case value ent of
ERaw _ valueF -> valueF Parens info
in (fieldName info field <> " = " <> valueToSet, valueVals)
sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a) sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
sub mode query = ERaw noMeta $ \_ info -> first parens $ toRawSql mode info query sub mode query = ERaw noMeta $ \_ info -> first parens $ toRawSql mode info query

8
src/Database/Esqueleto/PostgreSQL.hs
View File

@ -182,7 +182,7 @@ upsert
) )
=> record => record
-- ^ new record to insert -- ^ new record to insert
-> [SqlExpr (Update record)] -> [SqlExpr (Entity record) -> SqlExpr Update]
-- ^ updates to perform if the record already exists -- ^ updates to perform if the record already exists
-> R.ReaderT SqlBackend m (Entity record) -> R.ReaderT SqlBackend m (Entity record)
-- ^ the record in the database after the operation -- ^ the record in the database after the operation
@ -200,7 +200,7 @@ upsertBy
-- ^ uniqueness constraint to find by -- ^ uniqueness constraint to find by
-> record -> record
-- ^ new record to insert -- ^ new record to insert
-> [SqlExpr (Update record)] -> [SqlExpr (Entity record) -> SqlExpr Update]
-- ^ updates to perform if the record already exists -- ^ updates to perform if the record already exists
-> R.ReaderT SqlBackend m (Entity record) -> R.ReaderT SqlBackend m (Entity record)
-- ^ the record in the database after the operation -- ^ the record in the database after the operation
@ -276,7 +276,7 @@ insertSelectWithConflict
-- a unique "MyUnique 0", "MyUnique undefined" would work as well. -- a unique "MyUnique 0", "MyUnique undefined" would work as well.
-> SqlQuery (SqlExpr (Insertion val)) -> SqlQuery (SqlExpr (Insertion val))
-- ^ Insert query. -- ^ Insert query.
-> (SqlExpr (Entity val) -> SqlExpr (Entity val) -> [SqlExpr (Update val)]) -> (SqlExpr (Entity val) -> SqlExpr (Entity val) -> [SqlExpr (Entity val) -> SqlExpr Update])
-- ^ A list of updates to be applied in case of the constraint being -- ^ A list of updates to be applied in case of the constraint being
-- violated. The expression takes the current and excluded value to produce -- violated. The expression takes the current and excluded value to produce
-- the updates. -- the updates.
@ -292,7 +292,7 @@ insertSelectWithConflictCount
. (FinalResult a, KnowResult a ~ Unique val, MonadIO m, PersistEntity val) . (FinalResult a, KnowResult a ~ Unique val, MonadIO m, PersistEntity val)
=> a => a
-> SqlQuery (SqlExpr (Insertion val)) -> SqlQuery (SqlExpr (Insertion val))
-> (SqlExpr (Entity val) -> SqlExpr (Entity val) -> [SqlExpr (Update val)]) -> (SqlExpr (Entity val) -> SqlExpr (Entity val) -> [SqlExpr (Entity val) -> SqlExpr Update])
-> SqlWriteT m Int64 -> SqlWriteT m Int64
insertSelectWithConflictCount unique query conflictQuery = do insertSelectWithConflictCount unique query conflictQuery = do
conn <- R.ask conn <- R.ask