pituicat/src/Affection/MessageBus/Class.hs

62 lines
1.8 KiB
Haskell
Raw Normal View History

2017-11-27 00:43:43 +00:00
{-# LANGUAGE MultiParamTypeClasses #-}
2017-12-15 16:48:12 +00:00
{-# LANGUAGE TypeFamilies #-}
2017-12-20 01:00:48 +00:00
{-# LANGUAGE FlexibleContexts #-}
2017-12-13 03:37:16 +00:00
{-# LANGUAGE AllowAmbiguousTypes #-}
2017-12-20 01:00:48 +00:00
{-# LANGUAGE ExistentialQuantification #-}
2018-09-25 05:02:33 +00:00
module Affection.MessageBus.Class 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
2018-09-25 05:02:33 +00:00
-- | This typeclass defines the behaviour of a participant in the message system
2017-12-27 16:33:31 +00:00
class (Message (Mesg prt us), Show (Mesg prt us)) => Participant prt us where
2018-09-25 05:02:33 +00:00
type Mesg prt us :: * -- ^ Message datatype
2017-12-15 16:48:12 +00:00
-- | Function to get the list of subscribers from the participant
2017-12-13 03:37:16 +00:00
partSubscribers
2017-12-15 16:48:12 +00:00
:: prt
-- ^ the 'Participant''s subscriber storage
2017-12-27 16:33:31 +00:00
-> Affection us [Mesg prt us -> Affection us ()]
2017-12-15 16:48:12 +00:00
-- ^ List of Subscriber functions
2017-12-13 03:37:16 +00:00
-- | Subscribe to the 'Participant''s events
partSubscribe
2017-12-15 16:48:12 +00:00
:: prt
-- ^ The 'Participant''s subscriber storage
2017-12-27 16:33:31 +00:00
-> (Mesg prt us -> Affection us ())
2017-12-15 16:48:12 +00:00
-- ^ What to do in case of a 'Message'
-- (Subscriber function)
2017-12-27 16:33:31 +00:00
-> Affection us UUID
2017-12-15 16:48:12 +00:00
-- ^ 'UUID' of the registered subscriber Function
2017-12-13 03:37:16 +00:00
-- | Unsubscribe a Subscriber function from Participant
partUnSubscribe
2017-12-15 16:48:12 +00:00
:: prt
-- ^ The 'Participant''s subscriber storage to unsubscribe from
2017-12-27 16:33:31 +00:00
-> UUID
2017-12-15 16:48:12 +00:00
-- ^ The subscriber function's 'UUID'
2017-12-13 14:53:51 +00:00
-> Affection us ()
2017-12-13 03:37:16 +00:00
-- | Get the 'Participant' to emit a 'Message' on all of its subscribers
2017-12-12 12:12:27 +00:00
partEmit
2017-12-15 16:48:12 +00:00
:: prt
-- ^ The 'Participant''s subscriber storage
2017-12-27 16:33:31 +00:00
-> Mesg prt us
2017-12-15 16:48:12 +00:00
-- ^ The 'Message' to emit
2017-12-13 14:53:51 +00:00
-> Affection us ()
2017-12-13 03:37:16 +00:00
partEmit p m = do
2017-12-22 05:28:58 +00:00
liftIO $ logIO Verbose $ "Emitting message: " ++ show m
2017-12-13 03:37:16 +00:00
l <- partSubscribers p
mapM_ ($ m) l
2017-12-12 12:12:27 +00:00
2017-12-15 16:48:12 +00:00
-- | Helper function to generate new 'UUID's
2017-12-13 14:53:51 +00:00
genUUID :: Affection us UUID
2017-12-15 17:12:16 +00:00
genUUID = liftIO nextRandom