never executed always true always false

    1 -- | This module contains a type class that
    2 -- describes exchangable operations on messages
    3 -- boxes.
    4 module UnliftIO.MessageBox.Class
    5   ( IsMessageBoxArg (..),
    6     IsMessageBox (..),
    7     IsInput (..),
    8     handleMessage,
    9   )
   10 where
   11 
   12 import Data.Kind (Type)
   13 import UnliftIO.MessageBox.Util.Future (Future, awaitFuture)
   14 import UnliftIO (MonadUnliftIO, timeout)
   15 import Control.Monad (void)
   16 
   17 -- | Types that configure and allow the creation of a 'MessageBox'.
   18 --
   19 -- Create 'IsMessageBox' instances from a parameter.
   20 -- Types that determine 'MessageBox' values.
   21 --
   22 -- For a limited message box this might be the limit of
   23 -- the message queue.
   24 class
   25   (IsMessageBox (MessageBox argument), IsInput (Input (MessageBox argument))) =>
   26   IsMessageBoxArg argument
   27   where
   28   -- | The message box that can be created from the
   29   -- message box argument
   30   type MessageBox argument :: Type -> Type
   31 
   32   -- | Return a message limit.
   33   --
   34   -- NOTE: This method was added for unit tests.
   35   -- Although the method is totally valid, it
   36   -- might not be super useful in production code.
   37   -- Also note that the naming follows the rule:
   38   -- Reserve short names for entities that are
   39   -- used often.
   40   getConfiguredMessageLimit :: argument -> Maybe Int
   41 
   42   -- | Create a new @msgBox@ according to the @argument@.
   43   -- This is required to receive a message.
   44   -- NOTE: Only one process may receive on an msgBox.
   45   newMessageBox :: MonadUnliftIO m => argument -> m (MessageBox argument a)
   46 
   47 -- | A type class for msgBox types.
   48 -- A common interface for receiving messages.
   49 class IsInput (Input box) => IsMessageBox box where
   50   -- | Type of the corresponding input
   51   type Input box :: Type -> Type
   52 
   53   -- | Receive a message. Take whatever time it takes.
   54   -- Return 'Just' the value or 'Nothing' when an error
   55   -- occurred.
   56   --
   57   -- NOTE: Nothing may sporadically be returned, especially
   58   -- when there is a lot of load, so please make sure to 
   59   -- build your application in such a way, that it 
   60   -- anticipates failure.
   61   receive :: MonadUnliftIO m => box a -> m (Maybe a)
   62 
   63   -- | Return a 'Future' that can be used to wait for the
   64   -- arrival of the next message.
   65   -- NOTE: Each future value represents the next slot in the queue
   66   -- so one future corresponds to exactly that message (should it arrive)
   67   -- and if that future value is dropped, that message will be lost!
   68   tryReceive :: MonadUnliftIO m => box a -> m (Future a)
   69 
   70   -- | Wait for an incoming message or return Nothing.
   71   --
   72   -- The default implementation uses 'tryReceive' to get a
   73   -- 'Future' on which 'awaitFuture' inside a 'timeout' is called.
   74   --
   75   -- Instances might override this with more performant implementations
   76   -- especially non-blocking Unagi channel based implementation.
   77   --
   78   -- NOTE: Nothing may sporadically be returned, especially
   79   -- when there is a lot of load, so please make sure to 
   80   -- build your application in such a way, that it 
   81   -- anticipates failure.
   82   receiveAfter ::
   83     MonadUnliftIO m =>
   84     -- | Message box
   85     box a ->
   86     -- | Time in micro seconds to wait until the
   87     -- action is invoked.
   88     Int ->
   89     m (Maybe a)
   90   receiveAfter !mbox !t =
   91     tryReceive mbox >>= timeout t . awaitFuture
   92 
   93   -- | Create a new @input@ that enqueus messages,
   94   -- which are received by the @box@
   95   newInput :: MonadUnliftIO m => box a -> m (Input box a)
   96 
   97 -- | A type class for input types.
   98 -- A common interface for delivering messages.
   99 class IsInput input where
  100   -- | Send a message. Take whatever time it takes.
  101   -- Depending on the implementation, this might
  102   -- be a non-blocking operation.
  103   -- Return if the operation was successful.
  104   --
  105   -- NOTE: @False@ may sporadically be returned, especially
  106   -- when there is a lot of load, so please make sure to 
  107   -- build your application in such a way, that it 
  108   -- anticipates failure.
  109   deliver :: MonadUnliftIO m => input a -> a -> m Bool
  110   -- | See 'deliver' but with @()@ as return value.
  111   --   If 'deliver' fails, it fails silently.
  112   deliver_ :: MonadUnliftIO m => input a -> a -> m ()
  113   deliver_ i a = void (deliver i a)
  114 
  115 -- ** Utility Functions for Receiving Messages
  116 
  117 -- | Receive a message and apply a function to it.
  118 handleMessage ::
  119   (MonadUnliftIO m, IsMessageBox box) =>
  120   box message ->
  121   (message -> m b) ->
  122   m (Maybe b)
  123 handleMessage !box !onMessage = do
  124   !maybeMessage <- receive box
  125   case maybeMessage of
  126     Nothing -> pure Nothing
  127     Just !message -> do
  128       Just <$> onMessage message