yesodweb · parsonsmatt · Apr 20, 2021 · Apr 5, 2021 · Apr 5, 2021 · Apr 6, 2021
diff --git a/persistent-mysql/ChangeLog.md b/persistent-mysql/ChangeLog.md
@@ -1,5 +1,11 @@
 # Changelog for persistent-mysql
 
+## 2.13.0.0 (unreleased)
+
+* [#1225](https://github.com/yesodweb/persistent/pull/1225)
+    * Support `persistent-2.13` changes for SqlBackend being made internal.
+    * Remove the deprecated `SomeField` type and pattern.
+
 ## 2.12.0.0
 
 * Decomposed `HaskellName` into `ConstraintNameHS`, `EntityNameHS`, `FieldNameHS`. Decomposed `DBName` into `ConstraintNameDB`, `EntityNameDB`, `FieldNameDB` respectively. [#1174](https://github.com/yesodweb/persistent/pull/1174)

diff --git a/persistent-mysql/Database/Persist/MySQL.hs b/persistent-mysql/Database/Persist/MySQL.hs
@@ -26,8 +26,6 @@ module Database.Persist.MySQL
     , insertOnDuplicateKeyUpdate
     , insertManyOnDuplicateKeyUpdate
     , HandleUpdateCollision
-    , pattern SomeField
-    , SomeField
     , copyField
     , copyUnlessNull
     , copyUnlessEmpty
@@ -72,6 +70,7 @@ import qualified Data.Text.IO as T
 import System.Environment (getEnvironment)
 
 import Database.Persist.Sql
+import Database.Persist.SqlBackend
 import Database.Persist.Sql.Types.Internal (makeIsolationLevelStatement)
 import qualified Database.Persist.Sql.Util as Util
 
@@ -86,73 +85,71 @@ import qualified Database.MySQL.Simple.Types  as MySQL
 -- 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 :: (MonadLoggerIO m, MonadUnliftIO m)
-              => MySQL.ConnectInfo
-              -- ^ Connection information.
-              -> Int
-              -- ^ Number of connections to be kept open in the pool.
-              -> (Pool SqlBackend -> m a)
-              -- ^ Action to be executed that uses the connection pool.
-              -> m a
+withMySQLPool
+    :: (MonadLoggerIO m, MonadUnliftIO m)
+    => MySQL.ConnectInfo
+    -- ^ Connection information.
+    -> Int
+    -- ^ Number of connections to be kept open in the pool.
+    -> (Pool SqlBackend -> m a)
+    -- ^ Action to be executed that uses the connection pool.
+    -> m a
 withMySQLPool ci = withSqlPool $ open' ci
 
-
 -- | 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 :: (MonadUnliftIO m, MonadLoggerIO m)
-                => MySQL.ConnectInfo
-                -- ^ Connection information.
-                -> Int
-                -- ^ Number of connections to be kept open in the pool.
-                -> m (Pool SqlBackend)
+createMySQLPool
+    :: (MonadUnliftIO m, MonadLoggerIO m)
+    => MySQL.ConnectInfo
+    -- ^ Connection information.
+    -> Int
+    -- ^ Number of connections to be kept open in the pool.
+    -> m (Pool SqlBackend)
 createMySQLPool ci = createSqlPool $ open' ci
 
-
 -- | Same as 'withMySQLPool', but instead of opening a pool
 -- of connections, only one connection is opened.
-withMySQLConn :: (MonadUnliftIO m, MonadLoggerIO m)
-              => MySQL.ConnectInfo
-              -- ^ Connection information.
-              -> (SqlBackend -> m a)
-              -- ^ Action to be executed that uses the connection.
-              -> m a
+withMySQLConn
+    :: (MonadUnliftIO m, MonadLoggerIO m)
+    => MySQL.ConnectInfo
+    -- ^ Connection information.
+    -> (SqlBackend -> m a)
+    -- ^ Action to be executed that uses the connection.
+    -> m a
 withMySQLConn = withSqlConn . open'
 
-
 -- | Internal function that opens a connection to the MySQL
 -- server.
 open' :: MySQL.ConnectInfo -> LogFunc -> IO SqlBackend
 open' ci logFunc = do
     conn <- MySQL.connect ci
     MySQLBase.autocommit conn False -- disable autocommit!
     smap <- newIORef $ Map.empty
-    return $ SqlBackend
-        { connPrepare    = prepare' conn
-        , connStmtMap    = smap
-        , connInsertSql  = insertSql'
-        , connInsertManySql = Nothing
-        , connUpsertSql = Nothing
-        , connPutManySql = Just putManySql
-        , connClose      = MySQL.close conn
-        , connMigrateSql = migrate' ci
-        , 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
-        , connEscapeFieldName = T.pack . escapeF
-        , connEscapeTableName = T.pack . escapeE . entityDB
-        , connEscapeRawName = T.pack . escapeDBName . T.unpack
-        , connNoLimit    = "LIMIT 18446744073709551615"
-        -- This noLimit is suggested by MySQL's own docs, see
-        -- <http://dev.mysql.com/doc/refman/5.5/en/select.html>
-        , connRDBMS      = "mysql"
-        , connLimitOffset = decorateSQLWithLimitOffset "LIMIT 18446744073709551615"
-        , connLogFunc    = logFunc
-        , connMaxParams = Nothing
-        , connRepsertManySql = Just repsertManySql
-        }
+    return $
+        setConnPutManySql putManySql $
+        setConnRepsertManySql repsertManySql $
+        mkSqlBackend MkSqlBackendArgs
+            { connPrepare    = prepare' conn
+            , connStmtMap    = smap
+            , connInsertSql  = insertSql'
+            , connClose      = MySQL.close conn
+            , connMigrateSql = migrate' ci
+            , 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
+            , connEscapeFieldName = T.pack . escapeF
+            , connEscapeTableName = T.pack . escapeE . entityDB
+            , connEscapeRawName = T.pack . escapeDBName . T.unpack
+            , connNoLimit    = "LIMIT 18446744073709551615"
+            -- This noLimit is suggested by MySQL's own docs, see
+            -- <http://dev.mysql.com/doc/refman/5.5/en/select.html>
+            , connRDBMS      = "mysql"
+            , connLimitOffset = decorateSQLWithLimitOffset "LIMIT 18446744073709551615"
+            , connLogFunc    = logFunc
+            }
 
 -- | Prepare a query.  We don't support prepared statements, but
 -- we'll do some client-side preprocessing here.
@@ -1244,37 +1241,34 @@ mockMigrate _connectInfo allDefs _getter val = do
 -- the actual database isn't already present in the system.
 mockMigration :: Migration -> IO ()
 mockMigration mig = do
-  smap <- newIORef $ Map.empty
-  let sqlbackend = SqlBackend { connPrepare = \_ -> do
-                                             return Statement
-                                                        { stmtFinalize = return ()
-                                                        , stmtReset = return ()
-                                                        , stmtExecute = undefined
-                                                        , stmtQuery = \_ -> return $ return ()
-                                                        },
-                             connInsertManySql = Nothing,
-                             connInsertSql = undefined,
-                             connStmtMap = smap,
-                             connClose = undefined,
-                             connMigrateSql = mockMigrate undefined,
-                             connBegin = undefined,
-                             connCommit = undefined,
-                             connRollback = undefined,
-                             connEscapeFieldName = T.pack . escapeDBName . T.unpack . unFieldNameDB,
-                             connEscapeTableName = T.pack . escapeDBName . T.unpack . unEntityNameDB . entityDB,
-                             connEscapeRawName = T.pack . escapeDBName . T.unpack,
-                             connNoLimit = undefined,
-                             connRDBMS = undefined,
-                             connLimitOffset = undefined,
-                             connLogFunc = undefined,
-                             connUpsertSql = undefined,
-                             connPutManySql = undefined,
-                             connMaxParams = Nothing,
-                             connRepsertManySql = Nothing
-                             }
-      result = runReaderT . runWriterT . runWriterT $ mig
-  resp <- result sqlbackend
-  mapM_ T.putStrLn $ map snd $ snd resp
+    smap <- newIORef $ Map.empty
+    let sqlbackend =
+            mkSqlBackend MkSqlBackendArgs
+                { connPrepare = \_ -> do
+                    return Statement
+                        { stmtFinalize = return ()
+                        , stmtReset = return ()
+                        , stmtExecute = undefined
+                        , stmtQuery = \_ -> return $ return ()
+                        }
+                , connInsertSql = undefined
+                , connStmtMap = smap
+                , connClose = undefined
+                , connMigrateSql = mockMigrate undefined
+                , connBegin = undefined
+                , connCommit = undefined
+                , connRollback = undefined
+                , connEscapeFieldName = T.pack . escapeDBName . T.unpack . unFieldNameDB
+                , connEscapeTableName = T.pack . escapeDBName . T.unpack . unEntityNameDB . entityDB
+                , connEscapeRawName = T.pack . escapeDBName . T.unpack
+                , connNoLimit = undefined
+                , connRDBMS = undefined
+                , connLimitOffset = undefined
+                , connLogFunc = undefined
+                }
+        result = runReaderT . runWriterT . runWriterT $ mig
+    resp <- result sqlbackend
+    mapM_ T.putStrLn $ map snd $ snd resp
 
 -- | 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
@@ -1299,21 +1293,10 @@ insertOnDuplicateKeyUpdate record =
 --
 -- @since 2.8.0
 data HandleUpdateCollision record where
-  -- | Copy the field directly from the 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 -> 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
-
-pattern SomeField :: EntityField record typ -> SomeField record
-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 directly from the 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 -> HandleUpdateCollision record
 
 -- | Copy the field into the database only if the value in the
 -- corresponding record is non-@NULL@.

diff --git a/persistent-mysql/persistent-mysql.cabal b/persistent-mysql/persistent-mysql.cabal
@@ -1,5 +1,5 @@
 name:            persistent-mysql
-version:         2.12.0.0
+version:         2.13.0.0
 license:         MIT
 license-file:    LICENSE
 author:          Felipe Lessa <felipe.lessa@gmail.com>, Michael Snoyman
@@ -28,7 +28,7 @@ extra-source-files: ChangeLog.md
 
 library
     build-depends:   base             >= 4.9      && < 5
-                   , persistent       >= 2.12   && < 3
+                   , persistent       >= 2.13   && < 3
                    , aeson            >= 1.0
                    , blaze-builder
                    , bytestring       >= 0.10.8

diff --git a/persistent-postgresql/ChangeLog.md b/persistent-postgresql/ChangeLog.md
@@ -1,5 +1,11 @@
 # Changelog for persistent-postgresql
 
+
+## 2.13.0.0 (unreleased)
+
+* [#1225](https://github.com/yesodweb/persistent/pull/1225)
+    * Support `persistent-2.13.0.0` making SQlBackend internal
+
 # 2.12.1.1
 
 * [#1235](https://github.com/yesodweb/persistent/pull/1235)

diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs
@@ -103,6 +103,7 @@ import Data.Time (NominalDiffTime, localTimeToUTC, utc)
 import System.Environment (getEnvironment)
 
 import Database.Persist.Sql
+import Database.Persist.SqlBackend
 import qualified Database.Persist.Sql.Util as Util
 
 -- | A @libpq@ connection string.  A simple example of connection
@@ -348,14 +349,15 @@ openSimpleConnWithVersion getVerDouble logFunc conn = do
 -- and connection.
 createBackend :: LogFunc -> NonEmpty Word
               -> IORef (Map.Map Text Statement) -> PG.Connection -> SqlBackend
-createBackend logFunc serverVersion smap conn = do
-    SqlBackend
+createBackend logFunc serverVersion smap conn =
+    maybe id setConnPutManySql (upsertFunction putManySql serverVersion) $
+    maybe id setConnUpsertSql (upsertFunction upsertSql' serverVersion) $
+    setConnInsertManySql insertManySql' $
+    maybe id setConnRepsertManySql (upsertFunction repsertManySql serverVersion) $
+    mkSqlBackend MkSqlBackendArgs
         { connPrepare    = prepare' conn
         , connStmtMap    = smap
         , connInsertSql  = insertSql'
-        , connInsertManySql = Just insertManySql'
-        , connUpsertSql  = upsertFunction upsertSql' serverVersion
-        , connPutManySql = upsertFunction putManySql serverVersion
         , connClose      = PG.close conn
         , connMigrateSql = migrate'
         , connBegin      = \_ mIsolation -> case mIsolation of
@@ -374,8 +376,6 @@ createBackend logFunc serverVersion smap conn = do
         , connRDBMS      = "postgresql"
         , connLimitOffset = decorateSQLWithLimitOffset "LIMIT ALL"
         , connLogFunc = logFunc
-        , connMaxParams = Nothing
-        , connRepsertManySql = upsertFunction repsertManySql serverVersion
         }
 
 prepare' :: PG.Connection -> Text -> IO Statement
@@ -1706,37 +1706,34 @@ mockMigrate allDefs _ entity = fmap (fmap $ map showAlterDb) $ do
 -- with the difference that an actual database is not needed.
 mockMigration :: Migration -> IO ()
 mockMigration mig = do
-  smap <- newIORef $ Map.empty
-  let sqlbackend = SqlBackend { connPrepare = \_ -> do
-                                             return Statement
-                                                        { stmtFinalize = return ()
-                                                        , stmtReset = return ()
-                                                        , stmtExecute = undefined
-                                                        , stmtQuery = \_ -> return $ return ()
-                                                        },
-                             connInsertManySql = Nothing,
-                             connInsertSql = undefined,
-                             connUpsertSql = Nothing,
-                             connPutManySql = Nothing,
-                             connStmtMap = smap,
-                             connClose = undefined,
-                             connMigrateSql = mockMigrate,
-                             connBegin = undefined,
-                             connCommit = undefined,
-                             connRollback = undefined,
-                             connEscapeFieldName = escapeF,
-                             connEscapeTableName = escapeE . entityDB,
-                             connEscapeRawName = escape,
-                             connNoLimit = undefined,
-                             connRDBMS = undefined,
-                             connLimitOffset = undefined,
-                             connLogFunc = undefined,
-                             connMaxParams = Nothing,
-                             connRepsertManySql = Nothing
-                             }
-      result = runReaderT $ runWriterT $ runWriterT mig
-  resp <- result sqlbackend
-  mapM_ T.putStrLn $ map snd $ snd resp
+    smap <- newIORef $ Map.empty
+    let sqlbackend =
+            mkSqlBackend MkSqlBackendArgs
+                { connPrepare = \_ -> do
+                    return Statement
+                        { stmtFinalize = return ()
+                        , stmtReset = return ()
+                        , stmtExecute = undefined
+                        , stmtQuery = \_ -> return $ return ()
+                        }
+                , connInsertSql = undefined
+                , connStmtMap = smap
+                , connClose = undefined
+                , connMigrateSql = mockMigrate
+                , connBegin = undefined
+                , connCommit = undefined
+                , connRollback = undefined
+                , connEscapeFieldName = escapeF
+                , connEscapeTableName = escapeE . entityDB
+                , connEscapeRawName = escape
+                , connNoLimit = undefined
+                , connRDBMS = undefined
+                , connLimitOffset = undefined
+                , connLogFunc = undefined
+                }
+        result = runReaderT $ runWriterT $ runWriterT mig
+    resp <- result sqlbackend
+    mapM_ T.putStrLn $ map snd $ snd resp
 
 putManySql :: EntityDef -> Int -> Text
 putManySql ent n = putManySql' conflictColumns fields ent n
@@ -2025,7 +2022,5 @@ migrateEnableExtension extName = WriterT $ WriterT $ do
 
 postgresMkColumns :: [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])
 postgresMkColumns allDefs t =
-    mkColumns allDefs t (emptyBackendSpecificOverrides
-        { backendSpecificForeignKeyName = Just refName
-        }
-    )
+    mkColumns allDefs t
+    $ setBackendSpecificForeignKeyName refName emptyBackendSpecificOverrides
diff --git a/persistent-postgresql/persistent-postgresql.cabal b/persistent-postgresql/persistent-postgresql.cabal
@@ -1,5 +1,5 @@
 name:            persistent-postgresql
-version:         2.12.1.1
+version:         2.13.0.0
 license:         MIT
 license-file:    LICENSE
 author:          Felipe Lessa, Michael Snoyman <michael@snoyman.com>
@@ -16,7 +16,7 @@ extra-source-files: ChangeLog.md
 
 library
     build-depends:   base                  >= 4.9      && < 5
-                   , persistent            >= 2.12.1.0 && < 2.13
+                   , persistent            >= 2.13     && < 3
                    , aeson                 >= 1.0
                    , attoparsec
                    , blaze-builder