{-# 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
