{-# 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 :: String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse String
name EvalP (Maybe a)
eval = IO (Pulse a) -> Build (Pulse a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Pulse a) -> Build (Pulse a))
-> IO (Pulse a) -> Build (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 (Pulse a)
forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
newRef (Pulse' a -> IO (Pulse a)) -> Pulse' a -> IO (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 :: Build (Pulse a)
neverP = IO (Pulse a) -> Build (Pulse a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Pulse a) -> Build (Pulse a))
-> IO (Pulse a) -> Build (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 (Pulse a)
forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
newRef (Pulse' a -> IO (Pulse a)) -> Pulse' a -> IO (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 :: a -> Latch a
pureL a
a = IO (Latch a) -> Latch a
forall a. IO a -> a
unsafePerformIO (IO (Latch a) -> Latch a) -> IO (Latch a) -> 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 = 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 :: a -> Build (Pulse a -> Build (), Latch a)
newLatch a
a = mdo
Latch a
latch <- IO (Latch a) -> ReaderWriterIOT BuildR BuildW IO (Latch a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Latch a) -> ReaderWriterIOT BuildR BuildW IO (Latch a))
-> IO (Latch a) -> ReaderWriterIOT BuildR 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 BuildR BuildW IO (Weak (Latch a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Weak (Latch a))
-> ReaderWriterIOT BuildR BuildW IO (Weak (Latch a)))
-> IO (Weak (Latch a))
-> ReaderWriterIOT BuildR 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 BuildR BuildW IO (Ref LatchWrite')
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ref LatchWrite')
-> ReaderWriterIOT BuildR BuildW IO (Ref LatchWrite'))
-> IO (Ref LatchWrite')
-> ReaderWriterIOT BuildR 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 BuildR (EvalPW, BuildW) Vault IO (Maybe a) -> EvalP a
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
p
, _latchLW :: Weak (Latch a)
_latchLW = Weak (Latch a)
w
}
Weak (Ref LatchWrite')
_ <- IO (Weak (Ref LatchWrite'))
-> ReaderWriterIOT BuildR BuildW IO (Weak (Ref LatchWrite'))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Weak (Ref LatchWrite'))
-> ReaderWriterIOT BuildR BuildW IO (Weak (Ref LatchWrite')))
-> IO (Weak (Ref LatchWrite'))
-> ReaderWriterIOT BuildR 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 :: EvalL a -> Latch a
cachedLatch EvalL a
eval = IO (Latch a) -> Latch a
forall a. IO a -> a
unsafePerformIO (IO (Latch a) -> Latch a) -> IO (Latch a) -> Latch a
forall a b. (a -> b) -> a -> b
$ mdo
Latch a
latch <- 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
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
$ Latch a -> IO (Latch' a)
forall (m :: * -> *) a. MonadIO m => Ref a -> m a
readRef 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` Latch a -> Latch' a -> IO ()
forall (m :: * -> *) a. MonadIO m => Ref a -> a -> m ()
put 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
}
Latch a -> IO (Latch a)
forall (m :: * -> *) a. Monad m => a -> m a
return Latch a
latch
addOutput :: Pulse EvalO -> Build ()
addOutput :: Pulse EvalO -> Build ()
addOutput Pulse EvalO
p = do
Ref Output'
o <- IO (Ref Output') -> ReaderWriterIOT BuildR BuildW IO (Ref Output')
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ref Output')
-> ReaderWriterIOT BuildR BuildW IO (Ref Output'))
-> IO (Ref Output')
-> ReaderWriterIOT BuildR BuildW IO (Ref Output')
forall a b. (a -> b) -> a -> b
$ Output' -> IO (Ref Output')
forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
newRef (Output' -> IO (Ref Output')) -> Output' -> IO (Ref 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 BuildR (EvalPW, BuildW) Vault IO (Maybe EvalO)
-> EvalP EvalO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pulse EvalO
-> RWSIOT BuildR (EvalPW, 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` Ref Output' -> SomeNode
O Ref 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, [Ref Output'], Action, Maybe (Build ()))
-> BuildW
BuildW (DependencyBuilder
forall a. Monoid a => a
mempty, [Ref Output'
o], Action
forall a. Monoid a => a
mempty, Maybe (Build ())
forall a. Monoid a => a
mempty)
runBuildIO :: BuildR -> BuildIO a -> IO (a, Action, [Output])
runBuildIO :: BuildR -> BuildIO a -> IO (a, Action, [Ref Output'])
runBuildIO BuildR
i BuildIO a
m = do
(a
a, BuildW (DependencyBuilder
topologyUpdates, [Ref Output']
os, Action
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
Action -> IO ()
doit Action
liftIOLaters
(a, Action, [Ref Output']) -> IO (a, Action, [Ref Output'])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,IO () -> Action
Action (IO () -> Action) -> IO () -> Action
forall a b. (a -> b) -> a -> b
$ DependencyBuilder -> IO ()
Deps.buildDependencies DependencyBuilder
topologyUpdates,[Ref Output']
os)
where
unfold :: BuildW -> BuildIO a -> IO (a, BuildW)
unfold :: BuildW -> BuildIO a -> IO (a, BuildW)
unfold BuildW
w BuildIO a
m = do
(a
a, BuildW (DependencyBuilder
w1, [Ref Output']
w2, Action
w3, Maybe (Build ())
later)) <- BuildIO a -> BuildR -> 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 BuildR
i
let w' :: BuildW
w' = BuildW
w BuildW -> BuildW -> BuildW
forall a. Semigroup a => a -> a -> a
<> (DependencyBuilder, [Ref Output'], Action, Maybe (Build ()))
-> BuildW
BuildW (DependencyBuilder
w1,[Ref Output']
w2,Action
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, [Ref Output'], Action, Maybe (Build ()))
-> BuildW
BuildW (DependencyBuilder
forall a. Monoid a => a
mempty, [Ref Output']
forall a. Monoid a => a
mempty, Action
forall a. Monoid a => a
mempty, Build () -> Maybe (Build ())
forall a. a -> Maybe a
Just Build ()
x)
buildLaterReadNow :: Build a -> Build a
buildLaterReadNow :: Build a -> Build a
buildLaterReadNow Build a
m = do
IORef a
ref <- IO (IORef a) -> ReaderWriterIOT BuildR BuildW IO (IORef a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef a) -> ReaderWriterIOT BuildR BuildW IO (IORef a))
-> IO (IORef a) -> ReaderWriterIOT BuildR 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 :: Build a -> Build a
liftBuild = Build a -> Build a
forall a. a -> a
id
getTimeB :: Build Time
getTimeB :: Build Time
getTimeB = BuildR -> Time
forall a b. (a, b) -> a
fst (BuildR -> Time)
-> ReaderWriterIOT BuildR BuildW IO BuildR -> Build Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderWriterIOT BuildR BuildW IO BuildR
forall (m :: * -> *) r w. Monad m => ReaderWriterIOT r w m r
RW.ask
alwaysP :: Build (Pulse ())
alwaysP :: Build (Pulse ())
alwaysP = BuildR -> Pulse ()
forall a b. (a, b) -> b
snd (BuildR -> Pulse ())
-> ReaderWriterIOT BuildR BuildW IO BuildR -> Build (Pulse ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderWriterIOT BuildR BuildW IO BuildR
forall (m :: * -> *) r w. Monad m => ReaderWriterIOT r w m r
RW.ask
readLatchB :: Latch a -> Build a
readLatchB :: Latch a -> Build a
readLatchB = IO a -> Build a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Build a) -> (Latch a -> IO a) -> Latch a -> Build 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 :: 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 :: 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, [Ref Output'], Action, Maybe (Build ()))
-> BuildW
BuildW (SomeNode -> SomeNode -> DependencyBuilder
Deps.addChild SomeNode
parent SomeNode
child, [Ref Output']
forall a. Monoid a => a
mempty, Action
forall a. Monoid a => a
mempty, Maybe (Build ())
forall a. Monoid a => a
mempty)
changeParent :: Pulse child -> Pulse parent -> Build ()
changeParent :: 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, [Ref Output'], Action, 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, [Ref Output']
forall a. Monoid a => a
mempty, Action
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, [Ref Output'], Action, Maybe (Build ()))
-> BuildW
BuildW (DependencyBuilder
forall a. Monoid a => a
mempty, [Ref Output']
forall a. Monoid a => a
mempty, IO () -> Action
Action IO ()
x, Maybe (Build ())
forall a. Monoid a => a
mempty)
readLatchIO :: Latch a -> IO a
readLatchIO :: 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 :: 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 :: Vault -> EvalP a -> Build (a, EvalPW)
runEvalP Vault
s1 EvalP a
m = (BuildR -> IO ((a, EvalPW), BuildW)) -> Build (a, EvalPW)
forall (m :: * -> *) w r a.
(MonadIO m, Monoid w) =>
(r -> IO (a, w)) -> ReaderWriterIOT r w m a
RW.readerWriterIOT ((BuildR -> IO ((a, EvalPW), BuildW)) -> Build (a, EvalPW))
-> (BuildR -> IO ((a, EvalPW), BuildW)) -> Build (a, EvalPW)
forall a b. (a -> b) -> a -> b
$ \BuildR
r2 -> do
(a
a,Vault
_,(EvalPW
w1,BuildW
w2)) <- EvalP a -> BuildR -> Vault -> IO (a, Vault, (EvalPW, 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 BuildR
r2 Vault
s1
((a, EvalPW), BuildW) -> IO ((a, EvalPW), BuildW)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a,EvalPW
w1), BuildW
w2)
liftBuildP :: Build a -> EvalP a
liftBuildP :: Build a -> EvalP a
liftBuildP Build a
m = (BuildR -> Vault -> IO (a, Vault, (EvalPW, BuildW))) -> EvalP 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 ((BuildR -> Vault -> IO (a, Vault, (EvalPW, BuildW))) -> EvalP a)
-> (BuildR -> Vault -> IO (a, Vault, (EvalPW, BuildW))) -> EvalP a
forall a b. (a -> b) -> a -> b
$ \BuildR
r2 Vault
s -> do
(a
a,BuildW
w2) <- Build a -> BuildR -> 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 BuildR
r2
(a, Vault, (EvalPW, BuildW)) -> IO (a, Vault, (EvalPW, BuildW))
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,Vault
s,(EvalPW
forall a. Monoid a => a
mempty,BuildW
w2))
askTime :: EvalP Time
askTime :: EvalP Time
askTime = BuildR -> Time
forall a b. (a, b) -> a
fst (BuildR -> Time)
-> RWSIOT BuildR (EvalPW, BuildW) Vault IO BuildR -> EvalP Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWSIOT BuildR (EvalPW, BuildW) Vault IO BuildR
forall (m :: * -> *) r w s. Monad m => RWSIOT r w s m r
RWS.ask
readPulseP :: Pulse a -> EvalP (Maybe a)
readPulseP :: 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 BuildR (EvalPW, 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 BuildR (EvalPW, BuildW) Vault IO Vault -> EvalP (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWSIOT BuildR (EvalPW, 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 :: Key (Maybe a) -> Maybe a -> EvalP ()
writePulseP Key (Maybe a)
key Maybe a
a = do
Vault
s <- RWSIOT BuildR (EvalPW, 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 :: 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 :: Latch a -> EvalP (Future a)
readLatchFutureP = Future a -> EvalP (Future a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Future a -> EvalP (Future a))
-> (Latch a -> Future a) -> Latch a -> EvalP (Future a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Latch a -> Future a
forall a. Latch a -> IO a
readLatchIO
rememberLatchUpdate :: IO () -> EvalP ()
rememberLatchUpdate :: IO () -> EvalP ()
rememberLatchUpdate IO ()
x = (EvalPW, BuildW) -> EvalP ()
forall (m :: * -> *) w r s.
(MonadIO m, Monoid w) =>
w -> RWSIOT r w s m ()
RWS.tell ((IO () -> Action
Action IO ()
x,[(Ref Output', EvalO)]
forall a. Monoid a => a
mempty),BuildW
forall a. Monoid a => a
mempty)
rememberOutput :: (Output, EvalO) -> EvalP ()
rememberOutput :: (Ref Output', EvalO) -> EvalP ()
rememberOutput (Ref Output', EvalO)
x = (EvalPW, BuildW) -> EvalP ()
forall (m :: * -> *) w r s.
(MonadIO m, Monoid w) =>
w -> RWSIOT r w s m ()
RWS.tell ((Action
forall a. Monoid a => a
mempty,[(Ref 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 :: 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 :: (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