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.Class.PersistStore
import Database.Persist.Sql.Raw
import Database.Persist.SqlBackend.Internal
import Database.Persist.SqlBackend.Internal.IsolationLevel
import Database.Persist.SqlBackend.Internal.SqlPoolHooks

-- | 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 :: forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
SqlPoolHooks m backend
defaultSqlPoolHooks =
    SqlPoolHooks
        { alterBackend :: backend -> m backend
alterBackend = backend -> m backend
forall a. a -> m a
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 a. IO a -> m a
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 a. IO a -> m a
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 a. IO a -> m a
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 :: forall (m :: * -> *) backend.
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 :: forall (m :: * -> *) backend.
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 = f $ alterBackend hooks}

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

getRunBefore
    :: SqlPoolHooks m backend -> (backend -> Maybe IsolationLevel -> m ())
getRunBefore :: forall (m :: * -> *) backend.
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 :: forall (m :: * -> *) backend.
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 = f $ runBefore hooks}

setRunBefore
    :: SqlPoolHooks m backend
    -> (backend -> Maybe IsolationLevel -> m ())
    -> SqlPoolHooks m backend
setRunBefore :: forall (m :: * -> *) backend.
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 = f}

getRunAfter
    :: SqlPoolHooks m backend -> (backend -> Maybe IsolationLevel -> m ())
getRunAfter :: forall (m :: * -> *) backend.
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 :: forall (m :: * -> *) backend.
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 = f $ runAfter hooks}

setRunAfter
    :: SqlPoolHooks m backend
    -> (backend -> Maybe IsolationLevel -> m ())
    -> SqlPoolHooks m backend
setRunAfter :: forall (m :: * -> *) backend.
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 = f}

getRunOnException
    :: SqlPoolHooks m backend
    -> (backend -> Maybe IsolationLevel -> SomeException -> m ())
getRunOnException :: forall (m :: * -> *) backend.
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 :: forall (m :: * -> *) backend.
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 = f $ runOnException hooks}

setRunOnException
    :: SqlPoolHooks m backend
    -> (backend -> Maybe IsolationLevel -> SomeException -> m ())
    -> SqlPoolHooks m backend
setRunOnException :: forall (m :: * -> *) backend.
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 = f}