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

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

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

pause :: EventNetwork -> IO ()
pause :: EventNetwork -> IO ()
pause EventNetwork{ IORef Bool
actuated :: EventNetwork -> IORef Bool
actuated :: IORef Bool
actuated } = IORef Bool -> Bool -> IO ()
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
    actuated <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False                   -- flag to set running status
    s        <- newEmptyMVar                     -- setup callback machinery
    size     <- newIORef 0

    let 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, s0) <-                             -- compile initial graph
        Prim.compile (runReaderT setup eventNetwork) =<< Prim.emptyNetwork
    putMVar s s0                                -- set initial state
    writeIORef size =<< Prim.getSize s0

    return eventNetwork

fromAddHandler :: AddHandler a -> Moment (Event a)
fromAddHandler :: forall a. AddHandler a -> Moment (Event a)
fromAddHandler AddHandler a
addHandler = do
    (p, fire) <- Build (Pulse a, a -> Step) -> Moment (Pulse a, a -> Step)
forall a. Build a -> Moment a
liftBuild Build (Pulse a, a -> Step)
forall a. Build (Pulse a, a -> Step)
Prim.newInput
    network   <- ask
    _unregister <- liftIO $ register addHandler $ runStep network . fire
    return $ Prim.fromPure p

addReactimate :: Event (Future (IO ())) -> Moment ()
addReactimate :: Event (IO (IO ())) -> Moment ()
addReactimate Event (IO (IO ()))
e = do
    network   <- ReaderT EventNetwork Build EventNetwork
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    liftBuild $ Prim.buildLater $ do
        -- Run cached computation later to allow more recursion with `Moment`
        p <- runReaderT (runCached e) network
        Prim.addHandler p id

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

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

liftIOLater :: IO () -> Moment ()
liftIOLater :: IO () -> Moment ()
liftIOLater = BuildIO () -> Moment ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT EventNetwork m a
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 :: forall a. Behavior a -> Event () -> Behavior a
imposeChanges = ((Latch a, Pulse ()) -> Pulse () -> Moment (Latch a, Pulse ()))
-> Cached (ReaderT EventNetwork Build) (Latch a, Pulse ())
-> Event ()
-> Cached (ReaderT EventNetwork Build) (Latch a, Pulse ())
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 ()))
 -> Cached (ReaderT EventNetwork Build) (Latch a, Pulse ())
 -> Event ()
 -> Cached (ReaderT EventNetwork Build) (Latch a, Pulse ()))
-> ((Latch a, Pulse ()) -> Pulse () -> Moment (Latch a, Pulse ()))
-> Cached (ReaderT EventNetwork Build) (Latch a, Pulse ())
-> Event ()
-> Cached (ReaderT EventNetwork Build) (Latch a, Pulse ())
forall a b. (a -> b) -> a -> b
$ \(Latch a
l1,Pulse ()
_) Pulse ()
p2 -> (Latch a, Pulse ()) -> Moment (Latch a, Pulse ())
forall a. a -> ReaderT EventNetwork Build a
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 = Moment (Pulse a) -> Cached (ReaderT EventNetwork Build) (Pulse a)
forall (m :: * -> *) a. Monad m => m a -> Cached m a
don'tCache  (Moment (Pulse a) -> Cached (ReaderT EventNetwork Build) (Pulse a))
-> Moment (Pulse a)
-> Cached (ReaderT EventNetwork Build) (Pulse a)
forall a b. (a -> b) -> a -> b
$ Build (Pulse a) -> Moment (Pulse a)
forall a. Build a -> Moment a
liftBuild 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 :: 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 = (Pulse a -> Pulse b -> Moment (Pulse c))
-> Cached (ReaderT EventNetwork Build) (Pulse a)
-> Cached (ReaderT EventNetwork Build) (Pulse b)
-> Cached (ReaderT EventNetwork Build) (Pulse 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 -> Moment (Pulse c))
 -> Cached (ReaderT EventNetwork Build) (Pulse a)
 -> Cached (ReaderT EventNetwork Build) (Pulse b)
 -> Cached (ReaderT EventNetwork Build) (Pulse c))
-> (Pulse a -> Pulse b -> Moment (Pulse c))
-> Cached (ReaderT EventNetwork Build) (Pulse a)
-> Cached (ReaderT EventNetwork Build) (Pulse b)
-> Cached (ReaderT EventNetwork Build) (Pulse c)
forall a b. (a -> b) -> a -> b
$ (Build (Pulse c) -> Moment (Pulse c)
forall a. Build a -> Moment a
liftBuild (Build (Pulse c) -> Moment (Pulse c))
-> (Pulse b -> Build (Pulse c)) -> Pulse b -> Moment (Pulse c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Pulse b -> Build (Pulse c)) -> Pulse b -> Moment (Pulse c))
-> (Pulse a -> Pulse b -> Build (Pulse c))
-> Pulse a
-> Pulse b
-> Moment (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 :: forall a. Event (Maybe a) -> Event a
filterJust  = (Pulse (Maybe a) -> Moment (Pulse a))
-> Cached (ReaderT EventNetwork Build) (Pulse (Maybe a))
-> Cached (ReaderT EventNetwork Build) (Pulse a)
forall (m :: * -> *) a b.
(MonadFix m, MonadIO m) =>
(a -> m b) -> Cached m a -> Cached m b
liftCached1 ((Pulse (Maybe a) -> Moment (Pulse a))
 -> Cached (ReaderT EventNetwork Build) (Pulse (Maybe a))
 -> Cached (ReaderT EventNetwork Build) (Pulse a))
-> (Pulse (Maybe a) -> Moment (Pulse a))
-> Cached (ReaderT EventNetwork Build) (Pulse (Maybe a))
-> Cached (ReaderT EventNetwork Build) (Pulse a)
forall a b. (a -> b) -> a -> b
$ Build (Pulse a) -> Moment (Pulse a)
forall a. Build a -> Moment a
liftBuild (Build (Pulse a) -> Moment (Pulse a))
-> (Pulse (Maybe a) -> Build (Pulse a))
-> Pulse (Maybe a)
-> Moment (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 :: forall a b. (a -> b) -> Event a -> Event b
mapE a -> b
f = (Pulse a -> Moment (Pulse b))
-> Cached (ReaderT EventNetwork Build) (Pulse a)
-> Cached (ReaderT EventNetwork Build) (Pulse b)
forall (m :: * -> *) a b.
(MonadFix m, MonadIO m) =>
(a -> m b) -> Cached m a -> Cached m b
liftCached1 ((Pulse a -> Moment (Pulse b))
 -> Cached (ReaderT EventNetwork Build) (Pulse a)
 -> Cached (ReaderT EventNetwork Build) (Pulse b))
-> (Pulse a -> Moment (Pulse b))
-> Cached (ReaderT EventNetwork Build) (Pulse a)
-> Cached (ReaderT EventNetwork Build) (Pulse b)
forall a b. (a -> b) -> a -> b
$ Build (Pulse b) -> Moment (Pulse b)
forall a. Build a -> Moment a
liftBuild (Build (Pulse b) -> Moment (Pulse b))
-> (Pulse a -> Build (Pulse b)) -> Pulse a -> Moment (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 :: forall a b. Behavior (a -> b) -> Event a -> Event b
applyE = ((Latch (a -> b), Pulse ()) -> Pulse a -> Moment (Pulse b))
-> Cached (ReaderT EventNetwork Build) (Latch (a -> b), Pulse ())
-> Cached (ReaderT EventNetwork Build) (Pulse a)
-> Cached (ReaderT EventNetwork Build) (Pulse 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 -> Moment (Pulse b))
 -> Cached (ReaderT EventNetwork Build) (Latch (a -> b), Pulse ())
 -> Cached (ReaderT EventNetwork Build) (Pulse a)
 -> Cached (ReaderT EventNetwork Build) (Pulse b))
-> ((Latch (a -> b), Pulse ()) -> Pulse a -> Moment (Pulse b))
-> Cached (ReaderT EventNetwork Build) (Latch (a -> b), Pulse ())
-> Cached (ReaderT EventNetwork Build) (Pulse a)
-> Cached (ReaderT EventNetwork Build) (Pulse b)
forall a b. (a -> b) -> a -> b
$ \(~(Latch (a -> b)
lf,Pulse ()
_)) Pulse a
px -> Build (Pulse b) -> Moment (Pulse b)
forall a. Build a -> Moment a
liftBuild (Build (Pulse b) -> Moment (Pulse b))
-> Build (Pulse b) -> Moment (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 :: forall a. Behavior a -> Event (Future a)
changesB = ((Latch a, Pulse ()) -> Moment (Pulse (Future a)))
-> Cached (ReaderT EventNetwork Build) (Latch a, Pulse ())
-> Cached (ReaderT EventNetwork Build) (Pulse (Future a))
forall (m :: * -> *) a b.
(MonadFix m, MonadIO m) =>
(a -> m b) -> Cached m a -> Cached m b
liftCached1 (((Latch a, Pulse ()) -> Moment (Pulse (Future a)))
 -> Cached (ReaderT EventNetwork Build) (Latch a, Pulse ())
 -> Cached (ReaderT EventNetwork Build) (Pulse (Future a)))
-> ((Latch a, Pulse ()) -> Moment (Pulse (Future a)))
-> Cached (ReaderT EventNetwork Build) (Latch a, Pulse ())
-> Cached (ReaderT EventNetwork Build) (Pulse (Future a))
forall a b. (a -> b) -> a -> b
$ \(~(Latch a
lx,Pulse ()
px)) -> Build (Pulse (Future a)) -> Moment (Pulse (Future a))
forall a. Build a -> Moment a
liftBuild (Build (Pulse (Future a)) -> Moment (Pulse (Future a)))
-> Build (Pulse (Future a)) -> Moment (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 :: forall a. a -> Behavior a
pureB a
a = Moment (Latch a, Pulse ())
-> Cached (ReaderT EventNetwork Build) (Latch a, Pulse ())
forall (m :: * -> *) a.
(MonadFix m, MonadIO m) =>
m a -> Cached m a
cache (Moment (Latch a, Pulse ())
 -> Cached (ReaderT EventNetwork Build) (Latch a, Pulse ()))
-> Moment (Latch a, Pulse ())
-> Cached (ReaderT EventNetwork Build) (Latch a, Pulse ())
forall a b. (a -> b) -> a -> b
$ do
    p <- Event () -> ReaderT EventNetwork Build (Pulse ())
forall (m :: * -> *) a. Cached m a -> m a
runCached Event ()
forall a. Event a
never
    return (Prim.pureL a, p)

applyB :: Behavior (a -> b) -> Behavior a -> Behavior b
applyB :: forall a b. Behavior (a -> b) -> Behavior a -> Behavior b
applyB = ((Latch (a -> b), Pulse ())
 -> (Latch a, Pulse ()) -> Moment (Latch b, Pulse ()))
-> Cached (ReaderT EventNetwork Build) (Latch (a -> b), Pulse ())
-> Cached (ReaderT EventNetwork Build) (Latch a, Pulse ())
-> Cached (ReaderT EventNetwork Build) (Latch b, Pulse ())
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 ()) -> Moment (Latch b, Pulse ()))
 -> Cached (ReaderT EventNetwork Build) (Latch (a -> b), Pulse ())
 -> Cached (ReaderT EventNetwork Build) (Latch a, Pulse ())
 -> Cached (ReaderT EventNetwork Build) (Latch b, Pulse ()))
-> ((Latch (a -> b), Pulse ())
    -> (Latch a, Pulse ()) -> Moment (Latch b, Pulse ()))
-> Cached (ReaderT EventNetwork Build) (Latch (a -> b), Pulse ())
-> Cached (ReaderT EventNetwork Build) (Latch a, Pulse ())
-> Cached (ReaderT EventNetwork Build) (Latch b, Pulse ())
forall a b. (a -> b) -> a -> b
$ \(~(Latch (a -> b)
l1,Pulse ()
p1)) (~(Latch a
l2,Pulse ()
p2)) -> Build (Latch b, Pulse ()) -> Moment (Latch b, Pulse ())
forall a. Build a -> Moment a
liftBuild (Build (Latch b, Pulse ()) -> Moment (Latch b, Pulse ()))
-> Build (Latch b, Pulse ()) -> Moment (Latch b, Pulse ())
forall a b. (a -> b) -> a -> b
$ do
    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 (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
    return (l3,p3)

mapB :: (a -> b) -> Behavior a -> Behavior b
mapB :: forall a b. (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)

{-----------------------------------------------------------------------------
    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
    (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
$ ReaderT EventNetwork Build a -> Moment ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT EventNetwork Build a -> Moment ())
-> ReaderT EventNetwork Build a -> Moment ()
forall a b. (a -> b) -> a -> b
$ Cached (ReaderT EventNetwork Build) a
-> ReaderT EventNetwork Build a
forall (m :: * -> *) a. Cached m a -> m a
runCached Cached (ReaderT EventNetwork Build) a
b
    Cached (ReaderT EventNetwork Build) a
-> ReaderT
     EventNetwork Build (Cached (ReaderT EventNetwork Build) a)
forall a. a -> ReaderT EventNetwork Build a
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 = ReaderT EventNetwork Build EventNetwork
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask ReaderT EventNetwork Build EventNetwork
-> (EventNetwork
    -> ReaderT
         EventNetwork Build (Cached (ReaderT EventNetwork Build) a))
-> ReaderT
     EventNetwork Build (Cached (ReaderT EventNetwork Build) a)
forall a b.
ReaderT EventNetwork Build a
-> (a -> ReaderT EventNetwork Build b)
-> ReaderT EventNetwork Build b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EventNetwork
r -> Build (Cached (ReaderT EventNetwork Build) a)
-> ReaderT
     EventNetwork Build (Cached (ReaderT EventNetwork Build) a)
forall a. Build a -> Moment a
liftBuild (Build (Cached (ReaderT EventNetwork Build) a)
 -> ReaderT
      EventNetwork Build (Cached (ReaderT EventNetwork Build) a))
-> Build (Cached (ReaderT EventNetwork Build) a)
-> ReaderT
     EventNetwork Build (Cached (ReaderT EventNetwork Build) a)
forall a b. (a -> b) -> a -> b
$ do
    let c :: Cached (ReaderT EventNetwork Build) a
c = Moment a -> Cached (ReaderT EventNetwork Build) 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)   -- prevent let-floating!
    BuildIO () -> BuildIO ()
Prim.buildLater (BuildIO () -> BuildIO ()) -> BuildIO () -> BuildIO ()
forall a b. (a -> b) -> a -> b
$ ReaderWriterIOT BuildR BuildW IO a -> BuildIO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderWriterIOT BuildR BuildW IO a -> BuildIO ())
-> ReaderWriterIOT BuildR BuildW IO a -> BuildIO ()
forall a b. (a -> b) -> a -> b
$ Moment a -> EventNetwork -> ReaderWriterIOT BuildR BuildW IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Cached (ReaderT EventNetwork Build) a -> Moment a
forall (m :: * -> *) a. Cached m a -> m a
runCached Cached (ReaderT EventNetwork Build) a
c) EventNetwork
r
    Cached (ReaderT EventNetwork Build) a
-> Build (Cached (ReaderT EventNetwork Build) a)
forall a. a -> ReaderWriterIOT BuildR BuildW IO a
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 = Moment (Latch a, Pulse ())
-> Moment (Cached (ReaderT EventNetwork Build) (Latch a, Pulse ()))
forall a.
Moment a -> Moment (Cached (ReaderT EventNetwork Build) a)
cacheAndSchedule (Moment (Latch a, Pulse ())
 -> Moment
      (Cached (ReaderT EventNetwork Build) (Latch a, Pulse ())))
-> Moment (Latch a, Pulse ())
-> Moment (Cached (ReaderT EventNetwork Build) (Latch a, Pulse ()))
forall a b. (a -> b) -> a -> b
$ do
    p0 <- Event a -> ReaderT EventNetwork Build (Pulse a)
forall (m :: * -> *) a. Cached m a -> m a
runCached Event a
e
    liftBuild $ do
        p1    <- Prim.mapP const p0
        p2    <- Prim.mapP (const ()) p1
        (l,_) <- Prim.accumL a p1
        return (l,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 = Moment (Pulse a)
-> Moment (Cached (ReaderT EventNetwork Build) (Pulse a))
forall a.
Moment a -> Moment (Cached (ReaderT EventNetwork Build) a)
cacheAndSchedule (Moment (Pulse a)
 -> Moment (Cached (ReaderT EventNetwork Build) (Pulse a)))
-> Moment (Pulse a)
-> Moment (Cached (ReaderT EventNetwork Build) (Pulse a))
forall a b. (a -> b) -> a -> b
$ do
    p0 <- Event (a -> a) -> ReaderT EventNetwork Build (Pulse (a -> a))
forall (m :: * -> *) a. Cached m a -> m a
runCached Event (a -> a)
e1
    liftBuild $ do
        (_,p1) <- Prim.accumL a p0
        return 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
    r <- ReaderT EventNetwork Build EventNetwork
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    liftBuild $ f $ runReaderT m r

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

initialBLater :: Behavior a -> Moment a
initialBLater :: forall a. 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 :: forall a. Pulse (Moment a) -> Moment (Pulse a)
executeP Pulse (Moment a)
p1 = do
    r <- ReaderT EventNetwork Build EventNetwork
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    liftBuild $ do
        p2 <- Prim.mapP runReaderT p1
        Prim.executeP p2 r

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

        p3 <- Prim.executeP p2 r
        Prim.switchP p0 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 = ReaderT EventNetwork Build EventNetwork
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask ReaderT EventNetwork Build EventNetwork
-> (EventNetwork -> ReaderT EventNetwork Build (Behavior a))
-> ReaderT EventNetwork Build (Behavior a)
forall a b.
ReaderT EventNetwork Build a
-> (a -> ReaderT EventNetwork Build b)
-> ReaderT EventNetwork Build b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EventNetwork
r -> Moment (Latch a, Pulse ())
-> ReaderT EventNetwork Build (Behavior a)
forall a.
Moment a -> Moment (Cached (ReaderT EventNetwork Build) a)
cacheAndSchedule (Moment (Latch a, Pulse ())
 -> ReaderT EventNetwork Build (Behavior a))
-> Moment (Latch a, Pulse ())
-> ReaderT EventNetwork Build (Behavior a)
forall a b. (a -> b) -> a -> b
$ do
    ~(l0,p0) <- Behavior a -> Moment (Latch a, Pulse ())
forall (m :: * -> *) a. Cached m a -> m a
runCached Behavior a
b
    p1       <- runCached e
    liftBuild $ do
        p2 <- Prim.mapP (runReaderT . runCached) p1
        p3 <- Prim.executeP p2 r

        lr <- Prim.switchL l0 =<< Prim.mapP fst p3
        -- TODO: switch away the initial behavior
        let c1 = Pulse ()
p0                              -- initial behavior changes
        c2 <- Prim.mapP (const ()) p3            -- or switch happens
        never <- Prim.neverP
        c3 <- Prim.switchP never =<< Prim.mapP snd p3  -- or current behavior changes
        pr <- merge c1 =<< merge c2 c3
        return (lr, 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 ())