persistent-mysql-haskell 0.3.3 → 0.3.4
raw patch · 4 files changed
+161/−32 lines, 4 filesdep ~tls
Dependency ranges changed: tls
Files
- ChangeLog.md +5/−0
- Database/Persist/MySQL.hs +152/−29
- README.md +1/−1
- persistent-mysql-haskell.cabal +3/−2
ChangeLog.md view
@@ -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).
Database/Persist/MySQL.hs view
@@ -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@.
README.md view
@@ -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 ```
persistent-mysql-haskell.cabal view
@@ -1,5 +1,5 @@ name: persistent-mysql-haskell-version: 0.3.3+version: 0.3.4 license: MIT license-file: LICENSE author: Naushadh <naushadh@protonmail.com>, Felipe Lessa <felipe.lessa@gmail.com>, 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