module FRP.Grapefruit.Circuit (
Circuit,
act,
putSetup,
create
) where
import Prelude (($), (>>), IO, flip, return)
import qualified Prelude
import Control.Arrow as Arrow
import Control.Arrow.Operations as ArrowOperations
import Control.Arrow.Transformer as ArrowTransformer
import Control.Arrow.Transformer.Reader as ReaderArrow
import Control.Arrow.Transformer.Writer as WriterArrow
import Control.Concurrent.MVar as MVar
import Data.Unique as Unique
import FRP.Grapefruit.Setup as Setup
import Internal.Circuit as Circuit
act :: Circuit era (IO output) output
act = Circuit $ (lift >>> lift >>> lift) (Kleisli Prelude.id)
putSetup :: Circuit era Setup ()
putSetup = Circuit $ (lift >>> lift) write
create :: (forall era. Circuit era i o) -> i -> IO (o,IO ())
create circuit input = do
startTimeID <- newUnique
ecFinalizerVar <- newMVar (return ())
(output,setup) <- runCircuitArrow (polyCircuitArrow circuit)
startTimeID
ecFinalizerVar
input
finalize <- Setup.run setup
return (output,finalize)
polyCircuitArrow :: (forall era. Circuit era input output) -> CircuitArrow input output
polyCircuitArrow plainCircuit = circuitArrow plainCircuit
circuitArrow :: Circuit era input output -> CircuitArrow input output
circuitArrow (Circuit circuitArrow) = circuitArrow
runCircuitArrow :: CircuitArrow input output
-> Unique
-> MVar (IO ())
-> input
-> IO (output,Setup)
runCircuitArrow circuitArrow startTimeID ecFinalizerVar input = run where
run = runKleisli ioArrow input
ioArrow = runWriter setupWriterArrow
setupWriterArrow = arr (flip (,) ecFinalizerVar) >>> runReader ecFinVarReaderArrow
ecFinVarReaderArrow = arr (flip (,) startTimeID) >>> runReader circuitArrow