summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHeather <>2014-09-23 06:13:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-09-23 06:13:00 (GMT)
commita17c7f590f593cd5ec853ddf0ec48343b14621cf (patch)
tree024799273f99f5e56eca46df3b5b2b25276b5079
version 0.0.1HEAD0.0.1master
-rw-r--r--Control/Concurrent/Reactive.hs90
-rw-r--r--LICENSE25
-rw-r--r--Setup.hs2
-rw-r--r--reactive-haskell.cabal16
4 files changed, 133 insertions, 0 deletions
diff --git a/Control/Concurrent/Reactive.hs b/Control/Concurrent/Reactive.hs
new file mode 100644
index 0000000..e0cacc9
--- /dev/null
+++ b/Control/Concurrent/Reactive.hs
@@ -0,0 +1,90 @@
+{-# LANGUAGE RankNTypes, GADTs, ScopedTypeVariables, LambdaCase #-}
+
+-- |
+-- Module: Data.Concurrent.Reactive
+-- Copyright: Andy Gill (??-2008), Heather Cynede (2014)
+-- License: BSD3
+-- |
+
+module Control.Concurrent.Reactive
+ ( Action
+ , Request
+ , reactiveObjectIO
+ , Sink
+ , pauseIO
+ , reactiveIO
+ ) where
+
+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
+
+-- This is the 'forkIO' of the O'Haskell Object sub-system.
+-- To consider; how do we handle proper exceptions?
+-- we need to bullet-proof this for exception!
+
+-- 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
+ -- We return the pid, so you can build a hard-abort function
+ -- we need to think about this; how do you abort an object
+ -- the state is passed as the argument, watch for strictness issues.
+ let dispatch state =
+ readChan chan >>= \case Act act -> do state1 <- act state
+ dispatch $! state1
+ Req req box -> do (state1,ret) <- req state
+ putMVar box ret
+ dispatch $! state1
+ Done box -> do putMVar box ()
+ return () -- no looping; we are done
+ pid <- forkIO $ dispatch state
+
+ -- This trick of using a return MVar is straight from Johan's PhD.
+ let requestit :: forall r. Request state r -> IO r
+ requestit fun = do
+ ret <- newEmptyMVar
+ writeChan chan $ Req fun ret
+ takeMVar ret -- wait for the object to react
+ actionit act = writeChan chan $ Act act
+ doneit = do
+ ret <- newEmptyMVar
+ writeChan chan $ Done ret
+ takeMVar ret -- wait for the object to *finish*
+
+ return (mkObject pid requestit actionit doneit)
+
+-- From Conal; a Sink is a object into which things are thrown.
+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 ()
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..1cb393f
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,25 @@
+Copyright (c) 2008 Andy Gill
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+3. The names of the authors may not be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/reactive-haskell.cabal b/reactive-haskell.cabal
new file mode 100644
index 0000000..ffd6ef3
--- /dev/null
+++ b/reactive-haskell.cabal
@@ -0,0 +1,16 @@
+Name: reactive-haskell
+Version: 0.0.1
+
+Synopsis: minimal fork of io-reactive
+Description: API for generating reactive objects
+Category: Control, Reactivity
+
+License: BSD3
+License-file: LICENSE
+
+Author: Andy Gill, Heather Cynede
+Maintainer: Heather Cynede <heather@live.ru>
+
+Build-Depends: base >= 4.3 && < 5
+Exposed-Modules: Control.Concurrent.Reactive
+build-type: Simple