{-# OPTIONS -fplugin=Rattus.Plugin #-}
{-# LANGUAGE TypeOperators #-}

-- | Programming with single shot events, i.e. events that may occur at
-- most once.

module Rattus.Event
  ( map
  , never
  , switch
  , switchTrans
  , whenJust
  , Event(..)
  , await
  , trigger
  , triggerMap
  )

where

import Rattus
import Rattus.Stream hiding (map)

import Prelude hiding ((<*>), map)


-- | An event may either occur now or later.
data Event a = Now !a | Wait (O (Event a))

-- all functions in this module are in Rattus 
{-# ANN module Rattus #-}

-- | Apply a function to the value of the event (if it ever occurs).
{-# NOINLINE [1] map #-}
map :: Box (a -> b) -> Event a -> Event b
map :: Box (a -> b) -> Event a -> Event b
map f :: Box (a -> b)
f (Now x :: a
x) = b -> Event b
forall a. a -> Event a
Now (Box (a -> b) -> a -> b
forall a. Box a -> a
unbox Box (a -> b)
f a
x)
map f :: Box (a -> b)
f (Wait x :: O (Event a)
x) = O (Event b) -> Event b
forall a. O (Event a) -> Event a
Wait ((Event a -> Event b) -> O (Event a -> Event b)
forall a. a -> O a
delay (Box (a -> b) -> Event a -> Event b
forall a b. Box (a -> b) -> Event a -> Event b
map Box (a -> b)
f) O (Event a -> Event b) -> O (Event a) -> O (Event b)
forall a b. O (a -> b) -> O a -> O b
<*> O (Event a)
x)

-- | An event that will never occur.
never :: Event a
never :: Event a
never = O (Event a) -> Event a
forall a. O (Event a) -> Event a
Wait (Event a -> O (Event a)
forall a. a -> O a
delay Event a
forall a. Event a
never)


-- | @switch s e@ will behave like @s@ until the event @e@ occurs with
-- value @s'@, in which case it will behave as @s'@.
switch :: Str a -> Event (Str a) -> Str a
switch :: Str a -> Event (Str a) -> Str a
switch (x :: a
x ::: xs :: O (Str a)
xs) (Wait fas :: O (Event (Str a))
fas) = a
x a -> O (Str a) -> Str a
forall a. a -> O (Str a) -> Str a
::: ((Str a -> Event (Str a) -> Str a)
-> O (Str a -> Event (Str a) -> Str a)
forall a. a -> O a
delay Str a -> Event (Str a) -> Str a
forall a. Str a -> Event (Str a) -> Str a
switch O (Str a -> Event (Str a) -> Str a)
-> O (Str a) -> O (Event (Str a) -> Str a)
forall a b. O (a -> b) -> O a -> O b
<*> O (Str a)
xs O (Event (Str a) -> Str a) -> O (Event (Str a)) -> O (Str a)
forall a b. O (a -> b) -> O a -> O b
<*> O (Event (Str a))
fas)
switch _xs :: Str a
_xs        (Now ys :: Str a
ys)   = Str a
ys 

-- | Turn a stream of 'Maybe''s into an event. The event will occur
-- whenever the stream has a value of the form @Just' v@, and the
-- event then has value @v@.
firstJust :: Str (Maybe' a) -> Event a
firstJust :: Str (Maybe' a) -> Event a
firstJust (Just' x :: a
x ::: _) = a -> Event a
forall a. a -> Event a
Now a
x
firstJust (Nothing' ::: xs :: O (Str (Maybe' a))
xs) = O (Event a) -> Event a
forall a. O (Event a) -> Event a
Wait ((Str (Maybe' a) -> Event a) -> O (Str (Maybe' a) -> Event a)
forall a. a -> O a
delay Str (Maybe' a) -> Event a
forall a. Str (Maybe' a) -> Event a
firstJust O (Str (Maybe' a) -> Event a) -> O (Str (Maybe' a)) -> O (Event a)
forall a b. O (a -> b) -> O a -> O b
<*> O (Str (Maybe' a))
xs)

-- | Turn a stream of 'Maybe''s into a stream of events. Each such
-- event behaves as if created by 'firstJust'.
whenJust :: Str (Maybe' a) -> Str (Event a)
whenJust :: Str (Maybe' a) -> Str (Event a)
whenJust cur :: Str (Maybe' a)
cur@(_ ::: xs :: O (Str (Maybe' a))
xs) = Str (Maybe' a) -> Event a
forall a. Str (Maybe' a) -> Event a
firstJust Str (Maybe' a)
cur Event a -> O (Str (Event a)) -> Str (Event a)
forall a. a -> O (Str a) -> Str a
::: ((Str (Maybe' a) -> Str (Event a))
-> O (Str (Maybe' a) -> Str (Event a))
forall a. a -> O a
delay Str (Maybe' a) -> Str (Event a)
forall a. Str (Maybe' a) -> Str (Event a)
whenJust O (Str (Maybe' a) -> Str (Event a))
-> O (Str (Maybe' a)) -> O (Str (Event a))
forall a b. O (a -> b) -> O a -> O b
<*> O (Str (Maybe' a))
xs)


-- | Like 'switch' but works on stream functions instead of
-- streams. That is, @switchTrans s e@ will behave like @s@ until the
-- event @e@ occurs with value @s'@, in which case it will behave as
-- @s'@.
switchTrans :: (Str a -> Str b) -> Event (Str a -> Str b) -> (Str a -> Str b)
switchTrans :: (Str a -> Str b) -> Event (Str a -> Str b) -> Str a -> Str b
switchTrans f :: Str a -> Str b
f es :: Event (Str a -> Str b)
es as :: Str a
as = Str b -> Event (Str a -> Str b) -> Str a -> Str b
forall b a. Str b -> Event (Str a -> Str b) -> Str a -> Str b
switchTrans' (Str a -> Str b
f Str a
as) Event (Str a -> Str b)
es Str a
as

-- | Helper function for 'switchTrans'.
switchTrans' :: Str b -> Event (Str a -> Str b) -> Str a -> Str b
switchTrans' :: Str b -> Event (Str a -> Str b) -> Str a -> Str b
switchTrans' (x :: b
x ::: xs :: O (Str b)
xs) (Wait fas :: O (Event (Str a -> Str b))
fas) (_:::is :: O (Str a)
is) = b
x b -> O (Str b) -> Str b
forall a. a -> O (Str a) -> Str a
::: ((Str b -> Event (Str a -> Str b) -> Str a -> Str b)
-> O (Str b -> Event (Str a -> Str b) -> Str a -> Str b)
forall a. a -> O a
delay Str b -> Event (Str a -> Str b) -> Str a -> Str b
forall b a. Str b -> Event (Str a -> Str b) -> Str a -> Str b
switchTrans' O (Str b -> Event (Str a -> Str b) -> Str a -> Str b)
-> O (Str b) -> O (Event (Str a -> Str b) -> Str a -> Str b)
forall a b. O (a -> b) -> O a -> O b
<*> O (Str b)
xs O (Event (Str a -> Str b) -> Str a -> Str b)
-> O (Event (Str a -> Str b)) -> O (Str a -> Str b)
forall a b. O (a -> b) -> O a -> O b
<*> O (Event (Str a -> Str b))
fas O (Str a -> Str b) -> O (Str a) -> O (Str b)
forall a b. O (a -> b) -> O a -> O b
<*> O (Str a)
is)
switchTrans' _xs :: Str b
_xs        (Now ys :: Str a -> Str b
ys)   is :: Str a
is = Str a -> Str b
ys Str a
is

-- | Helper function for 'await'.
await1 :: Stable a => a -> Event b -> Event (a :* b)
await1 :: a -> Event b -> Event (a :* b)
await1 a :: a
a (Wait eb :: O (Event b)
eb) = O (Event (a :* b)) -> Event (a :* b)
forall a. O (Event a) -> Event a
Wait ((a -> Event b -> Event (a :* b))
-> O (a -> Event b -> Event (a :* b))
forall a. a -> O a
delay a -> Event b -> Event (a :* b)
forall a b. Stable a => a -> Event b -> Event (a :* b)
await1 O (a -> Event b -> Event (a :* b))
-> a -> O (Event b -> Event (a :* b))
forall a b. Stable a => O (a -> b) -> a -> O b
<** a
a O (Event b -> Event (a :* b)) -> O (Event b) -> O (Event (a :* b))
forall a b. O (a -> b) -> O a -> O b
<*> O (Event b)
eb)
await1 a :: a
a (Now  b :: b
b)  = (a :* b) -> Event (a :* b)
forall a. a -> Event a
Now  (a
a a -> b -> a :* b
forall a b. a -> b -> a :* b
:* b
b)

-- | Helper function for 'await'.
await2 :: Stable b => b -> Event a -> Event (a :* b)
await2 :: b -> Event a -> Event (a :* b)
await2 b :: b
b (Wait ea :: O (Event a)
ea) = O (Event (a :* b)) -> Event (a :* b)
forall a. O (Event a) -> Event a
Wait ((b -> Event a -> Event (a :* b))
-> O (b -> Event a -> Event (a :* b))
forall a. a -> O a
delay b -> Event a -> Event (a :* b)
forall b a. Stable b => b -> Event a -> Event (a :* b)
await2 O (b -> Event a -> Event (a :* b))
-> b -> O (Event a -> Event (a :* b))
forall a b. Stable a => O (a -> b) -> a -> O b
<** b
b O (Event a -> Event (a :* b)) -> O (Event a) -> O (Event (a :* b))
forall a b. O (a -> b) -> O a -> O b
<*> O (Event a)
ea)
await2 b :: b
b (Now  a :: a
a)  = (a :* b) -> Event (a :* b)
forall a. a -> Event a
Now  (a
a a -> b -> a :* b
forall a b. a -> b -> a :* b
:* b
b)

-- | Synchronise two events. The resulting event occurs after both
-- events have occurred (coinciding with whichever event occurred
-- last.
await :: (Stable a, Stable b) => Event a -> Event b -> Event(a :* b)
await :: Event a -> Event b -> Event (a :* b)
await (Wait ea :: O (Event a)
ea) (Wait eb :: O (Event b)
eb)  = O (Event (a :* b)) -> Event (a :* b)
forall a. O (Event a) -> Event a
Wait ((Event a -> Event b -> Event (a :* b))
-> O (Event a -> Event b -> Event (a :* b))
forall a. a -> O a
delay Event a -> Event b -> Event (a :* b)
forall a b.
(Stable a, Stable b) =>
Event a -> Event b -> Event (a :* b)
await O (Event a -> Event b -> Event (a :* b))
-> O (Event a) -> O (Event b -> Event (a :* b))
forall a b. O (a -> b) -> O a -> O b
<*> O (Event a)
ea O (Event b -> Event (a :* b)) -> O (Event b) -> O (Event (a :* b))
forall a b. O (a -> b) -> O a -> O b
<*> O (Event b)
eb)
await (Now a :: a
a)   eb :: Event b
eb         = a -> Event b -> Event (a :* b)
forall a b. Stable a => a -> Event b -> Event (a :* b)
await1 a
a Event b
eb
await ea :: Event a
ea        (Now b :: b
b)    = b -> Event a -> Event (a :* b)
forall b a. Stable b => b -> Event a -> Event (a :* b)
await2 b
b Event a
ea

-- | Trigger an event as soon as the given predicate turns true on the
-- given stream. The value of the event is the same as that of the
-- stream at that time.
trigger :: Box (a -> Bool) -> Str a -> Event a
trigger :: Box (a -> Bool) -> Str a -> Event a
trigger p :: Box (a -> Bool)
p (x :: a
x ::: xs :: O (Str a)
xs)
  | Box (a -> Bool) -> a -> Bool
forall a. Box a -> a
unbox Box (a -> Bool)
p a
x  = a -> Event a
forall a. a -> Event a
Now a
x
  | Bool
otherwise  = O (Event a) -> Event a
forall a. O (Event a) -> Event a
Wait ((Str a -> Event a) -> O (Str a -> Event a)
forall a. a -> O a
delay (Box (a -> Bool) -> Str a -> Event a
forall a. Box (a -> Bool) -> Str a -> Event a
trigger Box (a -> Bool)
p) O (Str a -> Event a) -> O (Str a) -> O (Event a)
forall a b. O (a -> b) -> O a -> O b
<*> O (Str a)
xs)


-- | Trigger an event as soon as the given function produces a 'Just''
-- value.
triggerMap :: Box (a -> Maybe' b) -> Str a -> Event b
triggerMap :: Box (a -> Maybe' b) -> Str a -> Event b
triggerMap f :: Box (a -> Maybe' b)
f (x :: a
x ::: xs :: O (Str a)
xs) =
  case Box (a -> Maybe' b) -> a -> Maybe' b
forall a. Box a -> a
unbox Box (a -> Maybe' b)
f a
x of
    Just' y :: b
y  -> b -> Event b
forall a. a -> Event a
Now b
y
    Nothing' -> O (Event b) -> Event b
forall a. O (Event a) -> Event a
Wait ((Str a -> Event b) -> O (Str a -> Event b)
forall a. a -> O a
delay (Box (a -> Maybe' b) -> Str a -> Event b
forall a b. Box (a -> Maybe' b) -> Str a -> Event b
triggerMap Box (a -> Maybe' b)
f) O (Str a -> Event b) -> O (Str a) -> O (Event b)
forall a b. O (a -> b) -> O a -> O b
<*> O (Str a)
xs)

{-# RULES

  "map/map" forall f g xs.
    map f (map g xs) = map (box (unbox f . unbox g)) xs ;

#-}