From f69716dcfeca01896ec42dec874393fbe60d3939 Mon Sep 17 00:00:00 2001 From: Mitchell Vitez Date: Wed, 6 Jan 2021 15:37:05 -0500 Subject: [PATCH] Replace askLogFunc with askLoggerIO (#1162) * replace askLogFunc with askLoggerIO * overly aggressive find and replace * changelog * import MonadLoggerIO * changelog -> 2.12 Co-authored-by: Matt Parsons --- persistent-mysql/Database/Persist/MySQL.hs | 8 ++--- .../Database/Persist/Postgresql.hs | 20 ++++++------ persistent-sqlite/Database/Persist/Sqlite.hs | 31 +++++++++---------- persistent/ChangeLog.md | 5 +-- persistent/Database/Persist/Sql/Run.hs | 24 +++++--------- 5 files changed, 39 insertions(+), 49 deletions(-) diff --git a/persistent-mysql/Database/Persist/MySQL.hs b/persistent-mysql/Database/Persist/MySQL.hs index a6c6bb9b9..bfe43aed7 100644 --- a/persistent-mysql/Database/Persist/MySQL.hs +++ b/persistent-mysql/Database/Persist/MySQL.hs @@ -41,7 +41,7 @@ import Control.Arrow import Control.Monad import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.IO.Unlift (MonadUnliftIO) -import Control.Monad.Logger (MonadLogger, runNoLoggingT) +import Control.Monad.Logger (MonadLoggerIO, runNoLoggingT) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT, runExceptT) import Control.Monad.Trans.Reader (runReaderT, ReaderT) @@ -86,7 +86,7 @@ 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 :: (MonadLogger m, MonadUnliftIO m) +withMySQLPool :: (MonadLoggerIO m, MonadUnliftIO m) => MySQL.ConnectInfo -- ^ Connection information. -> Int @@ -100,7 +100,7 @@ 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, MonadLogger m) +createMySQLPool :: (MonadUnliftIO m, MonadLoggerIO m) => MySQL.ConnectInfo -- ^ Connection information. -> Int @@ -111,7 +111,7 @@ createMySQLPool ci = createSqlPool $ open' ci -- | Same as 'withMySQLPool', but instead of opening a pool -- of connections, only one connection is opened. -withMySQLConn :: (MonadUnliftIO m, MonadLogger m) +withMySQLConn :: (MonadUnliftIO m, MonadLoggerIO m) => MySQL.ConnectInfo -- ^ Connection information. -> (SqlBackend -> m a) diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs index 70660d36a..550732a27 100644 --- a/persistent-postgresql/Database/Persist/Postgresql.hs +++ b/persistent-postgresql/Database/Persist/Postgresql.hs @@ -49,7 +49,7 @@ import Control.Exception (Exception, throw, throwIO) import Control.Monad import Control.Monad.Except import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO) -import Control.Monad.Logger (MonadLogger, runNoLoggingT) +import Control.Monad.Logger (MonadLoggerIO, runNoLoggingT) import Control.Monad.Trans.Reader (runReaderT) import Control.Monad.Trans.Writer (WriterT(..), runWriterT) @@ -116,7 +116,7 @@ instance Exception PostgresServerVersionError -- have been released. -- The provided action should use 'runSqlConn' and *not* 'runReaderT' because -- the former brackets the database action with transaction begin/commit. -withPostgresqlPool :: (MonadLogger m, MonadUnliftIO m) +withPostgresqlPool :: (MonadLoggerIO m, MonadUnliftIO m) => ConnectionString -- ^ Connection string to the database. -> Int @@ -132,7 +132,7 @@ withPostgresqlPool ci = withPostgresqlPoolWithVersion getServerVersion ci -- the server version (to work around an Amazon Redshift bug). -- -- @since 2.6.2 -withPostgresqlPoolWithVersion :: (MonadUnliftIO m, MonadLogger m) +withPostgresqlPoolWithVersion :: (MonadUnliftIO m, MonadLoggerIO m) => (PG.Connection -> IO (Maybe Double)) -- ^ Action to perform to get the server version. -> ConnectionString @@ -151,7 +151,7 @@ withPostgresqlPoolWithVersion getVerDouble ci = do -- | Same as 'withPostgresqlPool', but can be configured with 'PostgresConf' and 'PostgresConfHooks'. -- -- @since 2.11.0.0 -withPostgresqlPoolWithConf :: (MonadUnliftIO m, MonadLogger m) +withPostgresqlPoolWithConf :: (MonadUnliftIO m, MonadLoggerIO m) => PostgresConf -- ^ Configuration for connecting to Postgres -> PostgresConfHooks -- ^ Record of callback functions -> (Pool SqlBackend -> m a) @@ -168,7 +168,7 @@ withPostgresqlPoolWithConf conf hooks = do -- responsibility to properly close the connection pool when -- unneeded. Use 'withPostgresqlPool' for an automatic resource -- control. -createPostgresqlPool :: (MonadUnliftIO m, MonadLogger m) +createPostgresqlPool :: (MonadUnliftIO m, MonadLoggerIO m) => ConnectionString -- ^ Connection string to the database. -> Int @@ -186,7 +186,7 @@ createPostgresqlPool = createPostgresqlPoolModified (const $ return ()) -- -- @since 2.1.3 createPostgresqlPoolModified - :: (MonadUnliftIO m, MonadLogger m) + :: (MonadUnliftIO m, MonadLoggerIO m) => (PG.Connection -> IO ()) -- ^ Action to perform after connection is created. -> ConnectionString -- ^ Connection string to the database. -> Int -- ^ Number of connections to be kept open in the pool. @@ -199,7 +199,7 @@ createPostgresqlPoolModified = createPostgresqlPoolModifiedWithVersion getServer -- -- @since 2.6.2 createPostgresqlPoolModifiedWithVersion - :: (MonadUnliftIO m, MonadLogger m) + :: (MonadUnliftIO m, MonadLoggerIO m) => (PG.Connection -> IO (Maybe Double)) -- ^ Action to perform to get the server version. -> (PG.Connection -> IO ()) -- ^ Action to perform after connection is created. -> ConnectionString -- ^ Connection string to the database. @@ -213,7 +213,7 @@ createPostgresqlPoolModifiedWithVersion getVerDouble modConn ci = do -- -- @since 2.11.0.0 createPostgresqlPoolWithConf - :: (MonadUnliftIO m, MonadLogger m) + :: (MonadUnliftIO m, MonadLoggerIO m) => PostgresConf -- ^ Configuration for connecting to Postgres -> PostgresConfHooks -- ^ Record of callback functions -> m (Pool SqlBackend) @@ -234,7 +234,7 @@ postgresConfToConnectionPoolConfig conf = -- of connections, only one connection is opened. -- The provided action should use 'runSqlConn' and *not* 'runReaderT' because -- the former brackets the database action with transaction begin/commit. -withPostgresqlConn :: (MonadUnliftIO m, MonadLogger m) +withPostgresqlConn :: (MonadUnliftIO m, MonadLoggerIO m) => ConnectionString -> (SqlBackend -> m a) -> m a withPostgresqlConn = withPostgresqlConnWithVersion getServerVersion @@ -242,7 +242,7 @@ withPostgresqlConn = withPostgresqlConnWithVersion getServerVersion -- the server version (to work around an Amazon Redshift bug). -- -- @since 2.6.2 -withPostgresqlConnWithVersion :: (MonadUnliftIO m, MonadLogger m) +withPostgresqlConnWithVersion :: (MonadUnliftIO m, MonadLoggerIO m) => (PG.Connection -> IO (Maybe Double)) -> ConnectionString -> (SqlBackend -> m a) diff --git a/persistent-sqlite/Database/Persist/Sqlite.hs b/persistent-sqlite/Database/Persist/Sqlite.hs index bda8db16c..d9bfefc7d 100644 --- a/persistent-sqlite/Database/Persist/Sqlite.hs +++ b/persistent-sqlite/Database/Persist/Sqlite.hs @@ -50,7 +50,7 @@ import Control.Concurrent (threadDelay) import qualified Control.Exception as E import Control.Monad (forM_) import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO, askRunInIO, withRunInIO, withUnliftIO, unliftIO, withRunInIO) -import Control.Monad.Logger (NoLoggingT, runNoLoggingT, MonadLogger, logWarn, runLoggingT) +import Control.Monad.Logger (NoLoggingT, runNoLoggingT, MonadLoggerIO, logWarn, runLoggingT, askLoggerIO) import Control.Monad.Trans.Reader (ReaderT, runReaderT, withReaderT) import Control.Monad.Trans.Writer (runWriterT) import Data.Acquire (Acquire, mkAcquire, with) @@ -62,7 +62,6 @@ import qualified Data.Conduit.List as CL import qualified Data.HashMap.Lazy as HashMap import Data.Int (Int64) import Data.IORef -import qualified Data.List as List import qualified Data.Map as Map import Data.Monoid ((<>)) import Data.Pool (Pool) @@ -82,7 +81,7 @@ import qualified Database.Sqlite as Sqlite -- Note that this should not be used with the @:memory:@ connection string, as -- the pool will regularly remove connections, destroying your database. -- Instead, use 'withSqliteConn'. -createSqlitePool :: (MonadLogger m, MonadUnliftIO m) +createSqlitePool :: (MonadLoggerIO m, MonadUnliftIO m) => Text -> Int -> m (Pool SqlBackend) createSqlitePool = createSqlitePoolFromInfo . conStringToInfo @@ -93,14 +92,14 @@ createSqlitePool = createSqlitePoolFromInfo . conStringToInfo -- Instead, use 'withSqliteConn'. -- -- @since 2.6.2 -createSqlitePoolFromInfo :: (MonadLogger m, MonadUnliftIO m) +createSqlitePoolFromInfo :: (MonadLoggerIO m, MonadUnliftIO m) => SqliteConnectionInfo -> Int -> m (Pool SqlBackend) createSqlitePoolFromInfo connInfo = createSqlPool $ openWith const connInfo -- | Run the given action with a connection pool. -- -- Like 'createSqlitePool', this should not be used with @:memory:@. -withSqlitePool :: (MonadUnliftIO m, MonadLogger m) +withSqlitePool :: (MonadUnliftIO m, MonadLoggerIO m) => Text -> Int -- ^ number of connections to open -> (Pool SqlBackend -> m a) -> m a @@ -111,18 +110,18 @@ withSqlitePool connInfo = withSqlPool . openWith const $ conStringToInfo connInf -- Like 'createSqlitePool', this should not be used with @:memory:@. -- -- @since 2.6.2 -withSqlitePoolInfo :: (MonadUnliftIO m, MonadLogger m) +withSqlitePoolInfo :: (MonadUnliftIO m, MonadLoggerIO m) => SqliteConnectionInfo -> Int -- ^ number of connections to open -> (Pool SqlBackend -> m a) -> m a withSqlitePoolInfo connInfo = withSqlPool $ openWith const connInfo -withSqliteConn :: (MonadUnliftIO m, MonadLogger m) +withSqliteConn :: (MonadUnliftIO m, MonadLoggerIO m) => Text -> (SqlBackend -> m a) -> m a withSqliteConn = withSqliteConnInfo . conStringToInfo -- | @since 2.6.2 -withSqliteConnInfo :: (MonadUnliftIO m, MonadLogger m) +withSqliteConnInfo :: (MonadUnliftIO m, MonadLoggerIO m) => SqliteConnectionInfo -> (SqlBackend -> m a) -> m a withSqliteConnInfo = withSqlConn . openWith const @@ -185,7 +184,7 @@ wrapConnection = wrapConnectionInfo (mkSqliteConnectionInfo "") -- | Retry if a Busy is thrown, following an exponential backoff strategy. -- -- @since 2.9.3 -retryOnBusy :: (MonadUnliftIO m, MonadLogger m) => m a -> m a +retryOnBusy :: (MonadUnliftIO m, MonadLoggerIO m) => m a -> m a retryOnBusy action = start $ take 20 $ delays 1000 where @@ -211,7 +210,7 @@ retryOnBusy action = -- -- @since 2.9.3 waitForDatabase - :: (MonadUnliftIO m, MonadLogger m, BackendCompatible SqlBackend backend) + :: (MonadUnliftIO m, MonadLoggerIO m, BackendCompatible SqlBackend backend) => ReaderT backend m () waitForDatabase = retryOnBusy $ rawExecute "SELECT 42" [] @@ -770,12 +769,12 @@ instance FromJSON SqliteConnectionInfo where -- -- @since 2.10.2 withRawSqliteConnInfo - :: (MonadUnliftIO m, MonadLogger m) + :: (MonadUnliftIO m, MonadLoggerIO m) => SqliteConnectionInfo -> (RawSqlite SqlBackend -> m a) -> m a withRawSqliteConnInfo connInfo f = do - logFunc <- askLogFunc + logFunc <- askLoggerIO withRunInIO $ \run -> E.bracket (openBackend logFunc) closeBackend $ run . f where openBackend = openWith RawSqlite connInfo @@ -790,7 +789,7 @@ withRawSqliteConnInfo connInfo f = do -- -- @since 2.10.6 createRawSqlitePoolFromInfo - :: (MonadLogger m, MonadUnliftIO m) + :: (MonadLoggerIO m, MonadUnliftIO m) => SqliteConnectionInfo -> (RawSqlite SqlBackend -> m ()) -- ^ An action that is run whenever a new `RawSqlite` connection is @@ -811,7 +810,7 @@ createRawSqlitePoolFromInfo connInfo f n = do -- -- @since 2.10.6 createRawSqlitePoolFromInfo_ - :: (MonadLogger m, MonadUnliftIO m) + :: (MonadLoggerIO m, MonadUnliftIO m) => SqliteConnectionInfo -> Int -> m (Pool (RawSqlite SqlBackend)) createRawSqlitePoolFromInfo_ connInfo = createRawSqlitePoolFromInfo connInfo (const (return ())) @@ -820,7 +819,7 @@ createRawSqlitePoolFromInfo_ connInfo = -- -- @since 2.10.6 withRawSqlitePoolInfo - :: (MonadUnliftIO m, MonadLogger m) + :: (MonadUnliftIO m, MonadLoggerIO m) => SqliteConnectionInfo -> (RawSqlite SqlBackend -> m ()) -> Int -- ^ number of connections to open @@ -838,7 +837,7 @@ withRawSqlitePoolInfo connInfo f n work = do -- -- @since 2.10.6 withRawSqlitePoolInfo_ - :: (MonadUnliftIO m, MonadLogger m) + :: (MonadUnliftIO m, MonadLoggerIO m) => SqliteConnectionInfo -> Int -- ^ number of connections to open -> (Pool (RawSqlite SqlBackend) -> m a) diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md index 67ce507e1..1d3bad065 100644 --- a/persistent/ChangeLog.md +++ b/persistent/ChangeLog.md @@ -1,11 +1,12 @@ # Changelog for persistent -## 2.12.0.0 +## 2.12 +* [#1162](https://github.com/yesodweb/persistent/pull/1162) + * Replace `askLogFunc` with `askLoggerIO` * Decomposed `HaskellName` into `ConstraintNameHS`, `EntityNameHS`, `FieldNameHS`. Decomposed `DBName` into `ConstraintNameDB`, `EntityNameDB`, `FieldNameDB` respectively. [#1174](https://github.com/yesodweb/persistent/pull/1174) ## 2.11.0.2 - * Fix a bug where an empty entity definition would break parsing of `EntityDef`s. [#1176](https://github.com/yesodweb/persistent/issues/1176) ## 2.11.0.1 diff --git a/persistent/Database/Persist/Sql/Run.hs b/persistent/Database/Persist/Sql/Run.hs index 2615fba25..33923084f 100644 --- a/persistent/Database/Persist/Sql/Run.hs +++ b/persistent/Database/Persist/Sql/Run.hs @@ -192,7 +192,7 @@ liftSqlPersistMPool liftSqlPersistMPool x pool = liftIO (runSqlPersistMPool x pool) withSqlPool - :: forall backend m a. (MonadLogger m, MonadUnliftIO m, BackendCompatible SqlBackend backend) + :: forall backend m a. (MonadLoggerIO m, MonadUnliftIO m, BackendCompatible SqlBackend backend) => (LogFunc -> IO backend) -- ^ create a new connection -> Int -- ^ connection count -> (Pool backend -> m a) @@ -204,7 +204,7 @@ withSqlPool mkConn connCount f = withSqlPoolWithConfig mkConn (defaultConnection -- -- @since 2.11.0.0 withSqlPoolWithConfig - :: forall backend m a. (MonadLogger m, MonadUnliftIO m, BackendCompatible SqlBackend backend) + :: forall backend m a. (MonadLoggerIO m, MonadUnliftIO m, BackendCompatible SqlBackend backend) => (LogFunc -> IO backend) -- ^ Function to create a new connection -> ConnectionPoolConfig -> (Pool backend -> m a) @@ -215,7 +215,7 @@ withSqlPoolWithConfig mkConn poolConfig f = withUnliftIO $ \u -> bracket (unliftIO u . f) createSqlPool - :: forall backend m. (MonadLogger m, MonadUnliftIO m, BackendCompatible SqlBackend backend) + :: forall backend m. (MonadLoggerIO m, MonadUnliftIO m, BackendCompatible SqlBackend backend) => (LogFunc -> IO backend) -> Int -> m (Pool backend) @@ -225,12 +225,12 @@ createSqlPool mkConn size = createSqlPoolWithConfig mkConn (defaultConnectionPoo -- -- @since 2.11.0.0 createSqlPoolWithConfig - :: forall m backend. (MonadLogger m, MonadUnliftIO m, BackendCompatible SqlBackend backend) + :: forall m backend. (MonadLoggerIO m, MonadUnliftIO m, BackendCompatible SqlBackend backend) => (LogFunc -> IO backend) -- ^ Function to create a new connection -> ConnectionPoolConfig -> m (Pool backend) createSqlPoolWithConfig mkConn config = do - logFunc <- askLogFunc + logFunc <- askLoggerIO -- Resource pool will swallow any exceptions from close. We want to log -- them instead. let loggedClose :: backend -> IO () @@ -244,16 +244,6 @@ createSqlPoolWithConfig mkConn config = do (connectionPoolConfigIdleTimeout config) (connectionPoolConfigSize config) --- NOTE: This function is a terrible, ugly hack. It would be much better to --- just clean up monad-logger. --- --- FIXME: in a future release, switch over to the new askLoggerIO function --- added in monad-logger 0.3.10. That function was not available at the time --- this code was written. -askLogFunc :: forall m. (MonadUnliftIO m, MonadLogger m) => m LogFunc -askLogFunc = withRunInIO $ \run -> - return $ \a b c d -> run (monadLoggerLog a b c d) - -- | Create a connection and run sql queries within it. This function -- automatically closes the connection on it's completion. -- @@ -307,10 +297,10 @@ askLogFunc = withRunInIO $ \run -> -- withSqlConn - :: forall backend m a. (MonadUnliftIO m, MonadLogger m, BackendCompatible SqlBackend backend) + :: forall backend m a. (MonadUnliftIO m, MonadLoggerIO m, BackendCompatible SqlBackend backend) => (LogFunc -> IO backend) -> (backend -> m a) -> m a withSqlConn open f = do - logFunc <- askLogFunc + logFunc <- askLoggerIO withRunInIO $ \run -> bracket (open logFunc) close'