module Server.CommandController
  ( CommandController,
    new,
    take,
    release,
    put,
  )
where

import Agda.Interaction.Base (IOTCM)
import Control.Concurrent
import Control.Concurrent.SizedChan
import Control.Monad (forM_)
import Prelude hiding (take)

data CommandController
  = CommandController
      (SizedChan IOTCM)
      -- ^ Unbounded Command queue
      (MVar IOTCM)
      -- ^ MVar for the Command consumer

new :: IO CommandController
new :: IO CommandController
new = SizedChan IOTCM -> MVar IOTCM -> CommandController
CommandController (SizedChan IOTCM -> MVar IOTCM -> CommandController)
-> IO (SizedChan IOTCM) -> IO (MVar IOTCM -> CommandController)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (SizedChan IOTCM)
forall a. IO (SizedChan a)
newSizedChan IO (MVar IOTCM -> CommandController)
-> IO (MVar IOTCM) -> IO CommandController
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (MVar IOTCM)
forall a. IO (MVar a)
newEmptyMVar

-- | Blocks if the front is empty
take :: CommandController -> IO IOTCM
take :: CommandController -> IO IOTCM
take (CommandController SizedChan IOTCM
_ MVar IOTCM
front) = MVar IOTCM -> IO IOTCM
forall a. MVar a -> IO a
takeMVar MVar IOTCM
front

-- | Move the payload from the queue to the front
-- Does not block if the front or the queue is empty
release :: CommandController -> IO ()
release :: CommandController -> IO ()
release (CommandController SizedChan IOTCM
queue MVar IOTCM
front) = do
  Maybe IOTCM
result <- SizedChan IOTCM -> IO (Maybe IOTCM)
forall a. SizedChan a -> IO (Maybe a)
tryReadSizedChan SizedChan IOTCM
queue
  Maybe IOTCM -> (IOTCM -> IO Bool) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe IOTCM
result (MVar IOTCM -> IOTCM -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar MVar IOTCM
front)

-- | Does not block
-- Move the payload to the front if the front is empty
put :: CommandController -> IOTCM -> IO ()
put :: CommandController -> IOTCM -> IO ()
put (CommandController SizedChan IOTCM
queue MVar IOTCM
front) IOTCM
command = do
  Bool
isEmpty <- MVar IOTCM -> IO Bool
forall a. MVar a -> IO Bool
isEmptyMVar MVar IOTCM
front
  if Bool
isEmpty
    then MVar IOTCM -> IOTCM -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar IOTCM
front IOTCM
command
    else SizedChan IOTCM -> IOTCM -> IO ()
forall a. SizedChan a -> a -> IO ()
writeSizedChan SizedChan IOTCM
queue IOTCM
command