{-# LANGUAGE RecursiveDo, ScopedTypeVariables #-}
module Reactive.Banana.Prim.Mid.Combinators where
import Control.Monad
import Control.Monad.IO.Class
import Reactive.Banana.Prim.Low.Plumbing
( newPulse, newLatch, cachedLatch
, dependOn, keepAlive, changeParent
, getValueL
, readPulseP, readLatchP, readLatchFutureP, liftBuildP,
)
import qualified Reactive.Banana.Prim.Low.Plumbing (pureL)
import Reactive.Banana.Prim.Low.Types (Latch, Future, Pulse, Build, EvalP)
debug :: String -> a -> a
debug :: String -> a -> a
debug String
_ = a -> a
forall a. a -> a
id
mapP :: (a -> b) -> Pulse a -> Build (Pulse b)
mapP :: (a -> b) -> Pulse a -> Build (Pulse b)
mapP a -> b
f Pulse a
p1 = do
Pulse b
p2 <- String -> EvalP (Maybe b) -> Build (Pulse b)
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"mapP" ({-# SCC mapP #-} (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Maybe a -> Maybe b)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
-> EvalP (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pulse a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse a
p1)
Pulse b
p2 Pulse b -> Pulse a -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse a
p1
Pulse b -> Build (Pulse b)
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse b
p2
tagFuture :: Latch a -> Pulse b -> Build (Pulse (Future a))
tagFuture :: Latch a -> Pulse b -> Build (Pulse (Future a))
tagFuture Latch a
x Pulse b
p1 = do
Pulse (Future a)
p2 <- String -> EvalP (Maybe (Future a)) -> Build (Pulse (Future a))
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"tagFuture" (EvalP (Maybe (Future a)) -> Build (Pulse (Future a)))
-> EvalP (Maybe (Future a)) -> Build (Pulse (Future a))
forall a b. (a -> b) -> a -> b
$
(b -> Future a) -> Maybe b -> Maybe (Future a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> Future a) -> Maybe b -> Maybe (Future a))
-> (Future a -> b -> Future a)
-> Future a
-> Maybe b
-> Maybe (Future a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Future a -> b -> Future a
forall a b. a -> b -> a
const (Future a -> Maybe b -> Maybe (Future a))
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Future a)
-> RWSIOT
BuildR (EvalPW, BuildW) Vault IO (Maybe b -> Maybe (Future a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Latch a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Future a)
forall a. Latch a -> EvalP (Future a)
readLatchFutureP Latch a
x RWSIOT
BuildR (EvalPW, BuildW) Vault IO (Maybe b -> Maybe (Future a))
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe b)
-> EvalP (Maybe (Future a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pulse b -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe b)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse b
p1
Pulse (Future a)
p2 Pulse (Future a) -> Pulse b -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse b
p1
Pulse (Future a) -> Build (Pulse (Future a))
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse (Future a)
p2
filterJustP :: Pulse (Maybe a) -> Build (Pulse a)
filterJustP :: Pulse (Maybe a) -> Build (Pulse a)
filterJustP Pulse (Maybe a)
p1 = do
Pulse a
p2 <- String -> EvalP (Maybe a) -> Build (Pulse a)
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"filterJustP" ({-# SCC filterJustP #-} Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe a) -> Maybe a)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe (Maybe a))
-> EvalP (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pulse (Maybe a)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe (Maybe a))
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse (Maybe a)
p1)
Pulse a
p2 Pulse a -> Pulse (Maybe a) -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse (Maybe a)
p1
Pulse a -> Build (Pulse a)
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse a
p2
unsafeMapIOP :: forall a b. (a -> IO b) -> Pulse a -> Build (Pulse b)
unsafeMapIOP :: (a -> IO b) -> Pulse a -> Build (Pulse b)
unsafeMapIOP a -> IO b
f Pulse a
p1 = do
Pulse b
p2 <- String -> EvalP (Maybe b) -> Build (Pulse b)
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"unsafeMapIOP"
({-# SCC unsafeMapIOP #-} Maybe a -> EvalP (Maybe b)
eval (Maybe a -> EvalP (Maybe b))
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
-> EvalP (Maybe b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pulse a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse a
p1)
Pulse b
p2 Pulse b -> Pulse a -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse a
p1
Pulse b -> Build (Pulse b)
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse b
p2
where
eval :: Maybe a -> EvalP (Maybe b)
eval :: Maybe a -> EvalP (Maybe b)
eval (Just a
x) = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO b -> EvalP (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO b -> RWSIOT BuildR (EvalPW, BuildW) Vault IO b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (a -> IO b
f a
x)
eval Maybe a
Nothing = Maybe b -> EvalP (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
mergeWithP
:: (a -> Maybe c)
-> (b -> Maybe c)
-> (a -> b -> Maybe c)
-> Pulse a
-> Pulse b
-> Build (Pulse c)
mergeWithP :: (a -> Maybe c)
-> (b -> Maybe c)
-> (a -> b -> Maybe c)
-> Pulse a
-> Pulse b
-> Build (Pulse c)
mergeWithP a -> Maybe c
f b -> Maybe c
g a -> b -> Maybe c
h Pulse a
px Pulse b
py = do
Pulse c
p <- String -> EvalP (Maybe c) -> Build (Pulse c)
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"mergeWithP"
({-# SCC mergeWithP #-} Maybe a -> Maybe b -> Maybe c
eval (Maybe a -> Maybe b -> Maybe c)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe b -> Maybe c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pulse a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse a
px RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe b -> Maybe c)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe b)
-> EvalP (Maybe c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pulse b -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe b)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse b
py)
Pulse c
p Pulse c -> Pulse a -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse a
px
Pulse c
p Pulse c -> Pulse b -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse b
py
Pulse c -> Build (Pulse c)
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse c
p
where
eval :: Maybe a -> Maybe b -> Maybe c
eval Maybe a
Nothing Maybe b
Nothing = Maybe c
forall a. Maybe a
Nothing
eval (Just a
x) Maybe b
Nothing = a -> Maybe c
f a
x
eval Maybe a
Nothing (Just b
y) = b -> Maybe c
g b
y
eval (Just a
x) (Just b
y) = a -> b -> Maybe c
h a
x b
y
applyP :: Latch (a -> b) -> Pulse a -> Build (Pulse b)
applyP :: Latch (a -> b) -> Pulse a -> Build (Pulse b)
applyP Latch (a -> b)
f Pulse a
x = do
Pulse b
p <- String -> EvalP (Maybe b) -> Build (Pulse b)
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"applyP"
({-# SCC applyP #-} (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Maybe a -> Maybe b)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (a -> b)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a -> Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Latch (a -> b) -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (a -> b)
forall a. Latch a -> EvalP a
readLatchP Latch (a -> b)
f RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a -> Maybe b)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
-> EvalP (Maybe b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pulse a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse a
x)
Pulse b
p Pulse b -> Pulse a -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse a
x
Pulse b -> Build (Pulse b)
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse b
p
pureL :: a -> Latch a
pureL :: a -> Latch a
pureL = a -> Latch a
forall a. a -> Latch a
Reactive.Banana.Prim.Low.Plumbing.pureL
mapL :: (a -> b) -> Latch a -> Latch b
mapL :: (a -> b) -> Latch a -> Latch b
mapL a -> b
f Latch a
lx = EvalL b -> Latch b
forall a. EvalL a -> Latch a
cachedLatch ({-# SCC mapL #-} a -> b
f (a -> b) -> ReaderWriterIOT () Time IO a -> EvalL b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Latch a -> ReaderWriterIOT () Time IO a
forall a. Latch a -> EvalL a
getValueL Latch a
lx)
applyL :: Latch (a -> b) -> Latch a -> Latch b
applyL :: Latch (a -> b) -> Latch a -> Latch b
applyL Latch (a -> b)
lf Latch a
lx = EvalL b -> Latch b
forall a. EvalL a -> Latch a
cachedLatch
({-# SCC applyL #-} Latch (a -> b) -> EvalL (a -> b)
forall a. Latch a -> EvalL a
getValueL Latch (a -> b)
lf EvalL (a -> b) -> ReaderWriterIOT () Time IO a -> EvalL b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Latch a -> ReaderWriterIOT () Time IO a
forall a. Latch a -> EvalL a
getValueL Latch a
lx)
accumL :: a -> Pulse (a -> a) -> Build (Latch a, Pulse a)
accumL :: a -> Pulse (a -> a) -> Build (Latch a, Pulse a)
accumL a
a Pulse (a -> a)
p1 = do
(Pulse a -> Build ()
updateOn, Latch a
x) <- a -> Build (Pulse a -> Build (), Latch a)
forall a. a -> Build (Pulse a -> Build (), Latch a)
newLatch a
a
Pulse a
p2 <- String -> EvalP (Maybe a) -> Build (Pulse a)
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"accumL" (EvalP (Maybe a) -> Build (Pulse a))
-> EvalP (Maybe a) -> Build (Pulse a)
forall a b. (a -> b) -> a -> b
$ do
a
a <- Latch a -> EvalP a
forall a. Latch a -> EvalP a
readLatchP Latch a
x
Maybe (a -> a)
f <- Pulse (a -> a) -> EvalP (Maybe (a -> a))
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse (a -> a)
p1
Maybe a -> EvalP (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> EvalP (Maybe a)) -> Maybe a -> EvalP (Maybe a)
forall a b. (a -> b) -> a -> b
$ ((a -> a) -> a) -> Maybe (a -> a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a -> a
g -> a -> a
g a
a) Maybe (a -> a)
f
Pulse a
p2 Pulse a -> Pulse (a -> a) -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse (a -> a)
p1
Pulse a -> Build ()
updateOn Pulse a
p2
(Latch a, Pulse a) -> Build (Latch a, Pulse a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Latch a
x,Pulse a
p2)
stepperL :: a -> Pulse a -> Build (Latch a)
stepperL :: a -> Pulse a -> Build (Latch a)
stepperL a
a Pulse a
p = do
(Pulse a -> Build ()
updateOn, Latch a
x) <- a -> Build (Pulse a -> Build (), Latch a)
forall a. a -> Build (Pulse a -> Build (), Latch a)
newLatch a
a
Pulse a -> Build ()
updateOn Pulse a
p
Latch a -> Build (Latch a)
forall (m :: * -> *) a. Monad m => a -> m a
return Latch a
x
switchL :: Latch a -> Pulse (Latch a) -> Build (Latch a)
switchL :: Latch a -> Pulse (Latch a) -> Build (Latch a)
switchL Latch a
l Pulse (Latch a)
pl = mdo
Latch (Latch a)
x <- Latch a -> Pulse (Latch a) -> Build (Latch (Latch a))
forall a. a -> Pulse a -> Build (Latch a)
stepperL Latch a
l Pulse (Latch a)
pl
Latch a -> Build (Latch a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Latch a -> Build (Latch a)) -> Latch a -> Build (Latch a)
forall a b. (a -> b) -> a -> b
$ EvalL a -> Latch a
forall a. EvalL a -> Latch a
cachedLatch (EvalL a -> Latch a) -> EvalL a -> Latch a
forall a b. (a -> b) -> a -> b
$ Latch (Latch a) -> EvalL (Latch a)
forall a. Latch a -> EvalL a
getValueL Latch (Latch a)
x EvalL (Latch a) -> (Latch a -> EvalL a) -> EvalL a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Latch a -> EvalL a
forall a. Latch a -> EvalL a
getValueL
executeP :: forall a b. Pulse (b -> Build a) -> b -> Build (Pulse a)
executeP :: Pulse (b -> Build a) -> b -> Build (Pulse a)
executeP Pulse (b -> Build a)
p1 b
b = do
Pulse a
p2 <- String -> EvalP (Maybe a) -> Build (Pulse a)
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"executeP" ({-# SCC executeP #-} Maybe (b -> Build a) -> EvalP (Maybe a)
eval (Maybe (b -> Build a) -> EvalP (Maybe a))
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe (b -> Build a))
-> EvalP (Maybe a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pulse (b -> Build a)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe (b -> Build a))
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse (b -> Build a)
p1)
Pulse a
p2 Pulse a -> Pulse (b -> Build a) -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse (b -> Build a)
p1
Pulse a -> Build (Pulse a)
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse a
p2
where
eval :: Maybe (b -> Build a) -> EvalP (Maybe a)
eval :: Maybe (b -> Build a) -> EvalP (Maybe a)
eval (Just b -> Build a
x) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO a -> EvalP (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Build a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO a
forall a. Build a -> EvalP a
liftBuildP (b -> Build a
x b
b)
eval Maybe (b -> Build a)
Nothing = Maybe a -> EvalP (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
switchP :: Pulse a -> Pulse (Pulse a) -> Build (Pulse a)
switchP :: Pulse a -> Pulse (Pulse a) -> Build (Pulse a)
switchP Pulse a
p Pulse (Pulse a)
pp = mdo
Latch (Pulse a)
lp <- Pulse a -> Pulse (Pulse a) -> Build (Latch (Pulse a))
forall a. a -> Pulse a -> Build (Latch a)
stepperL Pulse a
p Pulse (Pulse a)
pp
let
switch :: RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
switch = do
Maybe (Pulse a)
mnew <- Pulse (Pulse a) -> EvalP (Maybe (Pulse a))
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse (Pulse a)
pp
case Maybe (Pulse a)
mnew of
Maybe (Pulse a)
Nothing -> () -> RWSIOT BuildR (EvalPW, BuildW) Vault IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Pulse a
new -> Build () -> RWSIOT BuildR (EvalPW, BuildW) Vault IO ()
forall a. Build a -> EvalP a
liftBuildP (Build () -> RWSIOT BuildR (EvalPW, BuildW) Vault IO ())
-> Build () -> RWSIOT BuildR (EvalPW, BuildW) Vault IO ()
forall a b. (a -> b) -> a -> b
$ Pulse a
p2 Pulse a -> Pulse a -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`changeParent` Pulse a
new
Maybe a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
eval :: RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
eval = Pulse a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP (Pulse a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a))
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Pulse a)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Latch (Pulse a)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Pulse a)
forall a. Latch a -> EvalP a
readLatchP Latch (Pulse a)
lp
Pulse ()
p1 <- String -> EvalP (Maybe ()) -> Build (Pulse ())
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"switchP_in" EvalP (Maybe ())
forall a. RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
switch :: Build (Pulse ())
Pulse ()
p1 Pulse () -> Pulse (Pulse a) -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse (Pulse a)
pp
Pulse a
p2 <- String
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
-> Build (Pulse a)
forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
"switchP_out" RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe a)
eval
Pulse a
p2 Pulse a -> Pulse a -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`dependOn` Pulse a
p
Pulse a
p2 Pulse a -> Pulse () -> Build ()
forall child parent. Pulse child -> Pulse parent -> Build ()
`keepAlive` Pulse ()
p1
Pulse a -> Build (Pulse a)
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse a
p2