pituicat/src/Affection/MessageBus/Class.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
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 Affection.Logging

class (Show m, Message m) => Participant prt m where
  -- | Function to get the lsit of subscribers from the participant
  partSubscribers
    :: prt                         -- ^ the participant
    -> Affection sd [(m -> Affection sd ())] -- ^ List of Subscriber functions

  -- | Subscribe to the 'Participant''s events
  partSubscribe
    :: prt               -- ^ The 'Participant' to subscribe to
    -> (m -> IO ())      -- ^ What to do in case of a 'Message'
                         -- (Subscriber function)
    -> Affection sd UUID -- ^ 'UUID' of the registered subscriber Function

  -- | Unsubscribe a Subscriber function from Participant
  partUnSubscribe
    :: prt             -- ^ The 'Participant' to unsubscribe from
    -> UUID            -- ^ The subscriber function's 'UUID'
    -> Affection sd ()

  -- | Get the 'Participant' to emit a 'Message' on all of its subscribers
  partEmit
    :: prt             -- ^ The 'Participant'
    -> m               -- ^ The 'Message' to emit
    -> Affection sd ()
  partEmit p m = do
    liftIO $ logIO Debug $ "Emitting message: " ++ show m
    l <- partSubscribers p
    mapM_ ($ m) l

genUUID :: Affection sd UUID
genUUID = liftIO $ nextRandom