{-# LANGUAGE RecordWildCards, RecursiveDo, ScopedTypeVariables #-}
module Reactive.Banana.Prim.Low.Plumbing where
import Control.Monad (join)
import Control.Monad.IO.Class
import qualified Control.Monad.Trans.RWSIO as RWS
import qualified Control.Monad.Trans.ReaderWriterIO as RW
import Data.Functor
import Data.IORef
import qualified Data.Vault.Lazy as Lazy
import System.IO.Unsafe
import qualified Reactive.Banana.Prim.Low.Dependencies as Deps
import Reactive.Banana.Prim.Low.Types
import Reactive.Banana.Prim.Low.Util
import Data.Maybe (fromMaybe)
newPulse :: String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse :: forall a. String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
name EvalP (Maybe a)
eval = IO (Ref (Pulse' a))
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Ref (Pulse' a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ref (Pulse' a))
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Ref (Pulse' a)))
-> IO (Ref (Pulse' a))
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Ref (Pulse' a))
forall a b. (a -> b) -> a -> b
$ do
Key (Maybe a)
key <- IO (Key (Maybe a))
forall a. IO (Key a)
Lazy.newKey
Pulse' a -> IO (Ref (Pulse' a))
forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
newRef (Pulse' a -> IO (Ref (Pulse' a)))
-> Pulse' a -> IO (Ref (Pulse' a))
forall a b. (a -> b) -> a -> b
$ Pulse :: forall a.
Key (Maybe a)
-> Time
-> EvalP (Maybe a)
-> [Weak SomeNode]
-> [Weak SomeNode]
-> Level
-> String
-> Pulse' a
Pulse
{ _keyP :: Key (Maybe a)
_keyP = Key (Maybe a)
key
, _seenP :: Time
_seenP = Time
agesAgo
, _evalP :: EvalP (Maybe a)
_evalP = EvalP (Maybe a)
eval
, _childrenP :: [Weak SomeNode]
_childrenP = []
, _parentsP :: [Weak SomeNode]
_parentsP = []
, _levelP :: Level
_levelP = Level
ground
, _nameP :: String
_nameP = String
name
}
neverP :: Build (Pulse a)
neverP :: forall a. Build (Pulse a)
neverP = IO (Ref (Pulse' a))
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Ref (Pulse' a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ref (Pulse' a))
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Ref (Pulse' a)))
-> IO (Ref (Pulse' a))
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Ref (Pulse' a))
forall a b. (a -> b) -> a -> b
$ do
Key (Maybe a)
key <- IO (Key (Maybe a))
forall a. IO (Key a)
Lazy.newKey
Pulse' a -> IO (Ref (Pulse' a))
forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
newRef (Pulse' a -> IO (Ref (Pulse' a)))
-> Pulse' a -> IO (Ref (Pulse' a))
forall a b. (a -> b) -> a -> b
$ Pulse :: forall a.
Key (Maybe a)
-> Time
-> EvalP (Maybe a)
-> [Weak SomeNode]
-> [Weak SomeNode]
-> Level
-> String
-> Pulse' a
Pulse
{ _keyP :: Key (Maybe a)
_keyP = Key (Maybe a)
key
, _seenP :: Time
_seenP = Time
agesAgo
, _evalP :: EvalP (Maybe a)
_evalP = Maybe a -> EvalP (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
, _childrenP :: [Weak SomeNode]
_childrenP = []
, _parentsP :: [Weak SomeNode]
_parentsP = []
, _levelP :: Level
_levelP = Level
ground
, _nameP :: String
_nameP = String
"neverP"
}
pureL :: a -> Latch a
pureL :: forall a. a -> Latch a
pureL a
a = IO (Ref (Latch' a)) -> Ref (Latch' a)
forall a. IO a -> a
unsafePerformIO (IO (Ref (Latch' a)) -> Ref (Latch' a))
-> IO (Ref (Latch' a)) -> Ref (Latch' a)
forall a b. (a -> b) -> a -> b
$ Latch' a -> IO (Ref (Latch' a))
forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
newRef (Latch' a -> IO (Ref (Latch' a)))
-> Latch' a -> IO (Ref (Latch' a))
forall a b. (a -> b) -> a -> b
$ Latch :: forall a. Time -> a -> EvalL a -> Latch' a
Latch
{ _seenL :: Time
_seenL = Time
beginning
, _valueL :: a
_valueL = a
a
, _evalL :: EvalL a
_evalL = a -> EvalL a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
}
newLatch :: forall a. a -> Build (Pulse a -> Build (), Latch a)
newLatch :: forall a. a -> Build (Pulse a -> Build (), Latch a)
newLatch a
a = mdo
Latch a
latch <- IO (Latch a)
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Latch a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Latch a)
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Latch a))
-> IO (Latch a)
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Latch a)
forall a b. (a -> b) -> a -> b
$ Latch' a -> IO (Latch a)
forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
newRef (Latch' a -> IO (Latch a)) -> Latch' a -> IO (Latch a)
forall a b. (a -> b) -> a -> b
$ Latch :: forall a. Time -> a -> EvalL a -> Latch' a
Latch
{ _seenL :: Time
_seenL = Time
beginning
, _valueL :: a
_valueL = a
a
, _evalL :: EvalL a
_evalL = do
Latch {a
EvalL a
Time
_evalL :: EvalL a
_valueL :: a
_seenL :: Time
_evalL :: forall a. Latch' a -> EvalL a
_valueL :: forall a. Latch' a -> a
_seenL :: forall a. Latch' a -> Time
..} <- Latch a -> ReaderWriterIOT () Time IO (Latch' a)
forall (m :: * -> *) a. MonadIO m => Ref a -> m a
readRef Latch a
latch
Time -> ReaderWriterIOT () Time IO ()
forall (m :: * -> *) w r.
(MonadIO m, Monoid w) =>
w -> ReaderWriterIOT r w m ()
RW.tell Time
_seenL
a -> EvalL a
forall (m :: * -> *) a. Monad m => a -> m a
return a
_valueL
}
let
err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"incorrect Latch write"
updateOn :: Pulse a -> Build ()
updateOn :: Pulse a -> Build ()
updateOn Pulse a
p = do
Weak (Latch a)
w <- IO (Weak (Latch a))
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Weak (Latch a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Weak (Latch a))
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Weak (Latch a)))
-> IO (Weak (Latch a))
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Weak (Latch a))
forall a b. (a -> b) -> a -> b
$ Latch a -> Latch a -> IO (Weak (Latch a))
forall (m :: * -> *) a value.
MonadIO m =>
Ref a -> value -> m (Weak value)
mkWeakRefValue Latch a
latch Latch a
latch
Ref LatchWrite'
lw <- IO (Ref LatchWrite')
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Ref LatchWrite')
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ref LatchWrite')
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Ref LatchWrite'))
-> IO (Ref LatchWrite')
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Ref LatchWrite')
forall a b. (a -> b) -> a -> b
$ LatchWrite' -> IO (Ref LatchWrite')
forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
newRef (LatchWrite' -> IO (Ref LatchWrite'))
-> LatchWrite' -> IO (Ref LatchWrite')
forall a b. (a -> b) -> a -> b
$ LatchWrite :: forall a. EvalP a -> Weak (Latch a) -> LatchWrite'
LatchWrite
{ _evalLW :: EvalP a
_evalLW = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall {a}. a
err (Maybe a -> a)
-> RWSIOT
(Time, Pulse ())
((EvalLW, [(Output, EvalO)]), BuildW)
Vault
IO
(Maybe a)
-> EvalP a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pulse a
-> RWSIOT
(Time, Pulse ())
((EvalLW, [(Output, EvalO)]), BuildW)
Vault
IO
(Maybe a)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse a
p
, _latchLW :: Weak (Latch a)
_latchLW = Weak (Latch a)
w
}
Weak (Ref LatchWrite')
_ <- IO (Weak (Ref LatchWrite'))
-> ReaderWriterIOT
(Time, Pulse ()) BuildW IO (Weak (Ref LatchWrite'))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Weak (Ref LatchWrite'))
-> ReaderWriterIOT
(Time, Pulse ()) BuildW IO (Weak (Ref LatchWrite')))
-> IO (Weak (Ref LatchWrite'))
-> ReaderWriterIOT
(Time, Pulse ()) BuildW IO (Weak (Ref LatchWrite'))
forall a b. (a -> b) -> a -> b
$ Latch a -> Ref LatchWrite' -> IO (Weak (Ref LatchWrite'))
forall (m :: * -> *) a value.
MonadIO m =>
Ref a -> value -> m (Weak value)
mkWeakRefValue Latch a
latch Ref LatchWrite'
lw
Pulse a -> SomeNode
forall a. Pulse a -> SomeNode
P Pulse a
p SomeNode -> SomeNode -> Build ()
`addChild` Ref LatchWrite' -> SomeNode
L Ref LatchWrite'
lw
(Pulse a -> Build (), Latch a)
-> Build (Pulse a -> Build (), Latch a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pulse a -> Build ()
updateOn, Latch a
latch)
cachedLatch :: EvalL a -> Latch a
cachedLatch :: forall a. EvalL a -> Latch a
cachedLatch EvalL a
eval = IO (Ref (Latch' a)) -> Ref (Latch' a)
forall a. IO a -> a
unsafePerformIO (IO (Ref (Latch' a)) -> Ref (Latch' a))
-> IO (Ref (Latch' a)) -> Ref (Latch' a)
forall a b. (a -> b) -> a -> b
$ mdo
Ref (Latch' a)
latch <- Latch' a -> IO (Ref (Latch' a))
forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
newRef (Latch' a -> IO (Ref (Latch' a)))
-> Latch' a -> IO (Ref (Latch' a))
forall a b. (a -> b) -> a -> b
$ Latch :: forall a. Time -> a -> EvalL a -> Latch' a
Latch
{ _seenL :: Time
_seenL = Time
agesAgo
, _valueL :: a
_valueL = String -> a
forall a. HasCallStack => String -> a
error String
"Undefined value of a cached latch."
, _evalL :: EvalL a
_evalL = do
Latch{a
EvalL a
Time
_evalL :: EvalL a
_valueL :: a
_seenL :: Time
_evalL :: forall a. Latch' a -> EvalL a
_valueL :: forall a. Latch' a -> a
_seenL :: forall a. Latch' a -> Time
..} <- IO (Latch' a) -> ReaderWriterIOT () Time IO (Latch' a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Latch' a) -> ReaderWriterIOT () Time IO (Latch' a))
-> IO (Latch' a) -> ReaderWriterIOT () Time IO (Latch' a)
forall a b. (a -> b) -> a -> b
$ Ref (Latch' a) -> IO (Latch' a)
forall (m :: * -> *) a. MonadIO m => Ref a -> m a
readRef Ref (Latch' a)
latch
(a
a,Time
time) <- EvalL a -> ReaderWriterIOT () Time IO (a, Time)
forall (m :: * -> *) w r a.
(MonadIO m, Monoid w) =>
ReaderWriterIOT r w m a -> ReaderWriterIOT r w m (a, w)
RW.listen EvalL a
eval
IO a -> EvalL a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> EvalL a) -> IO a -> EvalL a
forall a b. (a -> b) -> a -> b
$ if Time
time Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
_seenL
then a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
_valueL
else do
let _seenL :: Time
_seenL = Time
time
let _valueL :: a
_valueL = a
a
a
a a -> IO () -> IO ()
`seq` Ref (Latch' a) -> Latch' a -> IO ()
forall (m :: * -> *) a. MonadIO m => Ref a -> a -> m ()
put Ref (Latch' a)
latch (Latch :: forall a. Time -> a -> EvalL a -> Latch' a
Latch {a
EvalL a
Time
_valueL :: a
_seenL :: Time
_evalL :: EvalL a
_evalL :: EvalL a
_valueL :: a
_seenL :: Time
..})
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
}
Ref (Latch' a) -> IO (Ref (Latch' a))
forall (m :: * -> *) a. Monad m => a -> m a
return Ref (Latch' a)
latch
addOutput :: Pulse EvalO -> Build ()
addOutput :: Pulse EvalO -> Build ()
addOutput Pulse EvalO
p = do
Output
o <- IO Output -> ReaderWriterIOT (Time, Pulse ()) BuildW IO Output
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Output -> ReaderWriterIOT (Time, Pulse ()) BuildW IO Output)
-> IO Output -> ReaderWriterIOT (Time, Pulse ()) BuildW IO Output
forall a b. (a -> b) -> a -> b
$ Output' -> IO Output
forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
newRef (Output' -> IO Output) -> Output' -> IO Output
forall a b. (a -> b) -> a -> b
$ Output :: EvalP EvalO -> Output'
Output
{ _evalO :: EvalP EvalO
_evalO = EvalO -> Maybe EvalO -> EvalO
forall a. a -> Maybe a -> a
fromMaybe (IO () -> EvalO
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> EvalO) -> IO () -> EvalO
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug String
"nop") (Maybe EvalO -> EvalO)
-> RWSIOT
(Time, Pulse ())
((EvalLW, [(Output, EvalO)]), BuildW)
Vault
IO
(Maybe EvalO)
-> EvalP EvalO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pulse EvalO
-> RWSIOT
(Time, Pulse ())
((EvalLW, [(Output, EvalO)]), BuildW)
Vault
IO
(Maybe EvalO)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse EvalO
p
}
Pulse EvalO -> SomeNode
forall a. Pulse a -> SomeNode
P Pulse EvalO
p SomeNode -> SomeNode -> Build ()
`addChild` Output -> SomeNode
O Output
o
BuildW -> Build ()
forall (m :: * -> *) w r.
(MonadIO m, Monoid w) =>
w -> ReaderWriterIOT r w m ()
RW.tell (BuildW -> Build ()) -> BuildW -> Build ()
forall a b. (a -> b) -> a -> b
$ (DependencyBuilder, [Output], EvalLW, Maybe (Build ())) -> BuildW
BuildW (DependencyBuilder
forall a. Monoid a => a
mempty, [Output
o], EvalLW
forall a. Monoid a => a
mempty, Maybe (Build ())
forall a. Monoid a => a
mempty)
runBuildIO :: BuildR -> BuildIO a -> IO (a, Action, [Output])
runBuildIO :: forall a. (Time, Pulse ()) -> BuildIO a -> IO (a, EvalLW, [Output])
runBuildIO (Time, Pulse ())
i BuildIO a
m = do
(a
a, BuildW (DependencyBuilder
topologyUpdates, [Output]
os, EvalLW
liftIOLaters, Maybe (Build ())
_)) <- BuildW -> BuildIO a -> IO (a, BuildW)
forall a. BuildW -> BuildIO a -> IO (a, BuildW)
unfold BuildW
forall a. Monoid a => a
mempty BuildIO a
m
EvalLW -> IO ()
doit EvalLW
liftIOLaters
(a, EvalLW, [Output]) -> IO (a, EvalLW, [Output])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,IO () -> EvalLW
Action (IO () -> EvalLW) -> IO () -> EvalLW
forall a b. (a -> b) -> a -> b
$ DependencyBuilder -> IO ()
Deps.buildDependencies DependencyBuilder
topologyUpdates,[Output]
os)
where
unfold :: BuildW -> BuildIO a -> IO (a, BuildW)
unfold :: forall a. BuildW -> BuildIO a -> IO (a, BuildW)
unfold BuildW
w BuildIO a
m = do
(a
a, BuildW (DependencyBuilder
w1, [Output]
w2, EvalLW
w3, Maybe (Build ())
later)) <- BuildIO a -> (Time, Pulse ()) -> IO (a, BuildW)
forall (m :: * -> *) w r a.
(MonadIO m, Monoid w) =>
ReaderWriterIOT r w m a -> r -> m (a, w)
RW.runReaderWriterIOT BuildIO a
m (Time, Pulse ())
i
let w' :: BuildW
w' = BuildW
w BuildW -> BuildW -> BuildW
forall a. Semigroup a => a -> a -> a
<> (DependencyBuilder, [Output], EvalLW, Maybe (Build ())) -> BuildW
BuildW (DependencyBuilder
w1,[Output]
w2,EvalLW
w3,Maybe (Build ())
forall a. Monoid a => a
mempty)
BuildW
w'' <- case Maybe (Build ())
later of
Just Build ()
m -> ((), BuildW) -> BuildW
forall a b. (a, b) -> b
snd (((), BuildW) -> BuildW) -> IO ((), BuildW) -> IO BuildW
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BuildW -> Build () -> IO ((), BuildW)
forall a. BuildW -> BuildIO a -> IO (a, BuildW)
unfold BuildW
w' Build ()
m
Maybe (Build ())
Nothing -> BuildW -> IO BuildW
forall (m :: * -> *) a. Monad m => a -> m a
return BuildW
w'
(a, BuildW) -> IO (a, BuildW)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,BuildW
w'')
buildLater :: Build () -> Build ()
buildLater :: Build () -> Build ()
buildLater Build ()
x = BuildW -> Build ()
forall (m :: * -> *) w r.
(MonadIO m, Monoid w) =>
w -> ReaderWriterIOT r w m ()
RW.tell (BuildW -> Build ()) -> BuildW -> Build ()
forall a b. (a -> b) -> a -> b
$ (DependencyBuilder, [Output], EvalLW, Maybe (Build ())) -> BuildW
BuildW (DependencyBuilder
forall a. Monoid a => a
mempty, [Output]
forall a. Monoid a => a
mempty, EvalLW
forall a. Monoid a => a
mempty, Build () -> Maybe (Build ())
forall a. a -> Maybe a
Just Build ()
x)
buildLaterReadNow :: Build a -> Build a
buildLaterReadNow :: forall a. Build a -> Build a
buildLaterReadNow Build a
m = do
IORef a
ref <- IO (IORef a)
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (IORef a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef a)
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (IORef a))
-> IO (IORef a)
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (IORef a)
forall a b. (a -> b) -> a -> b
$ a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef (a -> IO (IORef a)) -> a -> IO (IORef a)
forall a b. (a -> b) -> a -> b
$
String -> a
forall a. HasCallStack => String -> a
error String
"buildLaterReadNow: Trying to read before it is written."
Build () -> Build ()
buildLater (Build () -> Build ()) -> Build () -> Build ()
forall a b. (a -> b) -> a -> b
$ Build a
m Build a -> (a -> Build ()) -> Build ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Build ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Build ()) -> (a -> IO ()) -> a -> Build ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
ref
IO a -> Build a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Build a) -> IO a -> Build a
forall a b. (a -> b) -> a -> b
$ IO a -> IO a
forall a. IO a -> IO a
unsafeInterleaveIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
ref
liftBuild :: Build a -> BuildIO a
liftBuild :: forall a. Build a -> Build a
liftBuild = Build a -> Build a
forall a. a -> a
id
getTimeB :: Build Time
getTimeB :: Build Time
getTimeB = (Time, Pulse ()) -> Time
forall a b. (a, b) -> a
fst ((Time, Pulse ()) -> Time)
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Time, Pulse ())
-> Build Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Time, Pulse ())
forall (m :: * -> *) r w. Monad m => ReaderWriterIOT r w m r
RW.ask
alwaysP :: Build (Pulse ())
alwaysP :: Build (Pulse ())
alwaysP = (Time, Pulse ()) -> Pulse ()
forall a b. (a, b) -> b
snd ((Time, Pulse ()) -> Pulse ())
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Time, Pulse ())
-> Build (Pulse ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderWriterIOT (Time, Pulse ()) BuildW IO (Time, Pulse ())
forall (m :: * -> *) r w. Monad m => ReaderWriterIOT r w m r
RW.ask
readLatchB :: Latch a -> Build a
readLatchB :: forall a. Latch a -> Build a
readLatchB = IO a -> ReaderWriterIOT (Time, Pulse ()) BuildW IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> ReaderWriterIOT (Time, Pulse ()) BuildW IO a)
-> (Latch a -> IO a)
-> Latch a
-> ReaderWriterIOT (Time, Pulse ()) BuildW IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Latch a -> IO a
forall a. Latch a -> IO a
readLatchIO
dependOn :: Pulse child -> Pulse parent -> Build ()
dependOn :: forall child parent. Pulse child -> Pulse parent -> Build ()
dependOn Pulse child
child Pulse parent
parent = Pulse parent -> SomeNode
forall a. Pulse a -> SomeNode
P Pulse parent
parent SomeNode -> SomeNode -> Build ()
`addChild` Pulse child -> SomeNode
forall a. Pulse a -> SomeNode
P Pulse child
child
keepAlive :: Pulse child -> Pulse parent -> Build ()
keepAlive :: forall child parent. Pulse child -> Pulse parent -> Build ()
keepAlive Pulse child
child Pulse parent
parent = IO () -> Build ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Build ()) -> IO () -> Build ()
forall a b. (a -> b) -> a -> b
$ IO (Weak (Pulse parent)) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Weak (Pulse parent)) -> IO ())
-> IO (Weak (Pulse parent)) -> IO ()
forall a b. (a -> b) -> a -> b
$ Pulse child -> Pulse parent -> IO (Weak (Pulse parent))
forall (m :: * -> *) a value.
MonadIO m =>
Ref a -> value -> m (Weak value)
mkWeakRefValue Pulse child
child Pulse parent
parent
addChild :: SomeNode -> SomeNode -> Build ()
addChild :: SomeNode -> SomeNode -> Build ()
addChild SomeNode
parent SomeNode
child =
BuildW -> Build ()
forall (m :: * -> *) w r.
(MonadIO m, Monoid w) =>
w -> ReaderWriterIOT r w m ()
RW.tell (BuildW -> Build ()) -> BuildW -> Build ()
forall a b. (a -> b) -> a -> b
$ (DependencyBuilder, [Output], EvalLW, Maybe (Build ())) -> BuildW
BuildW (SomeNode -> SomeNode -> DependencyBuilder
Deps.addChild SomeNode
parent SomeNode
child, [Output]
forall a. Monoid a => a
mempty, EvalLW
forall a. Monoid a => a
mempty, Maybe (Build ())
forall a. Monoid a => a
mempty)
changeParent :: Pulse child -> Pulse parent -> Build ()
changeParent :: forall child parent. Pulse child -> Pulse parent -> Build ()
changeParent Pulse child
node Pulse parent
parent =
BuildW -> Build ()
forall (m :: * -> *) w r.
(MonadIO m, Monoid w) =>
w -> ReaderWriterIOT r w m ()
RW.tell (BuildW -> Build ()) -> BuildW -> Build ()
forall a b. (a -> b) -> a -> b
$ (DependencyBuilder, [Output], EvalLW, Maybe (Build ())) -> BuildW
BuildW (Pulse child -> Pulse parent -> DependencyBuilder
forall a b. Pulse a -> Pulse b -> DependencyBuilder
Deps.changeParent Pulse child
node Pulse parent
parent, [Output]
forall a. Monoid a => a
mempty, EvalLW
forall a. Monoid a => a
mempty, Maybe (Build ())
forall a. Monoid a => a
mempty)
liftIOLater :: IO () -> Build ()
liftIOLater :: IO () -> Build ()
liftIOLater IO ()
x = BuildW -> Build ()
forall (m :: * -> *) w r.
(MonadIO m, Monoid w) =>
w -> ReaderWriterIOT r w m ()
RW.tell (BuildW -> Build ()) -> BuildW -> Build ()
forall a b. (a -> b) -> a -> b
$ (DependencyBuilder, [Output], EvalLW, Maybe (Build ())) -> BuildW
BuildW (DependencyBuilder
forall a. Monoid a => a
mempty, [Output]
forall a. Monoid a => a
mempty, IO () -> EvalLW
Action IO ()
x, Maybe (Build ())
forall a. Monoid a => a
mempty)
readLatchIO :: Latch a -> IO a
readLatchIO :: forall a. Latch a -> IO a
readLatchIO Latch a
latch = do
Latch{a
EvalL a
Time
_evalL :: EvalL a
_valueL :: a
_seenL :: Time
_evalL :: forall a. Latch' a -> EvalL a
_valueL :: forall a. Latch' a -> a
_seenL :: forall a. Latch' a -> Time
..} <- Latch a -> IO (Latch' a)
forall (m :: * -> *) a. MonadIO m => Ref a -> m a
readRef Latch a
latch
IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ (a, Time) -> a
forall a b. (a, b) -> a
fst ((a, Time) -> a) -> IO (a, Time) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EvalL a -> () -> IO (a, Time)
forall (m :: * -> *) w r a.
(MonadIO m, Monoid w) =>
ReaderWriterIOT r w m a -> r -> m (a, w)
RW.runReaderWriterIOT EvalL a
_evalL ()
getValueL :: Latch a -> EvalL a
getValueL :: forall a. Latch a -> EvalL a
getValueL Latch a
latch = do
Latch{a
EvalL a
Time
_evalL :: EvalL a
_valueL :: a
_seenL :: Time
_evalL :: forall a. Latch' a -> EvalL a
_valueL :: forall a. Latch' a -> a
_seenL :: forall a. Latch' a -> Time
..} <- Latch a -> ReaderWriterIOT () Time IO (Latch' a)
forall (m :: * -> *) a. MonadIO m => Ref a -> m a
readRef Latch a
latch
EvalL a
_evalL
runEvalP :: Lazy.Vault -> EvalP a -> Build (a, EvalPW)
runEvalP :: forall a.
Vault -> EvalP a -> Build (a, (EvalLW, [(Output, EvalO)]))
runEvalP Vault
s1 EvalP a
m = ((Time, Pulse ()) -> IO ((a, (EvalLW, [(Output, EvalO)])), BuildW))
-> ReaderWriterIOT
(Time, Pulse ()) BuildW IO (a, (EvalLW, [(Output, EvalO)]))
forall (m :: * -> *) w r a.
(MonadIO m, Monoid w) =>
(r -> IO (a, w)) -> ReaderWriterIOT r w m a
RW.readerWriterIOT (((Time, Pulse ())
-> IO ((a, (EvalLW, [(Output, EvalO)])), BuildW))
-> ReaderWriterIOT
(Time, Pulse ()) BuildW IO (a, (EvalLW, [(Output, EvalO)])))
-> ((Time, Pulse ())
-> IO ((a, (EvalLW, [(Output, EvalO)])), BuildW))
-> ReaderWriterIOT
(Time, Pulse ()) BuildW IO (a, (EvalLW, [(Output, EvalO)]))
forall a b. (a -> b) -> a -> b
$ \(Time, Pulse ())
r2 -> do
(a
a,Vault
_,((EvalLW, [(Output, EvalO)])
w1,BuildW
w2)) <- EvalP a
-> (Time, Pulse ())
-> Vault
-> IO (a, Vault, ((EvalLW, [(Output, EvalO)]), BuildW))
forall (m :: * -> *) w r s a.
(MonadIO m, Monoid w) =>
RWSIOT r w s m a -> r -> s -> m (a, s, w)
RWS.runRWSIOT EvalP a
m (Time, Pulse ())
r2 Vault
s1
((a, (EvalLW, [(Output, EvalO)])), BuildW)
-> IO ((a, (EvalLW, [(Output, EvalO)])), BuildW)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a,(EvalLW, [(Output, EvalO)])
w1), BuildW
w2)
liftBuildP :: Build a -> EvalP a
liftBuildP :: forall a. Build a -> EvalP a
liftBuildP Build a
m = ((Time, Pulse ())
-> Vault -> IO (a, Vault, ((EvalLW, [(Output, EvalO)]), BuildW)))
-> RWSIOT
(Time, Pulse ()) ((EvalLW, [(Output, EvalO)]), BuildW) Vault IO a
forall (m :: * -> *) w r s a.
(MonadIO m, Monoid w) =>
(r -> s -> IO (a, s, w)) -> RWSIOT r w s m a
RWS.rwsT (((Time, Pulse ())
-> Vault -> IO (a, Vault, ((EvalLW, [(Output, EvalO)]), BuildW)))
-> RWSIOT
(Time, Pulse ()) ((EvalLW, [(Output, EvalO)]), BuildW) Vault IO a)
-> ((Time, Pulse ())
-> Vault -> IO (a, Vault, ((EvalLW, [(Output, EvalO)]), BuildW)))
-> RWSIOT
(Time, Pulse ()) ((EvalLW, [(Output, EvalO)]), BuildW) Vault IO a
forall a b. (a -> b) -> a -> b
$ \(Time, Pulse ())
r2 Vault
s -> do
(a
a,BuildW
w2) <- Build a -> (Time, Pulse ()) -> IO (a, BuildW)
forall (m :: * -> *) w r a.
(MonadIO m, Monoid w) =>
ReaderWriterIOT r w m a -> r -> m (a, w)
RW.runReaderWriterIOT Build a
m (Time, Pulse ())
r2
(a, Vault, ((EvalLW, [(Output, EvalO)]), BuildW))
-> IO (a, Vault, ((EvalLW, [(Output, EvalO)]), BuildW))
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,Vault
s,((EvalLW, [(Output, EvalO)])
forall a. Monoid a => a
mempty,BuildW
w2))
askTime :: EvalP Time
askTime :: EvalP Time
askTime = (Time, Pulse ()) -> Time
forall a b. (a, b) -> a
fst ((Time, Pulse ()) -> Time)
-> RWSIOT
(Time, Pulse ())
((EvalLW, [(Output, EvalO)]), BuildW)
Vault
IO
(Time, Pulse ())
-> EvalP Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWSIOT
(Time, Pulse ())
((EvalLW, [(Output, EvalO)]), BuildW)
Vault
IO
(Time, Pulse ())
forall (m :: * -> *) r w s. Monad m => RWSIOT r w s m r
RWS.ask
readPulseP :: Pulse a -> EvalP (Maybe a)
readPulseP :: forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse a
p = do
Pulse{Level
String
[Weak SomeNode]
Key (Maybe a)
EvalP (Maybe a)
Time
_nameP :: String
_levelP :: Level
_parentsP :: [Weak SomeNode]
_childrenP :: [Weak SomeNode]
_evalP :: EvalP (Maybe a)
_seenP :: Time
_keyP :: Key (Maybe a)
_nameP :: forall a. Pulse' a -> String
_levelP :: forall a. Pulse' a -> Level
_parentsP :: forall a. Pulse' a -> [Weak SomeNode]
_childrenP :: forall a. Pulse' a -> [Weak SomeNode]
_evalP :: forall a. Pulse' a -> EvalP (Maybe a)
_seenP :: forall a. Pulse' a -> Time
_keyP :: forall a. Pulse' a -> Key (Maybe a)
..} <- Pulse a
-> RWSIOT
(Time, Pulse ())
((EvalLW, [(Output, EvalO)]), BuildW)
Vault
IO
(Pulse' a)
forall (m :: * -> *) a. MonadIO m => Ref a -> m a
readRef Pulse a
p
Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe a) -> Maybe a)
-> (Vault -> Maybe (Maybe a)) -> Vault -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key (Maybe a) -> Vault -> Maybe (Maybe a)
forall a. Key a -> Vault -> Maybe a
Lazy.lookup Key (Maybe a)
_keyP (Vault -> Maybe a)
-> RWSIOT
(Time, Pulse ())
((EvalLW, [(Output, EvalO)]), BuildW)
Vault
IO
Vault
-> EvalP (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWSIOT
(Time, Pulse ())
((EvalLW, [(Output, EvalO)]), BuildW)
Vault
IO
Vault
forall (m :: * -> *) r w s. MonadIO m => RWSIOT r w s m s
RWS.get
writePulseP :: Lazy.Key (Maybe a) -> Maybe a -> EvalP ()
writePulseP :: forall a. Key (Maybe a) -> Maybe a -> EvalP ()
writePulseP Key (Maybe a)
key Maybe a
a = do
Vault
s <- RWSIOT
(Time, Pulse ())
((EvalLW, [(Output, EvalO)]), BuildW)
Vault
IO
Vault
forall (m :: * -> *) r w s. MonadIO m => RWSIOT r w s m s
RWS.get
Vault -> EvalP ()
forall (m :: * -> *) s r w. MonadIO m => s -> RWSIOT r w s m ()
RWS.put (Vault -> EvalP ()) -> Vault -> EvalP ()
forall a b. (a -> b) -> a -> b
$ Key (Maybe a) -> Maybe a -> Vault -> Vault
forall a. Key a -> a -> Vault -> Vault
Lazy.insert Key (Maybe a)
key Maybe a
a Vault
s
readLatchP :: Latch a -> EvalP a
readLatchP :: forall a. Latch a -> EvalP a
readLatchP = Build a -> EvalP a
forall a. Build a -> EvalP a
liftBuildP (Build a -> EvalP a) -> (Latch a -> Build a) -> Latch a -> EvalP a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Latch a -> Build a
forall a. Latch a -> Build a
readLatchB
readLatchFutureP :: Latch a -> EvalP (Future a)
readLatchFutureP :: forall a. Latch a -> EvalP (Future a)
readLatchFutureP = IO a
-> RWSIOT
(Time, Pulse ())
((EvalLW, [(Output, EvalO)]), BuildW)
Vault
IO
(IO a)
forall (m :: * -> *) a. Monad m => a -> m a
return (IO a
-> RWSIOT
(Time, Pulse ())
((EvalLW, [(Output, EvalO)]), BuildW)
Vault
IO
(IO a))
-> (Latch a -> IO a)
-> Latch a
-> RWSIOT
(Time, Pulse ())
((EvalLW, [(Output, EvalO)]), BuildW)
Vault
IO
(IO a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Latch a -> IO a
forall a. Latch a -> IO a
readLatchIO
rememberLatchUpdate :: IO () -> EvalP ()
rememberLatchUpdate :: IO () -> EvalP ()
rememberLatchUpdate IO ()
x = ((EvalLW, [(Output, EvalO)]), BuildW) -> EvalP ()
forall (m :: * -> *) w r s.
(MonadIO m, Monoid w) =>
w -> RWSIOT r w s m ()
RWS.tell ((IO () -> EvalLW
Action IO ()
x,[(Output, EvalO)]
forall a. Monoid a => a
mempty),BuildW
forall a. Monoid a => a
mempty)
rememberOutput :: (Output, EvalO) -> EvalP ()
rememberOutput :: (Output, EvalO) -> EvalP ()
rememberOutput (Output, EvalO)
x = ((EvalLW, [(Output, EvalO)]), BuildW) -> EvalP ()
forall (m :: * -> *) w r s.
(MonadIO m, Monoid w) =>
w -> RWSIOT r w s m ()
RWS.tell ((EvalLW
forall a. Monoid a => a
mempty,[(Output, EvalO)
x]),BuildW
forall a. Monoid a => a
mempty)
unwrapEvalP :: RWS.Tuple r w s -> RWS.RWSIOT r w s m a -> m a
unwrapEvalP :: forall r w s (m :: * -> *) a.
Tuple r w s -> RWSIOT r w s m a -> m a
unwrapEvalP Tuple r w s
r RWSIOT r w s m a
m = RWSIOT r w s m a -> Tuple r w s -> m a
forall r w s (m :: * -> *) a.
RWSIOT r w s m a -> Tuple r w s -> m a
RWS.run RWSIOT r w s m a
m Tuple r w s
r
wrapEvalP :: (RWS.Tuple r w s -> m a) -> RWS.RWSIOT r w s m a
wrapEvalP :: forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
wrapEvalP Tuple r w s -> m a
m = (Tuple r w s -> m a) -> RWSIOT r w s m a
forall r w s (m :: * -> *) a.
(Tuple r w s -> m a) -> RWSIOT r w s m a
RWS.R Tuple r w s -> m a
m