persistent-mysql 2.8.1 → 2.9.0
raw patch · 3 files changed
+50/−27 lines, 3 filesdep ~mysqldep ~persistent
Dependency ranges changed: mysql, persistent
Files
- ChangeLog.md +7/−0
- Database/Persist/MySQL.hs +41/−25
- persistent-mysql.cabal +2/−2
ChangeLog.md view
@@ -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)
Database/Persist/MySQL.hs view
@@ -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 ]
persistent-mysql.cabal view
@@ -1,5 +1,5 @@ name: persistent-mysql-version: 2.8.1+version: 2.9.0 license: MIT license-file: LICENSE author: Felipe Lessa <felipe.lessa@gmail.com>, 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