module Sq.Transactional
( Transactional
, embed
, transactionalRetry
, one
, maybe
, zero
, some
, list
, fold
, foldM
, Ref
, Retry (..)
, retry
, orElse
) where
import Control.Applicative hiding (some)
import Control.Concurrent
import Control.Concurrent.STM hiding (orElse, retry)
import Control.Exception.Safe qualified as Ex
import Control.Foldl qualified as F
import Control.Monad hiding (foldM)
import Control.Monad.Catch qualified as Cx
import Control.Monad.IO.Class
import Control.Monad.Ref hiding (Ref)
import Control.Monad.Ref qualified
import Control.Monad.Trans.Reader (ReaderT (ReaderT))
import Control.Monad.Trans.Resource qualified as R
import Control.Monad.Trans.Resource.Extra qualified as R hiding (runResourceT)
import Data.Acquire qualified as A
import Data.Coerce
import Data.Int
import Data.IntMap.Strict (IntMap)
import Data.IntMap.Strict qualified as IntMap
import Data.Kind
import Data.List.NonEmpty (NonEmpty)
import Prelude hiding (Read, maybe, read)
import Sq.Connection
import Sq.Mode
import Sq.Statement
import Sq.Support
data Retry = NoRetry | Retry
deriving (Retry -> Retry -> Bool
(Retry -> Retry -> Bool) -> (Retry -> Retry -> Bool) -> Eq Retry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Retry -> Retry -> Bool
== :: Retry -> Retry -> Bool
$c/= :: Retry -> Retry -> Bool
/= :: Retry -> Retry -> Bool
Eq, Eq Retry
Eq Retry =>
(Retry -> Retry -> Ordering)
-> (Retry -> Retry -> Bool)
-> (Retry -> Retry -> Bool)
-> (Retry -> Retry -> Bool)
-> (Retry -> Retry -> Bool)
-> (Retry -> Retry -> Retry)
-> (Retry -> Retry -> Retry)
-> Ord Retry
Retry -> Retry -> Bool
Retry -> Retry -> Ordering
Retry -> Retry -> Retry
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Retry -> Retry -> Ordering
compare :: Retry -> Retry -> Ordering
$c< :: Retry -> Retry -> Bool
< :: Retry -> Retry -> Bool
$c<= :: Retry -> Retry -> Bool
<= :: Retry -> Retry -> Bool
$c> :: Retry -> Retry -> Bool
> :: Retry -> Retry -> Bool
$c>= :: Retry -> Retry -> Bool
>= :: Retry -> Retry -> Bool
$cmax :: Retry -> Retry -> Retry
max :: Retry -> Retry -> Retry
$cmin :: Retry -> Retry -> Retry
min :: Retry -> Retry -> Retry
Ord, Int -> Retry -> ShowS
[Retry] -> ShowS
Retry -> String
(Int -> Retry -> ShowS)
-> (Retry -> String) -> ([Retry] -> ShowS) -> Show Retry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Retry -> ShowS
showsPrec :: Int -> Retry -> ShowS
$cshow :: Retry -> String
show :: Retry -> String
$cshowList :: [Retry] -> ShowS
showList :: [Retry] -> ShowS
Show)
data Env (g :: k) (r :: Retry) (t :: Mode) = Env
{ forall k (g :: k) (r :: Retry) (t :: Mode). Env g r t -> STM Int
unique :: STM Int
, forall k (g :: k) (r :: Retry) (t :: Mode).
Env g r t -> TVar (IntMap (SomeRef g))
refs :: TVar (IntMap (SomeRef g))
, forall k (g :: k) (r :: Retry) (t :: Mode).
Env g r t -> Transaction t
tx :: Transaction t
}
acquireEnv :: Transaction t -> A.Acquire (Env g r t)
acquireEnv :: forall {k} (t :: Mode) (g :: k) (r :: Retry).
Transaction t -> Acquire (Env g r t)
acquireEnv Transaction t
tx = do
STM Int
unique :: STM Int <- IO (STM Int) -> Acquire (STM Int)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
TVar Int
tv <- Int -> IO (TVar Int)
forall a. a -> IO (TVar a)
newTVarIO Int
0
STM Int -> IO (STM Int)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (STM Int -> IO (STM Int)) -> STM Int -> IO (STM Int)
forall a b. (a -> b) -> a -> b
$ Ref STM Int -> (Int -> (Int, Int)) -> STM Int
forall a b. Ref STM a -> (a -> (a, b)) -> STM b
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef' TVar Int
Ref STM Int
tv \Int
i -> (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
i)
TVar (IntMap (SomeRef g))
refs :: TVar (IntMap (SomeRef g)) <-
IO (TVar (IntMap (SomeRef g)))
-> (TVar (IntMap (SomeRef g)) -> IO ())
-> Acquire (TVar (IntMap (SomeRef g)))
forall a. IO a -> (a -> IO ()) -> Acquire a
R.mkAcquire1 (IntMap (SomeRef g) -> IO (TVar (IntMap (SomeRef g)))
forall a. a -> IO (TVar a)
newTVarIO IntMap (SomeRef g)
forall a. Monoid a => a
mempty) \TVar (IntMap (SomeRef g))
tvsrs ->
STM () -> IO ()
forall a. STM a -> IO a
atomically do
IntMap (SomeRef g)
srs <- TVar (IntMap (SomeRef g))
-> IntMap (SomeRef g) -> STM (IntMap (SomeRef g))
forall a. TVar a -> a -> STM a
swapTVar TVar (IntMap (SomeRef g))
tvsrs IntMap (SomeRef g)
forall a. Monoid a => a
mempty
IntMap (SomeRef g) -> (SomeRef g -> STM ()) -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ IntMap (SomeRef g)
srs \(SomeRef (Ref TVar (Maybe a)
tv)) ->
TVar (Maybe a) -> Maybe a -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe a)
tv Maybe a
forall a. Maybe a
Nothing
Env g r t -> Acquire (Env g r t)
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Env{TVar (IntMap (SomeRef g))
STM Int
Transaction t
unique :: STM Int
refs :: TVar (IntMap (SomeRef g))
tx :: Transaction t
tx :: Transaction t
unique :: STM Int
refs :: TVar (IntMap (SomeRef g))
..}
newtype Transactional (g :: k) (r :: Retry) (t :: Mode) (a :: Type)
= Transactional (Env g r t -> R.ResourceT IO a)
deriving
( (forall a b.
(a -> b) -> Transactional g r t a -> Transactional g r t b)
-> (forall a b.
a -> Transactional g r t b -> Transactional g r t a)
-> Functor (Transactional g r t)
forall k (g :: k) (r :: Retry) (t :: Mode) a b.
a -> Transactional g r t b -> Transactional g r t a
forall k (g :: k) (r :: Retry) (t :: Mode) a b.
(a -> b) -> Transactional g r t a -> Transactional g r t b
forall a b. a -> Transactional g r t b -> Transactional g r t a
forall a b.
(a -> b) -> Transactional g r t a -> Transactional g r t b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k (g :: k) (r :: Retry) (t :: Mode) a b.
(a -> b) -> Transactional g r t a -> Transactional g r t b
fmap :: forall a b.
(a -> b) -> Transactional g r t a -> Transactional g r t b
$c<$ :: forall k (g :: k) (r :: Retry) (t :: Mode) a b.
a -> Transactional g r t b -> Transactional g r t a
<$ :: forall a b. a -> Transactional g r t b -> Transactional g r t a
Functor
, Functor (Transactional g r t)
Functor (Transactional g r t) =>
(forall a. a -> Transactional g r t a)
-> (forall a b.
Transactional g r t (a -> b)
-> Transactional g r t a -> Transactional g r t b)
-> (forall a b c.
(a -> b -> c)
-> Transactional g r t a
-> Transactional g r t b
-> Transactional g r t c)
-> (forall a b.
Transactional g r t a
-> Transactional g r t b -> Transactional g r t b)
-> (forall a b.
Transactional g r t a
-> Transactional g r t b -> Transactional g r t a)
-> Applicative (Transactional g r t)
forall a. a -> Transactional g r t a
forall k (g :: k) (r :: Retry) (t :: Mode).
Functor (Transactional g r t)
forall k (g :: k) (r :: Retry) (t :: Mode) a.
a -> Transactional g r t a
forall k (g :: k) (r :: Retry) (t :: Mode) a b.
Transactional g r t a
-> Transactional g r t b -> Transactional g r t a
forall k (g :: k) (r :: Retry) (t :: Mode) a b.
Transactional g r t a
-> Transactional g r t b -> Transactional g r t b
forall k (g :: k) (r :: Retry) (t :: Mode) a b.
Transactional g r t (a -> b)
-> Transactional g r t a -> Transactional g r t b
forall k (g :: k) (r :: Retry) (t :: Mode) a b c.
(a -> b -> c)
-> Transactional g r t a
-> Transactional g r t b
-> Transactional g r t c
forall a b.
Transactional g r t a
-> Transactional g r t b -> Transactional g r t a
forall a b.
Transactional g r t a
-> Transactional g r t b -> Transactional g r t b
forall a b.
Transactional g r t (a -> b)
-> Transactional g r t a -> Transactional g r t b
forall a b c.
(a -> b -> c)
-> Transactional g r t a
-> Transactional g r t b
-> Transactional g r t 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
$cpure :: forall k (g :: k) (r :: Retry) (t :: Mode) a.
a -> Transactional g r t a
pure :: forall a. a -> Transactional g r t a
$c<*> :: forall k (g :: k) (r :: Retry) (t :: Mode) a b.
Transactional g r t (a -> b)
-> Transactional g r t a -> Transactional g r t b
<*> :: forall a b.
Transactional g r t (a -> b)
-> Transactional g r t a -> Transactional g r t b
$cliftA2 :: forall k (g :: k) (r :: Retry) (t :: Mode) a b c.
(a -> b -> c)
-> Transactional g r t a
-> Transactional g r t b
-> Transactional g r t c
liftA2 :: forall a b c.
(a -> b -> c)
-> Transactional g r t a
-> Transactional g r t b
-> Transactional g r t c
$c*> :: forall k (g :: k) (r :: Retry) (t :: Mode) a b.
Transactional g r t a
-> Transactional g r t b -> Transactional g r t b
*> :: forall a b.
Transactional g r t a
-> Transactional g r t b -> Transactional g r t b
$c<* :: forall k (g :: k) (r :: Retry) (t :: Mode) a b.
Transactional g r t a
-> Transactional g r t b -> Transactional g r t a
<* :: forall a b.
Transactional g r t a
-> Transactional g r t b -> Transactional g r t a
Applicative
, Applicative (Transactional g r t)
Applicative (Transactional g r t) =>
(forall a b.
Transactional g r t a
-> (a -> Transactional g r t b) -> Transactional g r t b)
-> (forall a b.
Transactional g r t a
-> Transactional g r t b -> Transactional g r t b)
-> (forall a. a -> Transactional g r t a)
-> Monad (Transactional g r t)
forall a. a -> Transactional g r t a
forall k (g :: k) (r :: Retry) (t :: Mode).
Applicative (Transactional g r t)
forall k (g :: k) (r :: Retry) (t :: Mode) a.
a -> Transactional g r t a
forall k (g :: k) (r :: Retry) (t :: Mode) a b.
Transactional g r t a
-> Transactional g r t b -> Transactional g r t b
forall k (g :: k) (r :: Retry) (t :: Mode) a b.
Transactional g r t a
-> (a -> Transactional g r t b) -> Transactional g r t b
forall a b.
Transactional g r t a
-> Transactional g r t b -> Transactional g r t b
forall a b.
Transactional g r t a
-> (a -> Transactional g r t b) -> Transactional g r t 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
$c>>= :: forall k (g :: k) (r :: Retry) (t :: Mode) a b.
Transactional g r t a
-> (a -> Transactional g r t b) -> Transactional g r t b
>>= :: forall a b.
Transactional g r t a
-> (a -> Transactional g r t b) -> Transactional g r t b
$c>> :: forall k (g :: k) (r :: Retry) (t :: Mode) a b.
Transactional g r t a
-> Transactional g r t b -> Transactional g r t b
>> :: forall a b.
Transactional g r t a
-> Transactional g r t b -> Transactional g r t b
$creturn :: forall k (g :: k) (r :: Retry) (t :: Mode) a.
a -> Transactional g r t a
return :: forall a. a -> Transactional g r t a
Monad
, Monad (Transactional g r t)
Monad (Transactional g r t) =>
(forall e a.
(HasCallStack, Exception e) =>
e -> Transactional g r t a)
-> MonadThrow (Transactional g r t)
forall k (g :: k) (r :: Retry) (t :: Mode).
Monad (Transactional g r t)
forall k (g :: k) (r :: Retry) (t :: Mode) e a.
(HasCallStack, Exception e) =>
e -> Transactional g r t a
forall e a.
(HasCallStack, Exception e) =>
e -> Transactional g r t a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall k (g :: k) (r :: Retry) (t :: Mode) e a.
(HasCallStack, Exception e) =>
e -> Transactional g r t a
throwM :: forall e a.
(HasCallStack, Exception e) =>
e -> Transactional g r t a
Cx.MonadThrow
, MonadCatch (Transactional g r t)
MonadCatch (Transactional g r t) =>
(forall b.
HasCallStack =>
((forall a. Transactional g r t a -> Transactional g r t a)
-> Transactional g r t b)
-> Transactional g r t b)
-> (forall b.
HasCallStack =>
((forall a. Transactional g r t a -> Transactional g r t a)
-> Transactional g r t b)
-> Transactional g r t b)
-> (forall a b c.
HasCallStack =>
Transactional g r t a
-> (a -> ExitCase b -> Transactional g r t c)
-> (a -> Transactional g r t b)
-> Transactional g r t (b, c))
-> MonadMask (Transactional g r t)
forall b.
HasCallStack =>
((forall a. Transactional g r t a -> Transactional g r t a)
-> Transactional g r t b)
-> Transactional g r t b
forall k (g :: k) (r :: Retry) (t :: Mode).
MonadCatch (Transactional g r t)
forall k (g :: k) (r :: Retry) (t :: Mode) b.
HasCallStack =>
((forall a. Transactional g r t a -> Transactional g r t a)
-> Transactional g r t b)
-> Transactional g r t b
forall k (g :: k) (r :: Retry) (t :: Mode) a b c.
HasCallStack =>
Transactional g r t a
-> (a -> ExitCase b -> Transactional g r t c)
-> (a -> Transactional g r t b)
-> Transactional g r t (b, c)
forall a b c.
HasCallStack =>
Transactional g r t a
-> (a -> ExitCase b -> Transactional g r t c)
-> (a -> Transactional g r t b)
-> Transactional g r t (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
HasCallStack =>
((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
HasCallStack =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall k (g :: k) (r :: Retry) (t :: Mode) b.
HasCallStack =>
((forall a. Transactional g r t a -> Transactional g r t a)
-> Transactional g r t b)
-> Transactional g r t b
mask :: forall b.
HasCallStack =>
((forall a. Transactional g r t a -> Transactional g r t a)
-> Transactional g r t b)
-> Transactional g r t b
$cuninterruptibleMask :: forall k (g :: k) (r :: Retry) (t :: Mode) b.
HasCallStack =>
((forall a. Transactional g r t a -> Transactional g r t a)
-> Transactional g r t b)
-> Transactional g r t b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Transactional g r t a -> Transactional g r t a)
-> Transactional g r t b)
-> Transactional g r t b
$cgeneralBracket :: forall k (g :: k) (r :: Retry) (t :: Mode) a b c.
HasCallStack =>
Transactional g r t a
-> (a -> ExitCase b -> Transactional g r t c)
-> (a -> Transactional g r t b)
-> Transactional g r t (b, c)
generalBracket :: forall a b c.
HasCallStack =>
Transactional g r t a
-> (a -> ExitCase b -> Transactional g r t c)
-> (a -> Transactional g r t b)
-> Transactional g r t (b, c)
Cx.MonadMask
, Monad (Transactional g r t)
Monad (Transactional g r t) =>
(forall a. String -> Transactional g r t a)
-> MonadFail (Transactional g r t)
forall a. String -> Transactional g r t a
forall k (g :: k) (r :: Retry) (t :: Mode).
Monad (Transactional g r t)
forall k (g :: k) (r :: Retry) (t :: Mode) a.
String -> Transactional g r t a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall k (g :: k) (r :: Retry) (t :: Mode) a.
String -> Transactional g r t a
fail :: forall a. String -> Transactional g r t a
MonadFail
)
via (ReaderT (Env g r t) (R.ResourceT IO))
un :: Transactional g r t a -> Env g r t -> R.ResourceT IO a
un :: forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
Transactional g r t a -> Env g r t -> ResourceT IO a
un = Transactional g r t a -> Env g r t -> ResourceT IO a
forall a b. Coercible a b => a -> b
coerce
{-# INLINE un #-}
mk :: (Env g r t -> R.ResourceT IO a) -> Transactional g r t a
mk :: forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
(Env g r t -> ResourceT IO a) -> Transactional g r t a
mk = (Env g r t -> ResourceT IO a) -> Transactional g r t a
forall a b. Coercible a b => a -> b
coerce
{-# INLINE mk #-}
transactionalRetry
:: forall m r t a
. (MonadIO m)
=> A.Acquire (Transaction t)
-> (forall g. Transactional g r t a)
-> m a
transactionalRetry :: forall {k} (m :: * -> *) (r :: Retry) (t :: Mode) a.
MonadIO m =>
Acquire (Transaction t)
-> (forall (g :: k). Transactional g r t a) -> m a
transactionalRetry Acquire (Transaction t)
atx forall (g :: k). Transactional g r t a
ta = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Word -> IO a
go Word
0)
where
go :: Word -> IO a
go :: Word -> IO a
go !Word
n = IO a -> (ErrRetry -> IO a) -> IO a
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
Ex.catch IO a
once \ErrRetry
ErrRetry -> do
let ms :: Double
ms = Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2 (Word -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
1 Word
n) :: Double)
Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double
1_000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ms)
Word -> IO a
go (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1)
once :: IO a
once :: IO a
once = ResourceT IO a -> IO a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
R.runResourceT do
(ReleaseKey
_, Env Any r t
env) <- Acquire (Env Any r t) -> ResourceT IO (ReleaseKey, Env Any r t)
forall (m :: * -> *) a.
MonadResource m =>
Acquire a -> m (ReleaseKey, a)
A.allocateAcquire (Acquire (Env Any r t) -> ResourceT IO (ReleaseKey, Env Any r t))
-> Acquire (Env Any r t) -> ResourceT IO (ReleaseKey, Env Any r t)
forall a b. (a -> b) -> a -> b
$ Transaction t -> Acquire (Env Any r t)
forall {k} (t :: Mode) (g :: k) (r :: Retry).
Transaction t -> Acquire (Env g r t)
acquireEnv (Transaction t -> Acquire (Env Any r t))
-> Acquire (Transaction t) -> Acquire (Env Any r t)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Acquire (Transaction t)
atx
Transactional Any r t a -> Env Any r t -> ResourceT IO a
forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
Transactional g r t a -> Env g r t -> ResourceT IO a
un Transactional Any r t a
forall (g :: k). Transactional g r t a
ta Env Any r t
env
embed
:: forall m t a
. (MonadIO m)
=> Transaction t
-> (forall g. Transactional g 'NoRetry t a)
-> m a
embed :: forall {k} (m :: * -> *) (t :: Mode) a.
MonadIO m =>
Transaction t
-> (forall (g :: k). Transactional g 'NoRetry t a) -> m a
embed Transaction t
tx forall (g :: k). Transactional g 'NoRetry t a
ta =
IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ ResourceT IO a -> IO a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
R.runResourceT do
(ReleaseKey
_, Env Any 'NoRetry t
env) <- Acquire (Env Any 'NoRetry t)
-> ResourceT IO (ReleaseKey, Env Any 'NoRetry t)
forall (m :: * -> *) a.
MonadResource m =>
Acquire a -> m (ReleaseKey, a)
A.allocateAcquire (Acquire (Env Any 'NoRetry t)
-> ResourceT IO (ReleaseKey, Env Any 'NoRetry t))
-> Acquire (Env Any 'NoRetry t)
-> ResourceT IO (ReleaseKey, Env Any 'NoRetry t)
forall a b. (a -> b) -> a -> b
$ Transaction t -> Acquire (Env Any 'NoRetry t)
forall {k} (t :: Mode) (g :: k) (r :: Retry).
Transaction t -> Acquire (Env g r t)
acquireEnv Transaction t
tx
Transactional Any 'NoRetry t a
-> Env Any 'NoRetry t -> ResourceT IO a
forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
Transactional g r t a -> Env g r t -> ResourceT IO a
un Transactional Any 'NoRetry t a
forall (g :: k). Transactional g 'NoRetry t a
ta Env Any 'NoRetry t
env
foldM
:: forall o z i t s g r
. (SubMode t s)
=> F.FoldM (Transactional g r t) o z
-> Statement s i o
-> i
-> Transactional g r t z
foldM :: forall {k} o z i (t :: Mode) (s :: Mode) (g :: k) (r :: Retry).
SubMode t s =>
FoldM (Transactional g r t) o z
-> Statement s i o -> i -> Transactional g r t z
foldM FoldM (Transactional g r t) o z
f Statement s i o
st i
i = (Env g r t -> ResourceT IO z) -> Transactional g r t z
forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
(Env g r t -> ResourceT IO a) -> Transactional g r t a
mk \Env g r t
env ->
FoldM (ResourceT IO) o z
-> Acquire (Transaction t)
-> Statement s i o
-> i
-> ResourceT IO z
forall o z i (t :: Mode) (s :: Mode) (m :: * -> *).
(MonadIO m, MonadMask m, SubMode t s) =>
FoldM m o z
-> Acquire (Transaction t) -> Statement s i o -> i -> m z
foldIO ((forall x. Transactional g r t x -> ResourceT IO x)
-> FoldM (Transactional g r t) o z -> FoldM (ResourceT IO) o z
forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x) -> FoldM m a b -> FoldM n a b
F.hoists ((Transactional g r t x -> Env g r t -> ResourceT IO x)
-> Env g r t -> Transactional g r t x -> ResourceT IO x
forall a b c. (a -> b -> c) -> b -> a -> c
flip Transactional g r t x -> Env g r t -> ResourceT IO x
forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
Transactional g r t a -> Env g r t -> ResourceT IO a
un Env g r t
env) FoldM (Transactional g r t) o z
f) (Transaction t -> Acquire (Transaction t)
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Env g r t
env.tx) Statement s i o
st i
i
instance Ex.MonadCatch (Transactional g r t) where
catch :: forall e a.
(HasCallStack, Exception e) =>
Transactional g r t a
-> (e -> Transactional g r t a) -> Transactional g r t a
catch Transactional g r t a
act e -> Transactional g r t a
f = (Env g r t -> ResourceT IO a) -> Transactional g r t a
forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
(Env g r t -> ResourceT IO a) -> Transactional g r t a
mk \Env g r t
env -> do
STM ()
refsRollback <- IO (STM ()) -> ResourceT IO (STM ())
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (STM ()) -> ResourceT IO (STM ()))
-> IO (STM ()) -> ResourceT IO (STM ())
forall a b. (a -> b) -> a -> b
$ STM (STM ()) -> IO (STM ())
forall a. STM a -> IO a
atomically (STM (STM ()) -> IO (STM ())) -> STM (STM ()) -> IO (STM ())
forall a b. (a -> b) -> a -> b
$ TVar (IntMap (SomeRef g)) -> STM (STM ())
forall {k} (g :: k). TVar (IntMap (SomeRef g)) -> STM (STM ())
saveSomeRefs Env g r t
env.refs
case Env g r t
env.tx.smode of
SMode t
SRead ->
ResourceT IO a
-> (SomeException -> ResourceT IO a) -> ResourceT IO a
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
Ex.catchAsync (Transactional g r t a -> Env g r t -> ResourceT IO a
forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
Transactional g r t a -> Env g r t -> ResourceT IO a
un Transactional g r t a
act Env g r t
env) \SomeException
se -> do
IO () -> ResourceT IO ()
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically STM ()
refsRollback
case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
se of
Maybe e
Nothing -> SomeException -> ResourceT IO a
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
Ex.throwM SomeException
se
Just e
e -> Transactional g r t a -> Env g r t -> ResourceT IO a
forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
Transactional g r t a -> Env g r t -> ResourceT IO a
un (e -> Transactional g r t a
f e
e) Env g r t
env
SMode t
SWrite -> ((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO a)
-> ResourceT IO a
forall b.
HasCallStack =>
((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b)
-> ResourceT IO b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
Ex.mask \forall a. ResourceT IO a -> ResourceT IO a
restore -> do
Savepoint
sp <- Transaction 'Write -> ResourceT IO Savepoint
forall (m :: * -> *).
MonadIO m =>
Transaction 'Write -> m Savepoint
savepoint Env g r t
env.tx
ResourceT IO a -> ResourceT IO (Either SomeException a)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
Ex.tryAsync (ResourceT IO a -> ResourceT IO a
forall a. ResourceT IO a -> ResourceT IO a
restore (Transactional g r t a -> Env g r t -> ResourceT IO a
forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
Transactional g r t a -> Env g r t -> ResourceT IO a
un Transactional g r t a
act Env g r t
env)) ResourceT IO (Either SomeException a)
-> (Either SomeException a -> ResourceT IO a) -> ResourceT IO a
forall a b.
ResourceT IO a -> (a -> ResourceT IO b) -> ResourceT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right a
a -> do
ResourceT IO (Either SomeException ()) -> ResourceT IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ResourceT IO (Either SomeException ()) -> ResourceT IO ())
-> ResourceT IO (Either SomeException ()) -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ ResourceT IO () -> ResourceT IO (Either SomeException ())
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
Ex.tryAny (ResourceT IO () -> ResourceT IO (Either SomeException ()))
-> ResourceT IO () -> ResourceT IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ Savepoint -> ResourceT IO ()
forall (m :: * -> *). MonadIO m => Savepoint -> m ()
savepointRelease Savepoint
sp
a -> ResourceT IO a
forall a. a -> ResourceT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
Left SomeException
se -> do
IO () -> ResourceT IO ()
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically STM ()
refsRollback
Savepoint -> ResourceT IO ()
forall (m :: * -> *). MonadIO m => Savepoint -> m ()
savepointRollback Savepoint
sp
ResourceT IO (Either SomeException ()) -> ResourceT IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ResourceT IO (Either SomeException ()) -> ResourceT IO ())
-> ResourceT IO (Either SomeException ()) -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ ResourceT IO () -> ResourceT IO (Either SomeException ())
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
Ex.tryAny (ResourceT IO () -> ResourceT IO (Either SomeException ()))
-> ResourceT IO () -> ResourceT IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ Savepoint -> ResourceT IO ()
forall (m :: * -> *). MonadIO m => Savepoint -> m ()
savepointRelease Savepoint
sp
case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
Ex.fromException SomeException
se of
Maybe e
Nothing -> SomeException -> ResourceT IO a
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
Ex.throwM SomeException
se
Just e
e -> ResourceT IO a -> ResourceT IO a
forall a. ResourceT IO a -> ResourceT IO a
restore (ResourceT IO a -> ResourceT IO a)
-> ResourceT IO a -> ResourceT IO a
forall a b. (a -> b) -> a -> b
$ Transactional g r t a -> Env g r t -> ResourceT IO a
forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
Transactional g r t a -> Env g r t -> ResourceT IO a
un (e -> Transactional g r t a
f e
e) Env g r t
env
data ErrRetry = ErrRetry
deriving stock (Int -> ErrRetry -> ShowS
[ErrRetry] -> ShowS
ErrRetry -> String
(Int -> ErrRetry -> ShowS)
-> (ErrRetry -> String) -> ([ErrRetry] -> ShowS) -> Show ErrRetry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrRetry -> ShowS
showsPrec :: Int -> ErrRetry -> ShowS
$cshow :: ErrRetry -> String
show :: ErrRetry -> String
$cshowList :: [ErrRetry] -> ShowS
showList :: [ErrRetry] -> ShowS
Show)
deriving anyclass (Show ErrRetry
Typeable ErrRetry
(Typeable ErrRetry, Show ErrRetry) =>
(ErrRetry -> SomeException)
-> (SomeException -> Maybe ErrRetry)
-> (ErrRetry -> String)
-> Exception ErrRetry
SomeException -> Maybe ErrRetry
ErrRetry -> String
ErrRetry -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: ErrRetry -> SomeException
toException :: ErrRetry -> SomeException
$cfromException :: SomeException -> Maybe ErrRetry
fromException :: SomeException -> Maybe ErrRetry
$cdisplayException :: ErrRetry -> String
displayException :: ErrRetry -> String
Ex.Exception)
retry :: Transactional g 'Retry t a
retry :: forall {k} (g :: k) (t :: Mode) a. Transactional g 'Retry t a
retry = ErrRetry -> Transactional g 'Retry t a
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
Ex.throwM ErrRetry
ErrRetry
{-# INLINE retry #-}
orElse
:: Transactional g r t a
-> Transactional g r t a
-> Transactional g r t a
orElse :: forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
Transactional g r t a
-> Transactional g r t a -> Transactional g r t a
orElse Transactional g r t a
tl Transactional g r t a
tr = Transactional g r t a
-> (ErrRetry -> Transactional g r t a) -> Transactional g r t a
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
Ex.catch Transactional g r t a
tl \ErrRetry
ErrRetry -> Transactional g r t a
tr
instance Alternative (Transactional g 'Retry t) where
empty :: forall a. Transactional g 'Retry t a
empty = Transactional g 'Retry t a
forall {k} (g :: k) (t :: Mode) a. Transactional g 'Retry t a
retry
{-# INLINE empty #-}
<|> :: forall a.
Transactional g 'Retry t a
-> Transactional g 'Retry t a -> Transactional g 'Retry t a
(<|>) = Transactional g 'Retry t a
-> Transactional g 'Retry t a -> Transactional g 'Retry t a
forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
Transactional g r t a
-> Transactional g r t a -> Transactional g r t a
orElse
{-# INLINE (<|>) #-}
instance MonadPlus (Transactional g 'Retry t) where
mzero :: forall a. Transactional g 'Retry t a
mzero = Transactional g 'Retry t a
forall {k} (g :: k) (t :: Mode) a. Transactional g 'Retry t a
retry
{-# INLINE mzero #-}
mplus :: forall a.
Transactional g 'Retry t a
-> Transactional g 'Retry t a -> Transactional g 'Retry t a
mplus = Transactional g 'Retry t a
-> Transactional g 'Retry t a -> Transactional g 'Retry t a
forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
Transactional g r t a
-> Transactional g r t a -> Transactional g r t a
orElse
{-# INLINE mplus #-}
data SomeRef g where
SomeRef :: Ref g a -> SomeRef g
saveSomeRefs :: TVar (IntMap (SomeRef g)) -> STM (STM ())
saveSomeRefs :: forall {k} (g :: k). TVar (IntMap (SomeRef g)) -> STM (STM ())
saveSomeRefs TVar (IntMap (SomeRef g))
tvsrs = do
IntMap (SomeRef g)
srs0 <- TVar (IntMap (SomeRef g)) -> STM (IntMap (SomeRef g))
forall a. TVar a -> STM a
readTVar TVar (IntMap (SomeRef g))
tvsrs
IntMap (STM ())
rollbacks <- IntMap (SomeRef g)
-> (SomeRef g -> STM (STM ())) -> STM (IntMap (STM ()))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM IntMap (SomeRef g)
srs0 \(SomeRef (Ref TVar (Maybe a)
tv)) ->
TVar (Maybe a) -> Maybe a -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe a)
tv (Maybe a -> STM ()) -> STM (Maybe a) -> STM (STM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Maybe a) -> STM (Maybe a)
forall a. TVar a -> STM a
readTVar TVar (Maybe a)
tv
STM () -> STM (STM ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure do
IntMap (SomeRef g)
srs1 <- TVar (IntMap (SomeRef g))
-> IntMap (SomeRef g) -> STM (IntMap (SomeRef g))
forall a. TVar a -> a -> STM a
swapTVar TVar (IntMap (SomeRef g))
tvsrs IntMap (SomeRef g)
srs0
IntMap (SomeRef g) -> (SomeRef g -> STM ()) -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (IntMap (SomeRef g) -> IntMap (SomeRef g) -> IntMap (SomeRef g)
forall a b. IntMap a -> IntMap b -> IntMap a
IntMap.difference IntMap (SomeRef g)
srs1 IntMap (SomeRef g)
srs0) \(SomeRef (Ref TVar (Maybe a)
tv)) ->
TVar (Maybe a) -> Maybe a -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe a)
tv Maybe a
forall a. Maybe a
Nothing
IntMap (STM ()) -> STM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ IntMap (STM ())
rollbacks
newtype Ref g a = Ref (TVar (Maybe a))
deriving newtype
( Ref g a -> Ref g a -> Bool
(Ref g a -> Ref g a -> Bool)
-> (Ref g a -> Ref g a -> Bool) -> Eq (Ref g a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (g :: k) a. Ref g a -> Ref g a -> Bool
$c== :: forall k (g :: k) a. Ref g a -> Ref g a -> Bool
== :: Ref g a -> Ref g a -> Bool
$c/= :: forall k (g :: k) a. Ref g a -> Ref g a -> Bool
/= :: Ref g a -> Ref g a -> Bool
Eq
)
instance MonadRef (Transactional g r t) where
type Ref (Transactional g r t) = Sq.Transactional.Ref g
newRef :: forall a. a -> Transactional g r t (Ref (Transactional g r t) a)
newRef a
a = (Env g r t -> ResourceT IO (Ref g a))
-> Transactional g r t (Ref g a)
forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
(Env g r t -> ResourceT IO a) -> Transactional g r t a
mk \Env g r t
env -> IO (Ref g a) -> ResourceT IO (Ref g a)
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ref g a) -> ResourceT IO (Ref g a))
-> IO (Ref g a) -> ResourceT IO (Ref g a)
forall a b. (a -> b) -> a -> b
$ STM (Ref g a) -> IO (Ref g a)
forall a. STM a -> IO a
atomically do
Int
i <- Env g r t
env.unique
TVar (Maybe a)
tv <- Maybe a -> STM (TVar (Maybe a))
forall a. a -> STM (TVar a)
newTVar (Maybe a -> STM (TVar (Maybe a)))
-> Maybe a -> STM (TVar (Maybe a))
forall a b. (a -> b) -> a -> b
$! a -> Maybe a
forall a. a -> Maybe a
Just a
a
let ref :: Ref g a
ref = TVar (Maybe a) -> Ref g a
forall {k} (g :: k) a. TVar (Maybe a) -> Ref g a
Ref TVar (Maybe a)
tv
TVar (IntMap (SomeRef g))
-> (IntMap (SomeRef g) -> IntMap (SomeRef g)) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' Env g r t
env.refs ((IntMap (SomeRef g) -> IntMap (SomeRef g)) -> STM ())
-> (IntMap (SomeRef g) -> IntMap (SomeRef g)) -> STM ()
forall a b. (a -> b) -> a -> b
$ Int -> SomeRef g -> IntMap (SomeRef g) -> IntMap (SomeRef g)
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
i (SomeRef g -> IntMap (SomeRef g) -> IntMap (SomeRef g))
-> SomeRef g -> IntMap (SomeRef g) -> IntMap (SomeRef g)
forall a b. (a -> b) -> a -> b
$! Ref g a -> SomeRef g
forall {k} (g :: k) a. Ref g a -> SomeRef g
SomeRef Ref g a
ref
Ref g a -> STM (Ref g a)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ref g a
ref
readRef :: forall a. Ref (Transactional g r t) a -> Transactional g r t a
readRef (Ref TVar (Maybe a)
tv) = (Env g r t -> ResourceT IO a) -> Transactional g r t a
forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
(Env g r t -> ResourceT IO a) -> Transactional g r t a
mk \Env g r t
_ -> IO a -> ResourceT IO a
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> ResourceT IO a) -> IO a -> ResourceT IO a
forall a b. (a -> b) -> a -> b
$ STM a -> IO a
forall a. STM a -> IO a
atomically do
TVar (Maybe a) -> STM (Maybe a)
forall a. TVar a -> STM a
readTVar TVar (Maybe a)
tv STM (Maybe a) -> (Maybe a -> STM a) -> STM a
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just a
a -> a -> STM a
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
Maybe a
Nothing -> IOError -> STM a
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
Ex.throwM (IOError -> STM a) -> IOError -> STM a
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> IOError
String -> IOError
resourceVanishedWithCallStack String
"Ref"
writeRef :: forall a.
Ref (Transactional g r t) a -> a -> Transactional g r t ()
writeRef Ref (Transactional g r t) a
r a
a = Ref (Transactional g r t) a
-> (a -> (a, ())) -> Transactional g r t ()
forall a b.
Ref (Transactional g r t) a
-> (a -> (a, b)) -> Transactional g r t b
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef Ref (Transactional g r t) a
r \a
_ -> (a
a, ())
modifyRef :: forall a.
Ref (Transactional g r t) a -> (a -> a) -> Transactional g r t ()
modifyRef Ref (Transactional g r t) a
r a -> a
f = Ref (Transactional g r t) a
-> (a -> (a, ())) -> Transactional g r t ()
forall a b.
Ref (Transactional g r t) a
-> (a -> (a, b)) -> Transactional g r t b
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef Ref (Transactional g r t) a
r \a
a -> (a -> a
f a
a, ())
modifyRef' :: forall a.
Ref (Transactional g r t) a -> (a -> a) -> Transactional g r t ()
modifyRef' Ref (Transactional g r t) a
r a -> a
f = Ref (Transactional g r t) a
-> (a -> (a, ())) -> Transactional g r t ()
forall a b.
Ref (Transactional g r t) a
-> (a -> (a, b)) -> Transactional g r t b
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef' Ref (Transactional g r t) a
r \a
a -> (a -> a
f a
a, ())
instance MonadAtomicRef (Transactional g r t) where
atomicModifyRef :: forall a b.
Ref (Transactional g r t) a
-> (a -> (a, b)) -> Transactional g r t b
atomicModifyRef (Ref TVar (Maybe a)
tv) a -> (a, b)
f =
(Env g r t -> ResourceT IO b) -> Transactional g r t b
forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
(Env g r t -> ResourceT IO a) -> Transactional g r t a
mk \Env g r t
_ -> IO b -> ResourceT IO b
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> ResourceT IO b) -> IO b -> ResourceT IO b
forall a b. (a -> b) -> a -> b
$ STM b -> IO b
forall a. STM a -> IO a
atomically do
TVar (Maybe a) -> STM (Maybe a)
forall a. TVar a -> STM a
readTVar TVar (Maybe a)
tv STM (Maybe a) -> (Maybe a -> STM b) -> STM b
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just a
a0 | (a
a1, b
b) <- a -> (a, b)
f a
a0 -> do
TVar (Maybe a) -> Maybe a -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe a)
tv (Maybe a -> STM ()) -> Maybe a -> STM ()
forall a b. (a -> b) -> a -> b
$! a -> Maybe a
forall a. a -> Maybe a
Just a
a1
b -> STM b
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b
Maybe a
Nothing -> IOError -> STM b
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
Ex.throwM (IOError -> STM b) -> IOError -> STM b
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> IOError
String -> IOError
resourceVanishedWithCallStack String
"Ref"
atomicModifyRef' :: forall a b.
Ref (Transactional g r t) a
-> (a -> (a, b)) -> Transactional g r t b
atomicModifyRef' (Ref TVar (Maybe a)
tv) a -> (a, b)
f =
(Env g r t -> ResourceT IO b) -> Transactional g r t b
forall {k} (g :: k) (r :: Retry) (t :: Mode) a.
(Env g r t -> ResourceT IO a) -> Transactional g r t a
mk \Env g r t
_ -> IO b -> ResourceT IO b
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> ResourceT IO b) -> IO b -> ResourceT IO b
forall a b. (a -> b) -> a -> b
$ STM b -> IO b
forall a. STM a -> IO a
atomically do
TVar (Maybe a) -> STM (Maybe a)
forall a. TVar a -> STM a
readTVar TVar (Maybe a)
tv STM (Maybe a) -> (Maybe a -> STM b) -> STM b
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just a
a0 | (!a
a1, !b
b) <- a -> (a, b)
f a
a0 -> do
TVar (Maybe a) -> Maybe a -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe a)
tv (Maybe a -> STM ()) -> Maybe a -> STM ()
forall a b. (a -> b) -> a -> b
$! a -> Maybe a
forall a. a -> Maybe a
Just a
a1
b -> STM b
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b
Maybe a
Nothing -> IOError -> STM b
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
Ex.throwM (IOError -> STM b) -> IOError -> STM b
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> IOError
String -> IOError
resourceVanishedWithCallStack String
"Ref"
maybe
:: forall o i t s g r
. (SubMode t s)
=> Statement s i o
-> i
-> Transactional g r t (Maybe o)
maybe :: forall {k} o i (t :: Mode) (s :: Mode) (g :: k) (r :: Retry).
SubMode t s =>
Statement s i o -> i -> Transactional g r t (Maybe o)
maybe = FoldM (Transactional g r t) o (Maybe o)
-> Statement s i o -> i -> Transactional g r t (Maybe o)
forall {k} o z i (t :: Mode) (s :: Mode) (g :: k) (r :: Retry).
SubMode t s =>
FoldM (Transactional g r t) o z
-> Statement s i o -> i -> Transactional g r t z
foldM (FoldM (Transactional g r t) o (Maybe o)
-> Statement s i o -> i -> Transactional g r t (Maybe o))
-> FoldM (Transactional g r t) o (Maybe o)
-> Statement s i o
-> i
-> Transactional g r t (Maybe o)
forall a b. (a -> b) -> a -> b
$ ErrRows -> FoldM (Transactional g r t) o (Maybe o)
forall (m :: * -> *) e o.
(MonadThrow m, Exception e) =>
e -> FoldM m o (Maybe o)
foldMaybeM ErrRows
ErrRows_TooMany
{-# INLINE maybe #-}
one
:: forall o i t s g r
. (SubMode t s)
=> Statement s i o
-> i
-> Transactional g r t o
one :: forall {k} o i (t :: Mode) (s :: Mode) (g :: k) (r :: Retry).
SubMode t s =>
Statement s i o -> i -> Transactional g r t o
one = FoldM (Transactional g r t) o o
-> Statement s i o -> i -> Transactional g r t o
forall {k} o z i (t :: Mode) (s :: Mode) (g :: k) (r :: Retry).
SubMode t s =>
FoldM (Transactional g r t) o z
-> Statement s i o -> i -> Transactional g r t z
foldM (FoldM (Transactional g r t) o o
-> Statement s i o -> i -> Transactional g r t o)
-> FoldM (Transactional g r t) o o
-> Statement s i o
-> i
-> Transactional g r t o
forall a b. (a -> b) -> a -> b
$ ErrRows -> ErrRows -> FoldM (Transactional g r t) o o
forall (m :: * -> *) e o.
(MonadThrow m, Exception e) =>
e -> e -> FoldM m o o
foldOneM ErrRows
ErrRows_TooFew ErrRows
ErrRows_TooMany
{-# INLINE one #-}
zero
:: forall o i t s g r
. (SubMode t s)
=> Statement s i o
-> i
-> Transactional g r t ()
zero :: forall {k} o i (t :: Mode) (s :: Mode) (g :: k) (r :: Retry).
SubMode t s =>
Statement s i o -> i -> Transactional g r t ()
zero = FoldM (Transactional g r t) o ()
-> Statement s i o -> i -> Transactional g r t ()
forall {k} o z i (t :: Mode) (s :: Mode) (g :: k) (r :: Retry).
SubMode t s =>
FoldM (Transactional g r t) o z
-> Statement s i o -> i -> Transactional g r t z
foldM (FoldM (Transactional g r t) o ()
-> Statement s i o -> i -> Transactional g r t ())
-> FoldM (Transactional g r t) o ()
-> Statement s i o
-> i
-> Transactional g r t ()
forall a b. (a -> b) -> a -> b
$ ErrRows -> FoldM (Transactional g r t) o ()
forall (m :: * -> *) e o.
(MonadThrow m, Exception e) =>
e -> FoldM m o ()
foldZeroM ErrRows
ErrRows_TooMany
{-# INLINE zero #-}
some
:: forall o i t s g r
. (SubMode t s)
=> Statement s i o
-> i
-> Transactional g r t (Int64, NonEmpty o)
some :: forall {k} o i (t :: Mode) (s :: Mode) (g :: k) (r :: Retry).
SubMode t s =>
Statement s i o -> i -> Transactional g r t (Int64, NonEmpty o)
some = FoldM (Transactional g r t) o (Int64, NonEmpty o)
-> Statement s i o -> i -> Transactional g r t (Int64, NonEmpty o)
forall {k} o z i (t :: Mode) (s :: Mode) (g :: k) (r :: Retry).
SubMode t s =>
FoldM (Transactional g r t) o z
-> Statement s i o -> i -> Transactional g r t z
foldM (FoldM (Transactional g r t) o (Int64, NonEmpty o)
-> Statement s i o -> i -> Transactional g r t (Int64, NonEmpty o))
-> FoldM (Transactional g r t) o (Int64, NonEmpty o)
-> Statement s i o
-> i
-> Transactional g r t (Int64, NonEmpty o)
forall a b. (a -> b) -> a -> b
$ ErrRows -> FoldM (Transactional g r t) o (Int64, NonEmpty o)
forall (m :: * -> *) e o.
(MonadThrow m, Exception e) =>
e -> FoldM m o (Int64, NonEmpty o)
foldNonEmptyM ErrRows
ErrRows_TooFew
{-# INLINE some #-}
list
:: forall o i t s g r
. (SubMode t s)
=> Statement s i o
-> i
-> Transactional g r t (Int64, [o])
list :: forall {k} o i (t :: Mode) (s :: Mode) (g :: k) (r :: Retry).
SubMode t s =>
Statement s i o -> i -> Transactional g r t (Int64, [o])
list = Fold o (Int64, [o])
-> Statement s i o -> i -> Transactional g r t (Int64, [o])
forall {k} o z i (t :: Mode) (s :: Mode) (g :: k) (r :: Retry).
SubMode t s =>
Fold o z -> Statement s i o -> i -> Transactional g r t z
fold Fold o (Int64, [o])
forall o. Fold o (Int64, [o])
foldList
{-# INLINE list #-}
fold
:: forall o z i t s g r
. (SubMode t s)
=> F.Fold o z
-> Statement s i o
-> i
-> Transactional g r t z
fold :: forall {k} o z i (t :: Mode) (s :: Mode) (g :: k) (r :: Retry).
SubMode t s =>
Fold o z -> Statement s i o -> i -> Transactional g r t z
fold = FoldM (Transactional g r t) o z
-> Statement s i o -> i -> Transactional g r t z
forall {k} o z i (t :: Mode) (s :: Mode) (g :: k) (r :: Retry).
SubMode t s =>
FoldM (Transactional g r t) o z
-> Statement s i o -> i -> Transactional g r t z
foldM (FoldM (Transactional g r t) o z
-> Statement s i o -> i -> Transactional g r t z)
-> (Fold o z -> FoldM (Transactional g r t) o z)
-> Fold o z
-> Statement s i o
-> i
-> Transactional g r t z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fold o z -> FoldM (Transactional g r t) o z
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
F.generalize
{-# INLINE fold #-}