module TheatreDev.StmStructures.Runner
( Runner,
start,
tell,
kill,
wait,
receiveSingle,
receiveMultiple,
releaseWithException,
releaseNormally,
getId,
)
where
import Control.Concurrent.STM.TBQueue
import Control.Concurrent.STM.TMVar
import Data.UUID.V4 qualified as UuidV4
import TheatreDev.ExtrasFor.TBQueue
import TheatreDev.Prelude
data Runner a = Runner
{ forall a. Runner a -> TBQueue a
queue :: TBQueue a,
forall a. Runner a -> TVar Bool
receivesVar :: TVar Bool,
forall a. Runner a -> TMVar (Maybe SomeException)
resVar :: TMVar (Maybe SomeException),
forall a. Runner a -> UUID
id :: UUID
}
getId :: Runner a -> UUID
getId :: forall a. Runner a -> UUID
getId = (.id)
start :: IO (Runner a)
start :: forall a. IO (Runner a)
start =
do
TBQueue a
queue <- forall a. Natural -> IO (TBQueue a)
newTBQueueIO Natural
1000
TVar Bool
receivesVar <- forall a. a -> IO (TVar a)
newTVarIO Bool
True
TMVar (Maybe SomeException)
resVar <- forall a. IO (TMVar a)
newEmptyTMVarIO
UUID
id <- IO UUID
UuidV4.nextRandom
return Runner {TVar Bool
TMVar (Maybe SomeException)
TBQueue a
UUID
id :: UUID
resVar :: TMVar (Maybe SomeException)
receivesVar :: TVar Bool
queue :: TBQueue a
$sel:id:Runner :: UUID
$sel:resVar:Runner :: TMVar (Maybe SomeException)
$sel:receivesVar:Runner :: TVar Bool
$sel:queue:Runner :: TBQueue a
..}
tell :: Runner a -> a -> STM ()
tell :: forall a. Runner a -> a -> STM ()
tell Runner {TVar Bool
TMVar (Maybe SomeException)
TBQueue a
UUID
id :: UUID
resVar :: TMVar (Maybe SomeException)
receivesVar :: TVar Bool
queue :: TBQueue a
$sel:id:Runner :: forall a. Runner a -> UUID
$sel:resVar:Runner :: forall a. Runner a -> TMVar (Maybe SomeException)
$sel:receivesVar:Runner :: forall a. Runner a -> TVar Bool
$sel:queue:Runner :: forall a. Runner a -> TBQueue a
..} a
message =
do
Bool
receives <- forall a. TVar a -> STM a
readTVar TVar Bool
receivesVar
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
receives do
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue a
queue a
message
kill :: Runner a -> STM ()
kill :: forall a. Runner a -> STM ()
kill Runner {TVar Bool
TMVar (Maybe SomeException)
TBQueue a
UUID
id :: UUID
resVar :: TMVar (Maybe SomeException)
receivesVar :: TVar Bool
queue :: TBQueue a
$sel:id:Runner :: forall a. Runner a -> UUID
$sel:resVar:Runner :: forall a. Runner a -> TMVar (Maybe SomeException)
$sel:receivesVar:Runner :: forall a. Runner a -> TVar Bool
$sel:queue:Runner :: forall a. Runner a -> TBQueue a
..} =
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
receivesVar Bool
False
wait :: Runner a -> STM (Maybe SomeException)
wait :: forall a. Runner a -> STM (Maybe SomeException)
wait Runner {TVar Bool
TMVar (Maybe SomeException)
TBQueue a
UUID
id :: UUID
resVar :: TMVar (Maybe SomeException)
receivesVar :: TVar Bool
queue :: TBQueue a
$sel:id:Runner :: forall a. Runner a -> UUID
$sel:resVar:Runner :: forall a. Runner a -> TMVar (Maybe SomeException)
$sel:receivesVar:Runner :: forall a. Runner a -> TVar Bool
$sel:queue:Runner :: forall a. Runner a -> TBQueue a
..} = do
forall a. TMVar a -> STM a
readTMVar TMVar (Maybe SomeException)
resVar
receiveSingle ::
Runner a ->
STM (Maybe a)
receiveSingle :: forall a. Runner a -> STM (Maybe a)
receiveSingle Runner {TVar Bool
TMVar (Maybe SomeException)
TBQueue a
UUID
id :: UUID
resVar :: TMVar (Maybe SomeException)
receivesVar :: TVar Bool
queue :: TBQueue a
$sel:id:Runner :: forall a. Runner a -> UUID
$sel:resVar:Runner :: forall a. Runner a -> TMVar (Maybe SomeException)
$sel:receivesVar:Runner :: forall a. Runner a -> TVar Bool
$sel:queue:Runner :: forall a. Runner a -> TBQueue a
..} =
do
Maybe a
readResult <- forall a. TBQueue a -> STM (Maybe a)
tryReadTBQueue TBQueue a
queue
case Maybe a
readResult of
Maybe a
Nothing -> do
Bool
receives <- forall a. TVar a -> STM a
readTVar TVar Bool
receivesVar
if Bool
receives
then forall a. STM a
retry
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just a
message ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
message)
receiveMultiple ::
Runner a ->
STM (Maybe (NonEmpty a))
receiveMultiple :: forall a. Runner a -> STM (Maybe (NonEmpty a))
receiveMultiple Runner {TVar Bool
TMVar (Maybe SomeException)
TBQueue a
UUID
id :: UUID
resVar :: TMVar (Maybe SomeException)
receivesVar :: TVar Bool
queue :: TBQueue a
$sel:id:Runner :: forall a. Runner a -> UUID
$sel:resVar:Runner :: forall a. Runner a -> TMVar (Maybe SomeException)
$sel:receivesVar:Runner :: forall a. Runner a -> TVar Bool
$sel:queue:Runner :: forall a. Runner a -> TBQueue a
..} =
do
[a]
messages <- forall a. TBQueue a -> STM [a]
correctFlushTBQueue TBQueue a
queue
case [a]
messages of
[] -> do
Bool
receives <- forall a. TVar a -> STM a
readTVar TVar Bool
receivesVar
if Bool
receives
then forall a. STM a
retry
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
a
messagesHead : [a]
messagesTail ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ a
messagesHead forall a. a -> [a] -> NonEmpty a
:| [a]
messagesTail
releaseWithException :: Runner a -> SomeException -> STM ()
releaseWithException :: forall a. Runner a -> SomeException -> STM ()
releaseWithException Runner {TVar Bool
TMVar (Maybe SomeException)
TBQueue a
UUID
id :: UUID
resVar :: TMVar (Maybe SomeException)
receivesVar :: TVar Bool
queue :: TBQueue a
$sel:id:Runner :: forall a. Runner a -> UUID
$sel:resVar:Runner :: forall a. Runner a -> TMVar (Maybe SomeException)
$sel:receivesVar:Runner :: forall a. Runner a -> TVar Bool
$sel:queue:Runner :: forall a. Runner a -> TBQueue a
..} SomeException
exception =
do
forall a. TBQueue a -> STM [a]
correctFlushTBQueue TBQueue a
queue
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
receivesVar Bool
False
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Maybe SomeException)
resVar (forall a. a -> Maybe a
Just SomeException
exception)
releaseNormally :: Runner a -> STM ()
releaseNormally :: forall a. Runner a -> STM ()
releaseNormally Runner {TVar Bool
TMVar (Maybe SomeException)
TBQueue a
UUID
id :: UUID
resVar :: TMVar (Maybe SomeException)
receivesVar :: TVar Bool
queue :: TBQueue a
$sel:id:Runner :: forall a. Runner a -> UUID
$sel:resVar:Runner :: forall a. Runner a -> TMVar (Maybe SomeException)
$sel:receivesVar:Runner :: forall a. Runner a -> TVar Bool
$sel:queue:Runner :: forall a. Runner a -> TBQueue a
..} = do
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
receivesVar Bool
False
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Maybe SomeException)
resVar forall a. Maybe a
Nothing forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()