{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE NoFieldSelectors #-}

module TheatreDev.StmBased.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.List qualified as List
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
aliveVar :: 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
aliveVar <- 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)
aliveVar :: TVar Bool
queue :: TBQueue a
$sel:id:Runner :: UUID
$sel:resVar:Runner :: TMVar (Maybe SomeException)
$sel:aliveVar: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)
aliveVar :: TVar Bool
queue :: TBQueue a
$sel:id:Runner :: forall a. Runner a -> UUID
$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 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 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)
aliveVar :: TVar Bool
queue :: TBQueue a
$sel:id:Runner :: forall a. Runner a -> UUID
$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 a
..} =
  forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
aliveVar 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)
aliveVar :: TVar Bool
queue :: TBQueue a
$sel:id:Runner :: forall a. Runner a -> UUID
$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 a
..} = do
  Bool
isAlive <- forall a. TVar a -> STM a
readTVar TVar Bool
aliveVar
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isAlive forall a. STM a
retry
  Bool
queueIsEmpty <- forall a. TBQueue a -> STM Bool
isEmptyTBQueue TBQueue a
queue
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
queueIsEmpty forall a. STM a
retry
  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)
aliveVar :: TVar Bool
queue :: TBQueue a
$sel:id:Runner :: forall a. Runner a -> UUID
$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 a
..} =
  do
    Bool
alive <- forall a. TVar a -> STM a
readTVar TVar Bool
aliveVar
    if Bool
alive
      then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TBQueue a -> STM a
readTBQueue TBQueue a
queue
      else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

receiveMultiple ::
  (Show a) =>
  Runner a ->
  STM (Maybe (NonEmpty a))
receiveMultiple :: forall a. Show a => Runner a -> STM (Maybe (NonEmpty a))
receiveMultiple Runner {TVar Bool
TMVar (Maybe SomeException)
TBQueue a
UUID
id :: UUID
resVar :: TMVar (Maybe SomeException)
aliveVar :: TVar Bool
queue :: TBQueue a
$sel:id:Runner :: forall a. Runner a -> UUID
$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 a
..} =
  do
    [a]
messages <- forall a. TBQueue a -> STM [a]
simplerFlushTBQueue TBQueue a
queue
    case [a]
messages of
      [] -> do
        Bool
alive <- forall a. TVar a -> STM a
readTVar TVar Bool
aliveVar
        if Bool
alive
          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)
aliveVar :: TVar Bool
queue :: TBQueue a
$sel:id:Runner :: forall a. Runner a -> UUID
$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 a
..} SomeException
exception =
  do
    forall a. TBQueue a -> STM [a]
simplerFlushTBQueue TBQueue a
queue
    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)
aliveVar :: TVar Bool
queue :: TBQueue a
$sel:id:Runner :: forall a. Runner a -> UUID
$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 a
..} =
  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 ()