module Reactive.Banana.Model (
Event(..), Behavior(..),
never, filterE, unionWith, applyE, accumE, stepperB,
mapE, pureB, applyB, mapB,
interpretModel,
) where
import Control.Applicative
type Event a = [Maybe a]
data Behavior a = StepperB a (Event a)
never :: Event a
never = repeat Nothing
filterE :: (a -> Bool) -> Event a -> Event a
filterE p = map (>>= \x -> if p x then Just x else Nothing)
unionWith :: (a -> a -> a) -> Event a -> Event a -> Event a
unionWith f = zipWith g
where
g (Just x) (Just y) = Just $ f x y
g (Just x) Nothing = Just x
g Nothing (Just y) = Just y
g Nothing Nothing = Nothing
applyE :: Behavior (a -> b) -> Event a -> Event b
applyE _ [] = []
applyE (StepperB f fe) (x:xs) = fmap f x : applyE (step f fe) xs
where
step a (Nothing:b) = stepperB a b
step _ (Just a :b) = stepperB a b
accumE :: a -> Event (a -> a) -> Event a
accumE x [] = []
accumE x (Nothing:fs) = Nothing : accumE x fs
accumE x (Just f :fs) = let y = f x in y `seq` (Just y:accumE y fs)
stepperB :: a -> [Maybe a] -> Behavior a
stepperB = StepperB
mapE f = applyE (pureB f)
pureB x = stepperB x never
applyB :: Behavior (a -> b) -> Behavior a -> Behavior b
applyB (StepperB f fe) (StepperB x xe) =
stepperB (f x) $ mapE (uncurry ($)) pair
where
pair = accumE (f,x) $ unionWith (.) (mapE changeL fe) (mapE changeR xe)
changeL f (_,x) = (f,x)
changeR x (f,_) = (f,x)
mapB f = applyB (pureB f)
interpretModel :: (Event a -> Event b) -> Event a -> IO (Event b)
interpretModel = (return .)