persistent-mysql 2.6.1 → 2.6.2
raw patch · 3 files changed
+184/−31 lines, 3 filesdep ~mysql-simple
Dependency ranges changed: mysql-simple
Files
- ChangeLog.md +6/−0
- Database/Persist/MySQL.hs +176/−29
- persistent-mysql.cabal +2/−2
ChangeLog.md view
@@ -1,3 +1,9 @@+## 2.6.2++* Extend the `SomeField` type to allow `insertManyOnDuplicateKeyUpdate` to conditionally copy values.+* Depend on `mysql-simple >= 0.4.3` to fix encoding and decoding of date/time values with fractional seconds (when a column is specified using something like `sqltype=TIME(6)`). See also [#705](https://github.com/yesodweb/persistent/issues/705)+* Fix behavior of `insertManyOnDuplicateKeyUpdate` to ignore duplicate key exceptions when no updates specified.+ ## 2.6.1 * Add functions `insertOnDuplicateKeyUpdate`, `insertManyOnDuplicateKeyUpdate` to `Database.Persist.MySQL` module.
Database/Persist/MySQL.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-}@@ -17,7 +18,10 @@ , mockMigration , insertOnDuplicateKeyUpdate , insertManyOnDuplicateKeyUpdate- , SomeField(..)+ , SomeField(SomeField)+ , copyUnlessNull+ , copyUnlessEmpty+ , copyUnlessEq ) where import Control.Arrow@@ -25,13 +29,14 @@ import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (runExceptT)-import Control.Monad.Trans.Reader (runReaderT)+import Control.Monad.Trans.Reader (runReaderT, ReaderT, withReaderT) 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.ByteString (ByteString)-import Data.Either (partitionEithers) import Data.Fixed (Pico) import Data.Function (on) import Data.IORef@@ -65,6 +70,8 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Trans.Resource (runResourceT) +import Prelude+ -- | Create a MySQL connection pool and run the given action. -- The pool is properly released after the action finishes using -- it. Note that you should not use the given 'ConnectionPool'@@ -620,9 +627,13 @@ -- Text parseColumnType "varchar" ci = return (SqlString, ciMaxLength ci) parseColumnType "text" _ = return (SqlString, Nothing)+parseColumnType "mediumtext" _ = return (SqlString, Nothing)+parseColumnType "longtext" _ = return (SqlString, Nothing) -- ByteString parseColumnType "varbinary" ci = return (SqlBlob, ciMaxLength ci) parseColumnType "blob" _ = return (SqlBlob, Nothing)+parseColumnType "mediumblob" _ = return (SqlBlob, Nothing)+parseColumnType "longblob" _ = return (SqlBlob, Nothing) -- Time-related parseColumnType "time" _ = return (SqlTime, Nothing) parseColumnType "datetime" _ = return (SqlDayTime, Nothing)@@ -1022,70 +1033,206 @@ -- | MySQL specific 'upsert'. This will prevent multiple queries, when one will -- do. insertOnDuplicateKeyUpdate- :: ( PersistEntityBackend record ~ BaseBackend backend+ :: ( backend ~ PersistEntityBackend record , PersistEntity record , MonadIO m , PersistStore backend- , backend ~ SqlBackend+ , BackendCompatible SqlBackend backend ) => record -> [Update record]- -> SqlPersistT m ()+ -> ReaderT backend 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.+--+-- === __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- , 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.- -> [Update record] -- ^ A list of the updates to apply that aren't dependent on the record being inserted.- -> SqlPersistT m ()+ :: forall record backend m.+ ( backend ~ PersistEntityBackend record+ , BackendCompatible SqlBackend backend+ , 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.+ -> [Update record] -- ^ A list of the updates to apply that aren't dependent on the record being inserted.+ -> ReaderT backend m () insertManyOnDuplicateKeyUpdate [] _ _ = return ()-insertManyOnDuplicateKeyUpdate records [] [] = insertMany_ records insertManyOnDuplicateKeyUpdate records fieldValues updates =- uncurry rawExecute $ mkBulkInsertQuery records fieldValues updates+ withReaderT projectBackend+ . uncurry rawExecute+ $ mkBulkInsertQuery records fieldValues updates --- | This creates the query for 'bulkInsertOnDuplicateKeyUpdate'. It will give--- garbage results if you don't provide a list of either fields to copy or--- fields to update.+-- | This creates the query for 'bulkInsertOnDuplicateKeyUpdate'. 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. 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@@ -1095,7 +1242,7 @@ , " VALUES " , recordPlaceholders , " ON DUPLICATE KEY UPDATE "- , commaSeparated (fieldSets <> upds)+ , updateText ] -- | Vendored from @persistent@.
persistent-mysql.cabal view
@@ -1,5 +1,5 @@ name: persistent-mysql-version: 2.6.1+version: 2.6.2 license: MIT license-file: LICENSE author: Felipe Lessa <felipe.lessa@gmail.com>, Michael Snoyman@@ -29,7 +29,7 @@ library build-depends: base >= 4.6 && < 5 , transformers >= 0.2.1- , mysql-simple >= 0.2.2.3 && < 0.5+ , mysql-simple >= 0.4.3 && < 0.5 , mysql >= 0.1.1.3 && < 0.2 , blaze-builder , persistent >= 2.6.1 && < 3