{-# LANGUAGE RecordWildCards, RecursiveDo, BangPatterns, ScopedTypeVariables #-}
module Reactive.Banana.Prim.Plumbing where
import Control.Monad (join)
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import qualified Control.Monad.Trans.RWSIO as RWS
import qualified Control.Monad.Trans.Reader as Reader
import qualified Control.Monad.Trans.ReaderWriterIO as RW
import Data.Function (on)
import Data.Functor
import Data.IORef
import Data.List (sortBy)
import Data.Monoid
import qualified Data.Vault.Lazy as Lazy
import System.IO.Unsafe
import qualified Reactive.Banana.Prim.Dependencies as Deps
import Reactive.Banana.Prim.Types
import Reactive.Banana.Prim.Util
newPulse :: String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse :: String -> EvalP (Maybe a) -> Build (Pulse a)
newPulse name :: String
name eval :: 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
$ $WPulse :: 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
$ $WPulse :: 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 = "neverP"
}
pureL :: a -> Latch a
pureL :: a -> Latch a
pureL a :: 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
$ $WLatch :: 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
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
$ $WLatch :: 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 {..} <- 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 "incorrect Latch write"
updateOn :: Pulse a -> Build ()
updateOn :: Pulse a -> Build ()
updateOn p :: 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 -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
forall a. a
err a -> a
forall a. a -> a
id (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 eval :: 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
$ $WLatch :: 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 "Undefined value of a cached latch."
, _evalL :: EvalL a
_evalL = do
Latch{..} <- 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
a,time :: 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 ()
forall a b. a -> b -> b
`seq` Latch a -> Latch' a -> IO ()
forall (m :: * -> *) a. MonadIO m => Ref a -> a -> m ()
put Latch a
latch ($WLatch :: forall a. Time -> a -> EvalL a -> Latch' a
Latch {..})
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 p :: 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 -> (EvalO -> EvalO) -> Maybe EvalO -> EvalO
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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 "nop") EvalO -> EvalO
forall a. a -> a
id (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 i :: BuildR
i m :: BuildIO a
m = {-# SCC runBuild #-} do
(a :: a
a, BuildW (topologyUpdates :: DependencyBuilder
topologyUpdates, os :: [Ref Output']
os, liftIOLaters :: Action
liftIOLaters, _)) <- 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 -> IO ()) -> Action -> IO ()
forall a b. (a -> b) -> a -> b
$ 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 w :: BuildW
w m :: BuildIO a
m = do
(a :: a
a, BuildW (w1 :: DependencyBuilder
w1, w2 :: [Ref Output']
w2, w3 :: Action
w3, later :: 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 m :: 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
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 x :: 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 m :: 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 "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 = (\(x :: Time
x,_) -> Time
x) (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 = (\(_,x :: Pulse ()
x) -> Pulse ()
x) (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 child :: Pulse child
child parent :: 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 child :: Pulse child
child parent :: 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
$ 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 IO (Weak (Pulse parent)) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
addChild :: SomeNode -> SomeNode -> Build ()
addChild :: SomeNode -> SomeNode -> Build ()
addChild parent :: SomeNode
parent child :: 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 node :: Pulse child
node parent :: 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 x :: 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 :: Latch a
latch = do
Latch{..} <- 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 :: Latch a
latch = do
Latch{..} <- 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 s1 :: Vault
s1 m :: 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
$ \r2 :: BuildR
r2 -> do
(a :: a
a,_,(w1 :: EvalPW
w1,w2 :: 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 m :: 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
$ \r2 :: BuildR
r2 s :: Vault
s -> do
(a :: a
a,w2 :: 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 p :: Pulse a
p = do
Pulse{..} <- 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 :: Key (Maybe a)
key a :: 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 x :: 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 x :: (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 r :: Tuple r w s
r m :: 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 m :: 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