{-# LANGUAGE ScopedTypeVariables #-}

-- | Examples is meant to contain examples of using events which
-- are too small to go into their own module.
module Events.Examples(
   EventSet, -- These encode a set of events
   emptyEventSet, -- :: EventSet a
   addToEventSet, -- :: EventSet a -> Event a -> EventSet a
   fromEventSet, -- :: EventSet a -> Event (a,EventSet a)
   isEmptyEventSet, -- :: EventSet a -> Bool

   watch, -- :: Event a -> IO (Event a,IO ())
   -- watch is used for events which can be dropped occasionally.


   spawnRepeatedEvent, -- :: Event () -> IO (IO ())
   -- spawnRepeatedEvent concurrently syncs on the event until the
   -- given action is used; it is somewhat safer than spawnEvent.

   ) where

import qualified Data.IntMap as IntMap

import Events.Events
import Events.Channels

-- ------------------------------------------------------------------
-- Event Sets
-- ------------------------------------------------------------------

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 turns the event set into an event which
-- waits for one of the events to happen, and then returns
-- the value, plus the event set containing the remaining events.
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

-- ------------------------------------------------------------------
-- Watchers
-- ------------------------------------------------------------------

-- | watch is used for events like mouse motion events where
-- if we can\'t find time we don\'t want them queued.
-- The event returned waits until the original event next happens and
-- returns it.  A worker thread is needed to run this; the attached action
-- should be used to stop that thread when we are no longer interested.
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 concurrently syncs on the event until the
-- given action is used; it is somewhat safer than spawnEvent.
-- It also never interrupts the handler event attached to
-- the event.
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 ())))