{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Database.Persist.Monad
(
MonadSqlQuery
, withTransaction
, SqlQueryT
, runSqlQueryT
, runSqlQueryTWith
, SqlQueryEnv(..)
, mkSqlQueryEnv
, SqlTransaction
, rerunnableLift
, TransactionError(..)
, module Database.Persist.Monad.Shim
) where
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.IO.Unlift (MonadUnliftIO(..), wrappedWithRunInIO)
import Control.Monad.Reader (ReaderT, ask, runReaderT)
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Resource (MonadResource)
import Data.Pool (Pool)
import Database.Persist.Sql (SqlBackend, SqlPersistT, runSqlConn)
import qualified GHC.TypeLits as GHC
import UnliftIO.Concurrent (threadDelay)
import UnliftIO.Exception (Exception, SomeException, catchJust, throwIO)
import UnliftIO.Pool (withResource)
import Control.Monad.IO.Rerunnable (MonadRerunnableIO, rerunnableIO)
import Database.Persist.Monad.Class
import Database.Persist.Monad.Shim
import Database.Persist.Monad.SqlQueryRep
newtype SqlTransaction m a = SqlTransaction
{ SqlTransaction m a -> SqlPersistT m a
unSqlTransaction :: SqlPersistT m a
}
deriving (a -> SqlTransaction m b -> SqlTransaction m a
(a -> b) -> SqlTransaction m a -> SqlTransaction m b
(forall a b. (a -> b) -> SqlTransaction m a -> SqlTransaction m b)
-> (forall a b. a -> SqlTransaction m b -> SqlTransaction m a)
-> Functor (SqlTransaction m)
forall a b. a -> SqlTransaction m b -> SqlTransaction m a
forall a b. (a -> b) -> SqlTransaction m a -> SqlTransaction m b
forall (m :: * -> *) a b.
Functor m =>
a -> SqlTransaction m b -> SqlTransaction m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SqlTransaction m a -> SqlTransaction m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SqlTransaction m b -> SqlTransaction m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> SqlTransaction m b -> SqlTransaction m a
fmap :: (a -> b) -> SqlTransaction m a -> SqlTransaction m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SqlTransaction m a -> SqlTransaction m b
Functor, Functor (SqlTransaction m)
a -> SqlTransaction m a
Functor (SqlTransaction m)
-> (forall a. a -> SqlTransaction m a)
-> (forall a b.
SqlTransaction m (a -> b)
-> SqlTransaction m a -> SqlTransaction m b)
-> (forall a b c.
(a -> b -> c)
-> SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m c)
-> (forall a b.
SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m b)
-> (forall a b.
SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m a)
-> Applicative (SqlTransaction m)
SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m b
SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m a
SqlTransaction m (a -> b)
-> SqlTransaction m a -> SqlTransaction m b
(a -> b -> c)
-> SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m c
forall a. a -> SqlTransaction m a
forall a b.
SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m a
forall a b.
SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m b
forall a b.
SqlTransaction m (a -> b)
-> SqlTransaction m a -> SqlTransaction m b
forall a b c.
(a -> b -> c)
-> SqlTransaction m a -> SqlTransaction m b -> SqlTransaction 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 (SqlTransaction m)
forall (m :: * -> *) a. Applicative m => a -> SqlTransaction m a
forall (m :: * -> *) a b.
Applicative m =>
SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m a
forall (m :: * -> *) a b.
Applicative m =>
SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m b
forall (m :: * -> *) a b.
Applicative m =>
SqlTransaction m (a -> b)
-> SqlTransaction m a -> SqlTransaction m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m c
<* :: SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m a
*> :: SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m b
liftA2 :: (a -> b -> c)
-> SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m c
<*> :: SqlTransaction m (a -> b)
-> SqlTransaction m a -> SqlTransaction m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
SqlTransaction m (a -> b)
-> SqlTransaction m a -> SqlTransaction m b
pure :: a -> SqlTransaction m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> SqlTransaction m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (SqlTransaction m)
Applicative, Applicative (SqlTransaction m)
a -> SqlTransaction m a
Applicative (SqlTransaction m)
-> (forall a b.
SqlTransaction m a
-> (a -> SqlTransaction m b) -> SqlTransaction m b)
-> (forall a b.
SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m b)
-> (forall a. a -> SqlTransaction m a)
-> Monad (SqlTransaction m)
SqlTransaction m a
-> (a -> SqlTransaction m b) -> SqlTransaction m b
SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m b
forall a. a -> SqlTransaction m a
forall a b.
SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m b
forall a b.
SqlTransaction m a
-> (a -> SqlTransaction m b) -> SqlTransaction m b
forall (m :: * -> *). Monad m => Applicative (SqlTransaction m)
forall (m :: * -> *) a. Monad m => a -> SqlTransaction m a
forall (m :: * -> *) a b.
Monad m =>
SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m b
forall (m :: * -> *) a b.
Monad m =>
SqlTransaction m a
-> (a -> SqlTransaction m b) -> SqlTransaction 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 :: a -> SqlTransaction m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> SqlTransaction m a
>> :: SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
SqlTransaction m a -> SqlTransaction m b -> SqlTransaction m b
>>= :: SqlTransaction m a
-> (a -> SqlTransaction m b) -> SqlTransaction m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
SqlTransaction m a
-> (a -> SqlTransaction m b) -> SqlTransaction m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (SqlTransaction m)
Monad, Monad (SqlTransaction m)
Monad (SqlTransaction m)
-> (forall a. IO a -> SqlTransaction m a)
-> MonadRerunnableIO (SqlTransaction m)
IO a -> SqlTransaction m a
forall a. IO a -> SqlTransaction m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadRerunnableIO m
forall (m :: * -> *).
MonadRerunnableIO m =>
Monad (SqlTransaction m)
forall (m :: * -> *) a.
MonadRerunnableIO m =>
IO a -> SqlTransaction m a
rerunnableIO :: IO a -> SqlTransaction m a
$crerunnableIO :: forall (m :: * -> *) a.
MonadRerunnableIO m =>
IO a -> SqlTransaction m a
$cp1MonadRerunnableIO :: forall (m :: * -> *).
MonadRerunnableIO m =>
Monad (SqlTransaction m)
MonadRerunnableIO)
instance
( GHC.TypeError ('GHC.Text "Cannot run arbitrary IO actions within a transaction. If the IO action is rerunnable, use rerunnableIO")
, Monad m
)
=> MonadIO (SqlTransaction m) where
liftIO :: IO a -> SqlTransaction m a
liftIO = IO a -> SqlTransaction m a
forall a. HasCallStack => a
undefined
instance (MonadSqlQuery m, MonadUnliftIO m) => MonadSqlQuery (SqlTransaction m) where
type TransactionM (SqlTransaction m) = TransactionM m
runQueryRep :: SqlQueryRep record a -> SqlTransaction m a
runQueryRep = SqlPersistT m a -> SqlTransaction m a
forall (m :: * -> *) a. SqlPersistT m a -> SqlTransaction m a
SqlTransaction (SqlPersistT m a -> SqlTransaction m a)
-> (SqlQueryRep record a -> SqlPersistT m a)
-> SqlQueryRep record a
-> SqlTransaction m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlQueryRep record a -> SqlPersistT m a
forall (m :: * -> *) record a.
MonadUnliftIO m =>
SqlQueryRep record a -> SqlPersistT m a
runSqlQueryRep
withTransaction :: TransactionM (SqlTransaction m) a -> SqlTransaction m a
withTransaction = SqlPersistT m a -> SqlTransaction m a
forall (m :: * -> *) a. SqlPersistT m a -> SqlTransaction m a
SqlTransaction (SqlPersistT m a -> SqlTransaction m a)
-> (TransactionM m a -> SqlPersistT m a)
-> TransactionM m a
-> SqlTransaction m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionM m a -> SqlPersistT m a
forall (m :: * -> *) a. MonadSqlQuery m => TransactionM m a -> m a
withTransaction
runSqlTransaction :: MonadUnliftIO m => SqlBackend -> SqlTransaction m a -> m a
runSqlTransaction :: SqlBackend -> SqlTransaction m a -> m a
runSqlTransaction SqlBackend
conn = (ReaderT SqlBackend m a -> SqlBackend -> m a
forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> backend -> m a
`runSqlConn` SqlBackend
conn) (ReaderT SqlBackend m a -> m a)
-> (SqlTransaction m a -> ReaderT SqlBackend m a)
-> SqlTransaction m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlTransaction m a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. SqlTransaction m a -> SqlPersistT m a
unSqlTransaction
rerunnableLift :: MonadUnliftIO m => m a -> SqlTransaction m a
rerunnableLift :: m a -> SqlTransaction m a
rerunnableLift m a
m = SqlPersistT m a -> SqlTransaction m a
forall (m :: * -> *) a. SqlPersistT m a -> SqlTransaction m a
SqlTransaction (SqlPersistT m a -> SqlTransaction m a)
-> SqlPersistT m a -> SqlTransaction m a
forall a b. (a -> b) -> a -> b
$ m a -> SqlPersistT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> SqlPersistT m a) -> m a -> SqlPersistT m a
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> IO a) -> IO a) -> m a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO -> IO a -> IO a
forall (m :: * -> *) a. MonadRerunnableIO m => IO a -> m a
rerunnableIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ m a -> IO a
forall a. m a -> IO a
runInIO m a
m
data TransactionError
= RetryLimitExceeded
deriving (Int -> TransactionError -> ShowS
[TransactionError] -> ShowS
TransactionError -> String
(Int -> TransactionError -> ShowS)
-> (TransactionError -> String)
-> ([TransactionError] -> ShowS)
-> Show TransactionError
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
(TransactionError -> TransactionError -> Bool)
-> (TransactionError -> TransactionError -> Bool)
-> Eq TransactionError
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
data SqlQueryEnv = SqlQueryEnv
{ SqlQueryEnv -> Pool SqlBackend
backendPool :: Pool SqlBackend
, SqlQueryEnv -> SomeException -> Bool
retryIf :: SomeException -> Bool
, SqlQueryEnv -> Int
retryLimit :: Int
}
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 -> (SomeException -> Bool) -> Int -> SqlQueryEnv
SqlQueryEnv
{ Pool SqlBackend
backendPool :: Pool SqlBackend
backendPool :: Pool SqlBackend
backendPool
, retryIf :: SomeException -> Bool
retryIf = Bool -> SomeException -> Bool
forall a b. a -> b -> a
const Bool
False
, retryLimit :: Int
retryLimit = Int
10
}
newtype SqlQueryT m a = SqlQueryT
{ SqlQueryT m a -> ReaderT SqlQueryEnv m a
unSqlQueryT :: ReaderT SqlQueryEnv m a
} deriving
( a -> SqlQueryT m b -> SqlQueryT m a
(a -> b) -> SqlQueryT m a -> SqlQueryT m b
(forall a b. (a -> b) -> SqlQueryT m a -> SqlQueryT m b)
-> (forall a b. a -> SqlQueryT m b -> SqlQueryT m a)
-> Functor (SqlQueryT m)
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
<$ :: a -> SqlQueryT m b -> SqlQueryT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> SqlQueryT m b -> SqlQueryT m a
fmap :: (a -> b) -> SqlQueryT m a -> SqlQueryT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SqlQueryT m a -> SqlQueryT m b
Functor
, Functor (SqlQueryT m)
a -> SqlQueryT m a
Functor (SqlQueryT m)
-> (forall a. a -> SqlQueryT m a)
-> (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 a b. SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m b)
-> (forall a b. SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m a)
-> Applicative (SqlQueryT m)
SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m b
SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m a
SqlQueryT m (a -> b) -> SqlQueryT m a -> SqlQueryT m b
(a -> b -> c) -> SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m c
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
<* :: 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
*> :: 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 :: (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
<*> :: 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 :: a -> SqlQueryT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> SqlQueryT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (SqlQueryT m)
Applicative
, Applicative (SqlQueryT m)
a -> SqlQueryT m a
Applicative (SqlQueryT m)
-> (forall a b.
SqlQueryT m a -> (a -> SqlQueryT m b) -> SqlQueryT m b)
-> (forall a b. SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m b)
-> (forall a. a -> SqlQueryT m a)
-> Monad (SqlQueryT m)
SqlQueryT m a -> (a -> SqlQueryT m b) -> SqlQueryT m b
SqlQueryT m a -> SqlQueryT m b -> SqlQueryT m b
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 :: a -> SqlQueryT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> SqlQueryT m a
>> :: 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
>>= :: 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
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (SqlQueryT m)
Monad
, Monad (SqlQueryT m)
Monad (SqlQueryT m)
-> (forall a. IO a -> SqlQueryT m a) -> MonadIO (SqlQueryT m)
IO a -> SqlQueryT m a
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 :: IO a -> SqlQueryT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> SqlQueryT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (SqlQueryT m)
MonadIO
, m a -> SqlQueryT m a
(forall (m :: * -> *) a. Monad m => m a -> SqlQueryT m a)
-> MonadTrans SqlQueryT
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 :: m a -> SqlQueryT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> SqlQueryT m a
MonadTrans
, MonadIO (SqlQueryT m)
MonadIO (SqlQueryT m)
-> (forall a. ResourceT IO a -> SqlQueryT m a)
-> MonadResource (SqlQueryT m)
ResourceT IO a -> SqlQueryT m a
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 :: ResourceT IO a -> SqlQueryT m a
$cliftResourceT :: forall (m :: * -> *) a.
MonadResource m =>
ResourceT IO a -> SqlQueryT m a
$cp1MonadResource :: forall (m :: * -> *). MonadResource m => MonadIO (SqlQueryT m)
MonadResource
, Monad (SqlQueryT m)
Monad (SqlQueryT m)
-> (forall a. IO a -> SqlQueryT m a)
-> MonadRerunnableIO (SqlQueryT m)
IO a -> SqlQueryT m a
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 :: IO a -> SqlQueryT m a
$crerunnableIO :: forall (m :: * -> *) a.
MonadRerunnableIO m =>
IO a -> SqlQueryT m a
$cp1MonadRerunnableIO :: forall (m :: * -> *). MonadRerunnableIO m => Monad (SqlQueryT m)
MonadRerunnableIO
)
instance MonadUnliftIO m => MonadSqlQuery (SqlQueryT m) where
type TransactionM (SqlQueryT m) = SqlTransaction (SqlQueryT m)
runQueryRep :: SqlQueryRep record a -> SqlQueryT m a
runQueryRep = SqlTransaction (SqlQueryT m) a -> SqlQueryT m a
forall (m :: * -> *) a. MonadSqlQuery m => TransactionM m a -> m a
withTransaction (SqlTransaction (SqlQueryT m) a -> SqlQueryT m a)
-> (SqlQueryRep record a -> SqlTransaction (SqlQueryT m) a)
-> SqlQueryRep record a
-> SqlQueryT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlQueryRep record a -> SqlTransaction (SqlQueryT m) a
forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep
withTransaction :: TransactionM (SqlQueryT m) a -> SqlQueryT m a
withTransaction TransactionM (SqlQueryT m) a
m = do
SqlQueryEnv{Int
Pool SqlBackend
SomeException -> Bool
retryLimit :: Int
retryIf :: SomeException -> Bool
backendPool :: Pool SqlBackend
retryLimit :: SqlQueryEnv -> Int
retryIf :: SqlQueryEnv -> SomeException -> Bool
backendPool :: SqlQueryEnv -> Pool SqlBackend
..} <- ReaderT SqlQueryEnv m SqlQueryEnv -> SqlQueryT m SqlQueryEnv
forall (m :: * -> *) a. ReaderT SqlQueryEnv m a -> SqlQueryT m a
SqlQueryT ReaderT SqlQueryEnv m SqlQueryEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
Pool SqlBackend -> (SqlBackend -> SqlQueryT m a) -> SqlQueryT m a
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Pool a -> (a -> m b) -> m b
withResource Pool SqlBackend
backendPool ((SqlBackend -> SqlQueryT m a) -> SqlQueryT m a)
-> (SqlBackend -> SqlQueryT m a) -> SqlQueryT m a
forall a b. (a -> b) -> a -> b
$ \SqlBackend
conn ->
let filterRetry :: SomeException -> Maybe SomeException
filterRetry SomeException
e = if SomeException -> Bool
retryIf SomeException
e then SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e else Maybe SomeException
forall a. Maybe a
Nothing
loop :: Int -> SqlQueryT m a
loop Int
i = (SomeException -> Maybe SomeException)
-> SqlQueryT m a
-> (SomeException -> SqlQueryT m a)
-> SqlQueryT m a
forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust SomeException -> Maybe SomeException
filterRetry (SqlBackend -> SqlTransaction (SqlQueryT m) a -> SqlQueryT m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
SqlBackend -> SqlTransaction m a -> m a
runSqlTransaction SqlBackend
conn TransactionM (SqlQueryT m) a
SqlTransaction (SqlQueryT m) a
m) ((SomeException -> SqlQueryT m a) -> SqlQueryT m a)
-> (SomeException -> SqlQueryT m a) -> SqlQueryT m a
forall a b. (a -> b) -> a -> b
$ \SomeException
_ ->
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
retryLimit
then do
Int -> SqlQueryT m ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int -> SqlQueryT m ()) -> Int -> SqlQueryT m ()
forall a b. (a -> b) -> a -> b
$ Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
i
Int -> SqlQueryT m a
loop (Int -> SqlQueryT m a) -> Int -> SqlQueryT m a
forall a b. (a -> b) -> a -> b
$! Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
else TransactionError -> SqlQueryT m a
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 a. SqlQueryT m a -> IO a) -> IO b) -> SqlQueryT m b
withRunInIO = (ReaderT SqlQueryEnv m b -> SqlQueryT m b)
-> (forall a. SqlQueryT m a -> ReaderT SqlQueryEnv m a)
-> ((forall a. SqlQueryT m a -> IO a) -> IO b)
-> SqlQueryT m b
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 ReaderT SqlQueryEnv m b -> SqlQueryT m b
forall (m :: * -> *) a. ReaderT SqlQueryEnv m a -> SqlQueryT m a
SqlQueryT forall a. SqlQueryT m a -> ReaderT SqlQueryEnv m a
forall (m :: * -> *) a. SqlQueryT m a -> ReaderT SqlQueryEnv m a
unSqlQueryT
runSqlQueryT :: Pool SqlBackend -> SqlQueryT m a -> m a
runSqlQueryT :: Pool SqlBackend -> SqlQueryT m a -> m a
runSqlQueryT Pool SqlBackend
backendPool = SqlQueryEnv -> SqlQueryT m a -> m a
forall (m :: * -> *) a. SqlQueryEnv -> SqlQueryT m a -> m a
runSqlQueryTWith (SqlQueryEnv -> SqlQueryT m a -> m a)
-> SqlQueryEnv -> SqlQueryT m a -> m a
forall a b. (a -> b) -> a -> b
$ Pool SqlBackend -> (SqlQueryEnv -> SqlQueryEnv) -> SqlQueryEnv
mkSqlQueryEnv Pool SqlBackend
backendPool SqlQueryEnv -> SqlQueryEnv
forall a. a -> a
id
runSqlQueryTWith :: SqlQueryEnv -> SqlQueryT m a -> m a
runSqlQueryTWith :: SqlQueryEnv -> SqlQueryT m a -> m a
runSqlQueryTWith SqlQueryEnv
env = (ReaderT SqlQueryEnv m a -> SqlQueryEnv -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` SqlQueryEnv
env) (ReaderT SqlQueryEnv m a -> m a)
-> (SqlQueryT m a -> ReaderT SqlQueryEnv m a)
-> SqlQueryT m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlQueryT m a -> ReaderT SqlQueryEnv m a
forall (m :: * -> *) a. SqlQueryT m a -> ReaderT SqlQueryEnv m a
unSqlQueryT