persistent-mysql 2.6.2.1 → 2.8.0

raw patch · 3 files changed

+134/−85 lines, 3 filesdep +unliftio-coredep −monad-controldep ~basedep ~conduitdep ~persistentPVP ok

version bump matches the API change (PVP)

Dependencies added: unliftio-core

Dependencies removed: monad-control

Dependency ranges changed: base, conduit, persistent

API changes (from Hackage documentation)

Files

• ChangeLog.md +16/−0
• Database/Persist/MySQL.hs +113/−80
• persistent-mysql.cabal +5/−5

@@ -1,3 +1,19 @@+## 2.8.0 (Unreleased)++* 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)++-- This can be released as a minor change on the next update. Currently persistent-mysql can't be released because 2.6.2.2 depends on persistent-2.7.2 being released.++* The `SomeField` type was renamed to `HandleUpdateCollision` and deprecated. Please migrate to using `HandleUpdateCollision`.+* The `SomeField` constructor was deprecated, and a temporary pattern synonym introduced. Please migrate to using `copyField`.++## 2.6.2.2 [UNRELEASED ON HACKAGE]++-- This version depends on persistent 2.7.2, which introduced breaking changes and is deprecated on hackage.++* Fix ambiguous type errors introduced by `persistent-2.7.2` [#723](https://github.com/yesodweb/persistent/pull/723)+ ## 2.6.2.1  * Fix haddock documentation [#725](https://github.com/yesodweb/persistent/pull/725)

@@ -1,4 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-}@@ -16,9 +18,17 @@     , MySQLBase.defaultSSLInfo     , MySQLConf(..)     , mockMigration+     -- * @ON DUPLICATE KEY UPDATE@ Functionality     , insertOnDuplicateKeyUpdate     , insertManyOnDuplicateKeyUpdate-    , SomeField(SomeField)+#if MIN_VERSION_base(4,7,0)+    , HandleUpdateCollision+    , pattern SomeField+#elif MIN_VERSION_base(4,9,0)+    , HandleUpdateCollision(SomeField)+#endif+    , SomeField+    , copyField     , copyUnlessNull     , copyUnlessEmpty     , copyUnlessEq@@ -29,7 +39,7 @@ import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (runExceptT)-import Control.Monad.Trans.Reader (runReaderT, ReaderT, withReaderT)+import Control.Monad.Trans.Reader (runReaderT, ReaderT) import Control.Monad.Trans.Writer (runWriterT) import Data.Either (partitionEithers) import Data.Monoid ((<>))@@ -67,8 +77,7 @@  import qualified Database.MySQL.Base          as MySQLBase import qualified Database.MySQL.Base.Types    as MySQLBase-import Control.Monad.Trans.Control (MonadBaseControl)-import Control.Monad.Trans.Resource (runResourceT)+import Control.Monad.IO.Unlift (MonadUnliftIO)  import Prelude @@ -76,7 +85,7 @@ -- The pool is properly released after the action finishes using -- it.  Note that you should not use the given 'ConnectionPool' -- outside the action since it may be already been released.-withMySQLPool :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, IsSqlBackend backend)+withMySQLPool :: (MonadLogger m, MonadUnliftIO m, IsSqlBackend backend)               => MySQL.ConnectInfo               -- ^ Connection information.               -> Int@@ -90,7 +99,7 @@ -- | Create a MySQL connection pool.  Note that it's your -- responsibility to properly close the connection pool when -- unneeded.  Use 'withMySQLPool' for automatic resource control.-createMySQLPool :: (MonadBaseControl IO m, MonadIO m, MonadLogger m, IsSqlBackend backend)+createMySQLPool :: (MonadUnliftIO m, MonadLogger m, IsSqlBackend backend)                 => MySQL.ConnectInfo                 -- ^ Connection information.                 -> Int@@ -101,7 +110,7 @@  -- | Same as 'withMySQLPool', but instead of opening a pool -- of connections, only one connection is opened.-withMySQLConn :: (MonadBaseControl IO m, MonadIO m, MonadLogger m, IsSqlBackend backend)+withMySQLConn :: (MonadUnliftIO m, MonadLogger m, IsSqlBackend backend)               => MySQL.ConnectInfo               -- ^ Connection information.               -> (backend -> m a)@@ -178,7 +187,7 @@           => MySQL.Connection           -> MySQL.Query           -> [PersistValue]-          -> Acquire (Source m [PersistValue])+          -> Acquire (ConduitM () [PersistValue] m ()) withStmt' conn query vals = do     result <- mkAcquire createResult MySQLBase.freeResult     return $ fetchRows result >>= CL.sourceList@@ -465,45 +474,51 @@                  ) getColumns connectInfo getter def = do     -- Find out ID column.-    stmtIdClmn <- getter "SELECT COLUMN_NAME, \-                                 \IS_NULLABLE, \-                                 \DATA_TYPE, \-                                 \COLUMN_DEFAULT \-                          \FROM INFORMATION_SCHEMA.COLUMNS \-                          \WHERE TABLE_SCHEMA = ? \-                            \AND TABLE_NAME   = ? \-                            \AND COLUMN_NAME  = ?"-    inter1 <- with (stmtQuery stmtIdClmn vals) ($$ CL.consume)-    ids <- runResourceT $ CL.sourceList inter1 $$ helperClmns -- avoid nested queries+    stmtIdClmn <- getter $ T.concat+      [ "SELECT COLUMN_NAME, "+      ,   "IS_NULLABLE, "+      ,   "DATA_TYPE, "+      ,   "COLUMN_DEFAULT "+      , "FROM INFORMATION_SCHEMA.COLUMNS "+      , "WHERE TABLE_SCHEMA = ? "+      ,   "AND TABLE_NAME   = ? "+      ,   "AND COLUMN_NAME  = ?"+      ]+    inter1 <- with (stmtQuery stmtIdClmn vals) (\src -> runConduit $ src .| CL.consume)+    ids <- runConduitRes $ CL.sourceList inter1 .| helperClmns -- avoid nested queries      -- Find out all columns.-    stmtClmns <- getter "SELECT COLUMN_NAME, \-                               \IS_NULLABLE, \-                               \DATA_TYPE, \-                               \COLUMN_TYPE, \-                               \CHARACTER_MAXIMUM_LENGTH, \-                               \NUMERIC_PRECISION, \-                               \NUMERIC_SCALE, \-                               \COLUMN_DEFAULT \-                        \FROM INFORMATION_SCHEMA.COLUMNS \-                        \WHERE TABLE_SCHEMA = ? \-                          \AND TABLE_NAME   = ? \-                          \AND COLUMN_NAME <> ?"-    inter2 <- with (stmtQuery stmtClmns vals) ($$ CL.consume)-    cs <- runResourceT $ CL.sourceList inter2 $$ helperClmns -- avoid nested queries+    stmtClmns <- getter $ T.concat+      [ "SELECT COLUMN_NAME, "+      ,   "IS_NULLABLE, "+      ,   "DATA_TYPE, "+      ,   "COLUMN_TYPE, "+      ,   "CHARACTER_MAXIMUM_LENGTH, "+      ,   "NUMERIC_PRECISION, "+      ,   "NUMERIC_SCALE, "+      ,   "COLUMN_DEFAULT "+      , "FROM INFORMATION_SCHEMA.COLUMNS "+      , "WHERE TABLE_SCHEMA = ? "+      ,   "AND TABLE_NAME   = ? "+      ,   "AND COLUMN_NAME <> ?"+      ]+    inter2 <- with (stmtQuery stmtClmns vals) (\src -> runConduitRes $ src .| CL.consume)+    cs <- runConduitRes $ CL.sourceList inter2 .| helperClmns -- avoid nested queries      -- Find out the constraints.-    stmtCntrs <- getter "SELECT CONSTRAINT_NAME, \-                               \COLUMN_NAME \-                        \FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE \-                        \WHERE TABLE_SCHEMA = ? \-                          \AND TABLE_NAME   = ? \-                          \AND COLUMN_NAME <> ? \-                          \AND CONSTRAINT_NAME <> 'PRIMARY' \-                          \AND REFERENCED_TABLE_SCHEMA IS NULL \-                        \ORDER BY CONSTRAINT_NAME, \-                                 \COLUMN_NAME"-    us <- with (stmtQuery stmtCntrs vals) ($$ helperCntrs)+    stmtCntrs <- getter $ T.concat+      [ "SELECT CONSTRAINT_NAME, "+      ,   "COLUMN_NAME "+      , "FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE "+      , "WHERE TABLE_SCHEMA = ? "+      ,   "AND TABLE_NAME   = ? "+      ,   "AND COLUMN_NAME <> ? "+      ,   "AND CONSTRAINT_NAME <> 'PRIMARY' "+      ,   "AND REFERENCED_TABLE_SCHEMA IS NULL "+      , "ORDER BY CONSTRAINT_NAME, "+      ,   "COLUMN_NAME"+      ]+    us <- with (stmtQuery stmtCntrs vals) (\src -> runConduitRes $ src .| helperCntrs)      -- Return both     return (ids, cs ++ us)@@ -512,7 +527,7 @@            , PersistText $ unDBName $ entityDB def            , PersistText $ unDBName $ fieldDB $ entityId def ] -    helperClmns = CL.mapM getIt =$ CL.consume+    helperClmns = CL.mapM getIt .| CL.consume         where           getIt = fmap (either Left (Right . Left)) .                   liftIO .@@ -556,21 +571,23 @@                     _ -> fail $ "Invalid default column: " ++ show default'        -- Foreign key (if any)-      stmt <- lift $ getter "SELECT REFERENCED_TABLE_NAME, \-                                   \CONSTRAINT_NAME, \-                                   \ORDINAL_POSITION \-                            \FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE \-                            \WHERE TABLE_SCHEMA = ? \-                              \AND TABLE_NAME   = ? \-                              \AND COLUMN_NAME  = ? \-                              \AND REFERENCED_TABLE_SCHEMA = ? \-                            \ORDER BY CONSTRAINT_NAME, \-                                     \COLUMN_NAME"+      stmt <- lift . getter $ T.concat +        [ "SELECT REFERENCED_TABLE_NAME, "+        ,   "CONSTRAINT_NAME, "+        ,   "ORDINAL_POSITION "+        , "FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE "+        , "WHERE TABLE_SCHEMA = ? "+        ,   "AND TABLE_NAME   = ? "+        ,   "AND COLUMN_NAME  = ? "+        ,   "AND REFERENCED_TABLE_SCHEMA = ? "+        , "ORDER BY CONSTRAINT_NAME, "+        ,   "COLUMN_NAME"+        ]       let vars = [ PersistText $ pack $ MySQL.connectDatabase connectInfo                  , PersistText $ unDBName $ tname                  , PersistText cname                  , PersistText $ pack $ MySQL.connectDatabase connectInfo ]-      cntrs <- with (stmtQuery stmt vars) ($$ CL.consume)+      cntrs <- liftIO $ with (stmtQuery stmt vars) (\src -> runConduit $ src .| CL.consume)       ref <- case cntrs of                [] -> return Nothing                [[PersistText tab, PersistText ref, PersistInt64 pos]] ->@@ -617,7 +634,7 @@ parseColumnType "int" ci | ciColumnType ci == "int(11)"        = return (SqlInt32, Nothing) parseColumnType "bigint" ci | ciColumnType ci == "bigint(20)"  = return (SqlInt64, Nothing) -- Double-parseColumnType "double" _                                     = return (SqlReal, Nothing)+parseColumnType x@("double") ci | ciColumnType ci == x         = return (SqlReal, Nothing) parseColumnType "decimal" ci                                   =   case (ciNumericPrecision ci, ciNumericScale ci) of     (PersistInt64 p, PersistInt64 s) ->@@ -627,13 +644,9 @@ -- 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)@@ -1030,8 +1043,10 @@   resp <- result sqlbackend   mapM_ T.putStrLn $ map snd $ snd resp --- | MySQL specific 'upsert'. This will prevent multiple queries, when one will--- do.+-- | MySQL specific 'upsert_'. This will prevent multiple queries, when one will+-- do. The record will be inserted into the database. In the event that the+-- record already exists in the database, the record will have the+-- relevant updates performed. insertOnDuplicateKeyUpdate   :: ( backend ~ PersistEntityBackend record      , PersistEntity record@@ -1046,45 +1061,64 @@   insertManyOnDuplicateKeyUpdate [record] []  -- | 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.+-- @INSERT ... ON DUPLICATE KEY UPDATE@ functionality, exposed via+-- 'insertManyOnDuplicateKeyUpdate' in this library. ----- @since 2.6.2-data SomeField record where+-- @since 3.0.0+data HandleUpdateCollision record where   -- | Copy the field directly from the record.-  SomeField :: EntityField record typ -> SomeField record+  CopyField :: EntityField record typ -> HandleUpdateCollision record   -- | Only copy the field if it is not equal to the provided value.-  CopyUnlessEq :: PersistField typ => EntityField record typ -> typ -> SomeField record+  CopyUnlessEq :: PersistField typ => EntityField record typ -> typ -> HandleUpdateCollision record +-- | An alias for 'HandleUpdateCollision'. The type previously was only+-- used to copy a single value, but was expanded to be handle more complex+-- queries.+--+-- @since 2.6.2+type SomeField = HandleUpdateCollision++#if MIN_VERSION_base(4,8,0)+pattern SomeField :: EntityField record typ -> SomeField record+#endif+pattern SomeField x = CopyField x+{-# DEPRECATED SomeField "The type SomeField is deprecated. Use the type HandleUpdateCollision instead, and use the function copyField instead of the data constructor." #-}+ -- | 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 :: PersistField typ => EntityField record (Maybe typ) -> HandleUpdateCollision 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+-- The resulting 'HandleUpdateCollision' type is useful for the -- 'insertManyOnDuplicateKeyUpdate' function. -- -- @since  2.6.2-copyUnlessEmpty :: (Monoid.Monoid typ, PersistField typ) => EntityField record typ -> SomeField record+copyUnlessEmpty :: (Monoid.Monoid typ, PersistField typ) => EntityField record typ -> HandleUpdateCollision 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+-- The resulting 'HandleUpdateCollision' type is useful for the -- 'insertManyOnDuplicateKeyUpdate' function. -- -- @since  2.6.2-copyUnlessEq :: PersistField typ => EntityField record typ -> typ -> SomeField record+copyUnlessEq :: PersistField typ => EntityField record typ -> typ -> HandleUpdateCollision record copyUnlessEq = CopyUnlessEq +-- | Copy the field directly from the record.+--+-- @since 3.0+copyField :: PersistField typ => EntityField record typ -> HandleUpdateCollision record+copyField = CopyField+ -- | 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.@@ -1097,9 +1131,9 @@ -- 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__+-- === __More details on 'HandleUpdateCollision' usage__ ----- The @['SomeField']@ parameter allows you to specify which fields (and+-- The @['HandleUpdateCollision']@ 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: --@@ -1181,13 +1215,12 @@     , 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.+    -> [HandleUpdateCollision 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 fieldValues updates =-    withReaderT projectBackend-    . uncurry rawExecute+    uncurry rawExecute     $ mkBulkInsertQuery records fieldValues updates  -- | This creates the query for 'bulkInsertOnDuplicateKeyUpdate'. If you@@ -1197,14 +1230,14 @@ mkBulkInsertQuery     :: 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.+    -> [HandleUpdateCollision 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 <> copyUnlessValues)   where     mfieldDef x = case x of-        SomeField rec -> Right (fieldDbToText (persistFieldDef rec))+        CopyField 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

@@ -1,5 +1,5 @@ name:            persistent-mysql-version:         2.6.2.1+version:         2.8.0 license:         MIT license-file:    LICENSE author:          Felipe Lessa <felipe.lessa@gmail.com>, Michael Snoyman@@ -27,18 +27,18 @@ extra-source-files: ChangeLog.md  library-    build-depends:   base                  >= 4.6        && < 5+    build-depends:   base                  >= 4.8        && < 5                    , transformers          >= 0.2.1                    , mysql-simple          >= 0.4.3    && < 0.5                    , mysql                 >= 0.1.1.3  && < 0.2                    , blaze-builder-                   , persistent            >= 2.6.1    && < 3+                   , persistent            >= 2.8.0    && < 3                    , containers            >= 0.2                    , bytestring            >= 0.9                    , text                  >= 0.11.0.6-                   , monad-control         >= 0.2+                   , unliftio-core                    , aeson                 >= 0.6.2-                   , conduit               >= 0.5.3+                   , conduit               >= 1.2.8                    , resourcet             >= 0.4.10                    , monad-logger                    , resource-pool