{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ExistentialQuantification #-} module Affection.MessageBus.Class ( Participant(..) , genUUID , UUID ) where import Affection.MessageBus.Message import Affection.Types import Control.Monad.IO.Class (liftIO) import Data.UUID import Data.UUID.V4 import Data.String as S (fromString) import Affection.Logging -- | This typeclass defines the behaviour of a participant in the message system class (Message (Mesg prt), Show (Mesg prt)) => Participant prt where -- | Message datatype type Mesg prt :: * -- | Function to get the list of subscribers from the participant partSubscribers :: prt -- ^ the 'Participant''s subscriber storage -> Affection [Mesg prt -> Affection ()] -- ^ List of Subscriber functions -- | Subscribe to the 'Participant''s events partSubscribe :: prt -- ^ The 'Participant''s subscriber storage -> (Mesg prt -> Affection ()) -- ^ What to do in case of a 'Message' -- (Subscriber function) -> Affection UUID -- ^ 'UUID' of the registered subscriber Function -- | Unsubscribe a Subscriber function from Participant partUnSubscribe :: prt -- ^ The 'Participant''s subscriber storage to unsubscribe from -> UUID -- ^ The subscriber function's 'UUID' -> Affection () -- | Get the 'Participant' to emit a 'Message' on all of its subscribers partEmit :: prt -- ^ The 'Participant''s subscriber storage -> Mesg prt -- ^ The 'Message' to emit -> Affection () partEmit p m = do liftIO $ logIO Verbose $ "Emitting message: " <> S.fromString (show m) l <- partSubscribers p mapM_ ($ m) l -- | Helper function to generate new 'UUID's genUUID :: Affection UUID genUUID = liftIO nextRandom