{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-|
Module: Database.Persist.Monad

Defines the 'SqlQueryT' monad transformer, which has a 'MonadSqlQuery' instance
to execute @persistent@ database operations. Also provides easy transaction
management with 'withTransaction', which supports retrying with exponential
backoff and restricts IO actions to only allow IO actions explicitly marked
as rerunnable.

Usage:

@
myFunction :: (MonadSqlQuery m, MonadIO m) => m ()
myFunction = do
  insert_ $ Person { name = \"Alice\", age = Just 25 }
  insert_ $ Person { name = \"Bob\", age = Nothing }

  -- some other business logic

  personList <- selectList [] []
  liftIO $ print (personList :: [Person])

  -- everything in here will run in a transaction
  withTransaction $ do
    selectFirst [PersonAge >. 30] [] >>= \\case
      Nothing -> insert_ $ Person { name = \"Claire\", age = Just 50 }
      Just (Entity key person) -> replace key person{ age = Just (age person - 10) }

    -- liftIO doesn't work in here, since transactions can be retried.
    -- Use rerunnableIO to run IO actions, after verifying that the IO action
    -- can be rerun if the transaction needs to be retried.
    rerunnableIO $ putStrLn "Transaction is finished!"

  -- some more business logic

  return ()
@
-}
module Database.Persist.Monad (
  -- * Type class for executing database queries
  MonadSqlQuery,
  withTransaction,

  -- * SqlQueryT monad transformer
  SqlQueryT (..),
  mapSqlQueryT,
  runSqlQueryT,
  runSqlQueryTWith,
  SqlQueryEnv (..),
  mkSqlQueryEnv,

  -- ** SqlQueryT environment
  getSqlBackendPool,

  -- * Transactions
  SqlTransaction,
  TransactionError (..),
  catchSqlTransaction,

  -- * Lifted functions
  module Database.Persist.Monad.Shim,
) where

import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.IO.Unlift (MonadUnliftIO (..), wrappedWithRunInIO)
import Control.Monad.Logger (MonadLogger)
import Control.Monad.Reader (ReaderT (..), asks, mapReaderT)
import Control.Monad.Reader.Class (MonadReader (..))
import Control.Monad.Trans.Class (MonadTrans (..))
import Control.Monad.Trans.Resource (MonadResource)
import Data.Pool (Pool)
import Database.Persist.Sql (SqlBackend)
import UnliftIO.Concurrent (threadDelay)
import UnliftIO.Exception (Exception, SomeException, catchJust, throwIO)
import UnliftIO.Pool (withResource)

import Control.Monad.IO.Rerunnable (MonadRerunnableIO)
import Database.Persist.Monad.Class
import Database.Persist.Monad.Internal.SqlTransaction
import Database.Persist.Monad.Shim

{- SqlQueryT monad -}

-- | Environment to configure running 'SqlQueryT'.
--
--  For simple usage, you can just use 'runSqlQueryT', but for more advanced
--  usage, including the ability to retry transactions, use 'mkSqlQueryEnv' with
--  'runSqlQueryTWith'.
data SqlQueryEnv = SqlQueryEnv
  { SqlQueryEnv -> Pool SqlBackend
backendPool :: Pool SqlBackend
  -- ^ The pool for your persistent backend. Get this from @withSqlitePool@
  -- or the equivalent for your backend.
  , SqlQueryEnv -> SomeException -> Bool
retryIf :: SomeException -> Bool
  -- ^ Retry a transaction when an exception matches this predicate. Will
  -- retry with an exponential backoff.
  --
  -- Defaults to always returning False (i.e. never retry)
  , SqlQueryEnv -> Int
retryLimit :: Int
  -- ^ The number of times to retry, if 'retryIf' is satisfied.
  --
  -- Defaults to 10.
  , SqlQueryEnv -> SomeException -> IO ()
retryCallback :: SomeException -> IO ()
  -- ^ A callback to run if 'retryIf' returns True. Useful for logging.
  }

-- | Build a SqlQueryEnv from the default.
--
--  Usage:
--
--  @
--  let env = mkSqlQueryEnv pool $ \\env -> env { retryIf = 10 }
--  in runSqlQueryTWith env m
--  @
mkSqlQueryEnv :: Pool SqlBackend -> (SqlQueryEnv -> SqlQueryEnv) -> SqlQueryEnv
mkSqlQueryEnv :: Pool SqlBackend -> (SqlQueryEnv -> SqlQueryEnv) -> SqlQueryEnv
mkSqlQueryEnv Pool SqlBackend
backendPool SqlQueryEnv -> SqlQueryEnv
f =
  SqlQueryEnv -> SqlQueryEnv
f
    SqlQueryEnv
      { Pool SqlBackend
backendPool :: Pool SqlBackend
backendPool :: Pool SqlBackend
backendPool
      , retryIf :: SomeException -> Bool
retryIf = forall a b. a -> b -> a
const Bool
False
      , retryLimit :: Int
retryLimit = Int
10
      , retryCallback :: SomeException -> IO ()
retryCallback = \SomeException
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      }

-- | The monad transformer that implements 'MonadSqlQuery'.
newtype SqlQueryT m a = SqlQueryT
  { forall (m :: * -> *) a. SqlQueryT m a -> ReaderT SqlQueryEnv m a
unSqlQueryT :: ReaderT SqlQueryEnv m a
  }
  deriving
    ( forall a b. a -> SqlQueryT m b -> SqlQueryT m a
forall a b. (a -> b) -> SqlQueryT m a -> SqlQueryT m b
forall (m :: * -> *) a b.
Functor m =>
a -> SqlQueryT m b -> SqlQueryT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SqlQueryT m a -> SqlQueryT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SqlQueryT m b -> SqlQueryT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> SqlQueryT m b -> SqlQueryT m a
fmap :: forall a b. (a -> b) -> SqlQueryT m a -> SqlQueryT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SqlQueryT m a -> SqlQueryT m b
Functor
    , forall a. a -> SqlQueryT m a
forall a b. SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m a
forall a b. SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m b
forall a b. SqlQueryT m (a -> b) -> SqlQueryT m a -> SqlQueryT m b
forall a b c.
(a -> b -> c) -> SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (SqlQueryT m)
forall (m :: * -> *) a. Applicative m => a -> SqlQueryT m a
forall (m :: * -> *) a b.
Applicative m =>
SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m a
forall (m :: * -> *) a b.
Applicative m =>
SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m b
forall (m :: * -> *) a b.
Applicative m =>
SqlQueryT m (a -> b) -> SqlQueryT m a -> SqlQueryT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m c
<* :: forall a b. SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m a
*> :: forall a b. SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m b
liftA2 :: forall a b c.
(a -> b -> c) -> SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m c
<*> :: forall a b. SqlQueryT m (a -> b) -> SqlQueryT m a -> SqlQueryT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
SqlQueryT m (a -> b) -> SqlQueryT m a -> SqlQueryT m b
pure :: forall a. a -> SqlQueryT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> SqlQueryT m a
Applicative
    , forall a. a -> SqlQueryT m a
forall a b. SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m b
forall a b. SqlQueryT m a -> (a -> SqlQueryT m b) -> SqlQueryT m b
forall {m :: * -> *}. Monad m => Applicative (SqlQueryT m)
forall (m :: * -> *) a. Monad m => a -> SqlQueryT m a
forall (m :: * -> *) a b.
Monad m =>
SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m b
forall (m :: * -> *) a b.
Monad m =>
SqlQueryT m a -> (a -> SqlQueryT m b) -> SqlQueryT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> SqlQueryT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> SqlQueryT m a
>> :: forall a b. SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m b
>>= :: forall a b. SqlQueryT m a -> (a -> SqlQueryT m b) -> SqlQueryT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
SqlQueryT m a -> (a -> SqlQueryT m b) -> SqlQueryT m b
Monad
    , forall a. (a -> SqlQueryT m a) -> SqlQueryT m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall {m :: * -> *}. MonadFix m => Monad (SqlQueryT m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> SqlQueryT m a) -> SqlQueryT m a
mfix :: forall a. (a -> SqlQueryT m a) -> SqlQueryT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> SqlQueryT m a) -> SqlQueryT m a
MonadFix
    , forall a. IO a -> SqlQueryT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (SqlQueryT m)
forall (m :: * -> *) a. MonadIO m => IO a -> SqlQueryT m a
liftIO :: forall a. IO a -> SqlQueryT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> SqlQueryT m a
MonadIO
    , forall (m :: * -> *) a. Monad m => m a -> SqlQueryT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> SqlQueryT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> SqlQueryT m a
MonadTrans
    , forall a. ResourceT IO a -> SqlQueryT m a
forall (m :: * -> *).
MonadIO m -> (forall a. ResourceT IO a -> m a) -> MonadResource m
forall {m :: * -> *}. MonadResource m => MonadIO (SqlQueryT m)
forall (m :: * -> *) a.
MonadResource m =>
ResourceT IO a -> SqlQueryT m a
liftResourceT :: forall a. ResourceT IO a -> SqlQueryT m a
$cliftResourceT :: forall (m :: * -> *) a.
MonadResource m =>
ResourceT IO a -> SqlQueryT m a
MonadResource
    , forall a. IO a -> SqlQueryT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadRerunnableIO m
forall {m :: * -> *}. MonadRerunnableIO m => Monad (SqlQueryT m)
forall (m :: * -> *) a.
MonadRerunnableIO m =>
IO a -> SqlQueryT m a
rerunnableIO :: forall a. IO a -> SqlQueryT m a
$crerunnableIO :: forall (m :: * -> *) a.
MonadRerunnableIO m =>
IO a -> SqlQueryT m a
MonadRerunnableIO
    , forall e a. Exception e => e -> SqlQueryT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall {m :: * -> *}. MonadThrow m => Monad (SqlQueryT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SqlQueryT m a
throwM :: forall e a. Exception e => e -> SqlQueryT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SqlQueryT m a
MonadThrow
    , forall e a.
Exception e =>
SqlQueryT m a -> (e -> SqlQueryT m a) -> SqlQueryT m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall {m :: * -> *}. MonadCatch m => MonadThrow (SqlQueryT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SqlQueryT m a -> (e -> SqlQueryT m a) -> SqlQueryT m a
catch :: forall e a.
Exception e =>
SqlQueryT m a -> (e -> SqlQueryT m a) -> SqlQueryT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SqlQueryT m a -> (e -> SqlQueryT m a) -> SqlQueryT m a
MonadCatch
    , forall b.
((forall a. SqlQueryT m a -> SqlQueryT m a) -> SqlQueryT m b)
-> SqlQueryT m b
forall a b c.
SqlQueryT m a
-> (a -> ExitCase b -> SqlQueryT m c)
-> (a -> SqlQueryT m b)
-> SqlQueryT m (b, c)
forall {m :: * -> *}. MonadMask m => MonadCatch (SqlQueryT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. SqlQueryT m a -> SqlQueryT m a) -> SqlQueryT m b)
-> SqlQueryT m b
forall (m :: * -> *) a b c.
MonadMask m =>
SqlQueryT m a
-> (a -> ExitCase b -> SqlQueryT m c)
-> (a -> SqlQueryT m b)
-> SqlQueryT m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
SqlQueryT m a
-> (a -> ExitCase b -> SqlQueryT m c)
-> (a -> SqlQueryT m b)
-> SqlQueryT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
SqlQueryT m a
-> (a -> ExitCase b -> SqlQueryT m c)
-> (a -> SqlQueryT m b)
-> SqlQueryT m (b, c)
uninterruptibleMask :: forall b.
((forall a. SqlQueryT m a -> SqlQueryT m a) -> SqlQueryT m b)
-> SqlQueryT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. SqlQueryT m a -> SqlQueryT m a) -> SqlQueryT m b)
-> SqlQueryT m b
mask :: forall b.
((forall a. SqlQueryT m a -> SqlQueryT m a) -> SqlQueryT m b)
-> SqlQueryT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. SqlQueryT m a -> SqlQueryT m a) -> SqlQueryT m b)
-> SqlQueryT m b
MonadMask
    , forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> SqlQueryT m ()
forall (m :: * -> *).
Monad m
-> (forall msg.
    ToLogStr msg =>
    Loc -> LogSource -> LogLevel -> msg -> m ())
-> MonadLogger m
forall {m :: * -> *}. MonadLogger m => Monad (SqlQueryT m)
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> SqlQueryT m ()
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> SqlQueryT m ()
$cmonadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> SqlQueryT m ()
MonadLogger
    )

instance (MonadUnliftIO m) => MonadSqlQuery (SqlQueryT m) where
  type TransactionM (SqlQueryT m) = SqlTransaction (SqlQueryT m)

  -- Running a query directly in SqlQueryT will create a one-off transaction.
  runQueryRep :: forall record a.
Typeable record =>
SqlQueryRep record a -> SqlQueryT m a
runQueryRep = forall (m :: * -> *) a. MonadSqlQuery m => TransactionM m a -> m a
withTransaction forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep

  -- Start a new transaction and run the given 'SqlTransaction'
  withTransaction :: forall a. TransactionM (SqlQueryT m) a -> SqlQueryT m a
withTransaction TransactionM (SqlQueryT m) a
m = do
    SqlQueryEnv{Int
Pool SqlBackend
SomeException -> Bool
SomeException -> IO ()
retryCallback :: SomeException -> IO ()
retryLimit :: Int
retryIf :: SomeException -> Bool
backendPool :: Pool SqlBackend
retryCallback :: SqlQueryEnv -> SomeException -> IO ()
retryLimit :: SqlQueryEnv -> Int
retryIf :: SqlQueryEnv -> SomeException -> Bool
backendPool :: SqlQueryEnv -> Pool SqlBackend
..} <- forall (m :: * -> *) a. ReaderT SqlQueryEnv m a -> SqlQueryT m a
SqlQueryT forall r (m :: * -> *). MonadReader r m => m r
ask
    forall (m :: * -> *) a b.
MonadUnliftIO m =>
Pool a -> (a -> m b) -> m b
withResource Pool SqlBackend
backendPool forall a b. (a -> b) -> a -> b
$ \SqlBackend
conn ->
      let transactionEnv :: SqlTransactionEnv
transactionEnv =
            SqlTransactionEnv
              { sqlBackend :: SqlBackend
sqlBackend = SqlBackend
conn
              , ignoreCatch :: SomeException -> Bool
ignoreCatch = SomeException -> Bool
retryIf -- don't catch retry errors
              }
          filterRetry :: SomeException -> Maybe SomeException
filterRetry SomeException
e = if SomeException -> Bool
retryIf SomeException
e then forall a. a -> Maybe a
Just SomeException
e else forall a. Maybe a
Nothing
          loop :: Int -> SqlQueryT m a
loop Int
i = forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust SomeException -> Maybe SomeException
filterRetry (forall (m :: * -> *) a.
MonadUnliftIO m =>
SqlTransactionEnv -> SqlTransaction m a -> m a
runSqlTransaction SqlTransactionEnv
transactionEnv TransactionM (SqlQueryT m) a
m) forall a b. (a -> b) -> a -> b
$ \SomeException
e ->
            if Int
i forall a. Ord a => a -> a -> Bool
< Int
retryLimit
              then do
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ SomeException -> IO ()
retryCallback SomeException
e
                forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay forall a b. (a -> b) -> a -> b
$ Int
1000 forall a. Num a => a -> a -> a
* Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
i
                Int -> SqlQueryT m a
loop forall a b. (a -> b) -> a -> b
$! Int
i forall a. Num a => a -> a -> a
+ Int
1
              else forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO TransactionError
RetryLimitExceeded
       in Int -> SqlQueryT m a
loop Int
0

instance (MonadUnliftIO m) => MonadUnliftIO (SqlQueryT m) where
  withRunInIO :: forall b.
((forall a. SqlQueryT m a -> IO a) -> IO b) -> SqlQueryT m b
withRunInIO = forall (n :: * -> *) b (m :: * -> *).
MonadUnliftIO n =>
(n b -> m b)
-> (forall a. m a -> n a)
-> ((forall a. m a -> IO a) -> IO b)
-> m b
wrappedWithRunInIO forall (m :: * -> *) a. ReaderT SqlQueryEnv m a -> SqlQueryT m a
SqlQueryT forall (m :: * -> *) a. SqlQueryT m a -> ReaderT SqlQueryEnv m a
unSqlQueryT

mapSqlQueryT :: (m a -> n b) -> SqlQueryT m a -> SqlQueryT n b
mapSqlQueryT :: forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> SqlQueryT m a -> SqlQueryT n b
mapSqlQueryT m a -> n b
f = forall (m :: * -> *) a. ReaderT SqlQueryEnv m a -> SqlQueryT m a
SqlQueryT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> n b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. SqlQueryT m a -> ReaderT SqlQueryEnv m a
unSqlQueryT

instance (MonadReader r m) => MonadReader r (SqlQueryT m) where
  ask :: SqlQueryT m r
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> SqlQueryT m a -> SqlQueryT m a
local = forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> SqlQueryT m a -> SqlQueryT n b
mapSqlQueryT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local

-- | Errors that can occur when running a SQL transaction.
data TransactionError
  = -- | The retry limit was reached when retrying a transaction.
    RetryLimitExceeded
  deriving (Int -> TransactionError -> ShowS
[TransactionError] -> ShowS
TransactionError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactionError] -> ShowS
$cshowList :: [TransactionError] -> ShowS
show :: TransactionError -> String
$cshow :: TransactionError -> String
showsPrec :: Int -> TransactionError -> ShowS
$cshowsPrec :: Int -> TransactionError -> ShowS
Show, TransactionError -> TransactionError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransactionError -> TransactionError -> Bool
$c/= :: TransactionError -> TransactionError -> Bool
== :: TransactionError -> TransactionError -> Bool
$c== :: TransactionError -> TransactionError -> Bool
Eq)

instance Exception TransactionError

{- Running SqlQueryT -}

-- | Run the 'SqlQueryT' monad transformer with the given backend.
runSqlQueryT :: Pool SqlBackend -> SqlQueryT m a -> m a
runSqlQueryT :: forall (m :: * -> *) a. Pool SqlBackend -> SqlQueryT m a -> m a
runSqlQueryT Pool SqlBackend
backendPool = forall (m :: * -> *) a. SqlQueryEnv -> SqlQueryT m a -> m a
runSqlQueryTWith forall a b. (a -> b) -> a -> b
$ Pool SqlBackend -> (SqlQueryEnv -> SqlQueryEnv) -> SqlQueryEnv
mkSqlQueryEnv Pool SqlBackend
backendPool forall a. a -> a
id

-- | Run the 'SqlQueryT' monad transformer with the explicitly provided
--  environment.
runSqlQueryTWith :: SqlQueryEnv -> SqlQueryT m a -> m a
runSqlQueryTWith :: forall (m :: * -> *) a. SqlQueryEnv -> SqlQueryT m a -> m a
runSqlQueryTWith SqlQueryEnv
env = (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` SqlQueryEnv
env) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. SqlQueryT m a -> ReaderT SqlQueryEnv m a
unSqlQueryT

{- SqlQueryT environment -}

getSqlBackendPool :: (Monad m) => SqlQueryT m (Pool SqlBackend)
getSqlBackendPool :: forall (m :: * -> *). Monad m => SqlQueryT m (Pool SqlBackend)
getSqlBackendPool = forall (m :: * -> *) a. ReaderT SqlQueryEnv m a -> SqlQueryT m a
SqlQueryT (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SqlQueryEnv -> Pool SqlBackend
backendPool)