persistent-mysql 2.8.0 → 2.8.1
raw patch · 3 files changed
+48/−42 lines, 3 filesdep ~persistent
Dependency ranges changed: persistent
Files
- ChangeLog.md +5/−1
- Database/Persist/MySQL.hs +41/−39
- persistent-mysql.cabal +2/−2
ChangeLog.md view
@@ -1,4 +1,8 @@-## 2.8.0 (Unreleased)+## 2.8.1++* Implemented `connPutManySql` to utilize batched `putMany`. [#770](https://github.com/yesodweb/persistent/pull/770)++## 2.8.0 * Switch from `MonadBaseControl` to `MonadUnliftIO` * Fix duplicate migrations when using `mediumtext`, `longtext`, `mediumblob`, `longblob`, and `double`s using a custom precision. [#754](https://github.com/yesodweb/persistent/pull/754)
Database/Persist/MySQL.hs view
@@ -68,6 +68,7 @@ import Database.Persist.Sql import Database.Persist.Sql.Types.Internal (mkPersistBackend)+import Database.Persist.Sql.Util (commaSeparated, mkUpdateText', parenWrapped) import Data.Int (Int64) import qualified Database.MySQL.Simple as MySQL@@ -132,6 +133,7 @@ , connInsertSql = insertSql' , connInsertManySql = Nothing , connUpsertSql = Nothing+ , connPutManySql = Just putManySql , connClose = MySQL.close conn , connMigrateSql = migrate' ci , connBegin = const $ MySQL.execute_ conn "start transaction" >> return ()@@ -254,7 +256,7 @@ -- | Get the corresponding @'Getter' 'PersistValue'@ depending on -- the type of the column. getGetter :: MySQLBase.Field -> Getter PersistValue-getGetter field = go (MySQLBase.fieldType field) +getGetter field = go (MySQLBase.fieldType field) (MySQLBase.fieldLength field) (MySQLBase.fieldCharSet field) where@@ -285,7 +287,7 @@ go MySQLBase.VarChar _ _ = convertPV PersistText go MySQLBase.VarString _ _ = convertPV PersistText go MySQLBase.String _ _ = convertPV PersistText- + go MySQLBase.Blob _ 63 = convertPV PersistByteString go MySQLBase.TinyBlob _ 63 = convertPV PersistByteString go MySQLBase.MediumBlob _ 63 = convertPV PersistByteString@@ -344,10 +346,10 @@ let foreigns = do Column { cName=cname, cReference=Just (refTblName, _a) } <- newcols return $ AlterColumn name (refTblName, addReference allDefs (refName name cname) refTblName cname)- - let foreignsAlt = map (\fdef -> let (childfields, parentfields) = unzip (map (\((_,b),(_,d)) -> (b,d)) (foreignFields fdef)) ++ let foreignsAlt = map (\fdef -> let (childfields, parentfields) = unzip (map (\((_,b),(_,d)) -> (b,d)) (foreignFields fdef)) in AlterColumn name (foreignRefTableDBName fdef, AddReference (foreignRefTableDBName fdef) (foreignConstraintNameDBName fdef) childfields parentfields)) fdefs- + return $ Right $ map showAlterDb $ (addTable newcols val): uniques ++ foreigns ++ foreignsAlt -- No errors and something found, migrate (_, _, ([], old')) -> do@@ -1012,7 +1014,7 @@ -- | Mock a migration even when the database is not present.--- This function will mock the migration for a database even when +-- This function will mock the migration for a database even when -- the actual database isn't already present in the system. mockMigration :: Migration -> IO () mockMigration mig = do@@ -1038,8 +1040,9 @@ connLimitOffset = undefined, connLogFunc = undefined, connUpsertSql = undefined,+ connPutManySql = undefined, connMaxParams = Nothing}- result = runReaderT . runWriterT . runWriterT $ mig + result = runReaderT . runWriterT . runWriterT $ mig resp <- result sqlbackend mapM_ T.putStrLn $ map snd $ snd resp @@ -1124,7 +1127,7 @@ -- 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 which fields to copy from the record you're trying +-- 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@@ -1146,7 +1149,7 @@ -- -- Primary name -- @--- +-- -- > items: -- > +------+-------------+-------+----------+ -- > | name | description | price | quantity |@@ -1166,8 +1169,8 @@ -- -- We parse that into a list of Haskell records: ----- @ --- records = +-- @+-- records = -- [ Item { itemName = "foo", itemDescription = "" -- , itemPrice = Just 2.50, itemQuantity = Just 6 -- }@@ -1187,10 +1190,10 @@ -- value. So we can use 'copyUnlessNull' to only copy the existing values -- in. ----- The final code looks like this: +-- The final code looks like this: -- @--- 'insertManyOnDuplicateKeyUpdate' records --- [ 'copyUnlessEmpty' ItemDescription +-- 'insertManyOnDuplicateKeyUpdate' records+-- [ 'copyUnlessEmpty' ItemDescription -- , 'copyUnlessNull' ItemPrice -- , 'copyUnlessNull' ItemQuantity -- ]@@ -1250,7 +1253,7 @@ copyUnlessValues = map snd fieldsToMaybeCopy recordValues = concatMap (map toPersistValue . toPersistFields) records recordPlaceholders = commaSeparated $ map (parenWrapped . commaSeparated . map (const "?") . toPersistFields) records- mkCondFieldSet n _ = T.concat + mkCondFieldSet n _ = T.concat [ n , "=COALESCE(" , "NULLIF("@@ -1262,7 +1265,7 @@ ] condFieldSets = map (uncurry mkCondFieldSet) fieldsToMaybeCopy fieldSets = map (\n -> T.concat [n, "=VALUES(", n, ")"]) updateFieldNames- upds = map mkUpdateText updates+ upds = map (mkUpdateText' (pack . escapeDBName) id) updates updsValues = map (\(Update _ val _) -> toPersistValue val) updates updateText = case fieldSets <> upds <> condFieldSets of [] -> T.concat [firstField, "=", firstField]@@ -1279,27 +1282,26 @@ , updateText ] --- | Vendored from @persistent@.-mkUpdateText :: PersistEntity record => Update record -> Text-mkUpdateText x =- case updateUpdate x of- Assign -> n <> "=?"- Add -> T.concat [n, "=", n, "+?"]- Subtract -> T.concat [n, "=", n, "-?"]- Multiply -> T.concat [n, "=", n, "*?"]- Divide -> T.concat [n, "=", n, "/?"]- BackendSpecificUpdate up ->- error . T.unpack $ "BackendSpecificUpdate " <> up <> " not supported"+putManySql :: EntityDef -> Int -> Text+putManySql entityDef' numRecords+ | numRecords > 0 = q+ | otherwise = error "putManySql: numRecords MUST be greater than 0!" where- n = T.pack . escapeDBName . fieldDB . updateFieldDef $ x--commaSeparated :: [Text] -> Text-commaSeparated = T.intercalate ", "--parenWrapped :: Text -> Text-parenWrapped t = T.concat ["(", t, ")"]---- | Gets the 'FieldDef' for an 'Update'. Vendored from @persistent@.-updateFieldDef :: PersistEntity v => Update v -> FieldDef-updateFieldDef (Update f _ _) = persistFieldDef f-updateFieldDef BackendUpdate {} = error "updateFieldDef did not expect BackendUpdate"+ 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')+ q = T.concat+ [ "INSERT INTO "+ , tableName+ , " ("+ , commaSeparated entityFieldNames+ , ") "+ , " VALUES "+ , commaSeparated (replicate numRecords recordPlaceholders)+ , " ON DUPLICATE KEY UPDATE "+ , commaSeparated fieldSets+ ]
persistent-mysql.cabal view
@@ -1,5 +1,5 @@ name: persistent-mysql-version: 2.8.0+version: 2.8.1 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.0 && < 3+ , persistent >= 2.8.1 && < 3 , containers >= 0.2 , bytestring >= 0.9 , text >= 0.11.0.6