From a17c7f590f593cd5ec853ddf0ec48343b14621cf Mon Sep 17 00:00:00 2001 From: Heather <> Date: Tue, 23 Sep 2014 08:13:00 +0200 Subject: version 0.0.1 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 + +Build-Depends: base >= 4.3 && < 5 +Exposed-Modules: Control.Concurrent.Reactive +build-type: Simple -- cgit v0.10.2