{-# LANGUAGE Rank2Types #-}
module Reactive.Banana.Frameworks (
interpretAsHandler,
compile, MomentIO,
module Control.Event.Handler,
fromAddHandler, fromChanges, fromPoll,
reactimate, Future, reactimate',
changes,
imposeChanges,
execute, liftIOLater,
module Control.Monad.IO.Class,
interpretFrameworks, newEvent, mapEventIO, newBehavior,
EventNetwork, actuate, pause,
) where
import Control.Event.Handler
import Control.Monad
import Control.Monad.IO.Class
import Data.IORef
import Reactive.Banana.Combinators
import qualified Reactive.Banana.Prim.High.Combinators as Prim
import Reactive.Banana.Types
reactimate :: Event (IO ()) -> MomentIO ()
reactimate :: Event (IO ()) -> MomentIO ()
reactimate = Moment () -> MomentIO ()
forall a. Moment a -> MomentIO a
MIO (Moment () -> MomentIO ())
-> (Event (IO ()) -> Moment ()) -> Event (IO ()) -> MomentIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event (Future (IO ())) -> Moment ()
Prim.addReactimate (Event (Future (IO ())) -> Moment ())
-> (Event (IO ()) -> Event (Future (IO ())))
-> Event (IO ())
-> Moment ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO () -> Future (IO ()))
-> Event (IO ()) -> Event (Future (IO ()))
forall a b. (a -> b) -> Event a -> Event b
Prim.mapE IO () -> Future (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Event (IO ()) -> Event (Future (IO ())))
-> (Event (IO ()) -> Event (IO ()))
-> Event (IO ())
-> Event (Future (IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event (IO ()) -> Event (IO ())
forall a. Event a -> Event a
unE
reactimate' :: Event (Future (IO ())) -> MomentIO ()
reactimate' :: Event (Future (IO ())) -> MomentIO ()
reactimate' = Moment () -> MomentIO ()
forall a. Moment a -> MomentIO a
MIO (Moment () -> MomentIO ())
-> (Event (Future (IO ())) -> Moment ())
-> Event (Future (IO ()))
-> MomentIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event (Future (IO ())) -> Moment ()
Prim.addReactimate (Event (Future (IO ())) -> Moment ())
-> (Event (Future (IO ())) -> Event (Future (IO ())))
-> Event (Future (IO ()))
-> Moment ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Future (IO ()) -> Future (IO ()))
-> Event (Future (IO ())) -> Event (Future (IO ()))
forall a b. (a -> b) -> Event a -> Event b
Prim.mapE Future (IO ()) -> Future (IO ())
forall a. Future a -> Future a
unF (Event (Future (IO ())) -> Event (Future (IO ())))
-> (Event (Future (IO ())) -> Event (Future (IO ())))
-> Event (Future (IO ()))
-> Event (Future (IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event (Future (IO ())) -> Event (Future (IO ()))
forall a. Event a -> Event a
unE
fromAddHandler ::AddHandler a -> MomentIO (Event a)
fromAddHandler :: AddHandler a -> MomentIO (Event a)
fromAddHandler = Moment (Event a) -> MomentIO (Event a)
forall a. Moment a -> MomentIO a
MIO (Moment (Event a) -> MomentIO (Event a))
-> (AddHandler a -> Moment (Event a))
-> AddHandler a
-> MomentIO (Event a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event a -> Event a)
-> ReaderT EventNetwork Build (Event a) -> Moment (Event a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event a -> Event a
forall a. Event a -> Event a
E (ReaderT EventNetwork Build (Event a) -> Moment (Event a))
-> (AddHandler a -> ReaderT EventNetwork Build (Event a))
-> AddHandler a
-> Moment (Event a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddHandler a -> ReaderT EventNetwork Build (Event a)
forall a. AddHandler a -> Moment (Event a)
Prim.fromAddHandler
fromPoll :: IO a -> MomentIO (Behavior a)
fromPoll :: IO a -> MomentIO (Behavior a)
fromPoll = Moment (Behavior a) -> MomentIO (Behavior a)
forall a. Moment a -> MomentIO a
MIO (Moment (Behavior a) -> MomentIO (Behavior a))
-> (IO a -> Moment (Behavior a)) -> IO a -> MomentIO (Behavior a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Behavior a -> Behavior a)
-> ReaderT EventNetwork Build (Behavior a) -> Moment (Behavior a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Behavior a -> Behavior a
forall a. Behavior a -> Behavior a
B (ReaderT EventNetwork Build (Behavior a) -> Moment (Behavior a))
-> (IO a -> ReaderT EventNetwork Build (Behavior a))
-> IO a
-> Moment (Behavior a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> ReaderT EventNetwork Build (Behavior a)
forall a. IO a -> Moment (Behavior a)
Prim.fromPoll
fromChanges :: a -> AddHandler a -> MomentIO (Behavior a)
fromChanges :: a -> AddHandler a -> MomentIO (Behavior a)
fromChanges a
initial AddHandler a
changes = do
Event a
e <- AddHandler a -> MomentIO (Event a)
forall a. AddHandler a -> MomentIO (Event a)
fromAddHandler AddHandler a
changes
a -> Event a -> MomentIO (Behavior a)
forall (m :: * -> *) a.
MonadMoment m =>
a -> Event a -> m (Behavior a)
stepper a
initial Event a
e
changes :: Behavior a -> MomentIO (Event (Future a))
changes :: Behavior a -> MomentIO (Event (Future a))
changes = Event (Future a) -> MomentIO (Event (Future a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Event (Future a) -> MomentIO (Event (Future a)))
-> (Behavior a -> Event (Future a))
-> Behavior a
-> MomentIO (Event (Future a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event (Future a) -> Event (Future a)
forall a. Event a -> Event a
E (Event (Future a) -> Event (Future a))
-> (Behavior a -> Event (Future a))
-> Behavior a
-> Event (Future a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Future a -> Future a) -> Event (Future a) -> Event (Future a)
forall a b. (a -> b) -> Event a -> Event b
Prim.mapE Future a -> Future a
forall a. Future a -> Future a
F (Event (Future a) -> Event (Future a))
-> (Behavior a -> Event (Future a))
-> Behavior a
-> Event (Future a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior a -> Event (Future a)
forall a. Behavior a -> Event (Future a)
Prim.changesB (Behavior a -> Event (Future a))
-> (Behavior a -> Behavior a) -> Behavior a -> Event (Future a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior a -> Behavior a
forall a. Behavior a -> Behavior a
unB
imposeChanges :: Behavior a -> Event () -> Behavior a
imposeChanges :: Behavior a -> Event () -> Behavior a
imposeChanges Behavior a
b Event ()
e = Behavior a -> Behavior a
forall a. Behavior a -> Behavior a
B (Behavior a -> Behavior a) -> Behavior a -> Behavior a
forall a b. (a -> b) -> a -> b
$ Behavior a -> Event () -> Behavior a
forall a. Behavior a -> Event () -> Behavior a
Prim.imposeChanges (Behavior a -> Behavior a
forall a. Behavior a -> Behavior a
unB Behavior a
b) ((() -> ()) -> Event () -> Event ()
forall a b. (a -> b) -> Event a -> Event b
Prim.mapE (() -> () -> ()
forall a b. a -> b -> a
const ()) (Event () -> Event ()
forall a. Event a -> Event a
unE Event ()
e))
execute :: Event (MomentIO a) -> MomentIO (Event a)
execute :: Event (MomentIO a) -> MomentIO (Event a)
execute = Moment (Event a) -> MomentIO (Event a)
forall a. Moment a -> MomentIO a
MIO (Moment (Event a) -> MomentIO (Event a))
-> (Event (MomentIO a) -> Moment (Event a))
-> Event (MomentIO a)
-> MomentIO (Event a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event a -> Event a)
-> ReaderT EventNetwork Build (Event a) -> Moment (Event a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event a -> Event a
forall a. Event a -> Event a
E (ReaderT EventNetwork Build (Event a) -> Moment (Event a))
-> (Event (MomentIO a) -> ReaderT EventNetwork Build (Event a))
-> Event (MomentIO a)
-> Moment (Event a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event (Moment a) -> ReaderT EventNetwork Build (Event a)
forall a. Event (Moment a) -> Moment (Event a)
Prim.executeE (Event (Moment a) -> ReaderT EventNetwork Build (Event a))
-> (Event (MomentIO a) -> Event (Moment a))
-> Event (MomentIO a)
-> ReaderT EventNetwork Build (Event a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MomentIO a -> Moment a) -> Event (MomentIO a) -> Event (Moment a)
forall a b. (a -> b) -> Event a -> Event b
Prim.mapE MomentIO a -> Moment a
forall a. MomentIO a -> Moment a
unMIO (Event (MomentIO a) -> Event (Moment a))
-> (Event (MomentIO a) -> Event (MomentIO a))
-> Event (MomentIO a)
-> Event (Moment a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event (MomentIO a) -> Event (MomentIO a)
forall a. Event a -> Event a
unE
liftIOLater :: IO () -> MomentIO ()
liftIOLater :: IO () -> MomentIO ()
liftIOLater = Moment () -> MomentIO ()
forall a. Moment a -> MomentIO a
MIO (Moment () -> MomentIO ())
-> (IO () -> Moment ()) -> IO () -> MomentIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> Moment ()
Prim.liftIOLater
compile :: MomentIO () -> IO EventNetwork
compile :: MomentIO () -> IO EventNetwork
compile = (EventNetwork -> EventNetwork)
-> IO EventNetwork -> IO EventNetwork
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EventNetwork -> EventNetwork
EN (IO EventNetwork -> IO EventNetwork)
-> (MomentIO () -> IO EventNetwork)
-> MomentIO ()
-> IO EventNetwork
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Moment () -> IO EventNetwork
Prim.compile (Moment () -> IO EventNetwork)
-> (MomentIO () -> Moment ()) -> MomentIO () -> IO EventNetwork
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MomentIO () -> Moment ()
forall a. MomentIO a -> Moment a
unMIO
newtype EventNetwork = EN { EventNetwork -> EventNetwork
unEN :: Prim.EventNetwork }
actuate :: EventNetwork -> IO ()
actuate :: EventNetwork -> IO ()
actuate = EventNetwork -> IO ()
Prim.actuate (EventNetwork -> IO ())
-> (EventNetwork -> EventNetwork) -> EventNetwork -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventNetwork -> EventNetwork
unEN
pause :: EventNetwork -> IO ()
pause :: EventNetwork -> IO ()
pause = EventNetwork -> IO ()
Prim.pause (EventNetwork -> IO ())
-> (EventNetwork -> EventNetwork) -> EventNetwork -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventNetwork -> EventNetwork
unEN
newEvent :: MomentIO (Event a, Handler a)
newEvent :: MomentIO (Event a, Handler a)
newEvent = do
(AddHandler a
addHandler, Handler a
fire) <- IO (AddHandler a, Handler a) -> MomentIO (AddHandler a, Handler a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (AddHandler a, Handler a)
forall a. IO (AddHandler a, Handler a)
newAddHandler
Event a
e <- AddHandler a -> MomentIO (Event a)
forall a. AddHandler a -> MomentIO (Event a)
fromAddHandler AddHandler a
addHandler
(Event a, Handler a) -> MomentIO (Event a, Handler a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event a
e,Handler a
fire)
newBehavior :: a -> MomentIO (Behavior a, Handler a)
newBehavior :: a -> MomentIO (Behavior a, Handler a)
newBehavior a
a = do
(Event a
e, Handler a
fire) <- MomentIO (Event a, Handler a)
forall a. MomentIO (Event a, Handler a)
newEvent
Behavior a
b <- a -> Event a -> MomentIO (Behavior a)
forall (m :: * -> *) a.
MonadMoment m =>
a -> Event a -> m (Behavior a)
stepper a
a Event a
e
(Behavior a, Handler a) -> MomentIO (Behavior a, Handler a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Behavior a
b, Handler a
fire)
mapEventIO :: (a -> IO b) -> Event a -> MomentIO (Event b)
mapEventIO :: (a -> IO b) -> Event a -> MomentIO (Event b)
mapEventIO a -> IO b
f Event a
e1 = do
(Event b
e2, Handler b
handler) <- MomentIO (Event b, Handler b)
forall a. MomentIO (Event a, Handler a)
newEvent
Event (IO ()) -> MomentIO ()
reactimate (Event (IO ()) -> MomentIO ()) -> Event (IO ()) -> MomentIO ()
forall a b. (a -> b) -> a -> b
$ (a -> IO b
f (a -> IO b) -> Handler b -> a -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Handler b
handler) (a -> IO ()) -> Event a -> Event (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event a
e1
Event b -> MomentIO (Event b)
forall (m :: * -> *) a. Monad m => a -> m a
return Event b
e2
interpretFrameworks :: (Event a -> MomentIO (Event b)) -> [Maybe a] -> IO [Maybe b]
interpretFrameworks :: (Event a -> MomentIO (Event b)) -> [Maybe a] -> IO [Maybe b]
interpretFrameworks Event a -> MomentIO (Event b)
f [Maybe a]
xs = do
IORef (Maybe b)
output <- Maybe b -> IO (IORef (Maybe b))
forall a. a -> IO (IORef a)
newIORef Maybe b
forall a. Maybe a
Nothing
(AddHandler a
addHandler, Handler a
runHandlers) <- IO (AddHandler a, Handler a)
forall a. IO (AddHandler a, Handler a)
newAddHandler
EventNetwork
network <- MomentIO () -> IO EventNetwork
compile (MomentIO () -> IO EventNetwork) -> MomentIO () -> IO EventNetwork
forall a b. (a -> b) -> a -> b
$ do
Event a
e1 <- AddHandler a -> MomentIO (Event a)
forall a. AddHandler a -> MomentIO (Event a)
fromAddHandler AddHandler a
addHandler
Event b
e2 <- Event a -> MomentIO (Event b)
f Event a
e1
Event (IO ()) -> MomentIO ()
reactimate (Event (IO ()) -> MomentIO ()) -> Event (IO ()) -> MomentIO ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe b) -> Maybe b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe b)
output (Maybe b -> IO ()) -> (b -> Maybe b) -> b -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe b
forall a. a -> Maybe a
Just (b -> IO ()) -> Event b -> Event (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event b
e2
EventNetwork -> IO ()
actuate EventNetwork
network
[Maybe a] -> (Maybe a -> IO (Maybe b)) -> IO [Maybe b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Maybe a]
xs ((Maybe a -> IO (Maybe b)) -> IO [Maybe b])
-> (Maybe a -> IO (Maybe b)) -> IO [Maybe b]
forall a b. (a -> b) -> a -> b
$ \Maybe a
x -> do
case Maybe a
x of
Maybe a
Nothing -> Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
Just a
x -> do
Handler a
runHandlers a
x
Maybe b
b <- IORef (Maybe b) -> IO (Maybe b)
forall a. IORef a -> IO a
readIORef IORef (Maybe b)
output
IORef (Maybe b) -> Maybe b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe b)
output Maybe b
forall a. Maybe a
Nothing
Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
b
interpretAsHandler :: (Event a -> Moment (Event b)) -> AddHandler a -> AddHandler b
interpretAsHandler :: (Event a -> Moment (Event b)) -> AddHandler a -> AddHandler b
interpretAsHandler Event a -> Moment (Event b)
f AddHandler a
addHandlerA = (Handler b -> Future (IO ())) -> AddHandler b
forall a. (Handler a -> Future (IO ())) -> AddHandler a
AddHandler ((Handler b -> Future (IO ())) -> AddHandler b)
-> (Handler b -> Future (IO ())) -> AddHandler b
forall a b. (a -> b) -> a -> b
$ \Handler b
handlerB -> do
EventNetwork
network <- MomentIO () -> IO EventNetwork
compile (MomentIO () -> IO EventNetwork) -> MomentIO () -> IO EventNetwork
forall a b. (a -> b) -> a -> b
$ do
Event a
e1 <- AddHandler a -> MomentIO (Event a)
forall a. AddHandler a -> MomentIO (Event a)
fromAddHandler AddHandler a
addHandlerA
Event b
e2 <- Moment (Event b) -> MomentIO (Event b)
forall (m :: * -> *) a. MonadMoment m => Moment a -> m a
liftMoment (Event a -> Moment (Event b)
f Event a
e1)
Event (IO ()) -> MomentIO ()
reactimate (Event (IO ()) -> MomentIO ()) -> Event (IO ()) -> MomentIO ()
forall a b. (a -> b) -> a -> b
$ Handler b
handlerB Handler b -> Event b -> Event (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event b
e2
EventNetwork -> IO ()
actuate EventNetwork
network
IO () -> Future (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (EventNetwork -> IO ()
pause EventNetwork
network)