IO.hs

{-----------------------------------------------------------------------------
    reactive-banana
------------------------------------------------------------------------------}
module Reactive.Banana.Prim.IO where

import           Data.Functor
import           Data.Unique.Really
import qualified Data.Vault.Strict  as Strict
import qualified Data.Vault.Lazy    as Lazy
import           System.IO.Unsafe             (unsafePerformIO)

import Reactive.Banana.Prim.Combinators  (mapP)
import Reactive.Banana.Prim.Dependencies (maybeContinue)
import Reactive.Banana.Prim.Evaluation   (step)
import Reactive.Banana.Prim.Plumbing
import Reactive.Banana.Prim.Types

debug s = 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 :: Lazy.Key a -> Build (Pulse a, a -> Step)
newInput key = unsafePerformIO $ do
    uid <- newUnique
    let pulse = Pulse
            { evaluateP = maybeContinue <$> readPulseP pulse
            , getValueP = Lazy.lookup key
            , uidP      = uid
            , nameP     = "newInput"
            }
    return $ do
        always <- alwaysP
        let inputs a = (Lazy.insert key a Lazy.empty, [P pulse, P always])
        return (pulse, step . inputs)

-- | 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 p1 f = do
    p2 <- mapP (fmap f) p1
    addOutput p2

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