{-# OPTIONS -fplugin=Rattus.Plugin #-}
module Rattus.Events
( map
, never
, switch
, switchTrans
, Events
, trigger
, triggerMap
)
where
import Rattus
import Rattus.Stream hiding (map)
import qualified Rattus.Stream as S
import Prelude hiding ((<*>), map)
type Events a = Str (Maybe' a)
{-# ANN module Rattus #-}
{-# NOINLINE [1] map #-}
map :: Box (a -> b) -> Events a -> Events b
map f (Just' x ::: xs) = (Just' (unbox f x)) ::: delay (map f (adv xs))
map f (Nothing' ::: xs) = Nothing' ::: delay (map f (adv xs))
never :: Events a
never = Nothing' ::: delay never
switch :: Str a -> Events (Str a) -> Str a
switch (x ::: xs) (Nothing' ::: fas) = x ::: delay (switch (adv xs) (adv fas))
switch _xs (Just' (a ::: as) ::: fas) = a ::: (delay switch <*> as <*> fas)
switchTrans :: (Str a -> Str b) -> Events (Str a -> Str b) -> (Str a -> Str b)
switchTrans f es as = switchTrans' (f as) es as
switchTrans' :: Str b -> Events (Str a -> Str b) -> Str a -> Str b
switchTrans' (b ::: bs) (Nothing' ::: fs) (_:::as) = b ::: (delay switchTrans' <*> bs <*> fs <*> as)
switchTrans' _xs (Just' f ::: fs) as@(_:::as') = b' ::: (delay switchTrans' <*> bs' <*> fs <*> as')
where (b' ::: bs') = f as
trigger :: Box (a -> Bool) -> Str a -> Events a
trigger p (x ::: xs) = x' ::: (delay (trigger p) <*> xs)
where x' = if unbox p x then Just' x else Nothing'
triggerMap :: Box (a -> Maybe' b) -> Str a -> Events b
triggerMap = S.map
{-# RULES
"map/map" forall f g xs.
map f (map g xs) = map (box (unbox f . unbox g)) xs ;
#-}