module Reactive.Banana.Internal.EventBehavior1 (
interpret, compile,
Event, Behavior,
never, filterJust, unionWith, mapE, accumE, applyE,
changesB, stepperB, pureB, applyB, mapB,
Moment,
initialB, trimE, trimB, executeE, observeE, switchE, switchB,
addReactimate, fromAddHandler, fromPoll, liftIONow, liftIOLater,
EventNetwork, pause, actuate,
) where
import Data.Functor
import Data.Functor.Identity
import Control.Monad (join, (<=<))
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.Trans.Class (lift)
import qualified Reactive.Banana.Internal.PulseLatch0 as Prim
import Reactive.Banana.Internal.Cached
import Reactive.Banana.Internal.InputOutput
import Reactive.Banana.Frameworks.AddHandler
type Network = Prim.Network
type Latch = Prim.Latch
type Pulse = Prim.Pulse
type Behavior a = Cached Network (Latch a, Pulse ())
type Event a = Cached Network (Pulse a)
type Moment = Prim.NetworkSetup
runCachedM :: Cached Network a -> Moment a
runCachedM = Prim.liftNetwork . runCached
inputE :: InputChannel a -> Event a
inputE = mkCached . Prim.inputP
interpret :: (Event a -> Moment (Event b)) -> [Maybe a] -> IO [Maybe b]
interpret f = Prim.interpret (\pulse -> runCachedM =<< f (fromPure pulse))
compile :: Moment () -> IO EventNetwork
compile = Prim.compile
never = mkCached $ Prim.neverP
unionWith f = liftCached2 $ Prim.unionWith f
filterJust = liftCached1 $ Prim.filterJustP
accumE x = liftCached1 $ Prim.accumP x
mapE f = liftCached1 $ Prim.mapP f
applyE = liftCached2 $ \(lf,_) px -> Prim.applyP lf px
changesB = liftCached1 $ \(lx,px) -> Prim.tagFuture lx px
stepperB a = \c1 -> mkCached $ mdo
l <- Prim.stepperL a p1
p1 <- runCached c1
p2 <- Prim.mapP (const ()) p1
return (l,p2)
pureB a = stepperB a never
applyB = liftCached2 $ \(l1,p1) (l2,p2) -> do
p3 <- Prim.unionWith const p1 p2
l3 <- Prim.applyL l1 l2
return (l3,p3)
mapB f = applyB (pureB f)
initialB :: Behavior a -> Moment a
initialB b = Prim.liftNetwork $ do
~(l,_) <- runCached b
Prim.valueL l
trimE :: Event a -> Moment (Moment (Event a))
trimE e = do
p <- runCachedM e
return $ return $ fromPure p
trimB :: Behavior a -> Moment (Moment (Behavior a))
trimB b = do
~(l,p) <- runCachedM b
return $ return $ fromPure (l,p)
observeE :: Event (Moment a) -> Event a
observeE = liftCached1 $ Prim.executeP
executeE :: Event (Moment a) -> Moment (Event a)
executeE e = Prim.liftNetwork $ do
p <- runCached e
result <- Prim.executeP p
return $ fromPure result
switchE :: Event (Moment (Event a)) -> Event a
switchE = liftCached1 $ \p1 -> do
p2 <- Prim.mapP (runCachedM =<<) p1
p3 <- Prim.executeP p2
Prim.switchP p3
switchB :: Behavior a -> Event (Moment (Behavior a)) -> Behavior a
switchB = liftCached2 $ \(l0,p0) p1 -> do
p2 <- Prim.mapP (runCachedM =<<) p1
p3 <- Prim.executeP p2
lr <- Prim.switchL l0 =<< Prim.mapP fst p3
let c1 = p0
c2 <- Prim.mapP (const ()) p3
c3 <- Prim.switchP =<< Prim.mapP snd p3
pr <- merge c1 =<< merge c2 c3
return (lr, pr)
merge = Prim.unionWith (\_ _ -> ())
addReactimate :: Event (IO ()) -> Moment ()
addReactimate e = do
p <- runCachedM e
lift $ Prim.addReactimate p
liftIONow :: IO a -> Moment a
liftIONow = liftIO
liftIOLater :: IO () -> Moment ()
liftIOLater = lift . Prim.liftIOLater
fromAddHandler :: AddHandler a -> Moment (Event a)
fromAddHandler addHandler = do
i <- liftIO newInputChannel
p <- Prim.liftNetwork $ Prim.inputP i
lift $ Prim.registerHandler $ mapIO (return . (:[]) . toValue i) addHandler
return $ fromPure p
fromPoll :: IO a -> Moment (Behavior a)
fromPoll poll = do
a <- liftIO poll
e <- Prim.liftNetwork $ do
pm <- Prim.mapP (const $ liftIO poll) Prim.alwaysP
p <- Prim.executeP pm
return $ fromPure p
return $ stepperB a e
type EventNetwork = Prim.EventNetwork
pause = Prim.pause
actuate = Prim.actuate