{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE NoFieldSelectors #-}
module TheatreDev.StmBased.StmStructures.Runner
( Runner,
start,
tell,
kill,
wait,
receiveSingle,
receiveMultiple,
releaseWithException,
)
where
import Control.Concurrent.STM.TBQueue
import Control.Concurrent.STM.TMVar
import qualified TheatreDev.ExtrasFor.List as List
import TheatreDev.ExtrasFor.TBQueue
import TheatreDev.Prelude
data Runner a = Runner
{ forall a. Runner a -> TBQueue (Maybe a)
queue :: TBQueue (Maybe a),
forall a. Runner a -> TVar Bool
aliveVar :: TVar Bool,
forall a. Runner a -> TMVar (Maybe SomeException)
resVar :: TMVar (Maybe SomeException)
}
start :: STM (Runner a)
start :: forall a. STM (Runner a)
start =
do
TBQueue (Maybe a)
queue <- forall a. Natural -> STM (TBQueue a)
newTBQueue Natural
1000
TVar Bool
aliveVar <- forall a. a -> STM (TVar a)
newTVar Bool
True
TMVar (Maybe SomeException)
resVar <- forall a. STM (TMVar a)
newEmptyTMVar @(Maybe SomeException)
return Runner {TVar Bool
TBQueue (Maybe a)
TMVar (Maybe SomeException)
resVar :: TMVar (Maybe SomeException)
aliveVar :: TVar Bool
queue :: TBQueue (Maybe a)
$sel:resVar:Runner :: TMVar (Maybe SomeException)
$sel:aliveVar:Runner :: TVar Bool
$sel:queue:Runner :: TBQueue (Maybe a)
..}
tell :: Runner a -> a -> STM ()
tell :: forall a. Runner a -> a -> STM ()
tell Runner {TVar Bool
TBQueue (Maybe a)
TMVar (Maybe SomeException)
resVar :: TMVar (Maybe SomeException)
aliveVar :: TVar Bool
queue :: TBQueue (Maybe a)
$sel:resVar:Runner :: forall a. Runner a -> TMVar (Maybe SomeException)
$sel:aliveVar:Runner :: forall a. Runner a -> TVar Bool
$sel:queue:Runner :: forall a. Runner a -> TBQueue (Maybe a)
..} a
message =
do
Bool
alive <- forall a. TVar a -> STM a
readTVar TVar Bool
aliveVar
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alive do
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue (Maybe a)
queue forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
message
kill :: Runner a -> STM ()
kill :: forall a. Runner a -> STM ()
kill Runner {TVar Bool
TBQueue (Maybe a)
TMVar (Maybe SomeException)
resVar :: TMVar (Maybe SomeException)
aliveVar :: TVar Bool
queue :: TBQueue (Maybe a)
$sel:resVar:Runner :: forall a. Runner a -> TMVar (Maybe SomeException)
$sel:aliveVar:Runner :: forall a. Runner a -> TVar Bool
$sel:queue:Runner :: forall a. Runner a -> TBQueue (Maybe a)
..} =
do
Bool
alive <- forall a. TVar a -> STM a
readTVar TVar Bool
aliveVar
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alive do
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue (Maybe a)
queue forall a. Maybe a
Nothing
wait :: Runner a -> STM (Maybe SomeException)
wait :: forall a. Runner a -> STM (Maybe SomeException)
wait Runner {TVar Bool
TBQueue (Maybe a)
TMVar (Maybe SomeException)
resVar :: TMVar (Maybe SomeException)
aliveVar :: TVar Bool
queue :: TBQueue (Maybe a)
$sel:resVar:Runner :: forall a. Runner a -> TMVar (Maybe SomeException)
$sel:aliveVar:Runner :: forall a. Runner a -> TVar Bool
$sel:queue:Runner :: forall a. Runner a -> TBQueue (Maybe a)
..} =
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
TBQueue (Maybe a)
TMVar (Maybe SomeException)
resVar :: TMVar (Maybe SomeException)
aliveVar :: TVar Bool
queue :: TBQueue (Maybe a)
$sel:resVar:Runner :: forall a. Runner a -> TMVar (Maybe SomeException)
$sel:aliveVar:Runner :: forall a. Runner a -> TVar Bool
$sel:queue:Runner :: forall a. Runner a -> TBQueue (Maybe a)
..} =
do
Maybe a
message <- forall a. TBQueue a -> STM a
readTBQueue TBQueue (Maybe a)
queue
case Maybe a
message of
Just a
message -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
message)
Maybe a
Nothing -> do
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
aliveVar Bool
False
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Maybe SomeException)
resVar forall a. Maybe a
Nothing
return forall a. Maybe a
Nothing
receiveMultiple ::
Runner a ->
STM (Maybe (NonEmpty a))
receiveMultiple :: forall a. Runner a -> STM (Maybe (NonEmpty a))
receiveMultiple Runner {TVar Bool
TBQueue (Maybe a)
TMVar (Maybe SomeException)
resVar :: TMVar (Maybe SomeException)
aliveVar :: TVar Bool
queue :: TBQueue (Maybe a)
$sel:resVar:Runner :: forall a. Runner a -> TMVar (Maybe SomeException)
$sel:aliveVar:Runner :: forall a. Runner a -> TVar Bool
$sel:queue:Runner :: forall a. Runner a -> TBQueue (Maybe a)
..} =
do
([a]
messages, [Maybe a]
remainingCommands) <- do
Natural
queueLength <- forall a. TBQueue a -> STM Natural
lengthTBQueue TBQueue (Maybe a)
queue
Maybe a
head <- forall a. TBQueue a -> STM a
readTBQueue TBQueue (Maybe a)
queue
[Maybe a]
tail <- forall a. TBQueue a -> STM [a]
simplerFlushTBQueue TBQueue (Maybe a)
queue
return $ forall a. [Maybe a] -> ([a], [Maybe a])
List.splitWhileJust forall a b. (a -> b) -> a -> b
$ Maybe a
head forall a. a -> [a] -> [a]
: [Maybe a]
tail
case [a]
messages of
[] -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Maybe a]
remainingCommands forall a b. (a -> b) -> a -> b
$ forall a. TBQueue a -> a -> STM ()
unGetTBQueue TBQueue (Maybe a)
queue
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
aliveVar Bool
False
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Maybe SomeException)
resVar forall a. Maybe a
Nothing
return forall a. Maybe a
Nothing
a
messagesHead : [a]
messagesTail -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe a]
remainingCommands) do
forall a. TBQueue a -> a -> STM ()
unGetTBQueue TBQueue (Maybe a)
queue forall a. Maybe a
Nothing
return $ 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
TBQueue (Maybe a)
TMVar (Maybe SomeException)
resVar :: TMVar (Maybe SomeException)
aliveVar :: TVar Bool
queue :: TBQueue (Maybe a)
$sel:resVar:Runner :: forall a. Runner a -> TMVar (Maybe SomeException)
$sel:aliveVar:Runner :: forall a. Runner a -> TVar Bool
$sel:queue:Runner :: forall a. Runner a -> TBQueue (Maybe a)
..} SomeException
exception =
do
forall a. TBQueue a -> STM [a]
simplerFlushTBQueue TBQueue (Maybe a)
queue
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
aliveVar Bool
False
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Maybe SomeException)
resVar (forall a. a -> Maybe a
Just SomeException
exception)