reactive-banana 0.4.0.0 → 0.4.1.0

raw patch · 4 files changed

+60/−22 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• reactive-banana.cabal +1/−1
• src/Reactive/Banana/Implementation.hs +29/−15
• src/Reactive/Banana/Incremental.hs +12/−4
• src/Reactive/Banana/Model.hs +18/−2

@@ -1,5 +1,5 @@ Name:                reactive-banana-Version:             0.4.0.0+Version:             0.4.1.0 Synopsis:            Small but solid library for                      functional reactive programming (FRP). Description:         

@@ -15,7 +15,7 @@     -- * Building event networks with input/output     -- $build     NetworkDescription, compile,-    AddHandler, fromAddHandler, fromPoll, reactimate, liftIO,+    AddHandler, fromAddHandler, fromPoll, reactimate, liftIO, liftIOLater,          -- * Running event networks     EventNetwork, actuate, pause,@@ -27,19 +27,20 @@     module Data.Dynamic,     ) where -import Reactive.Banana.PushIO hiding (compile)-import qualified Reactive.Banana.PushIO as Implementation-import qualified Reactive.Banana.Model as Model- import Control.Applicative+import Control.Concurrent import Control.Monad.RWS  import Data.Dynamic-import Data.List (nub) import Data.IORef+import Data.List (nub) import qualified Data.Map as Map import Data.Unique +import Reactive.Banana.PushIO hiding (compile)+import qualified Reactive.Banana.PushIO as Implementation+import qualified Reactive.Banana.Model as Model+ -- debug = putStrLn  {-----------------------------------------------------------------------------@@ -62,12 +63,15 @@     let paths1 = groupChannelsBy (\p q x -> p x >> q x) paths      -- prepare threading the cache as state-    rcache <- newIORef emptyCache-    writeIORef rcache cache+    rcache <- newEmptyMVar+    putMVar rcache cache     let run m = do-            cache <- readIORef rcache+            -- takeMVar  makes sure that network runs are sequential+            -- In particular, the network will deadlock+            -- if you try to call an event handler during a  reactimate .+            cache <- takeMVar rcache             (_,cache') <- runRun m cache-            writeIORef rcache cache'+            putMVar rcache cache'         paths2 = map (\(i,p) -> (i, run . p)) $ paths1          return paths2@@ -142,7 +146,7 @@ -}  type AddHandler'  = (Channel, AddHandler Universe)-type Preparations = ([Model.Event Flavor (IO ())], [AddHandler'])+type Preparations = ([Model.Event Flavor (IO ())], [AddHandler'], [IO ()])  -- | Monad for describing event networks. -- @@ -166,11 +170,13 @@ instance Applicative (NetworkDescription) where     pure    = Prepare . pure     f <*> a = Prepare $ unPrepare f <*> unPrepare a+instance MonadFix (NetworkDescription) where+    mfix f  = Prepare $ mfix (unPrepare . f)  -- | Output. -- Execute the 'IO' action whenever the event occurs. reactimate :: Model.Event PushIO (IO ()) -> NetworkDescription ()-reactimate e = Prepare $ tell ([e], [])+reactimate e = Prepare $ tell ([e], [], [])  -- | A value of type @AddHandler a@ is just a facility for registering -- callback functions, also known as event handlers.@@ -193,7 +199,7 @@ fromAddHandler addHandler = Prepare $ do         channel <- newChannel         let addHandler' k = addHandler $ k . toUniverse channel-        tell ([], [(channel, addHandler')])+        tell ([], [(channel, addHandler')], [])         return $ input channel     where     newChannel = do c <- get; put $! c+1; return c@@ -213,18 +219,26 @@ fromPoll :: IO a -> NetworkDescription (Model.Behavior PushIO a) fromPoll m = return $ poll m +-- | Lift an 'IO' action into the 'NetworkDescription' monad,+-- but defer its execution until compilation time.+-- This can be useful for recursive definitions using 'MonadFix'.+liftIOLater :: IO () -> NetworkDescription ()+liftIOLater m = Prepare $ tell ([],[], [m])+ -- | Compile a 'NetworkDescription' into an 'EventNetwork' -- that you can 'actuate', 'pause' and so on. compile :: NetworkDescription () -> IO EventNetwork compile (Prepare m) = do-    (_,_,(outputs,inputs)) <- runRWST m () 0+    (_,_,(outputs,inputs,liftIOs)) <- runRWST m () 0+    sequence_ liftIOs          let -- union of all  reactimates         graph = mconcat outputs :: Model.Event Flavor (IO ())     paths <- compileHandlers graph          let -- register event handlers-        register = fmap sequence_ . sequence . map snd . applyChannels inputs $ paths+        register = fmap sequence_ . sequence . map snd . applyChannels inputs+                 $ paths     makeEventNetwork register  -- FIXME: make this faster

@@ -3,6 +3,7 @@          Derived data type, a hybrid between  Event  and  Behavior ------------------------------------------------------------------------------}+{-# LANGUAGE MultiParamTypeClasses #-} module Reactive.Banana.Incremental (     -- * Why a third type Discrete?     -- $discrete@@ -36,7 +37,8 @@ there are many different ways of implementing /incremental computations/. But I don't know a unified theory for them, so-I have decided that the reactive-banana will give /explicit control over updates to the user/+I have decided that the reactive-banana will give+/explicit control over updates to the user/ in the form of specialized data types like 'Discrete', and shall not attempt to bake experimental optimizations into the 'Behavior' type. @@ -44,12 +46,15 @@  * You get explicit control over updates (the 'changes' function), -* but you need to learn a third data type 'Discrete', which almost duplicates the 'Behavior' type.+* but you need to learn a third data type 'Discrete',+which almost duplicates the 'Behavior' type.  * Even though the type 'Behavior' is more fundamental, you will probably use 'Discrete' more often. -That said, 'Discrete' is not a new primitive type, but built from exising types and combinators; you are encouraged to look at the source code.+That said, 'Discrete' is not a new primitive type,+but built from exising types and combinators;+you are encouraged to look at the source code.  If you are an FRP implementor, I encourage you to find a better solution. But if you are a user, you may want to accept the trade-off for now.@@ -90,6 +95,10 @@ applyD :: FRP f => Discrete f (a -> b) -> Event f a -> Event f b applyD = apply . value +-- | Overloading 'applyD'+instance FRP f => Apply (Discrete f) (Event f) where+    (<@>) = applyD+ -- | Functor instance instance FRP f => Functor (Discrete f) where     fmap f r = stepperD (f $ initial r) $ fmap f (changes r)@@ -107,4 +116,3 @@         left  f (_,x) = (f,x)         right x (f,_) = (f,x) -    

@@ -3,7 +3,8 @@          Class interface + Semantic model ------------------------------------------------------------------------------}-{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances, EmptyDataDecls #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances, EmptyDataDecls,+  MultiParamTypeClasses #-} module Reactive.Banana.Model (     -- * Synopsis     -- | Combinators for building event networks and their semantics.@@ -14,7 +15,7 @@     Event, Behavior,     -- $classes     -- * Derived Combinators-    whenE, mapAccum,+    whenE, mapAccum, Apply(..),          -- * Model implementation     Model,@@ -182,6 +183,21 @@ mapAccum :: FRP f => acc -> Event f (acc -> (x,acc)) -> (Event f x, Behavior f acc) mapAccum acc ef = (fst <$> e, stepper acc (snd <$> e))     where e = accumE (undefined,acc) ((. snd) <$> ef)+++infixl 4 <@>, <@++-- | Class for overloading the 'apply' function.+class (Functor f, Functor g) => Apply f g where+    -- | Infix operation for the 'apply' function, similar to '<*>'+    (<@>) :: f (a -> b) -> g a -> g b+    -- | Convenience function, similar to '<*'+    (<@)  :: f a -> g b -> g a+    +    f <@ g = (const <$> f) <@> g ++instance FRP f => Apply (Behavior f) (Event f) where+    (<@>) = apply  {-----------------------------------------------------------------------------     Semantic model