module Database.Persist.SqlBackend.SqlPoolHooks
  ( SqlPoolHooks
  , defaultSqlPoolHooks
  , getAlterBackend
  , modifyAlterBackend
  , setAlterBackend
  , getRunBefore
  , modifyRunBefore
  , setRunBefore
  , getRunAfter
  , modifyRunAfter
  , setRunAfter
  , getRunOnException
  )
  where

import Control.Exception
import Control.Monad.IO.Class
import Database.Persist.Sql.Raw
import Database.Persist.SqlBackend.Internal
import Database.Persist.SqlBackend.Internal.SqlPoolHooks
import Database.Persist.SqlBackend.Internal.IsolationLevel
import Database.Persist.Class.PersistStore

-- | Lifecycle hooks that may be altered to extend SQL pool behavior
-- in a backwards compatible fashion.
--
-- By default, the hooks have the following semantics:
--
-- - 'alterBackend' has no effect
-- - 'runBefore' begins a transaction
-- - 'runAfter' commits the current transaction
-- - 'runOnException' rolls back the current transaction
--
-- @since 2.13.3.0
defaultSqlPoolHooks :: (MonadIO m, BackendCompatible SqlBackend backend) => SqlPoolHooks m backend
defaultSqlPoolHooks :: SqlPoolHooks m backend
defaultSqlPoolHooks = SqlPoolHooks :: forall (m :: * -> *) backend.
(backend -> m backend)
-> (backend -> Maybe IsolationLevel -> m ())
-> (backend -> Maybe IsolationLevel -> m ())
-> (backend -> Maybe IsolationLevel -> SomeException -> m ())
-> SqlPoolHooks m backend
SqlPoolHooks
    { alterBackend :: backend -> m backend
alterBackend = backend -> m backend
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    , runBefore :: backend -> Maybe IsolationLevel -> m ()
runBefore = \backend
conn Maybe IsolationLevel
mi -> do
        let sqlBackend :: SqlBackend
sqlBackend = backend -> SqlBackend
forall sup sub. BackendCompatible sup sub => sub -> sup
projectBackend backend
conn
        let getter :: Text -> IO Statement
getter = SqlBackend -> Text -> IO Statement
getStmtConn SqlBackend
sqlBackend
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SqlBackend
-> (Text -> IO Statement) -> Maybe IsolationLevel -> IO ()
connBegin SqlBackend
sqlBackend Text -> IO Statement
getter Maybe IsolationLevel
mi
    , runAfter :: backend -> Maybe IsolationLevel -> m ()
runAfter = \backend
conn Maybe IsolationLevel
_ -> do
        let sqlBackend :: SqlBackend
sqlBackend = backend -> SqlBackend
forall sup sub. BackendCompatible sup sub => sub -> sup
projectBackend backend
conn
        let getter :: Text -> IO Statement
getter = SqlBackend -> Text -> IO Statement
getStmtConn SqlBackend
sqlBackend
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SqlBackend -> (Text -> IO Statement) -> IO ()
connCommit SqlBackend
sqlBackend Text -> IO Statement
getter
    , runOnException :: backend -> Maybe IsolationLevel -> SomeException -> m ()
runOnException = \backend
conn Maybe IsolationLevel
_ SomeException
_ -> do
        let sqlBackend :: SqlBackend
sqlBackend = backend -> SqlBackend
forall sup sub. BackendCompatible sup sub => sub -> sup
projectBackend backend
conn
        let getter :: Text -> IO Statement
getter = SqlBackend -> Text -> IO Statement
getStmtConn SqlBackend
sqlBackend
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SqlBackend -> (Text -> IO Statement) -> IO ()
connRollback SqlBackend
sqlBackend Text -> IO Statement
getter
    }

getAlterBackend :: SqlPoolHooks m backend -> (backend -> m backend)
getAlterBackend :: SqlPoolHooks m backend -> backend -> m backend
getAlterBackend = SqlPoolHooks m backend -> backend -> m backend
forall (m :: * -> *) backend.
SqlPoolHooks m backend -> backend -> m backend
alterBackend

modifyAlterBackend :: SqlPoolHooks m backend -> ((backend -> m backend) -> (backend -> m backend)) -> SqlPoolHooks m backend
modifyAlterBackend :: SqlPoolHooks m backend
-> ((backend -> m backend) -> backend -> m backend)
-> SqlPoolHooks m backend
modifyAlterBackend SqlPoolHooks m backend
hooks (backend -> m backend) -> backend -> m backend
f = SqlPoolHooks m backend
hooks { alterBackend :: backend -> m backend
alterBackend = (backend -> m backend) -> backend -> m backend
f ((backend -> m backend) -> backend -> m backend)
-> (backend -> m backend) -> backend -> m backend
forall a b. (a -> b) -> a -> b
$ SqlPoolHooks m backend -> backend -> m backend
forall (m :: * -> *) backend.
SqlPoolHooks m backend -> backend -> m backend
alterBackend SqlPoolHooks m backend
hooks }

setAlterBackend :: SqlPoolHooks m backend -> (backend -> m backend) -> SqlPoolHooks m backend
setAlterBackend :: SqlPoolHooks m backend
-> (backend -> m backend) -> SqlPoolHooks m backend
setAlterBackend SqlPoolHooks m backend
hooks backend -> m backend
f = SqlPoolHooks m backend
hooks { alterBackend :: backend -> m backend
alterBackend = backend -> m backend
f }


getRunBefore :: SqlPoolHooks m backend -> (backend -> Maybe IsolationLevel -> m ())
getRunBefore :: SqlPoolHooks m backend -> backend -> Maybe IsolationLevel -> m ()
getRunBefore = SqlPoolHooks m backend -> backend -> Maybe IsolationLevel -> m ()
forall (m :: * -> *) backend.
SqlPoolHooks m backend -> backend -> Maybe IsolationLevel -> m ()
runBefore

modifyRunBefore :: SqlPoolHooks m backend -> ((backend -> Maybe IsolationLevel -> m ()) -> (backend -> Maybe IsolationLevel -> m ())) -> SqlPoolHooks m backend
modifyRunBefore :: SqlPoolHooks m backend
-> ((backend -> Maybe IsolationLevel -> m ())
    -> backend -> Maybe IsolationLevel -> m ())
-> SqlPoolHooks m backend
modifyRunBefore SqlPoolHooks m backend
hooks (backend -> Maybe IsolationLevel -> m ())
-> backend -> Maybe IsolationLevel -> m ()
f = SqlPoolHooks m backend
hooks { runBefore :: backend -> Maybe IsolationLevel -> m ()
runBefore = (backend -> Maybe IsolationLevel -> m ())
-> backend -> Maybe IsolationLevel -> m ()
f ((backend -> Maybe IsolationLevel -> m ())
 -> backend -> Maybe IsolationLevel -> m ())
-> (backend -> Maybe IsolationLevel -> m ())
-> backend
-> Maybe IsolationLevel
-> m ()
forall a b. (a -> b) -> a -> b
$ SqlPoolHooks m backend -> backend -> Maybe IsolationLevel -> m ()
forall (m :: * -> *) backend.
SqlPoolHooks m backend -> backend -> Maybe IsolationLevel -> m ()
runBefore SqlPoolHooks m backend
hooks }

setRunBefore :: SqlPoolHooks m backend -> (backend -> Maybe IsolationLevel -> m ()) -> SqlPoolHooks m backend
setRunBefore :: SqlPoolHooks m backend
-> (backend -> Maybe IsolationLevel -> m ())
-> SqlPoolHooks m backend
setRunBefore SqlPoolHooks m backend
h backend -> Maybe IsolationLevel -> m ()
f = SqlPoolHooks m backend
h { runBefore :: backend -> Maybe IsolationLevel -> m ()
runBefore = backend -> Maybe IsolationLevel -> m ()
f }


getRunAfter :: SqlPoolHooks m backend -> (backend -> Maybe IsolationLevel -> m ())
getRunAfter :: SqlPoolHooks m backend -> backend -> Maybe IsolationLevel -> m ()
getRunAfter = SqlPoolHooks m backend -> backend -> Maybe IsolationLevel -> m ()
forall (m :: * -> *) backend.
SqlPoolHooks m backend -> backend -> Maybe IsolationLevel -> m ()
runAfter

modifyRunAfter :: SqlPoolHooks m backend -> ((backend -> Maybe IsolationLevel -> m ()) -> (backend -> Maybe IsolationLevel -> m ())) -> SqlPoolHooks m backend
modifyRunAfter :: SqlPoolHooks m backend
-> ((backend -> Maybe IsolationLevel -> m ())
    -> backend -> Maybe IsolationLevel -> m ())
-> SqlPoolHooks m backend
modifyRunAfter SqlPoolHooks m backend
hooks (backend -> Maybe IsolationLevel -> m ())
-> backend -> Maybe IsolationLevel -> m ()
f = SqlPoolHooks m backend
hooks { runAfter :: backend -> Maybe IsolationLevel -> m ()
runAfter = (backend -> Maybe IsolationLevel -> m ())
-> backend -> Maybe IsolationLevel -> m ()
f ((backend -> Maybe IsolationLevel -> m ())
 -> backend -> Maybe IsolationLevel -> m ())
-> (backend -> Maybe IsolationLevel -> m ())
-> backend
-> Maybe IsolationLevel
-> m ()
forall a b. (a -> b) -> a -> b
$ SqlPoolHooks m backend -> backend -> Maybe IsolationLevel -> m ()
forall (m :: * -> *) backend.
SqlPoolHooks m backend -> backend -> Maybe IsolationLevel -> m ()
runAfter SqlPoolHooks m backend
hooks }

setRunAfter :: SqlPoolHooks m backend -> (backend -> Maybe IsolationLevel -> m ()) -> SqlPoolHooks m backend
setRunAfter :: SqlPoolHooks m backend
-> (backend -> Maybe IsolationLevel -> m ())
-> SqlPoolHooks m backend
setRunAfter SqlPoolHooks m backend
hooks backend -> Maybe IsolationLevel -> m ()
f = SqlPoolHooks m backend
hooks { runAfter :: backend -> Maybe IsolationLevel -> m ()
runAfter = backend -> Maybe IsolationLevel -> m ()
f }


getRunOnException :: SqlPoolHooks m backend -> (backend -> Maybe IsolationLevel -> SomeException -> m ())
getRunOnException :: SqlPoolHooks m backend
-> backend -> Maybe IsolationLevel -> SomeException -> m ()
getRunOnException = SqlPoolHooks m backend
-> backend -> Maybe IsolationLevel -> SomeException -> m ()
forall (m :: * -> *) backend.
SqlPoolHooks m backend
-> backend -> Maybe IsolationLevel -> SomeException -> m ()
runOnException

modifyRunOnException :: SqlPoolHooks m backend -> ((backend -> Maybe IsolationLevel -> SomeException -> m ()) -> (backend -> Maybe IsolationLevel -> SomeException -> m ())) -> SqlPoolHooks m backend
modifyRunOnException :: SqlPoolHooks m backend
-> ((backend -> Maybe IsolationLevel -> SomeException -> m ())
    -> backend -> Maybe IsolationLevel -> SomeException -> m ())
-> SqlPoolHooks m backend
modifyRunOnException SqlPoolHooks m backend
hooks (backend -> Maybe IsolationLevel -> SomeException -> m ())
-> backend -> Maybe IsolationLevel -> SomeException -> m ()
f = SqlPoolHooks m backend
hooks { runOnException :: backend -> Maybe IsolationLevel -> SomeException -> m ()
runOnException = (backend -> Maybe IsolationLevel -> SomeException -> m ())
-> backend -> Maybe IsolationLevel -> SomeException -> m ()
f ((backend -> Maybe IsolationLevel -> SomeException -> m ())
 -> backend -> Maybe IsolationLevel -> SomeException -> m ())
-> (backend -> Maybe IsolationLevel -> SomeException -> m ())
-> backend
-> Maybe IsolationLevel
-> SomeException
-> m ()
forall a b. (a -> b) -> a -> b
$ SqlPoolHooks m backend
-> backend -> Maybe IsolationLevel -> SomeException -> m ()
forall (m :: * -> *) backend.
SqlPoolHooks m backend
-> backend -> Maybe IsolationLevel -> SomeException -> m ()
runOnException SqlPoolHooks m backend
hooks }

setRunOnException :: SqlPoolHooks m backend -> (backend -> Maybe IsolationLevel -> SomeException -> m ()) -> SqlPoolHooks m backend
setRunOnException :: SqlPoolHooks m backend
-> (backend -> Maybe IsolationLevel -> SomeException -> m ())
-> SqlPoolHooks m backend
setRunOnException SqlPoolHooks m backend
hooks backend -> Maybe IsolationLevel -> SomeException -> m ()
f = SqlPoolHooks m backend
hooks { runOnException :: backend -> Maybe IsolationLevel -> SomeException -> m ()
runOnException = backend -> Maybe IsolationLevel -> SomeException -> m ()
f }