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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO (SizedChan a)
newSizedChan forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) = 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 <- forall a. SizedChan a -> IO (Maybe a)
tryReadSizedChan SizedChan IOTCM
queue
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe IOTCM
result (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 <- forall a. MVar a -> IO Bool
isEmptyMVar MVar IOTCM
front
  if Bool
isEmpty
    then forall a. MVar a -> a -> IO ()
putMVar MVar IOTCM
front IOTCM
command
    else forall a. SizedChan a -> a -> IO ()
writeSizedChan SizedChan IOTCM
queue IOTCM
command