reactivity 0.3.2.1 → 0.3.2.3

raw patch · 4 files changed

+15/−14 lines, 4 files

Files

• reactivity.cabal +2/−2
• src/Control/CUtils/Conc.hs +6/−3
• src/FRP/Reactivity/AlternateEvent.hs +5/−2
• src/FRP/Reactivity/Combinators.hs +2/−7

@@ -1,5 +1,5 @@ Name:                reactivity-Version:             0.3.2.1+Version:             0.3.2.3 Synopsis:            An alternate implementation of push-pull FRP. Category:            reactivity, FRP Description:         An alternate implementation of push-pull FRP. This is based on the Reactive package (http://haskell.org/haskellwiki/reactive) (and the sources have been made available in accordance with the GPL [license] of that package).@@ -28,9 +28,9 @@     }     Hs-Source-Dirs:      src     Exposed-Modules:-        FRP.Reactivity.AlternateEvent         FRP.Reactivity.Measurement         FRP.Reactivity.MeasurementWrapper+        FRP.Reactivity.AlternateEvent         FRP.Reactivity.RPC         FRP.Reactivity.Combinators         Data.WeakDict

@@ -1,4 +1,4 @@-{-# LANGUAGE Trustworthy, ScopedTypeVariables, DeriveDataTypeable, ImplicitParams, FlexibleInstances #-}
+{-# LANGUAGE Trustworthy, ScopedTypeVariables, DeriveDataTypeable, ImplicitParams, FlexibleInstances, FlexibleContexts #-}
 -- | A module of concurrent higher order functions.
 module Control.CUtils.Conc (ExceptionList(..), ConcException(..), assocFold, Concurrent(..), concF_, concF, conc_, conc, concP, progressConcF, oneOfF, oneOf) where
 
@@ -99,20 +99,23 @@ -- '->' has no effects, but one can compute its results in parallel anyway (pointlessly,
 -- in the case of 'arr_concF_').
 instance Concurrent (->) where
-	arr_assocFold f g x = unsafePerformIO $ assocFold (\x y -> return $! f (x, y)) g x
+	arr_assocFold f g (x, ar) = unsafePerformIO $ assocFold (\x y -> return $! f (x, y)) g x ar
 	arr_concF_ _ = arr (const ())
 	arr_concF mnds (parm, n) = let ?seq = True in unsafePerformIO $ concF n ((return $!) . mnds . (,) parm)
 	arr_oneOfF mnds (parm, n) = unsafePerformIO $ oneOfF n ((return $!) . mnds . (,) parm)
 
 -- |
-assocFold f g = runKleisli (arr_assocFold (Kleisli (uncurry f)) g)
+assocFold :: (t -> t -> IO t) -> (u -> t) -> t -> Array Int u -> IO t
+assocFold f g = curry (runKleisli (arr_assocFold (Kleisli (uncurry f)) g))
 
 partConc_ f mnds = concF_ (rangeSize (bounds mnds)) $ f . (+ fst (bounds mnds))
 
 -- |
+concF_ :: (?seq::Bool) => Int -> (Int -> IO ()) -> IO ()
 concF_ n mnds = runKleisli (arr_concF_ (Kleisli (mnds . snd))) ((), n)
 
 -- |
+concF :: (?seq::Bool) => Int -> (Int -> IO t) -> IO (Array Int t)
 concF n mnds = runKleisli (arr_concF (Kleisli (mnds . snd))) ((), n)
 
 -- |

@@ -36,7 +36,7 @@ {-# INLINE[0] eFromML #-}
 -- | Extracts an 'Event' from a list of measurements. No attempt has been made to sync up
 -- the time order of different calls to 'eFromML'. For this reason, it is not true that
--- "eFromML ml `mplus` eFromML ml2" equals "eFromML (ml `mergeStreams` ml2)"; please do any necessary
+-- "eFromML ml `mplus` eFromML ml2" equals "eFromML (ml `merge` ml2)"; please do any necessary
 -- syncing before calling 'eFromML'.
 eFromML :: [Measurement t] -> Event t
 eFromML ls = Event (\f -> liftM (_nonDispatchedIO . killThread) $ rpcFork (mapM_ (\meas -> _nonDispatchedIO (getValue meas) >>= uncurry f) ls))
@@ -70,7 +70,10 @@ 
 -- | Run an event -- see .Basic module for a way to run with a Windows event loop.
 runEvent :: Event t -> (t -> POSIXTime -> IO ()) -> IO ()
-runEvent e f = void $ runReaderT (unRPC $ unEvent e (\x t -> liftIO (f x t))) (False, undefined)
+runEvent e f = void $ do
+	mv <- newEmptyMVar
+	forkIO $ void $ runReaderT (unRPC $ unEvent e (\x t -> liftIO (f x t))) (False, mv)
+	rpcServer mv
 
 instance Applicative Event where
 	pure = return

@@ -7,7 +7,7 @@ -- * Derived event combinators
 tick, untilE, eitherOf, holdE, zipE, simultE, intersectE, differenceE, unionE, filterE, justE, duplicateE, withPrev, calmE, count, takeE, dropE, once, everyNth, slowE, rests, startAt, splitE,
 -- * Reactive behaviors
-Behavior, extractB, duplicateB, time, sampleAt, switcher, stepper, snapshot, flipFlop, history, scanB, delayB, slow, monoid, throttle, sumE, derivative, supersample, integral, threshold) where
+Behavior, extractB, duplicateB, time, switcher, stepper, snapshot, flipFlop, history, scanB, delayB, slow, monoid, throttle, sumE, derivative, supersample, integral, threshold) where
 
 import Control.Monad
 import Control.Monad.Fix
@@ -22,13 +22,12 @@ import Data.Function
 import qualified Data.Map as M
 import Data.IORef
-import FRP.Reactivity.MeasurementWrapper
 import FRP.Reactivity.AlternateEvent
 import Data.Time.Clock.POSIX
 
 -- | A convenience to generate a tick on a regular interval.
 {-# INLINE tick #-}
-tick start t = eventFromList (map (\t -> (t, t)) [start,start+t..])
+tick time t = eventFromList (map (\t -> (t, t)) [time,time+t..])
 
 -- | This functional can be used to terminate an event early.
 {-# INLINE untilE #-}
@@ -178,10 +177,6 @@ {-# INLINE time #-}
 time :: (MonadPlus e) => Behavior e POSIXTime
 time = Switcher id mzero
-
-{-# INLINE sampleAt #-}
-sampleAt :: Behavior MeasurementWrapper t -> POSIXTime -> t
-sampleAt beh t = snd $ extractMW $ snapshot (eventFromList [((), t)]) beh
 
 {-# INLINE switcher #-} 
 switcher (Switcher f e) e2 = Switcher f (switch $ return e `mplus` fmap (\(Switcher f e) -> return f `mplus` e) e2)