diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,13 @@ # Changelog for persistent-postgresql +# 2.12.1.1 + +* [#1235](https://github.com/yesodweb/persistent/pull/1235) + * `upsertWhere` and `upsertManyWhere` only worked in cases where a `Primary` + key was defined on a record, and no other uniqueness constraints. They + have been fixed to only work with records that have a single Uniqueness + constraint defined. + ## 2.12.1.0 * Added `upsertWhere` and `upsertManyWhere` to `persistent-postgresql`. [#1222](https://github.com/yesodweb/persistent/pull/1222). diff --git a/Database/Persist/Postgresql.hs b/Database/Persist/Postgresql.hs --- a/Database/Persist/Postgresql.hs +++ b/Database/Persist/Postgresql.hs @@ -1817,6 +1817,7 @@ , MonadIO m , PersistStore backend , BackendCompatible SqlBackend backend + , OnlyOneUniqueKey record ) => record -> [Update record] @@ -1825,83 +1826,98 @@ upsertWhere record updates filts = upsertManyWhere [record] [] updates filts --- | Exclude any record field if it doesn't match the filter record. Used only in `upsertWhere` and --- `upsertManyWhere` --- --- @since 2.12.1.0 --- TODO: we could probably make a sum type for the `Filter` record that's passed into the `upserWhere` and --- `upsertManyWhere` methods that has similar behavior to the HandleCollisionUpdate type. -excludeNotEqualToOriginal :: - (PersistField typ - , PersistEntity rec) => - EntityField rec typ -> - Filter rec -excludeNotEqualToOriginal field = - Filter - { filterField = - field, - filterFilter = - Ne, - filterValue = - UnsafeValue $ - PersistLiteral_ - Unescaped - bsForExcludedField - } - where - bsForExcludedField = - T.encodeUtf8 $ - "EXCLUDED." - <> fieldName field - -- | Postgres specific 'upsertManyWhere'. This method does the following: -- It will insert a record if no matching unique key exists. -- If a unique key exists, it will update the relevant field with a user-supplied value, however, -- it will only do this update on a user-supplied condition. -- For example, here's how this method could be called like such: -- --- upsertManyWhere [record] [recordField =. newValue] [recordField /= newValue] +-- upsertManyWhere [record] [recordField =. newValue] [recordField !=. newValue] -- -- Called thusly, this method will insert a new record (if none exists) OR update a recordField with a new value -- assuming the condition in the last block is met. -- --- -- @since 2.12.1.0 -upsertManyWhere :: - forall record backend m. - ( backend ~ PersistEntityBackend record, - BackendCompatible SqlBackend backend, - PersistEntityBackend record ~ SqlBackend, - PersistEntity record, - MonadIO m - ) => - -- | A list of the records you want to insert, or update - [record] -> - -- | A list of the fields you want to copy over. - [HandleUpdateCollision record] -> - -- | A list of the updates to apply that aren't dependent on the record being inserted. - [Update record] -> - -- | A filter condition that dictates the scope of the updates - [Filter record] -> - ReaderT backend m () +-- @since 2.12.1.0 +upsertManyWhere + :: forall record backend m. + ( backend ~ PersistEntityBackend record + , BackendCompatible SqlBackend backend + , PersistEntityBackend record ~ SqlBackend + , PersistEntity record + , OnlyOneUniqueKey record + , MonadIO m + ) + => [record] + -- ^ A list of the records you want to insert, or update + -> [HandleUpdateCollision record] + -- ^ A list of the fields you want to copy over. + -> [Update record] + -- ^ A list of the updates to apply that aren't dependent on the record + -- being inserted. + -> [Filter record] + -- ^ A filter condition that dictates the scope of the updates + -> ReaderT backend m () upsertManyWhere [] _ _ _ = return () upsertManyWhere records fieldValues updates filters = do - conn <- asks projectBackend - uncurry rawExecute $ - mkBulkUpsertQuery records conn fieldValues updates filters + conn <- asks projectBackend + let uniqDef = -- onlyOneUniqueDef (Nothing :: Maybe record) + case entityUniques (entityDef (Nothing :: Maybe record)) of + [uniq] -> uniq + _ -> error "impossible due to OnlyOneUniqueKey constraint" + -- TODO: use onlyOneUniqueDef when it's exported + uncurry rawExecute $ + mkBulkUpsertQuery records conn fieldValues updates filters uniqDef +-- | Exclude any record field if it doesn't match the filter record. Used only in `upsertWhere` and +-- `upsertManyWhere` +-- +-- TODO: we could probably make a sum type for the `Filter` record that's passed into the `upsertWhere` and +-- `upsertManyWhere` methods that has similar behavior to the HandleCollisionUpdate type. +-- +-- @since 2.12.1.0 +excludeNotEqualToOriginal + :: (PersistField typ, PersistEntity rec) + => EntityField rec typ + -> Filter rec +excludeNotEqualToOriginal field = + Filter + { filterField = + field + , filterFilter = + Ne + , filterValue = + UnsafeValue $ + PersistLiteral_ + Unescaped + bsForExcludedField + } + where + bsForExcludedField = + T.encodeUtf8 + $ "EXCLUDED." + <> fieldName field + -- | This creates the query for 'upsertManyWhere'. If you -- provide an empty list of updates to perform, then it will generate -- a dummy/no-op update using the first field of the record. This avoids -- duplicate key exceptions. mkBulkUpsertQuery - :: (PersistEntity record, PersistEntityBackend record ~ SqlBackend) - => [record] -- ^ A list of the records you want to insert, or update + :: (PersistEntity record, PersistEntityBackend record ~ SqlBackend, OnlyOneUniqueKey record) + => [record] + -- ^ A list of the records you want to insert, or update -> SqlBackend - -> [HandleUpdateCollision record] -- ^ A list of the fields you want to copy over. - -> [Update record] -- ^ A list of the updates to apply that aren't dependent on the record being inserted. - -> [Filter record] -- ^ A filter condition that dictates the scope of the updates + -> [HandleUpdateCollision record] + -- ^ A list of the fields you want to copy over. + -> [Update record] + -- ^ A list of the updates to apply that aren't dependent on the record being inserted. + -> [Filter record] + -- ^ A filter condition that dictates the scope of the updates + -> UniqueDef + -- ^ The specific uniqueness constraint to use on the record. Postgres + -- rquires that we use exactly one relevant constraint, and it can't do + -- a catch-all. How frustrating! -> (Text, [PersistValue]) -mkBulkUpsertQuery records conn fieldValues updates filters = +mkBulkUpsertQuery records conn fieldValues updates filters uniqDef = (q, recordValues <> updsValues <> copyUnlessValues <> whereVals) where mfieldDef x = case x of @@ -1910,7 +1926,8 @@ (fieldsToMaybeCopy, updateFieldNames) = partitionEithers $ map mfieldDef fieldValues fieldDbToText = escapeF . fieldDB entityDef' = entityDef records - conflictColumns = escapeF . fieldDB <$> entityKeyFields entityDef' + conflictColumns = + map (escapeF . snd) $ uniqueFields uniqDef firstField = case entityFieldNames of [] -> error "The entity you're trying to insert does not have any fields." (field:_) -> field @@ -1918,33 +1935,46 @@ nameOfTable = escapeE . entityDB $ entityDef' copyUnlessValues = map snd fieldsToMaybeCopy recordValues = concatMap (map toPersistValue . toPersistFields) records - recordPlaceholders = Util.commaSeparated $ map (Util.parenWrapped . Util.commaSeparated . map (const "?") . toPersistFields) records + recordPlaceholders = + Util.commaSeparated + $ map (Util.parenWrapped . Util.commaSeparated . map (const "?") . toPersistFields) + $ records mkCondFieldSet n _ = - T.concat - [ n - , "=COALESCE(" - , "NULLIF(" - , "EXCLUDED." - , n - , "," - , "?" - , ")" - , "," - , nameOfTable - , "." - , n - ,")" - ] + T.concat + [ n + , "=COALESCE(" + , "NULLIF(" + , "EXCLUDED." + , n + , "," + , "?" + , ")" + , "," + , nameOfTable + , "." + , n + ,")" + ] condFieldSets = map (uncurry mkCondFieldSet) fieldsToMaybeCopy fieldSets = map (\n -> T.concat [n, "=EXCLUDED.", n, ""]) updateFieldNames upds = map (Util.mkUpdateText' (escapeF) (\n -> T.concat [nameOfTable, ".", n])) updates updsValues = map (\(Update _ val _) -> toPersistValue val) updates - (wher, whereVals) = if null filters - then ("", []) - else (filterClauseWithVals (Just PrefixTableName) conn filters) - updateText = case fieldSets <> upds <> condFieldSets of - [] -> T.concat [firstField, "=EXCLUDED.", firstField] - xs -> Util.commaSeparated xs + (wher, whereVals) = + if null filters + then ("", []) + else (filterClauseWithVals (Just PrefixTableName) conn filters) + updateText = + case fieldSets <> upds <> condFieldSets of + [] -> + -- This case is really annoying, and probably unlikely to be + -- actually hit - someone would have had to call something like + -- `upsertManyWhere [] [] []`, but that would have been caught + -- by the prior case. + -- Would be nice to have something like a `NonEmpty (These ...)` + -- instead of multiple lists... + T.concat [firstField, "=", nameOfTable, ".", firstField] + xs -> + Util.commaSeparated xs q = T.concat [ "INSERT INTO " , nameOfTable diff --git a/persistent-postgresql.cabal b/persistent-postgresql.cabal --- a/persistent-postgresql.cabal +++ b/persistent-postgresql.cabal @@ -1,5 +1,5 @@ name: persistent-postgresql -version: 2.12.1.0 +version: 2.12.1.1 license: MIT license-file: LICENSE author: Felipe Lessa, Michael Snoyman @@ -68,6 +68,7 @@ , HUnit , hspec >= 2.4 , hspec-expectations + , hspec-expectations-lifted , monad-logger , QuickCheck , quickcheck-instances diff --git a/test/PgInit.hs b/test/PgInit.hs --- a/test/PgInit.hs +++ b/test/PgInit.hs @@ -1,58 +1,85 @@ -{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module PgInit ( - runConn - , runConn_ - , runConnAssert - , runConnAssertUseConf +module PgInit + ( runConn + , runConn_ + , runConnAssert + , runConnAssertUseConf - , MonadIO - , persistSettings - , MkPersistSettings (..) - , BackendKey(..) - , GenerateKey(..) + , MonadIO + , persistSettings + , MkPersistSettings (..) + , BackendKey(..) + , GenerateKey(..) - -- re-exports - , module Control.Monad.Trans.Reader - , module Control.Monad - , module Database.Persist.Sql - , module Database.Persist - , module Database.Persist.Sql.Raw.QQ - , module Init - , module Test.Hspec - , module Test.HUnit - , BS.ByteString - , Int32, Int64 - , liftIO - , mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase - , SomeException - , Text - , TestFn(..) - ) where + -- re-exports + , module Control.Monad.Trans.Reader + , module Control.Monad + , module Database.Persist.Sql + , module Database.Persist + , module Database.Persist.Sql.Raw.QQ + , module Init + , module Test.Hspec + , module Test.Hspec.Expectations.Lifted + , module Test.HUnit + , BS.ByteString + , Int32, Int64 + , liftIO + , mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase + , SomeException + , Text + , TestFn(..) + , LoggingT + , ResourceT + ) where import Init - ( TestFn(..), truncateTimeOfDay, truncateUTCTime - , truncateToMicro, arbText, liftA2, GenerateKey(..) - , (@/=), (@==), (==@), MonadFail - , assertNotEqual, assertNotEmpty, assertEmpty, asIO - , isTravis, RunDb - ) + ( GenerateKey(..) + , MonadFail + , RunDb + , TestFn(..) + , arbText + , asIO + , assertEmpty + , assertNotEmpty + , assertNotEqual + , isTravis + , liftA2 + , truncateTimeOfDay + , truncateToMicro + , truncateUTCTime + , (==@) + , (@/=) + , (@==) + ) -- re-exports import Control.Exception (SomeException) -import UnliftIO -import Control.Monad (void, replicateM, liftM, when, forM_) +import Control.Monad (forM_, liftM, replicateM, void, when) import Control.Monad.Trans.Reader import Data.Aeson (Value(..)) -import Database.Persist.TH (mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase, MkPersistSettings(..)) +import Database.Persist.Postgresql.JSON () import Database.Persist.Sql.Raw.QQ -import Database.Persist.Postgresql.JSON() +import Database.Persist.TH + ( MkPersistSettings(..) + , mkMigrate + , mkPersist + , persistLowerCase + , persistUpperCase + , share + , sqlSettings + ) import Test.Hspec + (Spec, afterAll_, before, beforeAll, describe, fdescribe, fit, it, + before_, SpecWith, Arg, hspec) +import Test.Hspec.Expectations.Lifted import Test.QuickCheck.Instances () +import UnliftIO -- testing -import Test.HUnit ((@?=),(@=?), Assertion, assertFailure, assertBool) +import Test.HUnit (Assertion, assertBool, assertFailure, (@=?), (@?=)) import Test.QuickCheck import Control.Monad (unless, (>=>)) diff --git a/test/UpsertWhere.hs b/test/UpsertWhere.hs --- a/test/UpsertWhere.hs +++ b/test/UpsertWhere.hs @@ -1,178 +1,178 @@ -{-# LANGUAGE DataKinds, FlexibleInstances, MultiParamTypeClasses, ExistentialQuantification #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE StandaloneDeriving #-} module UpsertWhere where -import Data.List (sort) +import PgInit import Database.Persist.Postgresql -import PgInit share [mkPersist sqlSettings, mkMigrate "upsertWhereMigrate"] [persistLowerCase| - Item - name Text sqltype=varchar(80) - description Text - price Double Maybe - quantity Int Maybe - Primary name - deriving Eq Show Ord +Item + name Text sqltype=varchar(80) + description Text + price Double Maybe + quantity Int Maybe + UniqueName name + deriving Eq Show Ord + |] +wipe :: IO () +wipe = runConnAssert $ do + deleteWhere ([] :: [Filter Item]) + +itDb :: String -> SqlPersistT (LoggingT (ResourceT IO)) a -> SpecWith (Arg (IO ())) +itDb msg action = it msg $ runConnAssert $ void action + specs :: Spec specs = describe "UpsertWhere" $ do - let item1 = Item "item1" "" (Just 3) Nothing - item2 = Item "item2" "hello world" Nothing (Just 2) - items = [item1, item2] + let item1 = Item "item1" "" (Just 3) Nothing + item2 = Item "item2" "hello world" Nothing (Just 2) + items = [item1, item2] - describe "upsertWhere" $ do - it "inserts appropriately" $ runConnAssert $ do - deleteWhere ([] :: [Filter Item]) - upsertWhere item1 [ItemDescription =. "i am item 1"] [] - Just item <- get (ItemKey "item1") - item @== item1 - it "performs only updates given if record already exists" $ runConnAssert $ do - deleteWhere ([] :: [Filter Item]) - let newDescription = "I am a new description" - insert_ item1 - upsertWhere - (Item "item1" "i am inserted description" (Just 1) (Just 2)) - [ItemDescription =. newDescription] - [] - Just item <- get (ItemKey "item1") - item @== item1 { itemDescription = newDescription } + describe "upsertWhere" $ before_ wipe $ do + itDb "inserts appropriately" $ do + upsertWhere item1 [ItemDescription =. "i am item 1"] [] + Just item <- fmap entityVal <$> getBy (UniqueName "item1") + item `shouldBe` item1 + itDb "performs only updates given if record already exists" $ do + let newDescription = "I am a new description" + insert_ item1 + upsertWhere + (Item "item1" "i am an inserted description" (Just 1) (Just 2)) + [ItemDescription =. newDescription] + [] + Just item <- fmap entityVal <$> getBy (UniqueName "item1") + item `shouldBe` item1 { itemDescription = newDescription } - describe "upsertManyWhere" $ do - it "inserts fresh records" $ runConnAssert $ do - deleteWhere ([] :: [Filter Item]) - insertMany_ items - let newItem = Item "item3" "fresh" Nothing Nothing - upsertManyWhere - (newItem : items) - [copyField ItemDescription] - [] - [] - dbItems <- map entityVal <$> selectList [] [] - sort dbItems @== sort (newItem : items) - it "updates existing records" $ runConnAssert $ do - deleteWhere ([] :: [Filter Item]) - let postUpdate = map (\i -> i { itemQuantity = fmap (+1) (itemQuantity i) }) items - insertMany_ items - upsertManyWhere - items - [] - [ItemQuantity +=. Just 1] - [] - dbItems <- sort . fmap entityVal <$> selectList [] [] - dbItems @== sort postUpdate - it "only copies passing values" $ runConnAssert $ do - deleteWhere ([] :: [Filter Item]) - insertMany_ items - let newItems = map (\i -> i { itemQuantity = Just 0, itemPrice = fmap (*2) (itemPrice i) }) items - postUpdate = map (\i -> i { itemPrice = fmap (*2) (itemPrice i) }) items - upsertManyWhere - newItems - [ - copyUnlessEq ItemQuantity (Just 0) - , copyField ItemPrice - ] - [] - [] - dbItems <- sort . fmap entityVal <$> selectList [] [] - dbItems @== sort postUpdate - it "inserts without modifying existing records if no updates specified" $ runConnAssert $ do - let newItem = Item "item3" "hi friends!" Nothing Nothing - deleteWhere ([] :: [Filter Item]) - insertMany_ items - upsertManyWhere - (newItem : items) - [] - [] - [] - dbItems <- sort . fmap entityVal <$> selectList [] [] - dbItems @== sort (newItem : items) - it "inserts without modifying existing records if no updates specified and there's a filter with True condition" $ - runConnAssert $ do - let newItem = Item "item3" "hi friends!" Nothing Nothing - deleteWhere ([] :: [Filter Item]) - insertMany_ items - upsertManyWhere - (newItem : items) - [] - [] - [ItemDescription ==. "hi friends!"] - dbItems <- sort . fmap entityVal <$> selectList [] [] - dbItems @== sort (newItem : items) - it "inserts without updating existing records if there are updates specified but there's a filter with a False condition" $ - runConnAssert $ do - let newItem = Item "item3" "hi friends!" Nothing Nothing - deleteWhere ([] :: [Filter Item]) - insertMany_ items - upsertManyWhere - (newItem : items) - [] - [ItemQuantity +=. Just 1] - [ItemDescription ==. "hi friends!"] - dbItems <- sort . fmap entityVal <$> selectList [] [] - dbItems @== sort (newItem : items) - it "inserts new records but does not update existing records if there are updates specified but the modification condition is False" $ - runConnAssert $ do - let newItem = Item "item3" "hi friends!" Nothing Nothing - deleteWhere ([] :: [Filter Item]) - insertMany_ items - upsertManyWhere - (newItem : items) - [] - [ItemQuantity +=. Just 1] - [excludeNotEqualToOriginal ItemDescription] - dbItems <- sort . fmap entityVal <$> selectList [] [] - dbItems @== sort (newItem : items) - it "inserts new records and updates existing records if there are updates specified and the modification condition is True (because it's empty)" $ - runConnAssert $ do - let newItem = Item "item3" "hello world" Nothing Nothing - postUpdate = map (\i -> i {itemQuantity = fmap (+ 1) (itemQuantity i)}) items - deleteWhere ([] :: [Filter Item]) - insertMany_ items - upsertManyWhere - (newItem : items) - [] - [ItemQuantity +=. Just 1] - [] - dbItems <- sort . fmap entityVal <$> selectList [] [] - dbItems @== sort (newItem : postUpdate) - it "inserts new records and updates existing records if there are updates specified and the modification filter condition is triggered" $ - runConnAssert $ do - let newItem = Item "item3" "hi friends!" Nothing Nothing - postUpdate = map (\i -> i {itemQuantity = fmap (+1) (itemQuantity i)}) items - deleteWhere ([] :: [Filter Item]) - insertMany_ items - upsertManyWhere - (newItem : items) - [ - copyUnlessEq ItemDescription "hi friends!" - , copyField ItemPrice - ] - [ItemQuantity +=. Just 1] - [ItemDescription !=. "bye friends!"] - dbItems <- sort . fmap entityVal <$> selectList [] [] - dbItems @== sort (newItem : postUpdate) - it "inserts an item and doesn't apply the update if the filter condition is triggered" $ - runConnAssert $ do - let newItem = Item "item3" "hello world" Nothing Nothing - deleteWhere ([] :: [Filter Item]) - insertMany_ items - upsertManyWhere - (newItem : items) - [] - [ItemQuantity +=. Just 1] - [excludeNotEqualToOriginal ItemDescription] - dbItems <- sort . fmap entityVal <$> selectList [] [] - dbItems @== sort (newItem : items) + describe "upsertManyWhere" $ do + itDb "inserts fresh records" $ do + insertMany_ items + let newItem = Item "item3" "fresh" Nothing Nothing + upsertManyWhere + (newItem : items) + [copyField ItemDescription] + [] + [] + dbItems <- map entityVal <$> selectList [] [] + dbItems `shouldMatchList` (newItem : items) + itDb "updates existing records" $ do + let + postUpdate = + map (\i -> i { itemQuantity = fmap (+1) (itemQuantity i) }) items + insertMany_ items + upsertManyWhere + items + [] + [ItemQuantity +=. Just 1] + [] + dbItems <- fmap entityVal <$> selectList [] [] + dbItems `shouldMatchList` postUpdate + itDb "only copies passing values" $ do + insertMany_ items + let newItems = map (\i -> i { itemQuantity = Just 0, itemPrice = fmap (*2) (itemPrice i) }) items + postUpdate = map (\i -> i { itemPrice = fmap (*2) (itemPrice i) }) items + upsertManyWhere + newItems + [ copyUnlessEq ItemQuantity (Just 0) + , copyField ItemPrice + ] + [] + [] + dbItems <- fmap entityVal <$> selectList [] [] + dbItems `shouldMatchList` postUpdate + itDb "inserts without modifying existing records if no updates specified" $ do + let newItem = Item "item3" "hi friends!" Nothing Nothing + insertMany_ items + upsertManyWhere + (newItem : items) + [] + [] + [] + dbItems <- fmap entityVal <$> selectList [] [] + dbItems `shouldMatchList` (newItem : items) + itDb "inserts without modifying existing records if no updates specified and there's a filter with True condition" $ + do + let newItem = Item "item3" "hi friends!" Nothing Nothing + insertMany_ items + upsertManyWhere + (newItem : items) + [] + [] + [ItemDescription ==. "hi friends!"] + dbItems <- fmap entityVal <$> selectList [] [] + dbItems `shouldMatchList` (newItem : items) + itDb "inserts without updating existing records if there are updates specified but there's a filter with a False condition" $ + do + let newItem = Item "item3" "hi friends!" Nothing Nothing + insertMany_ items + upsertManyWhere + (newItem : items) + [] + [ItemQuantity +=. Just 1] + [ItemDescription ==. "hi friends!"] + dbItems <- fmap entityVal <$> selectList [] [] + dbItems `shouldMatchList` (newItem : items) + itDb "inserts new records but does not update existing records if there are updates specified but the modification condition is False" $ + do + let newItem = Item "item3" "hi friends!" Nothing Nothing + insertMany_ items + upsertManyWhere + (newItem : items) + [] + [ItemQuantity +=. Just 1] + [excludeNotEqualToOriginal ItemDescription] + dbItems <- fmap entityVal <$> selectList [] [] + dbItems `shouldMatchList` (newItem : items) + itDb "inserts new records and updates existing records if there are updates specified and the modification condition is True (because it's empty)" $ + do + let newItem = Item "item3" "hello world" Nothing Nothing + postUpdate = map (\i -> i {itemQuantity = fmap (+ 1) (itemQuantity i)}) items + insertMany_ items + upsertManyWhere + (newItem : items) + [] + [ItemQuantity +=. Just 1] + [] + dbItems <- fmap entityVal <$> selectList [] [] + dbItems `shouldMatchList` (newItem : postUpdate) + itDb "inserts new records and updates existing records if there are updates specified and the modification filter condition is triggered" $ + do + let newItem = Item "item3" "hi friends!" Nothing Nothing + postUpdate = map (\i -> i {itemQuantity = fmap (+1) (itemQuantity i)}) items + insertMany_ items + upsertManyWhere + (newItem : items) + [ + copyUnlessEq ItemDescription "hi friends!" + , copyField ItemPrice + ] + [ItemQuantity +=. Just 1] + [ItemDescription !=. "bye friends!"] + dbItems <- fmap entityVal <$> selectList [] [] + dbItems `shouldMatchList` (newItem : postUpdate) + itDb "inserts an item and doesn't apply the update if the filter condition is triggered" $ + do + let newItem = Item "item3" "hello world" Nothing Nothing + insertMany_ items + upsertManyWhere + (newItem : items) + [] + [ItemQuantity +=. Just 1] + [excludeNotEqualToOriginal ItemDescription] + dbItems <- fmap entityVal <$> selectList [] [] + dbItems `shouldMatchList` (newItem : items)