-- | This module contains a type class that
-- describes exchangable operations on messages
-- boxes.
module UnliftIO.MessageBox.Class
  ( IsMessageBoxArg (..),
    IsMessageBox (..),
    IsInput (..),
    handleMessage,
  )
where

import Data.Kind (Type)
import UnliftIO.MessageBox.Util.Future (Future, awaitFuture)
import UnliftIO (MonadUnliftIO, timeout)
import Control.Monad (void)

-- | Types that configure and allow the creation of a 'MessageBox'.
--
-- Create 'IsMessageBox' instances from a parameter.
-- Types that determine 'MessageBox' values.
--
-- For a limited message box this might be the limit of
-- the message queue.
class
  (IsMessageBox (MessageBox argument), IsInput (Input (MessageBox argument))) =>
  IsMessageBoxArg argument
  where
  -- | The message box that can be created from the
  -- message box argument
  type MessageBox argument :: Type -> Type

  -- | Return a message limit.
  --
  -- NOTE: This method was added for unit tests.
  -- Although the method is totally valid, it
  -- might not be super useful in production code.
  -- Also note that the naming follows the rule:
  -- Reserve short names for entities that are
  -- used often.
  getConfiguredMessageLimit :: argument -> Maybe Int

  -- | Create a new @msgBox@ according to the @argument@.
  -- This is required to receive a message.
  -- NOTE: Only one process may receive on an msgBox.
  newMessageBox :: MonadUnliftIO m => argument -> m (MessageBox argument a)

-- | A type class for msgBox types.
-- A common interface for receiving messages.
class IsInput (Input box) => IsMessageBox box where
  -- | Type of the corresponding input
  type Input box :: Type -> Type

  -- | Receive a message. Take whatever time it takes.
  -- Return 'Just' the value or 'Nothing' when an error
  -- occurred.
  --
  -- NOTE: Nothing may sporadically be returned, especially
  -- when there is a lot of load, so please make sure to 
  -- build your application in such a way, that it 
  -- anticipates failure.
  receive :: MonadUnliftIO m => box a -> m (Maybe a)

  -- | Return a 'Future' that can be used to wait for the
  -- arrival of the next message.
  -- NOTE: Each future value represents the next slot in the queue
  -- so one future corresponds to exactly that message (should it arrive)
  -- and if that future value is dropped, that message will be lost!
  tryReceive :: MonadUnliftIO m => box a -> m (Future a)

  -- | Wait for an incoming message or return Nothing.
  --
  -- The default implementation uses 'tryReceive' to get a
  -- 'Future' on which 'awaitFuture' inside a 'timeout' is called.
  --
  -- Instances might override this with more performant implementations
  -- especially non-blocking Unagi channel based implementation.
  --
  -- NOTE: Nothing may sporadically be returned, especially
  -- when there is a lot of load, so please make sure to 
  -- build your application in such a way, that it 
  -- anticipates failure.
  receiveAfter ::
    MonadUnliftIO m =>
    -- | Message box
    box a ->
    -- | Time in micro seconds to wait until the
    -- action is invoked.
    Int ->
    m (Maybe a)
  receiveAfter !box a
mbox !Int
t =
    box a -> m (Future a)
forall (box :: * -> *) (m :: * -> *) a.
(IsMessageBox box, MonadUnliftIO m) =>
box a -> m (Future a)
tryReceive box a
mbox m (Future a) -> (Future a -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> m a -> m (Maybe a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout Int
t (m a -> m (Maybe a))
-> (Future a -> m a) -> Future a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Future a -> m a
forall (m :: * -> *) b. MonadUnliftIO m => Future b -> m b
awaitFuture

  -- | Create a new @input@ that enqueus messages,
  -- which are received by the @box@
  newInput :: MonadUnliftIO m => box a -> m (Input box a)

-- | A type class for input types.
-- A common interface for delivering messages.
class IsInput input where
  -- | Send a message. Take whatever time it takes.
  -- Depending on the implementation, this might
  -- be a non-blocking operation.
  -- Return if the operation was successful.
  --
  -- NOTE: @False@ may sporadically be returned, especially
  -- when there is a lot of load, so please make sure to 
  -- build your application in such a way, that it 
  -- anticipates failure.
  deliver :: MonadUnliftIO m => input a -> a -> m Bool
  -- | See 'deliver' but with @()@ as return value.
  --   If 'deliver' fails, it fails silently.
  deliver_ :: MonadUnliftIO m => input a -> a -> m ()
  deliver_ input a
i a
a = m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (input a -> a -> m Bool
forall (input :: * -> *) (m :: * -> *) a.
(IsInput input, MonadUnliftIO m) =>
input a -> a -> m Bool
deliver input a
i a
a)

-- ** Utility Functions for Receiving Messages

-- | Receive a message and apply a function to it.
handleMessage ::
  (MonadUnliftIO m, IsMessageBox box) =>
  box message ->
  (message -> m b) ->
  m (Maybe b)
handleMessage :: box message -> (message -> m b) -> m (Maybe b)
handleMessage !box message
box !message -> m b
onMessage = do
  !Maybe message
maybeMessage <- box message -> m (Maybe message)
forall (box :: * -> *) (m :: * -> *) a.
(IsMessageBox box, MonadUnliftIO m) =>
box a -> m (Maybe a)
receive box message
box
  case Maybe message
maybeMessage of
    Maybe message
Nothing -> Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
    Just !message
message -> do
      b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> m b -> m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> message -> m b
onMessage message
message