{-# LANGUAGE ScopedTypeVariables #-}
module Events.Examples(
EventSet,
emptyEventSet,
addToEventSet,
fromEventSet,
isEmptyEventSet,
watch,
spawnRepeatedEvent,
) where
import qualified Data.IntMap as IntMap
import Events.Events
import Events.Channels
data EventSet a = EventSet Int (IntMap.IntMap (Event a))
emptyEventSet :: EventSet a
emptyEventSet :: EventSet a
emptyEventSet = Int -> IntMap (Event a) -> EventSet a
forall a. Int -> IntMap (Event a) -> EventSet a
EventSet Int
0 IntMap (Event a)
forall a. IntMap a
IntMap.empty
addToEventSet :: EventSet a -> Event a -> EventSet a
addToEventSet :: EventSet a -> Event a -> EventSet a
addToEventSet (EventSet Int
next IntMap (Event a)
fmap) Event a
event =
Int -> IntMap (Event a) -> EventSet a
forall a. Int -> IntMap (Event a) -> EventSet a
EventSet (Int
nextInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Event a -> IntMap (Event a) -> IntMap (Event a)
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
next Event a
event IntMap (Event a)
fmap)
fromEventSet :: EventSet a -> Event (a,EventSet a)
fromEventSet :: EventSet a -> Event (a, EventSet a)
fromEventSet (EventSet Int
next IntMap (Event a)
fmap) =
[Event (a, EventSet a)] -> Event (a, EventSet a)
forall a. [Event a] -> Event a
choose
(((Int, Event a) -> Event (a, EventSet a))
-> [(Int, Event a)] -> [Event (a, EventSet a)]
forall a b. (a -> b) -> [a] -> [b]
map
(\ (Int
key,Event a
event) ->
Event a
event Event a -> (a -> IO (a, EventSet a)) -> Event (a, EventSet a)
forall a b. Event a -> (a -> IO b) -> Event b
>>>=
(\ a
a -> (a, EventSet a) -> IO (a, EventSet a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,Int -> IntMap (Event a) -> EventSet a
forall a. Int -> IntMap (Event a) -> EventSet a
EventSet Int
next (Int -> IntMap (Event a) -> IntMap (Event a)
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
key IntMap (Event a)
fmap)))
)
(IntMap (Event a) -> [(Int, Event a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap (Event a)
fmap)
)
isEmptyEventSet :: EventSet a -> Bool
isEmptyEventSet :: EventSet a -> Bool
isEmptyEventSet (EventSet Int
_ IntMap (Event a)
fmap) = IntMap (Event a) -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap (Event a)
fmap
watch :: Event a -> IO (Event a,IO ())
watch :: Event a -> IO (Event a, IO ())
watch (Event a
event :: Event a) =
do
Channel a
channel <- IO (Channel a)
forall a. IO (Channel a)
newChannel
Channel ()
dieChannel <- IO (Channel ())
forall a. IO (Channel a)
newChannel
let
die :: Event ()
die = Channel () -> Event ()
forall (chan :: * -> *) a. HasReceive chan => chan a -> Event a
receive Channel ()
dieChannel
waitForNext :: Event ()
waitForNext :: Event ()
waitForNext =
do
a
next <- Event a
event
a -> Event ()
passOn a
next
Event () -> Event () -> Event ()
forall a. Event a -> Event a -> Event a
+> Event ()
die
passOn :: a -> Event ()
passOn :: a -> Event ()
passOn a
val =
Event ()
waitForNext
Event () -> Event () -> Event ()
forall a. Event a -> Event a -> Event a
+> (do
Channel a -> a -> Event ()
forall (chan :: * -> *) a. HasSend chan => chan a -> a -> Event ()
send Channel a
channel a
val
Event ()
waitForNext
)
Event () -> Event () -> Event ()
forall a. Event a -> Event a -> Event a
+> Event ()
die
IO ()
_ <- Event () -> IO (IO ())
spawnEvent Event ()
waitForNext
(Event a, IO ()) -> IO (Event a, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Channel a -> Event a
forall (chan :: * -> *) a. HasReceive chan => chan a -> Event a
receive Channel a
channel,Event () -> IO ()
forall a. Event a -> IO a
sync(Channel () -> () -> Event ()
forall (chan :: * -> *) a. HasSend chan => chan a -> a -> Event ()
send Channel ()
dieChannel ()))
spawnRepeatedEvent :: Event () -> IO (IO ())
spawnRepeatedEvent :: Event () -> IO (IO ())
spawnRepeatedEvent Event ()
event =
do
Channel ()
dieChannel <- IO (Channel ())
forall a. IO (Channel a)
newChannel
let
die :: Event ()
die = Channel () -> Event ()
forall (chan :: * -> *) a. HasReceive chan => chan a -> Event a
receive Channel ()
dieChannel
handleEvent :: Event ()
handleEvent =
Event ()
die
Event () -> Event () -> Event ()
forall a. Event a -> Event a -> Event a
+> (do
Event ()
event
Event ()
handleEvent
)
IO ()
_ <- Event () -> IO (IO ())
spawnEvent Event ()
handleEvent
IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Event () -> IO ()
forall a. Event a -> IO a
sync(Event () -> Event ()
forall a. Event a -> Event ()
noWait(Channel () -> () -> Event ()
forall (chan :: * -> *) a. HasSend chan => chan a -> a -> Event ()
send Channel ()
dieChannel ())))