eternal 0.0.8 → 0.0.9

raw patch · 3 files changed

+78/−1 lines, 3 files

Files

• eternal.cabal +2/−1
• src/Control/Eternal.hs +2/−0
• src/Control/Eternal/Reactive.hs +74/−0

@@ -1,6 +1,6 @@ name:       eternal
 category:   Control
-version:    0.0.8
+version:    0.0.9
 author:        Heather Cynede
 maintainer:    Heather Cynede <Cynede@Gentoo.org>
 license: BSD3
@@ -23,6 +23,7 @@     Control.Eternal.String
     Control.Eternal.System
     Control.Eternal.Algorithms
+    Control.Eternal.Reactive
     
     Control.Eternal.Syntax.Operators
     Control.Eternal.Syntax.Lift

@@ -3,9 +3,11 @@   , module Control.Eternal.String
   , module Control.Eternal.System
   , module Control.Eternal.Algorithms
+  , module Control.Eternal.Reactive
   ) where
 
 import Control.Eternal.Syntax
 import Control.Eternal.String
 import Control.Eternal.System
 import Control.Eternal.Algorithms
+import Control.Eternal.Reactive

@@ -0,0 +1,74 @@+{-# LANGUAGE RankNTypes, GADTs, ScopedTypeVariables, LambdaCase #-}++module Control.Eternal.Reactive +	( Action+	, Request+	, reactiveObjectIO+    , Sink+    , pauseIO+    , reactiveIO+	) where++-- |+-- Module: Control.Eternal.Reactive+-- Copyright: Andy Gill (??-2008), Heather Cynede (2014)+-- License: BSD3+-- |++import Control.Concurrent.Chan+import Control.Concurrent+import Control.Exception as Ex++-- An action is an IO-based change to an explicit state+type Action s    = s -> IO s	 -- only state change+type Request s a = s -> IO (s,a) -- state change + reply to be passed back to caller++-- Choices:+--   * do the Requests see the failure+--   * Actions do not see anything+--   * +data Msg s = Act (Action s)+           | forall a . Req (Request s a) (MVar a)+           | Done (MVar ())++reactiveObjectIO+    :: forall state object. state+    -> (    ThreadId +            -> (forall r. Request state r -> IO r) 	-- requests+            -> (Action state -> IO ()) 	            -- actions+            -> IO ()				                -- done+            -> object+       ) -> IO object+reactiveObjectIO state mkObject = do+    chan <- newChan+    let dispatch st = +         readChan chan >>= \case Act act     -> do state1 <- act st+                                                   dispatch $! state1+                                 Req req box -> do (state1,ret) <- req st+                                                   putMVar box ret+                                                   dispatch $! state1+                                 Done box    -> do putMVar box ()+                                                   return ()+        requestit :: forall r. Request state r -> IO r+        requestit fun = do ret <- newEmptyMVar+                           writeChan chan $ Req fun ret+                           takeMVar ret -- wait+        actionit act = writeChan chan $ Act act+        doneit = do ret <- newEmptyMVar+                    writeChan chan $ Done ret+                    takeMVar ret -- wait+    pid <- forkIO $ dispatch state+    return (mkObject pid requestit actionit doneit)++type Sink a = a -> IO ()++-- This turns a reactive style call into a pausing IO call.+pauseIO :: (a -> Sink b -> IO ()) -> a -> IO b+pauseIO fn a = do var <- newEmptyMVar+                  forkIO $ do fn a (\ b -> putMVar var b)+                  takeMVar var++-- This turns a pausing IO call into a reactive style call.+reactiveIO :: (a -> IO b) -> a -> Sink b -> IO ()+reactiveIO fn a sinkB = do forkIO $ sinkB =<< fn a+                           return ()