-- | 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 !mbox !t = tryReceive mbox >>= timeout t . 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_ i a = void (deliver i 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 !onMessage = do !maybeMessage <- receive box case maybeMessage of Nothing -> pure Nothing Just !message -> do Just <$> onMessage message