module TheatreDev.StmStructures.Runner
  ( Runner,
    start,
    tell,
    kill,
    wait,
    receiveSingle,
    receiveMultiple,
    releaseWithException,
    releaseNormally,

    -- * Inspection
    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 ->
  -- | Action producing a message or nothing, after it's killed.
  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 ()