-- | STM minus retry. These STM actions are guaranteed not to block, and thus guaranteed not to be interrupted by an
-- async exception.
module Ki.Internal.NonblockingSTM
  ( NonblockingSTM,
    nonblockingAtomically,
    nonblockingThrowSTM,

    -- * TVar
    nonblockingReadTVar,
    nonblockingWriteTVar',
  )
where

import Control.Exception (Exception)
import Data.Coerce (coerce)
import GHC.Conc (STM, TVar, atomically, readTVar, throwSTM, writeTVar)

newtype NonblockingSTM a
  = NonblockingSTM (STM a)
  deriving newtype (Functor NonblockingSTM
Functor NonblockingSTM =>
(forall a. a -> NonblockingSTM a)
-> (forall a b.
    NonblockingSTM (a -> b) -> NonblockingSTM a -> NonblockingSTM b)
-> (forall a b c.
    (a -> b -> c)
    -> NonblockingSTM a -> NonblockingSTM b -> NonblockingSTM c)
-> (forall a b.
    NonblockingSTM a -> NonblockingSTM b -> NonblockingSTM b)
-> (forall a b.
    NonblockingSTM a -> NonblockingSTM b -> NonblockingSTM a)
-> Applicative NonblockingSTM
forall a. a -> NonblockingSTM a
forall a b.
NonblockingSTM a -> NonblockingSTM b -> NonblockingSTM a
forall a b.
NonblockingSTM a -> NonblockingSTM b -> NonblockingSTM b
forall a b.
NonblockingSTM (a -> b) -> NonblockingSTM a -> NonblockingSTM b
forall a b c.
(a -> b -> c)
-> NonblockingSTM a -> NonblockingSTM b -> NonblockingSTM 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 a. a -> NonblockingSTM a
pure :: forall a. a -> NonblockingSTM a
$c<*> :: forall a b.
NonblockingSTM (a -> b) -> NonblockingSTM a -> NonblockingSTM b
<*> :: forall a b.
NonblockingSTM (a -> b) -> NonblockingSTM a -> NonblockingSTM b
$cliftA2 :: forall a b c.
(a -> b -> c)
-> NonblockingSTM a -> NonblockingSTM b -> NonblockingSTM c
liftA2 :: forall a b c.
(a -> b -> c)
-> NonblockingSTM a -> NonblockingSTM b -> NonblockingSTM c
$c*> :: forall a b.
NonblockingSTM a -> NonblockingSTM b -> NonblockingSTM b
*> :: forall a b.
NonblockingSTM a -> NonblockingSTM b -> NonblockingSTM b
$c<* :: forall a b.
NonblockingSTM a -> NonblockingSTM b -> NonblockingSTM a
<* :: forall a b.
NonblockingSTM a -> NonblockingSTM b -> NonblockingSTM a
Applicative, (forall a b. (a -> b) -> NonblockingSTM a -> NonblockingSTM b)
-> (forall a b. a -> NonblockingSTM b -> NonblockingSTM a)
-> Functor NonblockingSTM
forall a b. a -> NonblockingSTM b -> NonblockingSTM a
forall a b. (a -> b) -> NonblockingSTM a -> NonblockingSTM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> NonblockingSTM a -> NonblockingSTM b
fmap :: forall a b. (a -> b) -> NonblockingSTM a -> NonblockingSTM b
$c<$ :: forall a b. a -> NonblockingSTM b -> NonblockingSTM a
<$ :: forall a b. a -> NonblockingSTM b -> NonblockingSTM a
Functor, Applicative NonblockingSTM
Applicative NonblockingSTM =>
(forall a b.
 NonblockingSTM a -> (a -> NonblockingSTM b) -> NonblockingSTM b)
-> (forall a b.
    NonblockingSTM a -> NonblockingSTM b -> NonblockingSTM b)
-> (forall a. a -> NonblockingSTM a)
-> Monad NonblockingSTM
forall a. a -> NonblockingSTM a
forall a b.
NonblockingSTM a -> NonblockingSTM b -> NonblockingSTM b
forall a b.
NonblockingSTM a -> (a -> NonblockingSTM b) -> NonblockingSTM 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 a b.
NonblockingSTM a -> (a -> NonblockingSTM b) -> NonblockingSTM b
>>= :: forall a b.
NonblockingSTM a -> (a -> NonblockingSTM b) -> NonblockingSTM b
$c>> :: forall a b.
NonblockingSTM a -> NonblockingSTM b -> NonblockingSTM b
>> :: forall a b.
NonblockingSTM a -> NonblockingSTM b -> NonblockingSTM b
$creturn :: forall a. a -> NonblockingSTM a
return :: forall a. a -> NonblockingSTM a
Monad)

nonblockingAtomically :: forall a. NonblockingSTM a -> IO a
nonblockingAtomically :: forall a. NonblockingSTM a -> IO a
nonblockingAtomically =
  forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(STM a -> IO a) STM a -> IO a
forall a. STM a -> IO a
atomically

nonblockingThrowSTM :: forall e x. (Exception e) => e -> NonblockingSTM x
nonblockingThrowSTM :: forall e x. Exception e => e -> NonblockingSTM x
nonblockingThrowSTM =
  forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(e -> STM x) e -> STM x
forall e a. Exception e => e -> STM a
throwSTM

nonblockingReadTVar :: forall a. TVar a -> NonblockingSTM a
nonblockingReadTVar :: forall a. TVar a -> NonblockingSTM a
nonblockingReadTVar =
  forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(TVar a -> STM a) TVar a -> STM a
forall a. TVar a -> STM a
readTVar

nonblockingWriteTVar' :: forall a. TVar a -> a -> NonblockingSTM ()
nonblockingWriteTVar' :: forall a. TVar a -> a -> NonblockingSTM ()
nonblockingWriteTVar' TVar a
var !a
x =
  STM () -> NonblockingSTM ()
forall a. STM a -> NonblockingSTM a
NonblockingSTM (TVar a -> a -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar a
var a
x)