From 362728f86ad9f97f54a20fe7da6f13b9a687c241 Mon Sep 17 00:00:00 2001 From: Dylan Martin Date: Tue, 20 Apr 2021 12:43:20 -0700 Subject: [PATCH 1/4] Make upserts handle unique fields (#1233) * trying my bset * idk maybe this works * remove logs * spacing --- .../Database/Persist/Postgresql.hs | 70 ++++++++++--------- persistent-postgresql/test/UpsertWhere.hs | 3 +- 2 files changed, 38 insertions(+), 35 deletions(-) diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs index 970e9772f..957a31a31 100644 --- a/persistent-postgresql/Database/Persist/Postgresql.hs +++ b/persistent-postgresql/Database/Persist/Postgresql.hs @@ -1817,6 +1817,7 @@ upsertWhere , MonadIO m , PersistStore backend , BackendCompatible SqlBackend backend + , OnlyOneUniqueKey record ) => record -> [Update record] @@ -1825,11 +1826,43 @@ upsertWhere upsertWhere record updates filts = upsertManyWhere [record] [] updates filts +-- | 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] +-- +-- 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 + , 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 + -- | 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 +-- 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. excludeNotEqualToOriginal :: (PersistField typ @@ -1854,43 +1887,12 @@ excludeNotEqualToOriginal field = "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] --- --- 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 - ) => - [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 - -- | 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) + :: (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. @@ -1906,7 +1908,7 @@ mkBulkUpsertQuery records conn fieldValues updates filters = (fieldsToMaybeCopy, updateFieldNames) = partitionEithers $ map mfieldDef fieldValues fieldDbToText = escapeF . fieldDB entityDef' = entityDef records - conflictColumns = escapeF . fieldDB <$> entityKeyFields entityDef' + conflictColumns = (escapeF . fieldDB <$> entityKeyFields entityDef') ++ concatMap (map (escapeF . snd) . uniqueFields) (entityUniques entityDef') firstField = case entityFieldNames of [] -> error "The entity you're trying to insert does not have any fields." (field:_) -> field diff --git a/persistent-postgresql/test/UpsertWhere.hs b/persistent-postgresql/test/UpsertWhere.hs index 626f83443..7dd8b1d62 100644 --- a/persistent-postgresql/test/UpsertWhere.hs +++ b/persistent-postgresql/test/UpsertWhere.hs @@ -18,6 +18,7 @@ import PgInit share [mkPersist sqlSettings, mkMigrate "upsertWhereMigrate"] [persistLowerCase| Item name Text sqltype=varchar(80) + UniqueName name description Text price Double Maybe quantity Int Maybe @@ -44,7 +45,7 @@ specs = describe "UpsertWhere" $ do let newDescription = "I am a new description" insert_ item1 upsertWhere - (Item "item1" "i am inserted description" (Just 1) (Just 2)) + (Item "item1" "i am an inserted description" (Just 1) (Just 2)) [ItemDescription =. newDescription] [] Just item <- get (ItemKey "item1") From d68f33cc0a35d693e1fdd03cdc58e81ac41867bf Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Tue, 20 Apr 2021 14:24:10 -0600 Subject: [PATCH 2/4] Require a Unique on upsertManyWhere --- .../Database/Persist/Postgresql.hs | 124 ++++--- .../persistent-postgresql.cabal | 1 + persistent-postgresql/test/PgInit.hs | 109 +++--- persistent-postgresql/test/UpsertWhere.hs | 315 +++++++++--------- 4 files changed, 298 insertions(+), 251 deletions(-) diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs index 957a31a31..ec32a0cd1 100644 --- a/persistent-postgresql/Database/Persist/Postgresql.hs +++ b/persistent-postgresql/Database/Persist/Postgresql.hs @@ -1838,7 +1838,7 @@ upsertWhere record updates filts = -- assuming the condition in the last block is met. -- -- @since 2.12.1.0 -upsertManyWhere +upsertManyWhere :: forall record backend m. ( backend ~ PersistEntityBackend record , BackendCompatible SqlBackend backend @@ -1846,46 +1846,51 @@ upsertManyWhere , 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 + ) + => [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 + uncurry rawExecute $ + mkBulkUpsertQuery records conn fieldValues updates filters -- | 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 `upsertWhere` and -- `upsertManyWhere` methods that has similar behavior to the HandleCollisionUpdate type. -excludeNotEqualToOriginal :: - (PersistField typ - , PersistEntity rec) => - EntityField rec typ -> - Filter rec +-- +-- @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 - } + Filter + { filterField = + field + , filterFilter = + Ne + , filterValue = + UnsafeValue $ + PersistLiteral_ + Unescaped + bsForExcludedField + } where bsForExcludedField = - T.encodeUtf8 $ - "EXCLUDED." - <> fieldName field + 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 @@ -1908,7 +1913,9 @@ mkBulkUpsertQuery records conn fieldValues updates filters = (fieldsToMaybeCopy, updateFieldNames) = partitionEithers $ map mfieldDef fieldValues fieldDbToText = escapeF . fieldDB entityDef' = entityDef records - conflictColumns = (escapeF . fieldDB <$> entityKeyFields entityDef') ++ concatMap (map (escapeF . snd) . uniqueFields) (entityUniques entityDef') + -- conflictColumns = (escapeF . fieldDB <$> entityKeyFields entityDef') ++ concatMap (map (escapeF . snd) . uniqueFields) (entityUniques entityDef') + conflictColumns = + concatMap (map (escapeF . snd) . uniqueFields) (entityUniques entityDef') firstField = case entityFieldNames of [] -> error "The entity you're trying to insert does not have any fields." (field:_) -> field @@ -1916,33 +1923,46 @@ mkBulkUpsertQuery records conn fieldValues updates filters = 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/persistent-postgresql.cabal b/persistent-postgresql/persistent-postgresql.cabal index 158569aee..bfe98d213 100644 --- a/persistent-postgresql/persistent-postgresql.cabal +++ b/persistent-postgresql/persistent-postgresql.cabal @@ -68,6 +68,7 @@ test-suite test , HUnit , hspec >= 2.4 , hspec-expectations + , hspec-expectations-lifted , monad-logger , QuickCheck , quickcheck-instances diff --git a/persistent-postgresql/test/PgInit.hs b/persistent-postgresql/test/PgInit.hs index 8c9906ce3..5cc14c55d 100644 --- a/persistent-postgresql/test/PgInit.hs +++ b/persistent-postgresql/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 - - , 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 +module PgInit + ( runConn + , runConn_ + , runConnAssert + , runConnAssertUseConf + + , 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.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/persistent-postgresql/test/UpsertWhere.hs b/persistent-postgresql/test/UpsertWhere.hs index 7dd8b1d62..1ed3eff7c 100644 --- a/persistent-postgresql/test/UpsertWhere.hs +++ b/persistent-postgresql/test/UpsertWhere.hs @@ -1,179 +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) - UniqueName name - 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 an 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) From 61f6d498aa791277960a83edea7a8e239f7d8e22 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Tue, 20 Apr 2021 14:38:12 -0600 Subject: [PATCH 3/4] pave the way for the minor version stuff --- .../Database/Persist/Postgresql.hs | 28 +++++++++++++------ .../Database/Persist/Class/PersistUnique.hs | 2 +- 2 files changed, 21 insertions(+), 9 deletions(-) diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs index ec32a0cd1..11f565d0b 100644 --- a/persistent-postgresql/Database/Persist/Postgresql.hs +++ b/persistent-postgresql/Database/Persist/Postgresql.hs @@ -1860,8 +1860,13 @@ upsertManyWhere upsertManyWhere [] _ _ _ = return () upsertManyWhere records fieldValues updates filters = do 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 + 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` @@ -1898,13 +1903,21 @@ excludeNotEqualToOriginal field = -- duplicate key exceptions. mkBulkUpsertQuery :: (PersistEntity record, PersistEntityBackend record ~ SqlBackend, OnlyOneUniqueKey record) - => [record] -- ^ A list of the records you want to insert, or update + => [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 @@ -1913,9 +1926,8 @@ mkBulkUpsertQuery records conn fieldValues updates filters = (fieldsToMaybeCopy, updateFieldNames) = partitionEithers $ map mfieldDef fieldValues fieldDbToText = escapeF . fieldDB entityDef' = entityDef records - -- conflictColumns = (escapeF . fieldDB <$> entityKeyFields entityDef') ++ concatMap (map (escapeF . snd) . uniqueFields) (entityUniques entityDef') conflictColumns = - concatMap (map (escapeF . snd) . uniqueFields) (entityUniques entityDef') + map (escapeF . snd) $ uniqueFields uniqDef firstField = case entityFieldNames of [] -> error "The entity you're trying to insert does not have any fields." (field:_) -> field diff --git a/persistent/Database/Persist/Class/PersistUnique.hs b/persistent/Database/Persist/Class/PersistUnique.hs index fcb0fd1ed..80e280a70 100644 --- a/persistent/Database/Persist/Class/PersistUnique.hs +++ b/persistent/Database/Persist/Class/PersistUnique.hs @@ -297,7 +297,7 @@ class PersistEntity record => OnlyOneUniqueKey record where -- | Given a proxy for a 'PersistEntity' record, this returns the sole -- 'UniqueDef' for that entity. -- --- @since 2.10.0 +-- @since TODO release me onlyOneUniqueDef :: (OnlyOneUniqueKey record, Monad proxy) => proxy record From 58ed6d0ca9c05ac45ae2d78809bd67f680e09ab1 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Tue, 20 Apr 2021 15:18:07 -0600 Subject: [PATCH 4/4] add changelog and cabal bump --- persistent-postgresql/ChangeLog.md | 8 ++++++++ persistent-postgresql/persistent-postgresql.cabal | 2 +- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/persistent-postgresql/ChangeLog.md b/persistent-postgresql/ChangeLog.md index 7fce26302..580e69507 100644 --- a/persistent-postgresql/ChangeLog.md +++ b/persistent-postgresql/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/persistent-postgresql/persistent-postgresql.cabal b/persistent-postgresql/persistent-postgresql.cabal index bfe98d213..279d4af0e 100644 --- a/persistent-postgresql/persistent-postgresql.cabal +++ b/persistent-postgresql/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