Events.hs

module Hob.Context.Events (
    initEventBus,
    registerEventHandler,
    emitEvent,
) where

import Control.Concurrent.MVar
import Control.Monad.Reader

import Hob.Context.Types

initEventBus :: IO EventBus
initEventBus = do
    bus <- newMVar []
    return $ EventBus (addEventListener bus) (lookupEvent bus)
    where
        addEventListener bus event action = do
            listeners <- takeMVar bus
            putMVar bus $ combineEventListeners event action listeners

        combineEventListeners :: Event -> App() -> [(Event, [App()])] -> [(Event, [App()])]
        combineEventListeners event action [] = [(event, [action])]
        combineEventListeners event action (x@(evt, initHandlers):xs) =
            if evt == event then (evt, action:initHandlers) : xs
            else x : combineEventListeners event action xs

        lookupEvent bus event = do
            listeners <- readMVar bus
            return $ findEvent event listeners

        findEvent _ [] = []
        findEvent event ((evt, handlers):xs) = if evt == event then handlers
                                               else findEvent event xs

registerEventHandler :: Event -> App() -> App()
registerEventHandler event handler = do
    bus <- fromContext eventBus
    liftIO $ addListener bus event handler

emitEvent :: Event -> App()
emitEvent event = do
    bus <- fromContext eventBus
    handlers <- liftIO $ listenersForEvent bus event
    sequence_ handlers