{-# LANGUAGE RecursiveDo, FlexibleInstances, NoMonomorphismRestriction #-}
module Reactive.Banana.Internal.Combinators where
import Control.Concurrent.MVar
import Control.Event.Handler
import Control.Monad
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader
import Data.Functor
import Data.Functor.Identity
import Data.IORef
import qualified Reactive.Banana.Prim as Prim
import Reactive.Banana.Prim.Cached
import Data.These (These(..), these)
type Build = Prim.Build
type Latch a = Prim.Latch a
type Pulse a = Prim.Pulse a
type Future = Prim.Future
type Behavior a = Cached Moment (Latch a, Pulse ())
type Event a = Cached Moment (Pulse a)
type Moment = ReaderT EventNetwork Prim.Build
liftBuild :: Build a -> Moment a
liftBuild :: Build a -> Moment a
liftBuild = Build a -> Moment a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
interpret :: (Event a -> Moment (Event b)) -> [Maybe a] -> IO [Maybe b]
interpret :: (Event a -> Moment (Event b)) -> [Maybe a] -> IO [Maybe b]
interpret Event a -> Moment (Event b)
f = (Pulse a -> BuildIO (Pulse b)) -> [Maybe a] -> IO [Maybe b]
forall a b.
(Pulse a -> BuildIO (Pulse b)) -> [Maybe a] -> IO [Maybe b]
Prim.interpret ((Pulse a -> BuildIO (Pulse b)) -> [Maybe a] -> IO [Maybe b])
-> (Pulse a -> BuildIO (Pulse b)) -> [Maybe a] -> IO [Maybe b]
forall a b. (a -> b) -> a -> b
$ \Pulse a
pulse -> ReaderT EventNetwork Build (Pulse b)
-> EventNetwork -> BuildIO (Pulse b)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Pulse a -> ReaderT EventNetwork Build (Pulse b)
g Pulse a
pulse) EventNetwork
forall a. HasCallStack => a
undefined
where
g :: Pulse a -> ReaderT EventNetwork Build (Pulse b)
g Pulse a
pulse = Event b -> ReaderT EventNetwork Build (Pulse b)
forall (m :: * -> *) a. Cached m a -> m a
runCached (Event b -> ReaderT EventNetwork Build (Pulse b))
-> Moment (Event b) -> ReaderT EventNetwork Build (Pulse b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Event a -> Moment (Event b)
f (Pulse a -> Event a
forall (m :: * -> *) a. Monad m => a -> Cached m a
Prim.fromPure Pulse a
pulse)
data EventNetwork = EventNetwork
{ EventNetwork -> Step -> IO ()
runStep :: Prim.Step -> IO ()
, EventNetwork -> IO ()
actuate :: IO ()
, EventNetwork -> IO ()
pause :: IO ()
}
compile :: Moment () -> IO EventNetwork
compile :: Moment () -> IO EventNetwork
compile Moment ()
setup = do
IORef Bool
actuated <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
MVar Network
s <- IO (MVar Network)
forall a. IO (MVar a)
newEmptyMVar
let
whenFlag :: IORef Bool -> IO () -> IO ()
whenFlag IORef Bool
flag IO ()
action = IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
flag IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b IO ()
action
runStep :: Step -> IO ()
runStep Step
f = IORef Bool -> IO () -> IO ()
whenFlag IORef Bool
actuated (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Network
s1 <- MVar Network -> IO Network
forall a. MVar a -> IO a
takeMVar MVar Network
s
(IO ()
output, Network
s2) <- Step
f Network
s1
MVar Network -> Network -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Network
s Network
s2
IO ()
output
eventNetwork :: EventNetwork
eventNetwork = EventNetwork :: (Step -> IO ()) -> IO () -> IO () -> EventNetwork
EventNetwork
{ runStep :: Step -> IO ()
runStep = Step -> IO ()
runStep
, actuate :: IO ()
actuate = IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
actuated Bool
True
, pause :: IO ()
pause = IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
actuated Bool
False
}
(()
output, Network
s0) <-
BuildIO () -> Network -> IO ((), Network)
forall a. BuildIO a -> Network -> IO (a, Network)
Prim.compile (Moment () -> EventNetwork -> BuildIO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Moment ()
setup EventNetwork
eventNetwork) Network
Prim.emptyNetwork
MVar Network -> Network -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Network
s Network
s0
EventNetwork -> IO EventNetwork
forall (m :: * -> *) a. Monad m => a -> m a
return (EventNetwork -> IO EventNetwork)
-> EventNetwork -> IO EventNetwork
forall a b. (a -> b) -> a -> b
$ EventNetwork
eventNetwork
fromAddHandler :: AddHandler a -> Moment (Event a)
fromAddHandler :: AddHandler a -> Moment (Event a)
fromAddHandler AddHandler a
addHandler = do
(Pulse a
p, a -> Step
fire) <- Build (Pulse a, a -> Step) -> Moment (Pulse a, a -> Step)
forall a. Build a -> Moment a
liftBuild (Build (Pulse a, a -> Step) -> Moment (Pulse a, a -> Step))
-> Build (Pulse a, a -> Step) -> Moment (Pulse a, a -> Step)
forall a b. (a -> b) -> a -> b
$ Build (Pulse a, a -> Step)
forall a. Build (Pulse a, a -> Step)
Prim.newInput
EventNetwork
network <- ReaderT EventNetwork Build EventNetwork
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
IO (IO ()) -> ReaderT EventNetwork Build (IO ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IO ()) -> ReaderT EventNetwork Build (IO ()))
-> IO (IO ()) -> ReaderT EventNetwork Build (IO ())
forall a b. (a -> b) -> a -> b
$ AddHandler a -> Handler a -> IO (IO ())
forall a. AddHandler a -> Handler a -> IO (IO ())
register AddHandler a
addHandler (Handler a -> IO (IO ())) -> Handler a -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ EventNetwork -> Step -> IO ()
runStep EventNetwork
network (Step -> IO ()) -> (a -> Step) -> Handler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Step
fire
Event a -> Moment (Event a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event a -> Moment (Event a)) -> Event a -> Moment (Event a)
forall a b. (a -> b) -> a -> b
$ Pulse a -> Event a
forall (m :: * -> *) a. Monad m => a -> Cached m a
Prim.fromPure Pulse a
p
addReactimate :: Event (Future (IO ())) -> Moment ()
addReactimate :: Event (IO (IO ())) -> Moment ()
addReactimate Event (IO (IO ()))
e = do
EventNetwork
network <- ReaderT EventNetwork Build EventNetwork
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
BuildIO () -> Moment ()
forall a. Build a -> Moment a
liftBuild (BuildIO () -> Moment ()) -> BuildIO () -> Moment ()
forall a b. (a -> b) -> a -> b
$ BuildIO () -> BuildIO ()
Prim.buildLater (BuildIO () -> BuildIO ()) -> BuildIO () -> BuildIO ()
forall a b. (a -> b) -> a -> b
$ do
Pulse (IO (IO ()))
p <- ReaderT EventNetwork Build (Pulse (IO (IO ())))
-> EventNetwork -> Build (Pulse (IO (IO ())))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Event (IO (IO ()))
-> ReaderT EventNetwork Build (Pulse (IO (IO ())))
forall (m :: * -> *) a. Cached m a -> m a
runCached Event (IO (IO ()))
e) EventNetwork
network
Pulse (IO (IO ())) -> (IO () -> IO ()) -> BuildIO ()
forall a. Pulse (Future a) -> (a -> IO ()) -> BuildIO ()
Prim.addHandler Pulse (IO (IO ()))
p IO () -> IO ()
forall a. a -> a
id
fromPoll :: IO a -> Moment (Behavior a)
fromPoll :: IO a -> Moment (Behavior a)
fromPoll IO a
poll = do
a
a <- IO a -> ReaderT EventNetwork Build a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
poll
Cached Moment (Pulse a)
e <- Build (Cached Moment (Pulse a)) -> Moment (Cached Moment (Pulse a))
forall a. Build a -> Moment a
liftBuild (Build (Cached Moment (Pulse a))
-> Moment (Cached Moment (Pulse a)))
-> Build (Cached Moment (Pulse a))
-> Moment (Cached Moment (Pulse a))
forall a b. (a -> b) -> a -> b
$ do
Pulse a
p <- (() -> IO a) -> Pulse () -> Build (Pulse a)
forall a b. (a -> IO b) -> Pulse a -> Build (Pulse b)
Prim.unsafeMapIOP (IO a -> () -> IO a
forall a b. a -> b -> a
const IO a
poll) (Pulse () -> Build (Pulse a))
-> ReaderWriterIOT BuildR BuildW IO (Pulse ()) -> Build (Pulse a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderWriterIOT BuildR BuildW IO (Pulse ())
Prim.alwaysP
Cached Moment (Pulse a) -> Build (Cached Moment (Pulse a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Cached Moment (Pulse a) -> Build (Cached Moment (Pulse a)))
-> Cached Moment (Pulse a) -> Build (Cached Moment (Pulse a))
forall a b. (a -> b) -> a -> b
$ Pulse a -> Cached Moment (Pulse a)
forall (m :: * -> *) a. Monad m => a -> Cached m a
Prim.fromPure Pulse a
p
a -> Cached Moment (Pulse a) -> Moment (Behavior a)
forall a. a -> Event a -> Moment (Behavior a)
stepperB a
a Cached Moment (Pulse a)
e
liftIONow :: IO a -> Moment a
liftIONow :: IO a -> Moment a
liftIONow = IO a -> Moment a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
liftIOLater :: IO () -> Moment ()
liftIOLater :: IO () -> Moment ()
liftIOLater = BuildIO () -> Moment ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (BuildIO () -> Moment ())
-> (IO () -> BuildIO ()) -> IO () -> Moment ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildIO () -> BuildIO ()
forall a. Build a -> Build a
Prim.liftBuild (BuildIO () -> BuildIO ())
-> (IO () -> BuildIO ()) -> IO () -> BuildIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> BuildIO ()
Prim.liftIOLater
imposeChanges :: Behavior a -> Event () -> Behavior a
imposeChanges :: Behavior a -> Event () -> Behavior a
imposeChanges = ((Latch a, Pulse ()) -> Pulse () -> Moment (Latch a, Pulse ()))
-> Behavior a -> Event () -> Behavior a
forall (m :: * -> *) a b c.
(MonadFix m, MonadIO m) =>
(a -> b -> m c) -> Cached m a -> Cached m b -> Cached m c
liftCached2 (((Latch a, Pulse ()) -> Pulse () -> Moment (Latch a, Pulse ()))
-> Behavior a -> Event () -> Behavior a)
-> ((Latch a, Pulse ()) -> Pulse () -> Moment (Latch a, Pulse ()))
-> Behavior a
-> Event ()
-> Behavior a
forall a b. (a -> b) -> a -> b
$ \(Latch a
l1,Pulse ()
_) Pulse ()
p2 -> (Latch a, Pulse ()) -> Moment (Latch a, Pulse ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Latch a
l1,Pulse ()
p2)
never :: Event a
never :: Event a
never = ReaderT EventNetwork Build (Pulse a) -> Event a
forall (m :: * -> *) a. Monad m => m a -> Cached m a
don'tCache (ReaderT EventNetwork Build (Pulse a) -> Event a)
-> ReaderT EventNetwork Build (Pulse a) -> Event a
forall a b. (a -> b) -> a -> b
$ Build (Pulse a) -> ReaderT EventNetwork Build (Pulse a)
forall a. Build a -> Moment a
liftBuild (Build (Pulse a) -> ReaderT EventNetwork Build (Pulse a))
-> Build (Pulse a) -> ReaderT EventNetwork Build (Pulse a)
forall a b. (a -> b) -> a -> b
$ Build (Pulse a)
forall a. Build (Pulse a)
Prim.neverP
mergeWith
:: (a -> c)
-> (b -> c)
-> (a -> b -> c)
-> Event a
-> Event b
-> Event c
mergeWith :: (a -> c)
-> (b -> c) -> (a -> b -> c) -> Event a -> Event b -> Event c
mergeWith a -> c
f b -> c
g a -> b -> c
h = (Pulse a -> Pulse b -> ReaderT EventNetwork Build (Pulse c))
-> Event a -> Event b -> Event c
forall (m :: * -> *) a b c.
(MonadFix m, MonadIO m) =>
(a -> b -> m c) -> Cached m a -> Cached m b -> Cached m c
liftCached2 ((Pulse a -> Pulse b -> ReaderT EventNetwork Build (Pulse c))
-> Event a -> Event b -> Event c)
-> (Pulse a -> Pulse b -> ReaderT EventNetwork Build (Pulse c))
-> Event a
-> Event b
-> Event c
forall a b. (a -> b) -> a -> b
$ (Build (Pulse c) -> ReaderT EventNetwork Build (Pulse c)
forall a. Build a -> Moment a
liftBuild (Build (Pulse c) -> ReaderT EventNetwork Build (Pulse c))
-> (Pulse b -> Build (Pulse c))
-> Pulse b
-> ReaderT EventNetwork Build (Pulse c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Pulse b -> Build (Pulse c))
-> Pulse b -> ReaderT EventNetwork Build (Pulse c))
-> (Pulse a -> Pulse b -> Build (Pulse c))
-> Pulse a
-> Pulse b
-> ReaderT EventNetwork Build (Pulse c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe c)
-> (b -> Maybe c)
-> (a -> b -> Maybe c)
-> Pulse a
-> Pulse b
-> Build (Pulse c)
forall a c b.
(a -> Maybe c)
-> (b -> Maybe c)
-> (a -> b -> Maybe c)
-> Pulse a
-> Pulse b
-> Build (Pulse c)
Prim.mergeWithP (c -> Maybe c
forall a. a -> Maybe a
Just (c -> Maybe c) -> (a -> c) -> a -> Maybe c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> c
f) (c -> Maybe c
forall a. a -> Maybe a
Just (c -> Maybe c) -> (b -> c) -> b -> Maybe c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
g) (\a
x b
y -> c -> Maybe c
forall a. a -> Maybe a
Just (a -> b -> c
h a
x b
y))
filterJust :: Event (Maybe a) -> Event a
filterJust :: Event (Maybe a) -> Event a
filterJust = (Pulse (Maybe a) -> ReaderT EventNetwork Build (Pulse a))
-> Event (Maybe a) -> Event a
forall (m :: * -> *) a b.
(MonadFix m, MonadIO m) =>
(a -> m b) -> Cached m a -> Cached m b
liftCached1 ((Pulse (Maybe a) -> ReaderT EventNetwork Build (Pulse a))
-> Event (Maybe a) -> Event a)
-> (Pulse (Maybe a) -> ReaderT EventNetwork Build (Pulse a))
-> Event (Maybe a)
-> Event a
forall a b. (a -> b) -> a -> b
$ Build (Pulse a) -> ReaderT EventNetwork Build (Pulse a)
forall a. Build a -> Moment a
liftBuild (Build (Pulse a) -> ReaderT EventNetwork Build (Pulse a))
-> (Pulse (Maybe a) -> Build (Pulse a))
-> Pulse (Maybe a)
-> ReaderT EventNetwork Build (Pulse a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pulse (Maybe a) -> Build (Pulse a)
forall a. Pulse (Maybe a) -> Build (Pulse a)
Prim.filterJustP
mapE :: (a -> b) -> Event a -> Event b
mapE :: (a -> b) -> Event a -> Event b
mapE a -> b
f = (Pulse a -> ReaderT EventNetwork Build (Pulse b))
-> Event a -> Event b
forall (m :: * -> *) a b.
(MonadFix m, MonadIO m) =>
(a -> m b) -> Cached m a -> Cached m b
liftCached1 ((Pulse a -> ReaderT EventNetwork Build (Pulse b))
-> Event a -> Event b)
-> (Pulse a -> ReaderT EventNetwork Build (Pulse b))
-> Event a
-> Event b
forall a b. (a -> b) -> a -> b
$ Build (Pulse b) -> ReaderT EventNetwork Build (Pulse b)
forall a. Build a -> Moment a
liftBuild (Build (Pulse b) -> ReaderT EventNetwork Build (Pulse b))
-> (Pulse a -> Build (Pulse b))
-> Pulse a
-> ReaderT EventNetwork Build (Pulse b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Pulse a -> Build (Pulse b)
forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP a -> b
f
applyE :: Behavior (a -> b) -> Event a -> Event b
applyE :: Behavior (a -> b) -> Event a -> Event b
applyE = ((Latch (a -> b), Pulse ())
-> Pulse a -> ReaderT EventNetwork Build (Pulse b))
-> Behavior (a -> b) -> Event a -> Event b
forall (m :: * -> *) a b c.
(MonadFix m, MonadIO m) =>
(a -> b -> m c) -> Cached m a -> Cached m b -> Cached m c
liftCached2 (((Latch (a -> b), Pulse ())
-> Pulse a -> ReaderT EventNetwork Build (Pulse b))
-> Behavior (a -> b) -> Event a -> Event b)
-> ((Latch (a -> b), Pulse ())
-> Pulse a -> ReaderT EventNetwork Build (Pulse b))
-> Behavior (a -> b)
-> Event a
-> Event b
forall a b. (a -> b) -> a -> b
$ \(~(Latch (a -> b)
lf,Pulse ()
_)) Pulse a
px -> Build (Pulse b) -> ReaderT EventNetwork Build (Pulse b)
forall a. Build a -> Moment a
liftBuild (Build (Pulse b) -> ReaderT EventNetwork Build (Pulse b))
-> Build (Pulse b) -> ReaderT EventNetwork Build (Pulse b)
forall a b. (a -> b) -> a -> b
$ Latch (a -> b) -> Pulse a -> Build (Pulse b)
forall a b. Latch (a -> b) -> Pulse a -> Build (Pulse b)
Prim.applyP Latch (a -> b)
lf Pulse a
px
changesB :: Behavior a -> Event (Future a)
changesB :: Behavior a -> Event (Future a)
changesB = ((Latch a, Pulse ())
-> ReaderT EventNetwork Build (Pulse (Future a)))
-> Behavior a -> Event (Future a)
forall (m :: * -> *) a b.
(MonadFix m, MonadIO m) =>
(a -> m b) -> Cached m a -> Cached m b
liftCached1 (((Latch a, Pulse ())
-> ReaderT EventNetwork Build (Pulse (Future a)))
-> Behavior a -> Event (Future a))
-> ((Latch a, Pulse ())
-> ReaderT EventNetwork Build (Pulse (Future a)))
-> Behavior a
-> Event (Future a)
forall a b. (a -> b) -> a -> b
$ \(~(Latch a
lx,Pulse ()
px)) -> Build (Pulse (Future a))
-> ReaderT EventNetwork Build (Pulse (Future a))
forall a. Build a -> Moment a
liftBuild (Build (Pulse (Future a))
-> ReaderT EventNetwork Build (Pulse (Future a)))
-> Build (Pulse (Future a))
-> ReaderT EventNetwork Build (Pulse (Future a))
forall a b. (a -> b) -> a -> b
$ Latch a -> Pulse () -> Build (Pulse (Future a))
forall a b. Latch a -> Pulse b -> Build (Pulse (Future a))
Prim.tagFuture Latch a
lx Pulse ()
px
pureB :: a -> Behavior a
pureB :: a -> Behavior a
pureB a
a = Moment (Latch a, Pulse ()) -> Behavior a
forall (m :: * -> *) a.
(MonadFix m, MonadIO m) =>
m a -> Cached m a
cache (Moment (Latch a, Pulse ()) -> Behavior a)
-> Moment (Latch a, Pulse ()) -> Behavior a
forall a b. (a -> b) -> a -> b
$ do
Pulse ()
p <- Event () -> Moment (Pulse ())
forall (m :: * -> *) a. Cached m a -> m a
runCached Event ()
forall a. Event a
never
(Latch a, Pulse ()) -> Moment (Latch a, Pulse ())
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Latch a
forall a. a -> Latch a
Prim.pureL a
a, Pulse ()
p)
applyB :: Behavior (a -> b) -> Behavior a -> Behavior b
applyB :: Behavior (a -> b) -> Behavior a -> Behavior b
applyB = ((Latch (a -> b), Pulse ())
-> (Latch a, Pulse ())
-> ReaderT EventNetwork Build (Latch b, Pulse ()))
-> Behavior (a -> b) -> Behavior a -> Behavior b
forall (m :: * -> *) a b c.
(MonadFix m, MonadIO m) =>
(a -> b -> m c) -> Cached m a -> Cached m b -> Cached m c
liftCached2 (((Latch (a -> b), Pulse ())
-> (Latch a, Pulse ())
-> ReaderT EventNetwork Build (Latch b, Pulse ()))
-> Behavior (a -> b) -> Behavior a -> Behavior b)
-> ((Latch (a -> b), Pulse ())
-> (Latch a, Pulse ())
-> ReaderT EventNetwork Build (Latch b, Pulse ()))
-> Behavior (a -> b)
-> Behavior a
-> Behavior b
forall a b. (a -> b) -> a -> b
$ \(~(Latch (a -> b)
l1,Pulse ()
p1)) (~(Latch a
l2,Pulse ()
p2)) -> Build (Latch b, Pulse ())
-> ReaderT EventNetwork Build (Latch b, Pulse ())
forall a. Build a -> Moment a
liftBuild (Build (Latch b, Pulse ())
-> ReaderT EventNetwork Build (Latch b, Pulse ()))
-> Build (Latch b, Pulse ())
-> ReaderT EventNetwork Build (Latch b, Pulse ())
forall a b. (a -> b) -> a -> b
$ do
Pulse ()
p3 <- (() -> Maybe ())
-> (() -> Maybe ())
-> (() -> () -> Maybe ())
-> Pulse ()
-> Pulse ()
-> ReaderWriterIOT BuildR BuildW IO (Pulse ())
forall a c b.
(a -> Maybe c)
-> (b -> Maybe c)
-> (a -> b -> Maybe c)
-> Pulse a
-> Pulse b
-> Build (Pulse c)
Prim.mergeWithP () -> Maybe ()
forall a. a -> Maybe a
Just () -> Maybe ()
forall a. a -> Maybe a
Just (Maybe () -> () -> Maybe ()
forall a b. a -> b -> a
const (Maybe () -> () -> Maybe ())
-> (() -> Maybe ()) -> () -> () -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Maybe ()
forall a. a -> Maybe a
Just) Pulse ()
p1 Pulse ()
p2
let l3 :: Latch b
l3 = Latch (a -> b) -> Latch a -> Latch b
forall a b. Latch (a -> b) -> Latch a -> Latch b
Prim.applyL Latch (a -> b)
l1 Latch a
l2
(Latch b, Pulse ()) -> Build (Latch b, Pulse ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Latch b
l3,Pulse ()
p3)
mapB :: (a -> b) -> Behavior a -> Behavior b
mapB :: (a -> b) -> Behavior a -> Behavior b
mapB a -> b
f = Behavior (a -> b) -> Behavior a -> Behavior b
forall a b. Behavior (a -> b) -> Behavior a -> Behavior b
applyB ((a -> b) -> Behavior (a -> b)
forall a. a -> Behavior a
pureB a -> b
f)
trim :: Cached Moment a -> Moment (Cached Moment a)
trim :: Cached Moment a -> Moment (Cached Moment a)
trim Cached Moment a
b = do
(BuildIO () -> BuildIO ()) -> Moment () -> Moment ()
forall a b. (Build a -> Build b) -> Moment a -> Moment b
liftBuildFun BuildIO () -> BuildIO ()
Prim.buildLater (Moment () -> Moment ()) -> Moment () -> Moment ()
forall a b. (a -> b) -> a -> b
$ Moment a -> Moment ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Moment a -> Moment ()) -> Moment a -> Moment ()
forall a b. (a -> b) -> a -> b
$ Cached Moment a -> Moment a
forall (m :: * -> *) a. Cached m a -> m a
runCached Cached Moment a
b
Cached Moment a -> Moment (Cached Moment a)
forall (m :: * -> *) a. Monad m => a -> m a
return Cached Moment a
b
cacheAndSchedule :: Moment a -> Moment (Cached Moment a)
cacheAndSchedule :: Moment a -> Moment (Cached Moment a)
cacheAndSchedule Moment a
m = ReaderT EventNetwork Build EventNetwork
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask ReaderT EventNetwork Build EventNetwork
-> (EventNetwork -> Moment (Cached Moment a))
-> Moment (Cached Moment a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EventNetwork
r -> Build (Cached Moment a) -> Moment (Cached Moment a)
forall a. Build a -> Moment a
liftBuild (Build (Cached Moment a) -> Moment (Cached Moment a))
-> Build (Cached Moment a) -> Moment (Cached Moment a)
forall a b. (a -> b) -> a -> b
$ do
let c :: Cached Moment a
c = Moment a -> Cached Moment a
forall (m :: * -> *) a.
(MonadFix m, MonadIO m) =>
m a -> Cached m a
cache (Moment a -> EventNetwork -> Moment a
forall a b. a -> b -> a
const Moment a
m EventNetwork
r)
BuildIO () -> BuildIO ()
Prim.buildLater (BuildIO () -> BuildIO ()) -> BuildIO () -> BuildIO ()
forall a b. (a -> b) -> a -> b
$ Build a -> BuildIO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Build a -> BuildIO ()) -> Build a -> BuildIO ()
forall a b. (a -> b) -> a -> b
$ Moment a -> EventNetwork -> Build a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Cached Moment a -> Moment a
forall (m :: * -> *) a. Cached m a -> m a
runCached Cached Moment a
c) EventNetwork
r
Cached Moment a -> Build (Cached Moment a)
forall (m :: * -> *) a. Monad m => a -> m a
return Cached Moment a
c
stepperB :: a -> Event a -> Moment (Behavior a)
stepperB :: a -> Event a -> Moment (Behavior a)
stepperB a
a Event a
e = Moment (Latch a, Pulse ()) -> Moment (Behavior a)
forall a. Moment a -> Moment (Cached Moment a)
cacheAndSchedule (Moment (Latch a, Pulse ()) -> Moment (Behavior a))
-> Moment (Latch a, Pulse ()) -> Moment (Behavior a)
forall a b. (a -> b) -> a -> b
$ do
Pulse a
p0 <- Event a -> Moment (Pulse a)
forall (m :: * -> *) a. Cached m a -> m a
runCached Event a
e
Build (Latch a, Pulse ()) -> Moment (Latch a, Pulse ())
forall a. Build a -> Moment a
liftBuild (Build (Latch a, Pulse ()) -> Moment (Latch a, Pulse ()))
-> Build (Latch a, Pulse ()) -> Moment (Latch a, Pulse ())
forall a b. (a -> b) -> a -> b
$ do
Pulse (a -> a)
p1 <- (a -> a -> a) -> Pulse a -> Build (Pulse (a -> a))
forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP a -> a -> a
forall a b. a -> b -> a
const Pulse a
p0
Pulse ()
p2 <- ((a -> a) -> ())
-> Pulse (a -> a) -> ReaderWriterIOT BuildR BuildW IO (Pulse ())
forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP (() -> (a -> a) -> ()
forall a b. a -> b -> a
const ()) Pulse (a -> a)
p1
(Latch a
l,Pulse a
_) <- a -> Pulse (a -> a) -> Build (Latch a, Pulse a)
forall a. a -> Pulse (a -> a) -> Build (Latch a, Pulse a)
Prim.accumL a
a Pulse (a -> a)
p1
(Latch a, Pulse ()) -> Build (Latch a, Pulse ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Latch a
l,Pulse ()
p2)
accumE :: a -> Event (a -> a) -> Moment (Event a)
accumE :: a -> Event (a -> a) -> Moment (Event a)
accumE a
a Event (a -> a)
e1 = Moment (Pulse a) -> Moment (Event a)
forall a. Moment a -> Moment (Cached Moment a)
cacheAndSchedule (Moment (Pulse a) -> Moment (Event a))
-> Moment (Pulse a) -> Moment (Event a)
forall a b. (a -> b) -> a -> b
$ do
Pulse (a -> a)
p0 <- Event (a -> a) -> Moment (Pulse (a -> a))
forall (m :: * -> *) a. Cached m a -> m a
runCached Event (a -> a)
e1
Build (Pulse a) -> Moment (Pulse a)
forall a. Build a -> Moment a
liftBuild (Build (Pulse a) -> Moment (Pulse a))
-> Build (Pulse a) -> Moment (Pulse a)
forall a b. (a -> b) -> a -> b
$ do
(Latch a
_,Pulse a
p1) <- a -> Pulse (a -> a) -> Build (Latch a, Pulse a)
forall a. a -> Pulse (a -> a) -> Build (Latch a, Pulse a)
Prim.accumL a
a Pulse (a -> a)
p0
Pulse a -> Build (Pulse a)
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse a
p1
liftBuildFun :: (Build a -> Build b) -> Moment a -> Moment b
liftBuildFun :: (Build a -> Build b) -> Moment a -> Moment b
liftBuildFun Build a -> Build b
f Moment a
m = do
EventNetwork
r <- ReaderT EventNetwork Build EventNetwork
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
Build b -> Moment b
forall a. Build a -> Moment a
liftBuild (Build b -> Moment b) -> Build b -> Moment b
forall a b. (a -> b) -> a -> b
$ Build a -> Build b
f (Build a -> Build b) -> Build a -> Build b
forall a b. (a -> b) -> a -> b
$ Moment a -> EventNetwork -> Build a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Moment a
m EventNetwork
r
valueB :: Behavior a -> Moment a
valueB :: Behavior a -> Moment a
valueB Behavior a
b = do
~(Latch a
l,Pulse ()
_) <- Behavior a -> Moment (Latch a, Pulse ())
forall (m :: * -> *) a. Cached m a -> m a
runCached Behavior a
b
Build a -> Moment a
forall a. Build a -> Moment a
liftBuild (Build a -> Moment a) -> Build a -> Moment a
forall a b. (a -> b) -> a -> b
$ Latch a -> Build a
forall a. Latch a -> Build a
Prim.readLatch Latch a
l
initialBLater :: Behavior a -> Moment a
initialBLater :: Behavior a -> Moment a
initialBLater = (Build a -> Build a) -> Moment a -> Moment a
forall a b. (Build a -> Build b) -> Moment a -> Moment b
liftBuildFun Build a -> Build a
forall a. Build a -> Build a
Prim.buildLaterReadNow (Moment a -> Moment a)
-> (Behavior a -> Moment a) -> Behavior a -> Moment a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior a -> Moment a
forall a. Behavior a -> Moment a
valueB
executeP :: Pulse (Moment a) -> Moment (Pulse a)
executeP :: Pulse (Moment a) -> Moment (Pulse a)
executeP Pulse (Moment a)
p1 = do
EventNetwork
r <- ReaderT EventNetwork Build EventNetwork
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
Build (Pulse a) -> Moment (Pulse a)
forall a. Build a -> Moment a
liftBuild (Build (Pulse a) -> Moment (Pulse a))
-> Build (Pulse a) -> Moment (Pulse a)
forall a b. (a -> b) -> a -> b
$ do
Pulse (EventNetwork -> Build a)
p2 <- (Moment a -> EventNetwork -> Build a)
-> Pulse (Moment a) -> Build (Pulse (EventNetwork -> Build a))
forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP Moment a -> EventNetwork -> Build a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Pulse (Moment a)
p1
Pulse (EventNetwork -> Build a) -> EventNetwork -> Build (Pulse a)
forall a b. Pulse (b -> Build a) -> b -> Build (Pulse a)
Prim.executeP Pulse (EventNetwork -> Build a)
p2 EventNetwork
r
observeE :: Event (Moment a) -> Event a
observeE :: Event (Moment a) -> Event a
observeE = (Pulse (Moment a) -> ReaderT EventNetwork Build (Pulse a))
-> Event (Moment a) -> Event a
forall (m :: * -> *) a b.
(MonadFix m, MonadIO m) =>
(a -> m b) -> Cached m a -> Cached m b
liftCached1 ((Pulse (Moment a) -> ReaderT EventNetwork Build (Pulse a))
-> Event (Moment a) -> Event a)
-> (Pulse (Moment a) -> ReaderT EventNetwork Build (Pulse a))
-> Event (Moment a)
-> Event a
forall a b. (a -> b) -> a -> b
$ Pulse (Moment a) -> ReaderT EventNetwork Build (Pulse a)
forall a. Pulse (Moment a) -> Moment (Pulse a)
executeP
executeE :: Event (Moment a) -> Moment (Event a)
executeE :: Event (Moment a) -> Moment (Event a)
executeE Event (Moment a)
e = do
Pulse a
p <- (Build (Pulse a) -> Build (Pulse a))
-> Moment (Pulse a) -> Moment (Pulse a)
forall a b. (Build a -> Build b) -> Moment a -> Moment b
liftBuildFun Build (Pulse a) -> Build (Pulse a)
forall a. Build a -> Build a
Prim.buildLaterReadNow (Moment (Pulse a) -> Moment (Pulse a))
-> Moment (Pulse a) -> Moment (Pulse a)
forall a b. (a -> b) -> a -> b
$ Pulse (Moment a) -> Moment (Pulse a)
forall a. Pulse (Moment a) -> Moment (Pulse a)
executeP (Pulse (Moment a) -> Moment (Pulse a))
-> ReaderT EventNetwork Build (Pulse (Moment a))
-> Moment (Pulse a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Event (Moment a) -> ReaderT EventNetwork Build (Pulse (Moment a))
forall (m :: * -> *) a. Cached m a -> m a
runCached Event (Moment a)
e
Event a -> Moment (Event a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event a -> Moment (Event a)) -> Event a -> Moment (Event a)
forall a b. (a -> b) -> a -> b
$ Pulse a -> Event a
forall (m :: * -> *) a. Monad m => a -> Cached m a
fromPure Pulse a
p
switchE :: Event (Event a) -> Moment (Event a)
switchE :: Event (Event a) -> Moment (Event a)
switchE Event (Event a)
e = ReaderT EventNetwork Build EventNetwork
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask ReaderT EventNetwork Build EventNetwork
-> (EventNetwork -> Moment (Event a)) -> Moment (Event a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EventNetwork
r -> Moment (Pulse a) -> Moment (Event a)
forall a. Moment a -> Moment (Cached Moment a)
cacheAndSchedule (Moment (Pulse a) -> Moment (Event a))
-> Moment (Pulse a) -> Moment (Event a)
forall a b. (a -> b) -> a -> b
$ do
Pulse (Event a)
p1 <- Event (Event a) -> Moment (Pulse (Event a))
forall (m :: * -> *) a. Cached m a -> m a
runCached Event (Event a)
e
Build (Pulse a) -> Moment (Pulse a)
forall a. Build a -> Moment a
liftBuild (Build (Pulse a) -> Moment (Pulse a))
-> Build (Pulse a) -> Moment (Pulse a)
forall a b. (a -> b) -> a -> b
$ do
Pulse (EventNetwork -> Build (Pulse a))
p2 <- (Event a -> EventNetwork -> Build (Pulse a))
-> Pulse (Event a)
-> Build (Pulse (EventNetwork -> Build (Pulse a)))
forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP (Moment (Pulse a) -> EventNetwork -> Build (Pulse a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Moment (Pulse a) -> EventNetwork -> Build (Pulse a))
-> (Event a -> Moment (Pulse a))
-> Event a
-> EventNetwork
-> Build (Pulse a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Moment (Pulse a)
forall (m :: * -> *) a. Cached m a -> m a
runCached) Pulse (Event a)
p1
Pulse (Pulse a)
p3 <- Pulse (EventNetwork -> Build (Pulse a))
-> EventNetwork -> Build (Pulse (Pulse a))
forall a b. Pulse (b -> Build a) -> b -> Build (Pulse a)
Prim.executeP Pulse (EventNetwork -> Build (Pulse a))
p2 EventNetwork
r
Pulse (Pulse a) -> Build (Pulse a)
forall a. Pulse (Pulse a) -> Build (Pulse a)
Prim.switchP Pulse (Pulse a)
p3
switchB :: Behavior a -> Event (Behavior a) -> Moment (Behavior a)
switchB :: Behavior a -> Event (Behavior a) -> Moment (Behavior a)
switchB Behavior a
b Event (Behavior a)
e = ReaderT EventNetwork Build EventNetwork
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask ReaderT EventNetwork Build EventNetwork
-> (EventNetwork -> Moment (Behavior a)) -> Moment (Behavior a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EventNetwork
r -> Moment (Latch a, Pulse ()) -> Moment (Behavior a)
forall a. Moment a -> Moment (Cached Moment a)
cacheAndSchedule (Moment (Latch a, Pulse ()) -> Moment (Behavior a))
-> Moment (Latch a, Pulse ()) -> Moment (Behavior a)
forall a b. (a -> b) -> a -> b
$ do
~(Latch a
l0,Pulse ()
p0) <- Behavior a -> Moment (Latch a, Pulse ())
forall (m :: * -> *) a. Cached m a -> m a
runCached Behavior a
b
Pulse (Behavior a)
p1 <- Event (Behavior a) -> Moment (Pulse (Behavior a))
forall (m :: * -> *) a. Cached m a -> m a
runCached Event (Behavior a)
e
Build (Latch a, Pulse ()) -> Moment (Latch a, Pulse ())
forall a. Build a -> Moment a
liftBuild (Build (Latch a, Pulse ()) -> Moment (Latch a, Pulse ()))
-> Build (Latch a, Pulse ()) -> Moment (Latch a, Pulse ())
forall a b. (a -> b) -> a -> b
$ do
Pulse (EventNetwork -> Build (Latch a, Pulse ()))
p2 <- (Behavior a -> EventNetwork -> Build (Latch a, Pulse ()))
-> Pulse (Behavior a)
-> Build (Pulse (EventNetwork -> Build (Latch a, Pulse ())))
forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP (Moment (Latch a, Pulse ())
-> EventNetwork -> Build (Latch a, Pulse ())
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Moment (Latch a, Pulse ())
-> EventNetwork -> Build (Latch a, Pulse ()))
-> (Behavior a -> Moment (Latch a, Pulse ()))
-> Behavior a
-> EventNetwork
-> Build (Latch a, Pulse ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior a -> Moment (Latch a, Pulse ())
forall (m :: * -> *) a. Cached m a -> m a
runCached) Pulse (Behavior a)
p1
Pulse (Latch a, Pulse ())
p3 <- Pulse (EventNetwork -> Build (Latch a, Pulse ()))
-> EventNetwork -> Build (Pulse (Latch a, Pulse ()))
forall a b. Pulse (b -> Build a) -> b -> Build (Pulse a)
Prim.executeP Pulse (EventNetwork -> Build (Latch a, Pulse ()))
p2 EventNetwork
r
Latch a
lr <- Latch a -> Pulse (Latch a) -> Build (Latch a)
forall a. Latch a -> Pulse (Latch a) -> Build (Latch a)
Prim.switchL Latch a
l0 (Pulse (Latch a) -> Build (Latch a))
-> ReaderWriterIOT BuildR BuildW IO (Pulse (Latch a))
-> Build (Latch a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((Latch a, Pulse ()) -> Latch a)
-> Pulse (Latch a, Pulse ())
-> ReaderWriterIOT BuildR BuildW IO (Pulse (Latch a))
forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP (Latch a, Pulse ()) -> Latch a
forall a b. (a, b) -> a
fst Pulse (Latch a, Pulse ())
p3
let c1 :: Pulse ()
c1 = Pulse ()
p0
Pulse ()
c2 <- ((Latch a, Pulse ()) -> ())
-> Pulse (Latch a, Pulse ())
-> ReaderWriterIOT BuildR BuildW IO (Pulse ())
forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP (() -> (Latch a, Pulse ()) -> ()
forall a b. a -> b -> a
const ()) Pulse (Latch a, Pulse ())
p3
Pulse ()
c3 <- Pulse (Pulse ()) -> ReaderWriterIOT BuildR BuildW IO (Pulse ())
forall a. Pulse (Pulse a) -> Build (Pulse a)
Prim.switchP (Pulse (Pulse ()) -> ReaderWriterIOT BuildR BuildW IO (Pulse ()))
-> ReaderWriterIOT BuildR BuildW IO (Pulse (Pulse ()))
-> ReaderWriterIOT BuildR BuildW IO (Pulse ())
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((Latch a, Pulse ()) -> Pulse ())
-> Pulse (Latch a, Pulse ())
-> ReaderWriterIOT BuildR BuildW IO (Pulse (Pulse ()))
forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP (Latch a, Pulse ()) -> Pulse ()
forall a b. (a, b) -> b
snd Pulse (Latch a, Pulse ())
p3
Pulse ()
pr <- Pulse () -> Pulse () -> ReaderWriterIOT BuildR BuildW IO (Pulse ())
merge Pulse ()
c1 (Pulse () -> ReaderWriterIOT BuildR BuildW IO (Pulse ()))
-> ReaderWriterIOT BuildR BuildW IO (Pulse ())
-> ReaderWriterIOT BuildR BuildW IO (Pulse ())
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pulse () -> Pulse () -> ReaderWriterIOT BuildR BuildW IO (Pulse ())
merge Pulse ()
c2 Pulse ()
c3
(Latch a, Pulse ()) -> Build (Latch a, Pulse ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Latch a
lr, Pulse ()
pr)
merge :: Pulse () -> Pulse () -> Build (Pulse ())
merge :: Pulse () -> Pulse () -> ReaderWriterIOT BuildR BuildW IO (Pulse ())
merge = (() -> Maybe ())
-> (() -> Maybe ())
-> (() -> () -> Maybe ())
-> Pulse ()
-> Pulse ()
-> ReaderWriterIOT BuildR BuildW IO (Pulse ())
forall a c b.
(a -> Maybe c)
-> (b -> Maybe c)
-> (a -> b -> Maybe c)
-> Pulse a
-> Pulse b
-> Build (Pulse c)
Prim.mergeWithP () -> Maybe ()
forall a. a -> Maybe a
Just () -> Maybe ()
forall a. a -> Maybe a
Just (\()
_ ()
_ -> () -> Maybe ()
forall a. a -> Maybe a
Just ())