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

import Control.Monad.IO.Class
    ( liftIO )
import qualified Data.Vault.Lazy        as Lazy

import Reactive.Banana.Prim.Mid.Combinators (mapP)
import Reactive.Banana.Prim.Mid.Evaluation  (step)
import Reactive.Banana.Prim.Mid.Plumbing
import Reactive.Banana.Prim.Mid.Types
import qualified Reactive.Banana.Prim.Low.Ref as Ref

debug :: String -> a -> a
debug :: forall a. String -> a -> a
debug String
_ = a -> a
forall a. a -> a
id

{-----------------------------------------------------------------------------
    Primitives connecting to the outside world
------------------------------------------------------------------------------}
-- | Create a new pulse in the network and a function to trigger it.
--
-- Together with 'addHandler', this function can be used to operate with
-- pulses as with standard callback-based events.
newInput :: forall a. Build (Pulse a, a -> Step)
newInput :: forall a. Build (Pulse a, a -> Step)
newInput = mdo
    Pulse ()
always <- Build (Pulse ())
alwaysP
    Key (Maybe a)
_key   <- IO (Key (Maybe a))
-> ReaderWriterIOT BuildR BuildW IO (Key (Maybe a))
forall a. IO a -> ReaderWriterIOT BuildR BuildW IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Key (Maybe a))
forall a. IO (Key a)
Lazy.newKey
    Ref SomeNodeD
nodeP  <- IO (Ref SomeNodeD)
-> ReaderWriterIOT BuildR BuildW IO (Ref SomeNodeD)
forall a. IO a -> ReaderWriterIOT BuildR BuildW IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ref SomeNodeD)
 -> ReaderWriterIOT BuildR BuildW IO (Ref SomeNodeD))
-> IO (Ref SomeNodeD)
-> ReaderWriterIOT BuildR BuildW IO (Ref SomeNodeD)
forall a b. (a -> b) -> a -> b
$ SomeNodeD -> IO (Ref SomeNodeD)
forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
Ref.new (SomeNodeD -> IO (Ref SomeNodeD))
-> SomeNodeD -> IO (Ref SomeNodeD)
forall a b. (a -> b) -> a -> b
$ PulseD a -> SomeNodeD
forall a. PulseD a -> SomeNodeD
P (PulseD a -> SomeNodeD) -> PulseD a -> SomeNodeD
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     = Pulse a -> EvalP (Maybe a)
forall a. Pulse a -> EvalP (Maybe a)
readPulseP Pulse a
pulse    -- get its own value
        , _nameP :: String
_nameP     = String
"newInput"
        }
    let pulse :: Pulse a
pulse = Pulse{Key (Maybe a)
_key :: Key (Maybe a)
_key :: Key (Maybe a)
_key,_nodeP :: Ref SomeNodeD
_nodeP=Ref SomeNodeD
nodeP}
    -- Also add the  alwaysP  pulse to the inputs.
    let run :: a -> Step
        run :: a -> Step
run a
a = Inputs -> Step
step ([Ref SomeNodeD
nodeP, Pulse () -> Ref SomeNodeD
forall a. Pulse a -> Ref SomeNodeD
_nodeP Pulse ()
always], Key (Maybe a) -> Maybe a -> Vault -> Vault
forall a. Key a -> a -> Vault -> Vault
Lazy.insert Key (Maybe a)
_key (a -> Maybe a
forall a. a -> Maybe a
Just a
a) Vault
Lazy.empty)
    (Pulse a, a -> Step) -> Build (Pulse a, a -> Step)
forall a. a -> ReaderWriterIOT BuildR BuildW IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pulse a
pulse, a -> Step
run)

-- | Register a handler to be executed whenever a pulse occurs.
--
-- The pulse may refer to future latch values.
addHandler :: Pulse (Future a) -> (a -> IO ()) -> Build ()
addHandler :: forall a. Pulse (Future a) -> (a -> IO ()) -> Build ()
addHandler Pulse (Future a)
p1 a -> IO ()
f = do
    Pulse (IO (IO ()))
p2 <- (Future a -> IO (IO ()))
-> Pulse (Future a) -> Build (Pulse (IO (IO ())))
forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
mapP ((a -> IO ()) -> Future a -> IO (IO ())
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> IO ()
f) Pulse (Future a)
p1
    Pulse (IO (IO ())) -> Build ()
addOutput Pulse (IO (IO ()))
p2

-- | Read the value of a 'Latch' at a particular moment in time.
readLatch :: Latch a -> Build a
readLatch :: forall a. Latch a -> Build a
readLatch = Latch a -> Build a
forall a. Latch a -> Build a
readLatchB