pituicat/src/Affection/MessageBus/Class.hs

51 lines
1.5 KiB
Haskell
Raw Normal View History

2017-11-27 00:43:43 +00:00
{-# LANGUAGE MultiParamTypeClasses #-}
2017-12-13 03:37:16 +00:00
{-# LANGUAGE AllowAmbiguousTypes #-}
2017-12-13 14:19:53 +00:00
{-# LANGUAGE Rank2Types #-}
2017-12-13 03:37:16 +00:00
module Affection.MessageBus.Class
( Participant(..)
, genUUID
, UUID
) where
2017-11-26 21:26:41 +00:00
import Affection.MessageBus.Message
2017-11-27 22:30:11 +00:00
import Affection.Types
2017-11-26 21:26:41 +00:00
2017-12-13 03:37:16 +00:00
import Control.Monad.IO.Class (liftIO)
2017-11-26 21:26:41 +00:00
2017-12-13 03:37:16 +00:00
import Data.UUID
import Data.UUID.V4
2017-11-26 21:26:41 +00:00
2017-12-13 03:37:16 +00:00
import Affection.Logging
2017-11-26 21:26:41 +00:00
2017-12-13 03:37:16 +00:00
class (Show m, Message m) => Participant prt m where
-- | Function to get the lsit of subscribers from the participant
partSubscribers
2017-12-13 14:19:53 +00:00
:: prt -- ^ the participant
2017-12-13 03:37:16 +00:00
-> Affection sd [(m -> Affection sd ())] -- ^ List of Subscriber functions
-- | Subscribe to the 'Participant''s events
partSubscribe
:: prt -- ^ The 'Participant' to subscribe to
2017-12-13 14:19:53 +00:00
-> (m -> Affection sd ()) -- ^ What to do in case of a 'Message'
2017-12-13 03:37:16 +00:00
-- (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
2017-12-12 12:12:27 +00:00
partEmit
:: prt -- ^ The 'Participant'
-> m -- ^ The 'Message' to emit
-> Affection sd ()
2017-12-13 03:37:16 +00:00
partEmit p m = do
liftIO $ logIO Debug $ "Emitting message: " ++ show m
l <- partSubscribers p
mapM_ ($ m) l
2017-12-12 12:12:27 +00:00
2017-12-13 03:37:16 +00:00
genUUID :: Affection sd UUID
genUUID = liftIO $ nextRandom