sodium 0.2.0.0 → 0.3.0.0

raw patch · 4 files changed

+126/−31 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• examples/tests.hs +47/−2
• sodium.cabal +12/−6
• src/FRP/Sodium.hs +1/−0
• src/FRP/Sodium/Impl.hs +66/−23

@@ -116,7 +116,7 @@     assertEqual "beh3" ["init", "second"] =<< readIORef outRef  -- | This demonstrates the fact that if there are multiple updates to a behaviour--- in a given transaction, the second one prevails.+-- in a given transaction, the last one prevails. beh4 = TestCase $ do     (ea :: Event M String, push) <- newEvent     outRef <- newIORef []@@ -354,6 +354,8 @@     synchronously $ push 'A'     synchronously $ push 'M'     synchronously $ push 'T'+    -- Flush processing on partition N before unlistening+    synchronously (return () :: Reactive N ())     unlisten     assertEqual "crossE1" "AMT" =<< readIORef outRef @@ -367,6 +369,8 @@     synchronously $ push 'C'     synchronously $ push 'D'     synchronously $ push 'E'+    -- Flush processing on partition N before unlistening+    synchronously (return () :: Reactive N ())     unlisten     assertEqual "cross1" "BCDE" =<< readIORef outRef @@ -380,6 +384,8 @@     synchronously $ push 'C'     synchronously $ push 'D'     synchronously $ push 'E'+    -- Flush processing on partition N before unlistening+    synchronously (return () :: Reactive N ())     unlisten     assertEqual "cross1" "ABCDE" =<< readIORef outRef @@ -400,9 +406,48 @@     unlisten     assertEqual "cycle1" "abc" =<< readIORef outRef +mergeWith1 = TestCase $ do+    outRef <- newIORef []+    (ea :: Event M Int, pushA) <- newEvent+    (eb :: Event M Int, pushB) <- newEvent+    unlisten <- synchronously $ do+        pushA 5+        listenIO (mergeWith (+) ea eb) $ \o -> modifyIORef outRef (++ [o])+    synchronously $ pushA 2+    synchronously $ pushB 3+    synchronously $ pushA 10 >> pushB 4+    synchronously $ pushB 7 >> pushA 1+    unlisten+    assertEqual "mergeWith1" [5,2,3,14,8] =<< readIORef outRef++mergeWith2 = TestCase $ do+    outRef <- newIORef []+    (ea :: Event M Int, pushA) <- newEvent+    (eb :: Event M Int, pushB) <- newEvent+    unlisten <- synchronously $ do+        pushA 5+        unlisten <- listenIO (mergeWith (+) ea eb) $ \o -> modifyIORef outRef (++ [o])+        pushB 99+        return unlisten+    unlisten+    assertEqual "mergeWith2" [104] =<< readIORef outRef++mergeWith3 = TestCase $ do+    outRef <- newIORef []+    (ea :: Event M Int, pushA) <- newEvent+    (eb :: Event M Int, pushB) <- newEvent+    unlisten <- synchronously $ do+        listenIO (mergeWith (+) ea eb) $ \o -> modifyIORef outRef (++ [o])+    synchronously $ pushA 2+    synchronously $ pushB 3 >> pushB 1 >> pushA 10+    synchronously $ pushB 9 >> pushB 11 >> pushB 12+    synchronously $ pushA 32 >> pushA 11 >> pushA 12+    unlisten+    assertEqual "mergeWith3" [2,14,32,55] =<< readIORef outRef+ tests = test [ event1, fmap1, merge1, justE1, filterE1, beh1, beh2, beh3, beh4, beh5, beh6,     appl1, appl2, attach1, count1, collect1, collect2, collectE1, collectE2, switchE1,-    switch1, once1, once2, crossE1, cross1, cross2, cycle1 ]+    switch1, once1, once2, crossE1, cross1, cross2, cycle1, mergeWith1, mergeWith2, mergeWith3 ]  main = {-forever $-} runTestTT tests 

@@ -1,15 +1,16 @@ name:                sodium-version:             0.2.0.0+version:             0.3.0.0 synopsis:            Sodium Reactive Programming (FRP) System description:         -  A general purpose Reactive Programming (FRP) system intended for \'industrial strength\'-  applications. It's a translation of a C++ implementation used for data acquisition, so-  the design, at least, has had some real-world testing.+  A general purpose Reactive Programming (FRP) system.   .+   * Goals include simplicity and completeness, but it is currently not built for speed.+  .    * Applicative style: Event implements Functor and Behaviour implements Applicative.   .    * FRP logic is tied to partitions, within which consistency is guaranteed.-     This allows you to selectively relax consistency guarantees to facilitate parallelism.+     This concept allows you to selectively relax consistency guarantees to+     facilitate parallelism.   .    * Instead of the common approach where inputs are fed into the front of a monolithic      \'reactimate\', Sodium allows you to push inputs in from scattered places in IO.@@ -21,7 +22,8 @@   .   See the /examples/ directory for test cases and examples.   .-  Changes: 0.2.0.0 fix some value recursion deadlocks and improve docs.+  Changes: 0.2.0.0 fix some value recursion deadlocks and improve docs;+           0.3.0.0 add mergeWith, make cross asynchronous license:             BSD3 license-file:        LICENSE author:              Stephen Blackheath@@ -35,6 +37,10 @@                      examples/poodle/Engine.hs                      examples/poodle/Image.hs                      examples/poodle/poodle.png++source-repository head+  type:     git+  location: https://github.com/the-real-blackh/sodium  library   hs-source-dirs:      src

@@ -61,6 +61,7 @@         Behavior,         never,         merge,+        mergeWith,         justE,         hold,         valueEvent,

@@ -78,14 +78,6 @@ schedulePriority1 :: Reactive p () -> Reactive p () schedulePriority1 task = Reactive $ modify $ \as -> as { asQueue1 = asQueue1 as |> task } --- | Queue the specified atomic to run at the end of the priority 2 queue-schedulePriority2 :: Int64 -> Reactive p () -> Reactive p ()-schedulePriority2 priority task = Reactive $ modify $ \as -> as {-        asQueue2 = M.alter (\mOldTask -> Just $ case mOldTask of-                Just oldTask -> oldTask >> task-                Nothing      -> task) priority (asQueue2 as)-    }- onFinal :: IO () -> Reactive p () onFinal task = Reactive $ modify $ \as -> as { asFinal = asFinal as >> task } @@ -205,12 +197,13 @@     l <- getListen ev     runListen l mMvTarget handle --- | Listen for firings of this event. The returned @IO ()@ is an IO action--- that unregisters the listener. This is the observer pattern.+-- | Variant of 'listenIO' that allows you to initiate more activity in the current+-- transaction. Useful for implementing new primitives. listen :: Event p a -> (a -> Reactive p ()) -> Reactive p (IO ()) listen ev handle = linkedListen ev Nothing handle --- | Variant of 'listen' that takes an IO action.+-- | Listen for firings of this event. The returned @IO ()@ is an IO action+-- that unregisters the listener. This is the observer pattern. listenIO :: Event p a -> (a -> IO ()) -> Reactive p (IO ()) listenIO ev handle = listen ev (ioReactive . handle) @@ -320,7 +313,7 @@     return (ev, push)  instance Functor (Event p) where-    f `fmap` (Event getListen cacheRef) = Event getListen' cacheRef+    f `fmap` Event getListen cacheRef = Event getListen' cacheRef       where         cacheRef = unsafePerformIO $ newIORef Nothing         getListen' = do@@ -329,18 +322,57 @@                 runListen l mMvNode (handle . f)  -- | Merge two streams of events of the same type.+--+-- In the case where two event occurrences are simultaneous (i.e. both+-- within the same transaction), both will be delivered in the same+-- transaction.+--+-- The order is not defined, because simultaneous events should be considered+-- to be order-agnostic. merge :: Typeable p => Event p a -> Event p a -> Event p a merge ea eb = Event gl cacheRef   where     cacheRef = unsafePerformIO $ newIORef Nothing     gl = do         l1 <- getListen ea-        l2 <- getListen eb+        l2 <- getListen eb                                         (l, push, mvNode) <- ioReactive newSink         unlistener1 <- unlistenize $ runListen l1 (Just mvNode) push         unlistener2 <- unlistenize $ runListen l2 (Just mvNode) push         (finalerize unlistener1 <=< finalerize unlistener2) l +-- | Merge two streams of events of the same type, combining simultaneous+-- event occurrences.+--+-- In the case where multiple event occurrences are simultaneous (i.e. all+-- within the same transaction), they are combined using the supplied+-- function. The output event is guaranteed not to have more than one+-- event occurrence per transaction.+--+-- The combine function should be commutative, because simultaneous events+-- should be considered to be order-agnostic.+mergeWith :: Typeable p => (a -> a -> a) -> Event p a -> Event p a -> Event p a+mergeWith f ea eb = Event gl cacheRef+  where+    cacheRef = unsafePerformIO $ newIORef Nothing+    gl = do+        l1 <- getListen ea+        l2 <- getListen eb+        (l, push, mvNode) <- ioReactive newSink+        outRef <- ioReactive $ newIORef Nothing+        let process a = do+                mOut <- ioReactive $ readIORef outRef+                ioReactive $ modifyIORef outRef $ \mOut -> Just $ case mOut of+                    Just out -> f out a+                    Nothing  -> a+                when (isNothing mOut) $ schedulePriority2 (Just mvNode) $ do+                    Just out <- ioReactive $ readIORef outRef+                    ioReactive $ writeIORef outRef Nothing+                    push out+        unlistener1 <- unlistenize $ runListen l1 (Just mvNode) process+        unlistener2 <- unlistenize $ runListen l2 (Just mvNode) process+        (finalerize unlistener1 <=< finalerize unlistener2) l+ -- | Unwrap Just values, and discard event occurrences with Nothing values. justE :: Typeable p => Event p (Maybe a) -> Event p a justE ema = Event gl cacheRef@@ -485,6 +517,21 @@     handle a     linkedListen (underlyingEvent ba) mMvNode handle +-- | Queue the specified atomic to run at the end of the priority 2 queue+schedulePriority2 :: Maybe (MVar (Node p))+                  -> Reactive p ()+                  -> Reactive p ()+schedulePriority2 mMvNode task = do+    mNode <- case mMvNode of+        Just mvNode -> Just <$> ioReactive (readMVar mvNode)+        Nothing -> pure Nothing+    let priority = maybe maxBound noSerial mNode+    Reactive $ modify $ \as -> as {+            asQueue2 = M.alter (\mOldTask -> Just $ case mOldTask of+                    Just oldTask -> oldTask >> task+                    Nothing      -> task) priority (asQueue2 as)+        }+ -- Clean up the listener so it gives only one value per transaction, specifically -- the last one.                 tidy :: (Maybe (MVar (Node p)) -> (a -> Reactive p ()) -> Reactive p (IO ()))@@ -494,12 +541,7 @@     listen mMvNode $ \a -> do         ma <- ioReactive $ readIORef aRef         ioReactive $ writeIORef aRef (Just a)-        priority <- case mMvNode of-            Just mvNode -> do-                node <- ioReactive $ readMVar mvNode-                return (noSerial node)-            Nothing -> return maxBound-        when (isNothing ma) $ schedulePriority2 priority $ do+        when (isNothing ma) $ schedulePriority2 mMvNode $ do             Just a <- ioReactive $ readIORef aRef             ioReactive $ writeIORef aRef Nothing             handle a@@ -509,12 +551,13 @@ linkedListenValue :: Behaviour p a -> Maybe (MVar (Node p)) -> (a -> Reactive p ()) -> Reactive p (IO ()) linkedListenValue ba = tidy (listenValueRaw ba) --- | Listen to the value of this behaviour with a guaranteed initial callback--- giving the current value, followed by callbacks for any updates. +-- | Variant of 'listenValueIO' that allows you to initiate more activity in the current+-- transaction. Useful for implementing new primitives. listenValue :: Behaviour p a -> (a -> Reactive p ()) -> Reactive p (IO ()) listenValue ba = linkedListenValue ba Nothing --- | Variant of 'listenValue' that takes an IO action.+-- | Listen to the value of this behaviour with a guaranteed initial callback+-- giving the current value, followed by callbacks for any updates.  listenValueIO :: Behaviour p a -> (a -> IO ()) -> Reactive p (IO ()) listenValueIO ba handle = listenValue ba (ioReactive . handle) @@ -686,7 +729,7 @@ crossE :: (Typeable p, Typeable q) => Event p a -> Reactive p (Event q a) crossE epa = do     (ev, push) <- ioReactive newEvent-    unlisten <- listenIO epa $ synchronously . push+    unlisten <- listenIO epa $ asynchronously . push     return $ finalizeEvent ev unlisten  -- | Cross the specified behaviour over to a different partition.