{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-----------------------------------------------------------------------------
    reactive-banana
------------------------------------------------------------------------------}
module Reactive.Banana.Prim.Mid.Plumbing where

import Control.Monad
    ( join, void )
import Control.Monad.IO.Class
    ( liftIO )
import Data.IORef
    ( newIORef, writeIORef, readIORef )
import Data.Maybe
    ( fromMaybe )
import System.IO.Unsafe
    ( unsafePerformIO, unsafeInterleaveIO )

import qualified Control.Monad.Trans.RWSIO          as RWS
import qualified Control.Monad.Trans.ReaderWriterIO as RW
import qualified Data.Vault.Lazy                    as Lazy

import qualified Reactive.Banana.Prim.Low.Ref as Ref
import           Reactive.Banana.Prim.Mid.Types

{-----------------------------------------------------------------------------
    Build primitive pulses and latches
------------------------------------------------------------------------------}
-- | Make 'Pulse' from evaluation function
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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Key (Maybe a)
_key <- forall a. IO (Key a)
Lazy.newKey
    Output
_nodeP <- forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
Ref.new forall a b. (a -> b) -> a -> b
$ forall a. PulseD a -> SomeNodeD
P forall a b. (a -> b) -> a -> b
$ PulseD
        { _keyP :: Key (Maybe a)
_keyP      = Key (Maybe a)
_key
        , _seenP :: Time
_seenP     = Time
agesAgo
        , _evalP :: EvalP (Maybe a)
_evalP     = EvalP (Maybe a)
eval
        , _nameP :: String
_nameP     = String
name
        }
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Pulse{Key (Maybe a)
_key :: Key (Maybe a)
_key :: Key (Maybe a)
_key,Output
_nodeP :: Output
_nodeP :: Output
_nodeP}

{-
* Note [PulseCreation]

We assume that we do not have to calculate a pulse occurrence
at the moment we create the pulse. Otherwise, we would have
to recalculate the dependencies *while* doing evaluation;
this is a recipe for desaster.

-}

-- | 'Pulse' that never fires.
neverP :: Build (Pulse a)
neverP :: forall a. Build (Pulse a)
neverP = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Key (Maybe a)
_key <- forall a. IO (Key a)
Lazy.newKey
    Output
_nodeP <- forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
Ref.new forall a b. (a -> b) -> a -> b
$ forall a. PulseD a -> SomeNodeD
P forall a b. (a -> b) -> a -> b
$ PulseD
        { _keyP :: Key (Maybe a)
_keyP      = Key (Maybe a)
_key
        , _seenP :: Time
_seenP     = Time
agesAgo
        , _evalP :: EvalP (Maybe a)
_evalP     = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
        , _nameP :: String
_nameP     = String
"neverP"
        }
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Pulse{Key (Maybe a)
_key :: Key (Maybe a)
_key :: Key (Maybe a)
_key,Output
_nodeP :: Output
_nodeP :: Output
_nodeP}

-- | Return a 'Latch' that has a constant value
pureL :: a -> Latch a
pureL :: forall a. a -> Latch a
pureL a
a = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
Ref.new forall a b. (a -> b) -> a -> b
$ Latch
    { _seenL :: Time
_seenL  = Time
beginning
    , _valueL :: a
_valueL = a
a
    , _evalL :: EvalL a
_evalL  = forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    }

-- | Make new 'Latch' that can be updated by a 'Pulse'
newLatch :: forall a. a -> Build (Pulse a -> Build (), Latch a)
newLatch :: forall a. a -> Build (Pulse a -> Build (), Latch a)
newLatch a
a = do
    Latch a
latch <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ mdo
        Latch a
latch <- forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
Ref.new forall a b. (a -> b) -> a -> b
$ 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. LatchD a -> EvalL a
_valueL :: forall a. LatchD a -> a
_seenL :: forall a. LatchD a -> Time
..} <- forall (m :: * -> *) a. MonadIO m => Ref a -> m a
Ref.read Latch a
latch
                forall (m :: * -> *) w r.
(MonadIO m, Monoid w) =>
w -> ReaderWriterIOT r w m ()
RW.tell Time
_seenL  -- indicate timestamp
                forall (m :: * -> *) a. Monad m => a -> m a
return a
_valueL  -- indicate value
            }
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Latch a
latch

    let
        err :: a
err        = 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  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall k v. Ref k -> v -> Maybe (IO ()) -> IO (Weak v)
Ref.mkWeak Latch a
latch Latch a
latch forall a. Maybe a
Nothing
            Output
lw <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
Ref.new forall a b. (a -> b) -> a -> b
$ LatchWriteD -> SomeNodeD
L forall a b. (a -> b) -> a -> b
$ LatchWriteD
                { _evalLW :: EvalP a
_evalLW  = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse a
p
                , _latchLW :: Weak (Latch a)
_latchLW = Weak (Latch a)
w
                }
            -- writer is alive only as long as the latch is alive
            Weak Output
_  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall k v. Ref k -> v -> Maybe (IO ()) -> IO (Weak v)
Ref.mkWeak Latch a
latch Output
lw forall a. Maybe a
Nothing
            forall a. Pulse a -> Output
_nodeP Pulse a
p Output -> Output -> Build ()
`addChild` Output
lw

    forall (m :: * -> *) a. Monad m => a -> m a
return (Pulse a -> Build ()
updateOn, Latch a
latch)

-- | Make a new 'Latch' that caches a previous computation.
cachedLatch :: EvalL a -> Latch a
cachedLatch :: forall a. EvalL a -> Latch a
cachedLatch EvalL a
eval = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ mdo
    Latch a
latch <- forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
Ref.new forall a b. (a -> b) -> a -> b
$ Latch
        { _seenL :: Time
_seenL  = Time
agesAgo
        , _valueL :: a
_valueL = 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. LatchD a -> EvalL a
_valueL :: forall a. LatchD a -> a
_seenL :: forall a. LatchD a -> Time
..} <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => Ref a -> m a
Ref.read Latch a
latch
            -- calculate current value (lazy!) with timestamp
            (a
a,Time
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
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ if Time
time forall a. Ord a => a -> a -> Bool
<= Time
_seenL
                then forall (m :: * -> *) a. Monad m => a -> m a
return a
_valueL     -- return old value
                else do                 -- update value
                    let _seenL :: Time
_seenL  = Time
time
                    let _valueL :: a
_valueL = a
a
                    a
a seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. MonadIO m => Ref a -> a -> m ()
Ref.put Latch a
latch (Latch {a
EvalL a
Time
_valueL :: a
_seenL :: Time
_evalL :: EvalL a
_evalL :: EvalL a
_valueL :: a
_seenL :: Time
..})
                    forall (m :: * -> *) a. Monad m => a -> m a
return a
a
        }
    forall (m :: * -> *) a. Monad m => a -> m a
return Latch a
latch

-- | Add a new output that depends on a 'Pulse'.
--
-- TODO: Return function to unregister the output again.
addOutput :: Pulse EvalO -> Build ()
addOutput :: Pulse EvalO -> Build ()
addOutput Pulse EvalO
p = do
    Output
o <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
Ref.new forall a b. (a -> b) -> a -> b
$ OutputD -> SomeNodeD
O forall a b. (a -> b) -> a -> b
$ Output
        { _evalO :: EvalP EvalO
_evalO = forall a. a -> Maybe a -> a
fromMaybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse EvalO
p
        }
    forall a. Pulse a -> Output
_nodeP Pulse EvalO
p Output -> Output -> Build ()
`addChild` Output
o
    forall (m :: * -> *) w r.
(MonadIO m, Monoid w) =>
w -> ReaderWriterIOT r w m ()
RW.tell forall a b. (a -> b) -> a -> b
$ (DependencyChanges, [Output], EvalLW, Maybe (Build ())) -> BuildW
BuildW (forall a. Monoid a => a
mempty, [Output
o], forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)

{-----------------------------------------------------------------------------
    Build monad
------------------------------------------------------------------------------}
runBuildIO :: BuildR -> BuildIO a -> IO (a, DependencyChanges, [Output])
runBuildIO :: forall a.
BuildR -> BuildIO a -> IO (a, DependencyChanges, [Output])
runBuildIO BuildR
i BuildIO a
m = do
    (a
a, BuildW (DependencyChanges
topologyUpdates, [Output]
os, EvalLW
liftIOLaters, Maybe (Build ())
_)) <- forall a. BuildW -> BuildIO a -> IO (a, BuildW)
unfold forall a. Monoid a => a
mempty BuildIO a
m
    EvalLW -> IO ()
doit EvalLW
liftIOLaters          -- execute late IOs
    forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,DependencyChanges
topologyUpdates,[Output]
os)
  where
    -- Recursively execute the  buildLater  calls.
    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 (DependencyChanges
w1, [Output]
w2, EvalLW
w3, Maybe (Build ())
later)) <- 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 forall a. Semigroup a => a -> a -> a
<> (DependencyChanges, [Output], EvalLW, Maybe (Build ())) -> BuildW
BuildW (DependencyChanges
w1,[Output]
w2,EvalLW
w3,forall a. Monoid a => a
mempty)
        BuildW
w'' <- case Maybe (Build ())
later of
            Just Build ()
m  -> forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. BuildW -> BuildIO a -> IO (a, BuildW)
unfold BuildW
w' Build ()
m
            Maybe (Build ())
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return BuildW
w'
        forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,BuildW
w'')

buildLater :: Build () -> Build ()
buildLater :: Build () -> Build ()
buildLater Build ()
x = forall (m :: * -> *) w r.
(MonadIO m, Monoid w) =>
w -> ReaderWriterIOT r w m ()
RW.tell forall a b. (a -> b) -> a -> b
$ (DependencyChanges, [Output], EvalLW, Maybe (Build ())) -> BuildW
BuildW (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty, forall a. a -> Maybe a
Just Build ()
x)

-- | Pretend to return a value right now,
-- but do not actually calculate it until later.
--
-- NOTE: Accessing the value before it's written leads to an error.
--
-- FIXME: Is there a way to have the value calculate on demand?
buildLaterReadNow :: Build a -> Build a
buildLaterReadNow :: forall a. Build a -> Build a
buildLaterReadNow Build a
m = do
    IORef a
ref <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$
        forall a. HasCallStack => String -> a
error String
"buildLaterReadNow: Trying to read before it is written."
    Build () -> Build ()
buildLater forall a b. (a -> b) -> a -> b
$ Build a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IORef a -> a -> IO ()
writeIORef IORef a
ref
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef a
ref

liftBuild :: Build a -> BuildIO a
liftBuild :: forall a. Build a -> Build a
liftBuild = forall a. a -> a
id

getTimeB :: Build Time
getTimeB :: Build Time
getTimeB = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r w. Monad m => ReaderWriterIOT r w m r
RW.ask

alwaysP :: Build (Pulse ())
alwaysP :: Build (Pulse ())
alwaysP = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Pulse a -> Output
_nodeP Pulse parent
parent Output -> Output -> Build ()
`addChild` forall a. Pulse a -> Output
_nodeP 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
    forall k v. Ref k -> v -> Maybe (IO ()) -> IO (Weak v)
Ref.mkWeak (forall a. Pulse a -> Output
_nodeP Pulse child
child) (forall a. Pulse a -> Output
_nodeP Pulse parent
parent) forall a. Maybe a
Nothing

addChild :: SomeNode -> SomeNode -> Build ()
addChild :: Output -> Output -> Build ()
addChild Output
parent Output
child =
    forall (m :: * -> *) w r.
(MonadIO m, Monoid w) =>
w -> ReaderWriterIOT r w m ()
RW.tell forall a b. (a -> b) -> a -> b
$ (DependencyChanges, [Output], EvalLW, Maybe (Build ())) -> BuildW
BuildW ([forall parent child.
parent -> child -> DependencyChange parent child
InsertEdge Output
parent Output
child], forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)

changeParent :: Pulse child -> Pulse parent -> Build ()
changeParent :: forall child parent. Pulse child -> Pulse parent -> Build ()
changeParent Pulse child
pulse0 Pulse parent
parent0 =
    forall (m :: * -> *) w r.
(MonadIO m, Monoid w) =>
w -> ReaderWriterIOT r w m ()
RW.tell forall a b. (a -> b) -> a -> b
$ (DependencyChanges, [Output], EvalLW, Maybe (Build ())) -> BuildW
BuildW ([forall parent child.
child -> parent -> DependencyChange parent child
ChangeParentTo Output
pulse Output
parent], forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)
   where
     pulse :: Output
pulse = forall a. Pulse a -> Output
_nodeP Pulse child
pulse0
     parent :: Output
parent = forall a. Pulse a -> Output
_nodeP Pulse parent
parent0

liftIOLater :: IO () -> Build ()
liftIOLater :: IO () -> Build ()
liftIOLater IO ()
x = forall (m :: * -> *) w r.
(MonadIO m, Monoid w) =>
w -> ReaderWriterIOT r w m ()
RW.tell forall a b. (a -> b) -> a -> b
$ (DependencyChanges, [Output], EvalLW, Maybe (Build ())) -> BuildW
BuildW (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty, IO () -> EvalLW
Action IO ()
x, forall a. Monoid a => a
mempty)

{-----------------------------------------------------------------------------
    EvalL monad
------------------------------------------------------------------------------}
-- | Evaluate a latch (-computation) at the latest time,
-- but discard timestamp information.
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. LatchD a -> EvalL a
_valueL :: forall a. LatchD a -> a
_seenL :: forall a. LatchD a -> Time
..} <- forall (m :: * -> *) a. MonadIO m => Ref a -> m a
Ref.read Latch a
latch
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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. LatchD a -> EvalL a
_valueL :: forall a. LatchD a -> a
_seenL :: forall a. LatchD a -> Time
..} <- forall (m :: * -> *) a. MonadIO m => Ref a -> m a
Ref.read Latch a
latch
    EvalL a
_evalL

{-----------------------------------------------------------------------------
    EvalP monad
------------------------------------------------------------------------------}
runEvalP :: Lazy.Vault -> EvalP a -> Build (a, EvalPW)
runEvalP :: forall a. Vault -> EvalP a -> Build (a, EvalPW)
runEvalP Vault
s1 EvalP a
m = forall (m :: * -> *) w r a.
(MonadIO m, Monoid w) =>
(r -> IO (a, w)) -> ReaderWriterIOT r w m a
RW.readerWriterIOT forall a b. (a -> b) -> a -> b
$ \BuildR
r2 -> do
    (a
a,Vault
_,(EvalPW
w1,BuildW
w2)) <- 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
    forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a,EvalPW
w1), BuildW
w2)

liftBuildP :: Build a -> EvalP a
liftBuildP :: forall a. Build a -> EvalP a
liftBuildP Build a
m = forall (m :: * -> *) w r s a.
(MonadIO m, Monoid w) =>
(r -> s -> IO (a, s, w)) -> RWSIOT r w s m a
RWS.rwsT forall a b. (a -> b) -> a -> b
$ \BuildR
r2 Vault
s -> do
    (a
a,BuildW
w2) <- 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
    forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,Vault
s,(forall a. Monoid a => a
mempty,BuildW
w2))

askTime :: EvalP Time
askTime :: EvalP Time
askTime = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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{Key (Maybe a)
_key :: Key (Maybe a)
_key :: forall a. Pulse a -> Key (Maybe a)
_key} =
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Key a -> Vault -> Maybe a
Lazy.lookup Key (Maybe a)
_key forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall (m :: * -> *) r w s. MonadIO m => RWSIOT r w s m s
RWS.get
    forall (m :: * -> *) s r w. MonadIO m => s -> RWSIOT r w s m ()
RWS.put forall a b. (a -> b) -> a -> b
$ 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 = forall a. Build a -> EvalP a
liftBuildP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Latch a -> Build a
readLatchB

readLatchFutureP :: Latch a -> EvalP (Future a)
readLatchFutureP :: forall a. Latch a -> EvalP (Future a)
readLatchFutureP = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Latch a -> IO a
readLatchIO

rememberLatchUpdate :: IO () -> EvalP ()
rememberLatchUpdate :: IO () -> EvalP ()
rememberLatchUpdate IO ()
x = forall (m :: * -> *) w r s.
(MonadIO m, Monoid w) =>
w -> RWSIOT r w s m ()
RWS.tell ((IO () -> EvalLW
Action IO ()
x,forall a. Monoid a => a
mempty),forall a. Monoid a => a
mempty)

rememberOutput :: (Output, EvalO) -> EvalP ()
rememberOutput :: (Output, EvalO) -> EvalP ()
rememberOutput (Output, EvalO)
x = forall (m :: * -> *) w r s.
(MonadIO m, Monoid w) =>
w -> RWSIOT r w s m ()
RWS.tell ((forall a. Monoid a => a
mempty,[(Output, EvalO)
x]),forall a. Monoid a => a
mempty)

-- worker wrapper to break sharing and support better inlining
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 = 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 = 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