-- ----------------------------------------------------------------------------
-- |
-- Module    : Event
-- Author    : Krasimir Angelov <kr.angelov@gmail.com>
-- Copyright : (c) Krasimir Angelov, All Rights Reserved
-- 
-- ----------------------------------------------------------------------------

module Event
	( Event
	, newEvent
	, mapEvent
	, clearEvent
	, addEventListener
	, removeEventListener
	, foreachEventListeners
	) where

import Control.Concurrent
import Data.List(partition)
import VsTypes(VSCOOKIE)
import Com

newtype Event a = Event (MVar (VSCOOKIE, [(VSCOOKIE, a)]))

newEvent :: IO (Event a)
newEvent = do
	ref <- newMVar (1, [])
	return (Event ref)
	
clearEvent :: Event (IUnknown a) -> IO ()
clearEvent (Event ref) =
    modifyMVar_ ref $ \(nextCookie, lst) -> do
	mapM_ (release . snd) lst
	return (nextCookie, [])

mapEvent :: (a -> IO b) -> Event a -> IO (Event b)
mapEvent f (Event ref) =
    withMVar ref $ \ (nextCookie, lst) -> do
	lst' <- mapM fn lst
	ref' <- newMVar (nextCookie, lst')
	return (Event ref')
    where
	fn (cookie,a) = do b <- f a; return (cookie,b)

addEventListener :: Event (IUnknown a) -> (IUnknown a) -> IO VSCOOKIE
addEventListener (Event ref) listener =
    modifyMVar ref $ \ (nextCookie, lst) -> do
	addRef listener
	return ((nextCookie+1, (nextCookie, listener):lst), 
		nextCookie)

removeEventListener :: Event (IUnknown a) -> VSCOOKIE -> IO ()
removeEventListener (Event ref) cookie =
    modifyMVar_ ref $ \ (nextCookie, lst) -> do
	let (lst1,lst2) = partition (\(c, adv) -> c == cookie) lst
	mapM_ (release . snd) lst1
	return (nextCookie, lst2)

foreachEventListeners :: Event (IUnknown a) -> ((IUnknown a) -> IO b) -> IO ()
foreachEventListeners (Event ref) action =
    withMVar ref $ \ (_nextCookie, lst) -> 
	mapM_ (action . snd) lst