{-----------------------------------------------------------------------------
    reactive-banana
------------------------------------------------------------------------------}
{-# LANGUAGE FlexibleInstances, NamedFieldPuns, NoMonomorphismRestriction #-}
module Reactive.Banana.Prim.High.Combinators where

import           Control.Exception
import           Control.Concurrent.MVar
import           Control.Event.Handler
import           Control.Monad
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class           (lift)
import           Control.Monad.Trans.Reader
import           Data.IORef
import qualified Reactive.Banana.Prim.Mid        as Prim
import           Reactive.Banana.Prim.High.Cached

type Build   = Prim.Build
type Latch a = Prim.Latch a
type Pulse a = Prim.Pulse a
type Future  = Prim.Future

{-----------------------------------------------------------------------------
    Types
------------------------------------------------------------------------------}
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 :: forall a. Build a -> Moment a
liftBuild = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

{-----------------------------------------------------------------------------
    Interpretation
------------------------------------------------------------------------------}
interpret :: (Event a -> Moment (Event b)) -> [Maybe a] -> IO [Maybe b]
interpret :: forall a b.
(Event a -> Moment (Event b)) -> [Maybe a] -> IO [Maybe b]
interpret Event a -> Moment (Event b)
f = forall a b.
(Pulse a -> BuildIO (Pulse b)) -> [Maybe a] -> IO [Maybe b]
Prim.interpret forall a b. (a -> b) -> a -> b
$ \Pulse a
pulse -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Pulse a -> ReaderT EventNetwork Build (Pulse b)
g Pulse a
pulse) forall a. HasCallStack => a
undefined
    where
    g :: Pulse a -> ReaderT EventNetwork Build (Pulse b)
g Pulse a
pulse = forall (m :: * -> *) a. Cached m a -> m a
runCached forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Event a -> Moment (Event b)
f (forall (m :: * -> *) a. Monad m => a -> Cached m a
Prim.fromPure Pulse a
pulse)
    -- Ignore any  addHandler  inside the  Moment

{-----------------------------------------------------------------------------
    IO
------------------------------------------------------------------------------}
-- | Data type representing an event network.
data EventNetwork = EventNetwork
    { EventNetwork -> IORef Bool
actuated :: IORef Bool
    , EventNetwork -> IORef Int
size :: IORef Int
    , EventNetwork -> MVar Network
s :: MVar Prim.Network
    }

runStep :: EventNetwork -> Prim.Step -> IO ()
runStep :: EventNetwork -> Step -> IO ()
runStep EventNetwork{ IORef Bool
actuated :: IORef Bool
actuated :: EventNetwork -> IORef Bool
actuated, MVar Network
s :: MVar Network
s :: EventNetwork -> MVar Network
s, IORef Int
size :: IORef Int
size :: EventNetwork -> IORef Int
size } Step
f = IORef Bool -> IO () -> IO ()
whenFlag IORef Bool
actuated forall a b. (a -> b) -> a -> b
$ do
    IO ()
output <- forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
        Network
s1 <- forall a. MVar a -> IO a
takeMVar MVar Network
s                   -- read and take lock
        -- pollValues <- sequence polls    -- poll mutable data
        (IO ()
output, Network
s2) <-
            forall a. IO a -> IO a
restore (Step
f Network
s1)                 -- calculate new state
                forall a b. IO a -> IO b -> IO a
`onException` forall a. MVar a -> a -> IO ()
putMVar MVar Network
s Network
s1 -- on error, restore the original state
        forall a. MVar a -> a -> IO ()
putMVar MVar Network
s Network
s2                       -- write state
        forall a. IORef a -> a -> IO ()
writeIORef IORef Int
size forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Network -> IO Int
Prim.getSize Network
s2
        forall (m :: * -> *) a. Monad m => a -> m a
return IO ()
output
    IO ()
output                                 -- run IO actions afterwards
  where
    whenFlag :: IORef Bool -> IO () -> IO ()
whenFlag IORef Bool
flag IO ()
action = forall a. IORef a -> IO a
readIORef IORef Bool
flag forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b IO ()
action

getSize :: EventNetwork -> IO Int
getSize :: EventNetwork -> IO Int
getSize EventNetwork{IORef Int
size :: IORef Int
size :: EventNetwork -> IORef Int
size} = forall a. IORef a -> IO a
readIORef IORef Int
size

actuate :: EventNetwork -> IO ()
actuate :: EventNetwork -> IO ()
actuate EventNetwork{ IORef Bool
actuated :: IORef Bool
actuated :: EventNetwork -> IORef Bool
actuated } = forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
actuated Bool
True

pause :: EventNetwork -> IO ()
pause :: EventNetwork -> IO ()
pause EventNetwork{ IORef Bool
actuated :: IORef Bool
actuated :: EventNetwork -> IORef Bool
actuated } = forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
actuated Bool
False

-- | Compile to an event network.
compile :: Moment () -> IO EventNetwork
compile :: Moment () -> IO EventNetwork
compile Moment ()
setup = do
    IORef Bool
actuated <- forall a. a -> IO (IORef a)
newIORef Bool
False                   -- flag to set running status
    MVar Network
s        <- forall a. IO (MVar a)
newEmptyMVar                     -- setup callback machinery
    IORef Int
size     <- forall a. a -> IO (IORef a)
newIORef Int
0

    let eventNetwork :: EventNetwork
eventNetwork = EventNetwork{ IORef Bool
actuated :: IORef Bool
actuated :: IORef Bool
actuated, MVar Network
s :: MVar Network
s :: MVar Network
s, IORef Int
size :: IORef Int
size :: IORef Int
size }

    (()
_output, Network
s0) <-                             -- compile initial graph
        forall a. BuildIO a -> Network -> IO (a, Network)
Prim.compile (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Moment ()
setup EventNetwork
eventNetwork) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Network
Prim.emptyNetwork
    forall a. MVar a -> a -> IO ()
putMVar MVar Network
s Network
s0                                -- set initial state
    forall a. IORef a -> a -> IO ()
writeIORef IORef Int
size forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Network -> IO Int
Prim.getSize Network
s0

    forall (m :: * -> *) a. Monad m => a -> m a
return EventNetwork
eventNetwork

fromAddHandler :: AddHandler a -> Moment (Event a)
fromAddHandler :: forall a. AddHandler a -> Moment (Event a)
fromAddHandler AddHandler a
addHandler = do
    (Pulse a
p, a -> Step
fire) <- forall a. Build a -> Moment a
liftBuild forall a. Build (Pulse a, a -> Step)
Prim.newInput
    EventNetwork
network   <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    IO ()
_unregister <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. AddHandler a -> Handler a -> IO (IO ())
register AddHandler a
addHandler forall a b. (a -> b) -> a -> b
$ EventNetwork -> Step -> IO ()
runStep EventNetwork
network forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Step
fire
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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   <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    forall a. Build a -> Moment a
liftBuild forall a b. (a -> b) -> a -> b
$ Build () -> Build ()
Prim.buildLater forall a b. (a -> b) -> a -> b
$ do
        -- Run cached computation later to allow more recursion with `Moment`
        Pulse (IO (IO ()))
p <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) a. Cached m a -> m a
runCached Event (IO (IO ()))
e) EventNetwork
network
        forall a. Pulse (Future a) -> (a -> IO ()) -> Build ()
Prim.addHandler Pulse (IO (IO ()))
p forall a. a -> a
id

fromPoll :: IO a -> Moment (Behavior a)
fromPoll :: forall a. IO a -> Moment (Behavior a)
fromPoll IO a
poll = do
    a
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
poll
    Cached (ReaderT EventNetwork Build) (Pulse a)
e <- forall a. Build a -> Moment a
liftBuild forall a b. (a -> b) -> a -> b
$ do
        Pulse a
p <- forall a b. (a -> IO b) -> Pulse a -> Build (Pulse b)
Prim.unsafeMapIOP (forall a b. a -> b -> a
const IO a
poll) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Build (Pulse ())
Prim.alwaysP
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> Cached m a
Prim.fromPure Pulse a
p
    forall a. a -> Event a -> Moment (Behavior a)
stepperB a
a Cached (ReaderT EventNetwork Build) (Pulse a)
e

liftIONow :: IO a -> Moment a
liftIONow :: forall a. IO a -> Moment a
liftIONow = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

liftIOLater :: IO () -> Moment ()
liftIOLater :: IO () -> Moment ()
liftIOLater = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Build a -> Build a
Prim.liftBuild forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> Build ()
Prim.liftIOLater

imposeChanges :: Behavior a -> Event () -> Behavior a
imposeChanges :: forall a. Behavior a -> Event () -> Behavior a
imposeChanges = forall (m :: * -> *) a b c.
(MonadFix m, MonadIO m) =>
(a -> b -> m c) -> Cached m a -> Cached m b -> Cached m c
liftCached2 forall a b. (a -> b) -> a -> b
$ \(Latch a
l1,Pulse ()
_) Pulse ()
p2 -> forall (m :: * -> *) a. Monad m => a -> m a
return (Latch a
l1,Pulse ()
p2)

{-----------------------------------------------------------------------------
    Combinators - basic
------------------------------------------------------------------------------}
never :: Event a
never :: forall a. Event a
never = forall (m :: * -> *) a. Monad m => m a -> Cached m a
don'tCache  forall a b. (a -> b) -> a -> b
$ forall a. Build a -> Moment a
liftBuild forall a. Build (Pulse a)
Prim.neverP

mergeWith
  :: (a -> c)
  -> (b -> c)
  -> (a -> b -> c)
  -> Event a
  -> Event b
  -> Event c
mergeWith :: forall a c b.
(a -> c)
-> (b -> c) -> (a -> b -> c) -> Event a -> Event b -> Event c
mergeWith a -> c
f b -> c
g a -> b -> c
h = forall (m :: * -> *) a b c.
(MonadFix m, MonadIO m) =>
(a -> b -> m c) -> Cached m a -> Cached m b -> Cached m c
liftCached2 forall a b. (a -> b) -> a -> b
$ (forall a. Build a -> Moment a
liftBuild forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b.
(a -> Maybe c)
-> (b -> Maybe c)
-> (a -> b -> Maybe c)
-> Pulse a
-> Pulse b
-> Build (Pulse c)
Prim.mergeWithP (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> c
f) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
g) (\a
x b
y -> forall a. a -> Maybe a
Just (a -> b -> c
h a
x b
y))


filterJust :: Event (Maybe a) -> Event a
filterJust :: forall a. Event (Maybe a) -> Event a
filterJust  = forall (m :: * -> *) a b.
(MonadFix m, MonadIO m) =>
(a -> m b) -> Cached m a -> Cached m b
liftCached1 forall a b. (a -> b) -> a -> b
$ forall a. Build a -> Moment a
liftBuild forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pulse (Maybe a) -> Build (Pulse a)
Prim.filterJustP

mapE :: (a -> b) -> Event a -> Event b
mapE :: forall a b. (a -> b) -> Event a -> Event b
mapE a -> b
f = forall (m :: * -> *) a b.
(MonadFix m, MonadIO m) =>
(a -> m b) -> Cached m a -> Cached m b
liftCached1 forall a b. (a -> b) -> a -> b
$ forall a. Build a -> Moment a
liftBuild forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP a -> b
f

applyE :: Behavior (a -> b) -> Event a -> Event b
applyE :: forall a b. Behavior (a -> b) -> Event a -> Event b
applyE = forall (m :: * -> *) a b c.
(MonadFix m, MonadIO m) =>
(a -> b -> m c) -> Cached m a -> Cached m b -> Cached m c
liftCached2 forall a b. (a -> b) -> a -> b
$ \(~(Latch (a -> b)
lf,Pulse ()
_)) Pulse a
px -> forall a. Build a -> Moment a
liftBuild forall a b. (a -> b) -> a -> 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 :: forall a. Behavior a -> Event (Future a)
changesB = forall (m :: * -> *) a b.
(MonadFix m, MonadIO m) =>
(a -> m b) -> Cached m a -> Cached m b
liftCached1 forall a b. (a -> b) -> a -> b
$ \(~(Latch a
lx,Pulse ()
px)) -> forall a. Build a -> Moment a
liftBuild forall a b. (a -> b) -> a -> b
$ forall a b. Latch a -> Pulse b -> Build (Pulse (Future a))
Prim.tagFuture Latch a
lx Pulse ()
px

pureB :: a -> Behavior a
pureB :: forall a. a -> Behavior a
pureB a
a = forall (m :: * -> *) a.
(MonadFix m, MonadIO m) =>
m a -> Cached m a
cache forall a b. (a -> b) -> a -> b
$ do
    Pulse ()
p <- forall (m :: * -> *) a. Cached m a -> m a
runCached forall a. Event a
never
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Latch a
Prim.pureL a
a, Pulse ()
p)

applyB :: Behavior (a -> b) -> Behavior a -> Behavior b
applyB :: forall a b. Behavior (a -> b) -> Behavior a -> Behavior b
applyB = forall (m :: * -> *) a b c.
(MonadFix m, MonadIO m) =>
(a -> b -> m c) -> Cached m a -> Cached m b -> Cached m c
liftCached2 forall a b. (a -> b) -> a -> b
$ \(~(Latch (a -> b)
l1,Pulse ()
p1)) (~(Latch a
l2,Pulse ()
p2)) -> forall a. Build a -> Moment a
liftBuild forall a b. (a -> b) -> a -> b
$ do
    Pulse ()
p3 <- forall a c b.
(a -> Maybe c)
-> (b -> Maybe c)
-> (a -> b -> Maybe c)
-> Pulse a
-> Pulse b
-> Build (Pulse c)
Prim.mergeWithP forall a. a -> Maybe a
Just forall a. a -> Maybe a
Just (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) Pulse ()
p1 Pulse ()
p2
    let l3 :: Latch b
l3 = forall a b. Latch (a -> b) -> Latch a -> Latch b
Prim.applyL Latch (a -> b)
l1 Latch a
l2
    forall (m :: * -> *) a. Monad m => a -> m a
return (Latch b
l3,Pulse ()
p3)

mapB :: (a -> b) -> Behavior a -> Behavior b
mapB :: forall a b. (a -> b) -> Behavior a -> Behavior b
mapB a -> b
f = forall a b. Behavior (a -> b) -> Behavior a -> Behavior b
applyB (forall a. a -> Behavior a
pureB a -> b
f)

{-----------------------------------------------------------------------------
    Combinators - accumulation
------------------------------------------------------------------------------}
-- Make sure that the cached computation (Event or Behavior)
-- is executed eventually during this moment.
trim :: Cached Moment a -> Moment (Cached Moment a)
trim :: forall a.
Cached (ReaderT EventNetwork Build) a
-> Moment (Cached (ReaderT EventNetwork Build) a)
trim Cached (ReaderT EventNetwork Build) a
b = do
    forall a b. (Build a -> Build b) -> Moment a -> Moment b
liftBuildFun Build () -> Build ()
Prim.buildLater forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Cached m a -> m a
runCached Cached (ReaderT EventNetwork Build) a
b
    forall (m :: * -> *) a. Monad m => a -> m a
return Cached (ReaderT EventNetwork Build) a
b

-- Cache a computation at this moment in time
-- and make sure that it is performed in the Build monad eventually
cacheAndSchedule :: Moment a -> Moment (Cached Moment a)
cacheAndSchedule :: forall a.
Moment a -> Moment (Cached (ReaderT EventNetwork Build) a)
cacheAndSchedule Moment a
m = forall (m :: * -> *) r. Monad m => ReaderT r m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EventNetwork
r -> forall a. Build a -> Moment a
liftBuild forall a b. (a -> b) -> a -> b
$ do
    let c :: Cached (ReaderT EventNetwork Build) a
c = forall (m :: * -> *) a.
(MonadFix m, MonadIO m) =>
m a -> Cached m a
cache (forall a b. a -> b -> a
const Moment a
m EventNetwork
r)   -- prevent let-floating!
    Build () -> Build ()
Prim.buildLater forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) a. Cached m a -> m a
runCached Cached (ReaderT EventNetwork Build) a
c) EventNetwork
r
    forall (m :: * -> *) a. Monad m => a -> m a
return Cached (ReaderT EventNetwork Build) a
c

stepperB :: a -> Event a -> Moment (Behavior a)
stepperB :: forall a. a -> Event a -> Moment (Behavior a)
stepperB a
a Event a
e = forall a.
Moment a -> Moment (Cached (ReaderT EventNetwork Build) a)
cacheAndSchedule forall a b. (a -> b) -> a -> b
$ do
    Pulse a
p0 <- forall (m :: * -> *) a. Cached m a -> m a
runCached Event a
e
    forall a. Build a -> Moment a
liftBuild forall a b. (a -> b) -> a -> b
$ do
        Pulse (a -> a)
p1    <- forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP forall a b. a -> b -> a
const Pulse a
p0
        Pulse ()
p2    <- forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP (forall a b. a -> b -> a
const ()) Pulse (a -> a)
p1
        (Latch a
l,Pulse a
_) <- forall a. a -> Pulse (a -> a) -> Build (Latch a, Pulse a)
Prim.accumL a
a Pulse (a -> a)
p1
        forall (m :: * -> *) a. Monad m => a -> m a
return (Latch a
l,Pulse ()
p2)

accumE :: a -> Event (a -> a) -> Moment (Event a)
accumE :: forall a. a -> Event (a -> a) -> Moment (Event a)
accumE a
a Event (a -> a)
e1 = forall a.
Moment a -> Moment (Cached (ReaderT EventNetwork Build) a)
cacheAndSchedule forall a b. (a -> b) -> a -> b
$ do
    Pulse (a -> a)
p0 <- forall (m :: * -> *) a. Cached m a -> m a
runCached Event (a -> a)
e1
    forall a. Build a -> Moment a
liftBuild forall a b. (a -> b) -> a -> b
$ do
        (Latch a
_,Pulse a
p1) <- forall a. a -> Pulse (a -> a) -> Build (Latch a, Pulse a)
Prim.accumL a
a Pulse (a -> a)
p0
        forall (m :: * -> *) a. Monad m => a -> m a
return Pulse a
p1

{-----------------------------------------------------------------------------
    Combinators - dynamic event switching
------------------------------------------------------------------------------}
liftBuildFun :: (Build a -> Build b) -> Moment a -> Moment b
liftBuildFun :: forall a b. (Build a -> Build b) -> Moment a -> Moment b
liftBuildFun Build a -> Build b
f Moment a
m = do
    EventNetwork
r <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    forall a. Build a -> Moment a
liftBuild forall a b. (a -> b) -> a -> b
$ Build a -> Build b
f forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Moment a
m EventNetwork
r

valueB :: Behavior a -> Moment a
valueB :: forall a. Behavior a -> Moment a
valueB Behavior a
b = do
    ~(Latch a
l,Pulse ()
_) <- forall (m :: * -> *) a. Cached m a -> m a
runCached Behavior a
b
    forall a. Build a -> Moment a
liftBuild forall a b. (a -> b) -> a -> b
$ forall a. Latch a -> Build a
Prim.readLatch Latch a
l

initialBLater :: Behavior a -> Moment a
initialBLater :: forall a. Behavior a -> Moment a
initialBLater = forall a b. (Build a -> Build b) -> Moment a -> Moment b
liftBuildFun forall a. Build a -> Build a
Prim.buildLaterReadNow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Behavior a -> Moment a
valueB

executeP :: Pulse (Moment a) -> Moment (Pulse a)
executeP :: forall a. Pulse (Moment a) -> Moment (Pulse a)
executeP Pulse (Moment a)
p1 = do
    EventNetwork
r <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    forall a. Build a -> Moment a
liftBuild forall a b. (a -> b) -> a -> b
$ do
        Pulse (EventNetwork -> Build a)
p2 <- forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Pulse (Moment a)
p1
        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 :: forall a. Event (Moment a) -> Event a
observeE = forall (m :: * -> *) a b.
(MonadFix m, MonadIO m) =>
(a -> m b) -> Cached m a -> Cached m b
liftCached1 forall a. Pulse (Moment a) -> Moment (Pulse a)
executeP

executeE :: Event (Moment a) -> Moment (Event a)
executeE :: forall a. Event (Moment a) -> Moment (Event a)
executeE Event (Moment a)
e = do
    -- Run cached computation later to allow more recursion with `Moment`
    Pulse a
p <- forall a b. (Build a -> Build b) -> Moment a -> Moment b
liftBuildFun forall a. Build a -> Build a
Prim.buildLaterReadNow forall a b. (a -> b) -> a -> b
$ forall a. Pulse (Moment a) -> Moment (Pulse a)
executeP forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. Cached m a -> m a
runCached Event (Moment a)
e
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> Cached m a
fromPure Pulse a
p

switchE :: Event a -> Event (Event a) -> Moment (Event a)
switchE :: forall a. Event a -> Event (Event a) -> Moment (Event a)
switchE Event a
e0 Event (Event a)
e = forall (m :: * -> *) r. Monad m => ReaderT r m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EventNetwork
r -> forall a.
Moment a -> Moment (Cached (ReaderT EventNetwork Build) a)
cacheAndSchedule forall a b. (a -> b) -> a -> b
$ do
    Pulse a
p0 <- forall (m :: * -> *) a. Cached m a -> m a
runCached Event a
e0
    Pulse (Event a)
p1 <- forall (m :: * -> *) a. Cached m a -> m a
runCached Event (Event a)
e
    forall a. Build a -> Moment a
liftBuild forall a b. (a -> b) -> a -> b
$ do
        Pulse (EventNetwork -> Build (Pulse a))
p2 <- forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Cached m a -> m a
runCached) Pulse (Event a)
p1

        Pulse (Pulse a)
p3 <- forall a b. Pulse (b -> Build a) -> b -> Build (Pulse a)
Prim.executeP Pulse (EventNetwork -> Build (Pulse a))
p2 EventNetwork
r
        forall a. Pulse a -> Pulse (Pulse a) -> Build (Pulse a)
Prim.switchP Pulse a
p0 Pulse (Pulse a)
p3

switchB :: Behavior a -> Event (Behavior a) -> Moment (Behavior a)
switchB :: forall a. Behavior a -> Event (Behavior a) -> Moment (Behavior a)
switchB Behavior a
b Event (Behavior a)
e = forall (m :: * -> *) r. Monad m => ReaderT r m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EventNetwork
r -> forall a.
Moment a -> Moment (Cached (ReaderT EventNetwork Build) a)
cacheAndSchedule forall a b. (a -> b) -> a -> b
$ do
    ~(Latch a
l0,Pulse ()
p0) <- forall (m :: * -> *) a. Cached m a -> m a
runCached Behavior a
b
    Pulse (Behavior a)
p1       <- forall (m :: * -> *) a. Cached m a -> m a
runCached Event (Behavior a)
e
    forall a. Build a -> Moment a
liftBuild forall a b. (a -> b) -> a -> b
$ do
        Pulse (EventNetwork -> Build (Latch a, Pulse ()))
p2 <- forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Cached m a -> m a
runCached) Pulse (Behavior a)
p1
        Pulse (Latch a, Pulse ())
p3 <- 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 <- forall a. Latch a -> Pulse (Latch a) -> Build (Latch a)
Prim.switchL Latch a
l0 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP forall a b. (a, b) -> a
fst Pulse (Latch a, Pulse ())
p3
        -- TODO: switch away the initial behavior
        let c1 :: Pulse ()
c1 = Pulse ()
p0                              -- initial behavior changes
        Pulse ()
c2 <- forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP (forall a b. a -> b -> a
const ()) Pulse (Latch a, Pulse ())
p3            -- or switch happens
        Pulse ()
never <- forall a. Build (Pulse a)
Prim.neverP
        Pulse ()
c3 <- forall a. Pulse a -> Pulse (Pulse a) -> Build (Pulse a)
Prim.switchP Pulse ()
never forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
Prim.mapP forall a b. (a, b) -> b
snd Pulse (Latch a, Pulse ())
p3  -- or current behavior changes
        Pulse ()
pr <- Pulse () -> Pulse () -> Build (Pulse ())
merge Pulse ()
c1 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pulse () -> Pulse () -> Build (Pulse ())
merge Pulse ()
c2 Pulse ()
c3
        forall (m :: * -> *) a. Monad m => a -> m a
return (Latch a
lr, Pulse ()
pr)

merge :: Pulse () -> Pulse () -> Build (Pulse ())
merge :: Pulse () -> Pulse () -> Build (Pulse ())
merge = forall a c b.
(a -> Maybe c)
-> (b -> Maybe c)
-> (a -> b -> Maybe c)
-> Pulse a
-> Pulse b
-> Build (Pulse c)
Prim.mergeWithP forall a. a -> Maybe a
Just forall a. a -> Maybe a
Just (\()
_ ()
_ -> forall a. a -> Maybe a
Just ())