diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,10 @@ +# Changelog for persistent-mysql + +## 2.9.0 + +* Added support for SQL isolation levels to via SqlBackend. [#812] +* Fix [832](https://github.com/yesodweb/persistent/issues/832): `repsertMany` now matches `mapM_ (uncurry repsert)` and is atomic. + ## 2.8.1 * Implemented `connPutManySql` to utilize batched `putMany`. [#770](https://github.com/yesodweb/persistent/pull/770) diff --git a/Database/Persist/MySQL.hs b/Database/Persist/MySQL.hs --- a/Database/Persist/MySQL.hs +++ b/Database/Persist/MySQL.hs @@ -35,6 +35,7 @@ ) where import Control.Arrow +import Control.Monad import Control.Monad.Logger (MonadLogger, runNoLoggingT) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Class (lift) @@ -67,8 +68,8 @@ import qualified Data.Text.Encoding as T import Database.Persist.Sql -import Database.Persist.Sql.Types.Internal (mkPersistBackend) -import Database.Persist.Sql.Util (commaSeparated, mkUpdateText', parenWrapped) +import Database.Persist.Sql.Types.Internal (mkPersistBackend, makeIsolationLevelStatement) +import qualified Database.Persist.Sql.Util as Util import Data.Int (Int64) import qualified Database.MySQL.Simple as MySQL @@ -136,7 +137,9 @@ , connPutManySql = Just putManySql , connClose = MySQL.close conn , connMigrateSql = migrate' ci - , connBegin = const $ MySQL.execute_ conn "start transaction" >> return () + , connBegin = \_ mIsolation -> do + forM_ mIsolation $ \iso -> MySQL.execute_ conn (makeIsolationLevelStatement iso) + MySQL.execute_ conn "start transaction" >> return () , connCommit = const $ MySQL.commit conn , connRollback = const $ MySQL.rollback conn , connEscapeName = pack . escapeDBName @@ -147,6 +150,7 @@ , connLimitOffset = decorateSQLWithLimitOffset "LIMIT 18446744073709551615" , connLogFunc = logFunc , connMaxParams = Nothing + , connRepsertManySql = Just repsertManySql } -- | Prepare a query. We don't support prepared statements, but @@ -573,7 +577,7 @@ _ -> fail $ "Invalid default column: " ++ show default' -- Foreign key (if any) - stmt <- lift . getter $ T.concat + stmt <- lift . getter $ T.concat [ "SELECT REFERENCED_TABLE_NAME, " , "CONSTRAINT_NAME, " , "ORDINAL_POSITION " @@ -892,6 +896,8 @@ ---------------------------------------------------------------------- +escape :: DBName -> Text +escape = T.pack . escapeDBName -- | Escape a database name to be included on a query. escapeDBName :: DBName -> String @@ -1041,7 +1047,9 @@ connLogFunc = undefined, connUpsertSql = undefined, connPutManySql = undefined, - connMaxParams = Nothing} + connMaxParams = Nothing, + connRepsertManySql = Nothing + } result = runReaderT . runWriterT . runWriterT $ mig resp <- result sqlbackend mapM_ T.putStrLn $ map snd $ snd resp @@ -1252,7 +1260,7 @@ 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 + recordPlaceholders = Util.commaSeparated $ map (Util.parenWrapped . Util.commaSeparated . map (const "?") . toPersistFields) records mkCondFieldSet n _ = T.concat [ n , "=COALESCE(" @@ -1265,16 +1273,16 @@ ] condFieldSets = map (uncurry mkCondFieldSet) fieldsToMaybeCopy fieldSets = map (\n -> T.concat [n, "=VALUES(", n, ")"]) updateFieldNames - upds = map (mkUpdateText' (pack . escapeDBName) id) updates + upds = map (Util.mkUpdateText' (pack . escapeDBName) id) updates updsValues = map (\(Update _ val _) -> toPersistValue val) updates updateText = case fieldSets <> upds <> condFieldSets of [] -> T.concat [firstField, "=", firstField] - xs -> commaSeparated xs + xs -> Util.commaSeparated xs q = T.concat [ "INSERT INTO " , tableName , " (" - , commaSeparated entityFieldNames + , Util.commaSeparated entityFieldNames , ") " , " VALUES " , recordPlaceholders @@ -1283,25 +1291,33 @@ ] putManySql :: EntityDef -> Int -> Text -putManySql entityDef' numRecords - | numRecords > 0 = q - | otherwise = error "putManySql: numRecords MUST be greater than 0!" +putManySql ent n = putManySql' fields ent n where - tableName = T.pack . escapeDBName . entityDB $ entityDef' - fieldDbToText = T.pack . escapeDBName . fieldDB - entityFieldNames = map fieldDbToText (entityFields entityDef') - recordPlaceholders= parenWrapped . commaSeparated - $ map (const "?") (entityFields entityDef') - mkAssignment n = T.concat [n, "=VALUES(", n, ")"] - fieldSets = map (mkAssignment . fieldDbToText) (entityFields entityDef') + fields = entityFields ent + +repsertManySql :: EntityDef -> Int -> Text +repsertManySql ent n = putManySql' fields ent n + where + fields = keyAndEntityFields ent + +putManySql' :: [FieldDef] -> EntityDef -> Int -> Text +putManySql' fields ent n = q + where + fieldDbToText = escape . fieldDB + mkAssignment f = T.concat [f, "=VALUES(", f, ")"] + + table = escape . entityDB $ ent + columns = Util.commaSeparated $ map fieldDbToText fields + placeholders = map (const "?") fields + updates = map (mkAssignment . fieldDbToText) fields + q = T.concat [ "INSERT INTO " - , tableName - , " (" - , commaSeparated entityFieldNames - , ") " + , table + , Util.parenWrapped columns , " VALUES " - , commaSeparated (replicate numRecords recordPlaceholders) + , Util.commaSeparated . replicate n + . Util.parenWrapped . Util.commaSeparated $ placeholders , " ON DUPLICATE KEY UPDATE " - , commaSeparated fieldSets + , Util.commaSeparated updates ] diff --git a/persistent-mysql.cabal b/persistent-mysql.cabal --- a/persistent-mysql.cabal +++ b/persistent-mysql.cabal @@ -1,5 +1,5 @@ name: persistent-mysql -version: 2.8.1 +version: 2.9.0 license: MIT license-file: LICENSE author: Felipe Lessa , Michael Snoyman @@ -32,7 +32,7 @@ , mysql-simple >= 0.4.3 && < 0.5 , mysql >= 0.1.1.3 && < 0.2 , blaze-builder - , persistent >= 2.8.1 && < 3 + , persistent >= 2.9.0 && < 3 , containers >= 0.2 , bytestring >= 0.9 , text >= 0.11.0.6