module Internal.Circuit (
Circuit (Circuit),
CircuitArrow,
getECFinalizerAdd,
getECFinalization,
getStartTimeID
) where
#if __GLASGOW_HASKELL__ >= 610
import Control.Category as Category
#endif
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
newtype Circuit era i o = Circuit (CircuitArrow i o)
deriving (
#if __GLASGOW_HASKELL__ >= 610
Category,
#endif
Arrow,
ArrowLoop,
ArrowApply
)
type CircuitArrow = ReaderArrow Unique ECFinVarReaderArrow
type ECFinVarReaderArrow = ReaderArrow (MVar (IO ())) SetupWriterArrow
type SetupWriterArrow = WriterArrow Setup IOArrow
type IOArrow = Kleisli IO
getECFinalizerAdd :: Circuit era () (IO () -> IO ())
getECFinalizerAdd = Circuit $
lift $
readState >>> arr addFinalizer where
addFinalizer finalizerVar finalizer = modifyMVar_ finalizerVar ((>> finalizer) >>> return)
getECFinalization :: Circuit era () (IO ())
getECFinalization = Circuit $
lift $
readState >>> arr (\finalizerVar -> do
finalizer <- takeMVar finalizerVar
putMVar finalizerVar (return ())
finalizer)
getStartTimeID :: Circuit era () Unique
getStartTimeID = Circuit $ readState