diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,8 @@ +## 0.3.4 +- Port [#693](https://github.com/yesodweb/persistent/pull/693) from `mysql-haskell`: Extend the `SomeField` type to allow `insertManyOnDuplicateKeyUpdate` to conditionally copy values. +- Port [#702](https://github.com/yesodweb/persistent/pull/702) from `mysql-haskell`: Fix behavior of `insertManyOnDuplicateKeyUpdate` to ignore duplicate key exceptions when no updates specified. +- Bumped TLS bounds to be in [sync with `mysql-haskell`](https://github.com/winterland1989/mysql-haskell/pull/15) and land ourselves [back on stackage](https://github.com/fpco/stackage/pull/2956). + ## 0.3.3 - Port from `mysql-haskell`: MySQL on duplicate key update [#674](https://github.com/yesodweb/persistent/pull/674). diff --git a/Database/Persist/MySQL.hs b/Database/Persist/MySQL.hs --- a/Database/Persist/MySQL.hs +++ b/Database/Persist/MySQL.hs @@ -19,7 +19,10 @@ , mockMigration , insertOnDuplicateKeyUpdate , insertManyOnDuplicateKeyUpdate - , SomeField(..) + , SomeField(SomeField) + , copyUnlessNull + , copyUnlessEmpty + , copyUnlessEq -- * TLS configuration , setMySQLConnectInfoTLS , MySQLTLS.TrustedCAStore(..) @@ -35,10 +38,11 @@ import Control.Monad.Trans.Except (runExceptT) import Control.Monad.Trans.Reader (runReaderT) import Control.Monad.Trans.Writer (runWriterT) +import Data.Either (partitionEithers) import Data.Monoid ((<>)) +import qualified Data.Monoid as Monoid import Data.Aeson import Data.Aeson.Types (modifyFailure) -import Data.Either (partitionEithers) import Data.Fixed (Pico) import Data.Function (on) import Data.IORef @@ -901,8 +905,8 @@ -- using @persistent@'s generic facilities. These values are the -- same that are given to 'withMySQLPool'. data MySQLConf = MySQLConf - MySQLConnectInfo -- ^ The connection information. - Int -- ^ How many connections should be held on the connection pool. + MySQLConnectInfo + Int deriving Show myConnInfo :: MySQLConf -> MySQLConnectInfo @@ -1096,51 +1100,149 @@ -- | MySQL specific 'upsert'. This will prevent multiple queries, when one will -- do. insertOnDuplicateKeyUpdate - :: ( PersistEntityBackend record ~ BaseBackend backend - , PersistEntity record - , MonadIO m - , PersistStore backend - , backend ~ SqlBackend - ) + :: (PersistEntity record, MonadIO m) => record -> [Update record] -> SqlPersistT m () insertOnDuplicateKeyUpdate record = insertManyOnDuplicateKeyUpdate [record] [] --- | This wraps values of an Entity's 'EntityField', making them have the same --- type. This allows them to be put in lists. +-- | This type is used to determine how to update rows using MySQL's +-- @INSERT ON DUPLICATE KEY UPDATE@ functionality, exposed via +-- 'insertManyOnDuplicateKeyUpdate' in the library. data SomeField record where SomeField :: EntityField record typ -> SomeField record + -- ^ Copy the field directly from the record. + CopyUnlessEq :: PersistField typ => EntityField record typ -> typ -> SomeField record + -- ^ Only copy the field if it is not equal to the provided value. + -- @since 2.6.2 +-- | Copy the field into the database only if the value in the +-- corresponding record is non-@NULL@. +-- +-- @since 2.6.2 +copyUnlessNull :: PersistField typ => EntityField record (Maybe typ) -> SomeField record +copyUnlessNull field = CopyUnlessEq field Nothing + +-- | Copy the field into the database only if the value in the +-- corresponding record is non-empty, where "empty" means the Monoid +-- definition for 'mempty'. Useful for 'Text', 'String', 'ByteString', etc. +-- +-- The resulting 'SomeField' type is useful for the +-- 'insertManyOnDuplicateKeyUpdate' function. +-- +-- @since 2.6.2 +copyUnlessEmpty :: (Monoid.Monoid typ, PersistField typ) => EntityField record typ -> SomeField record +copyUnlessEmpty field = CopyUnlessEq field Monoid.mempty + +-- | Copy the field into the database only if the field is not equal to the +-- provided value. This is useful to avoid copying weird nullary data into +-- the database. +-- +-- The resulting 'SomeField' type is useful for the +-- 'insertManyOnDuplicateKeyUpdate' function. +-- +-- @since 2.6.2 +copyUnlessEq :: PersistField typ => EntityField record typ -> typ -> SomeField record +copyUnlessEq = CopyUnlessEq + -- | Do a bulk insert on the given records in the first parameter. In the event -- that a key conflicts with a record currently in the database, the second and -- third parameters determine what will happen. -- -- The second parameter is a list of fields to copy from the original value. --- This allows you to specify that, when a collision occurs, you'll just update --- the value in the database with the field values that you inserted. +-- This allows you to specify which fields to copy from the record you're trying +-- to insert into the database to the preexisting row. -- -- The third parameter is a list of updates to perform that are independent of -- the value that is provided. You can use this to increment a counter value. -- These updates only occur if the original record is present in the database. -- --- Example: --- > insertManyOnDuplicateKeyUpdate --- [ {- a big ol' list of records you want to insert/update -} ] --- [ SomeField UserName, SomeField UserEmail ] -- this copies the values that are being inserted to existing records --- [ UserModified =. now, UserEncounted +=. 1 ] -- this update is performed for any field that matches the inserted records +-- === __More details on 'SomeField' usage__ +-- +-- The @['SomeField']@ parameter allows you to specify which fields (and +-- under which conditions) will be copied from the inserted rows. For +-- a brief example, consider the following data model and existing data set: +-- +-- @ +-- Item +-- name Text +-- description Text +-- price Double Maybe +-- quantity Int Maybe +-- +-- Primary name +-- @ +-- +-- > items: +-- > +------+-------------+-------+----------+ +-- > | name | description | price | quantity | +-- > +------+-------------+-------+----------+ +-- > | foo | very good | | 3 | +-- > | bar | | 3.99 | | +-- > +------+-------------+-------+----------+ +-- +-- This record type has a single natural key on @itemName@. Let's suppose +-- that we download a CSV of new items to store into the database. Here's +-- our CSV: +-- +-- > name,description,price,quantity +-- > foo,,2.50,6 +-- > bar,even better,,5 +-- > yes,wow,, +-- +-- We parse that into a list of Haskell records: +-- +-- @ +-- records = +-- [ Item { itemName = "foo", itemDescription = "" +-- , itemPrice = Just 2.50, itemQuantity = Just 6 +-- } +-- , Item "bar" "even better" Nothing (Just 5) +-- , Item "yes" "wow" Nothing Nothing +-- ] +-- @ +-- +-- The new CSV data is partial. It only includes __updates__ from the +-- upstream vendor. Our CSV library parses the missing description field as +-- an empty string. We don't want to override the existing description. So +-- we can use the 'copyUnlessEmpty' function to say: "Don't update when the +-- value is empty." +-- +-- Likewise, the new row for @bar@ includes a quantity, but no price. We do +-- not want to overwrite the existing price in the database with a @NULL@ +-- value. So we can use 'copyUnlessNull' to only copy the existing values +-- in. +-- +-- The final code looks like this: +-- @ +-- 'insertManyOnDuplicateKeyUpdate' records +-- [ 'copyUnlessEmpty' ItemDescription +-- , 'copyUnlessNull' ItemPrice +-- , 'copyUnlessNull' ItemQuantity +-- ] +-- [] +-- @ +-- +-- Once we run that code on the datahase, the new data set looks like this: +-- +-- > items: +-- > +------+-------------+-------+----------+ +-- > | name | description | price | quantity | +-- > +------+-------------+-------+----------+ +-- > | foo | very good | 2.50 | 6 | +-- > | bar | even better | 3.99 | 5 | +-- > | yes | wow | | | +-- > +------+-------------+-------+----------+ insertManyOnDuplicateKeyUpdate - :: ( PersistEntityBackend record ~ SqlBackend - , PersistEntity record + :: ( PersistEntity record , MonadIO m ) => [record] -- ^ A list of the records you want to insert, or update - -> [SomeField record] -- ^ A list of the fields you want to copy over. + -> [SomeField record] -- ^ A list of updates to perform based on the record being inserted. -> [Update record] -- ^ A list of the updates to apply that aren't dependent on the record being inserted. -> SqlPersistT m () insertManyOnDuplicateKeyUpdate [] _ _ = return () -insertManyOnDuplicateKeyUpdate records [] [] = insertMany_ records insertManyOnDuplicateKeyUpdate records fieldValues updates = uncurry rawExecute $ mkBulkInsertQuery records fieldValues updates @@ -1148,24 +1250,45 @@ -- garbage results if you don't provide a list of either fields to copy or -- fields to update. mkBulkInsertQuery - :: (PersistEntityBackend record ~ SqlBackend, PersistEntity record) + :: PersistEntity record => [record] -- ^ A list of the records you want to insert, or update -> [SomeField 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. -> (Text, [PersistValue]) mkBulkInsertQuery records fieldValues updates = - (q, recordValues <> updsValues) + (q, recordValues <> updsValues <> copyUnlessValues) where - fieldDefs = map (\x -> case x of SomeField rec -> persistFieldDef rec) fieldValues - updateFieldNames = map (T.pack . escapeDBName . fieldDB) fieldDefs + mfieldDef x = case x of + SomeField rec -> Right (fieldDbToText (persistFieldDef rec)) + CopyUnlessEq rec val -> Left (fieldDbToText (persistFieldDef rec), toPersistValue val) + (fieldsToMaybeCopy, updateFieldNames) = partitionEithers $ map mfieldDef fieldValues + fieldDbToText = T.pack . escapeDBName . fieldDB entityDef' = entityDef records - entityFieldNames = map (T.pack . escapeDBName . fieldDB) (entityFields entityDef') + firstField = case entityFieldNames of + [] -> error "The entity you're trying to insert does not have any fields." + (field:_) -> field + entityFieldNames = map fieldDbToText (entityFields entityDef') tableName = T.pack . escapeDBName . entityDB $ entityDef' + copyUnlessValues = map snd fieldsToMaybeCopy recordValues = concatMap (map toPersistValue . toPersistFields) records recordPlaceholders = commaSeparated $ map (parenWrapped . commaSeparated . map (const "?") . toPersistFields) records + mkCondFieldSet n _ = T.concat + [ n + , "=COALESCE(" + , "NULLIF(" + , "VALUES(", n, ")," + , "?" + , ")," + , n + , ")" + ] + condFieldSets = map (uncurry mkCondFieldSet) fieldsToMaybeCopy fieldSets = map (\n -> T.concat [n, "=VALUES(", n, ")"]) updateFieldNames upds = map mkUpdateText updates updsValues = map (\(Update _ val _) -> toPersistValue val) updates + updateText = case fieldSets <> upds <> condFieldSets of + [] -> T.concat [firstField, "=", firstField] + xs -> commaSeparated xs q = T.concat [ "INSERT INTO " , tableName @@ -1175,7 +1298,7 @@ , " VALUES " , recordPlaceholders , " ON DUPLICATE KEY UPDATE " - , commaSeparated (fieldSets <> upds) + , updateText ] -- | Vendored from @persistent@. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -95,5 +95,5 @@ - Local, ```bash - stack test persistent-test --flag persistent-test:mysql_haskell + stack test persistent-test --flag persistent-test:mysql_haskell --exec persistent-test ``` diff --git a/persistent-mysql-haskell.cabal b/persistent-mysql-haskell.cabal --- a/persistent-mysql-haskell.cabal +++ b/persistent-mysql-haskell.cabal @@ -1,5 +1,5 @@ name: persistent-mysql-haskell -version: 0.3.3 +version: 0.3.4 license: MIT license-file: LICENSE author: Naushadh , Felipe Lessa , Michael Snoyman @@ -39,10 +39,11 @@ , monad-logger , resource-pool , mysql-haskell >= 0.8.0.0 && < 1.0 + -- keep the following in sync with @mysql-haskell@ .cabal , io-streams >= 1.2 && < 2.0 , time >= 1.5.0 , network >= 2.3 && < 3.0 - , tls >= 1.3.5 && < 1.4 + , tls >= 1.3.5 && < 1.5 exposed-modules: Database.Persist.MySQL other-modules: Database.Persist.MySQLConnectInfoShowInstance ghc-options: -Wall