reactive-banana 0.4.1.1 → 0.4.2.0

raw patch · 4 files changed

+44/−90 lines, 4 filesdep +vaultdep −monads-tfdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: vault

Dependencies removed: monads-tf

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• reactive-banana.cabal +6/−6
• src/Reactive/Banana/Implementation.hs +11/−6
• src/Reactive/Banana/PushIO.hs +27/−20
• src/Reactive/Banana/Vault.hs +0/−58

@@ -1,5 +1,5 @@ Name:                reactive-banana-Version:             0.4.1.1+Version:             0.4.2.0 Synopsis:            Small but solid library for                      functional reactive programming (FRP). Description:         @@ -49,16 +49,16 @@                         Rank2Types, NoMonomorphismRestriction,                         DeriveDataTypeable     build-depends:-        base >= 4.2 && < 4.4, containers == 0.4.*,-        monads-tf == 0.1.*, transformers == 0.2.*,-        QuickCheck == 2.4.*+        base >= 4.3 && < 5, containers == 0.4.*,+        transformers == 0.2.*,+        QuickCheck == 2.4.*,+        vault == 0.1.*     exposed-modules:    Reactive.Banana,                         Reactive.Banana.Incremental,                         Reactive.Banana.Model,                         Reactive.Banana.Implementation,                         Reactive.Banana.Tests-    other-modules:      Reactive.Banana.PushIO,-                        Reactive.Banana.Vault+    other-modules:      Reactive.Banana.PushIO  Source-repository head     type:               git

@@ -29,11 +29,15 @@  import Control.Applicative import Control.Concurrent-import Control.Monad.RWS+import Control.Monad+import Control.Monad.Fix       (MonadFix(..))+import Control.Monad.IO.Class  (MonadIO(..))+import Control.Monad.Trans.RWS  import Data.Dynamic import Data.IORef import Data.List (nub)+import Data.Monoid import qualified Data.Map as Map import Data.Unique @@ -51,8 +55,8 @@ poll :: IO a -> Model.Behavior Flavor a poll = behavior . Poll -input :: Typeable a => Channel -> Model.Event Flavor a-input = event . Input+input :: Channel -> Key a -> Model.Event Flavor a+input c = event . Input c  compileHandlers :: Model.Event Flavor (IO ()) -> IO [(Channel, Universe -> IO ())] compileHandlers graph = do@@ -195,12 +199,13 @@ -- When the event network is actuated, -- this will register a callback function such that -- an event will occur whenever the callback function is called.-fromAddHandler :: Typeable a => AddHandler a -> NetworkDescription (Model.Event PushIO a)+fromAddHandler :: AddHandler a -> NetworkDescription (Model.Event PushIO a) fromAddHandler addHandler = Prepare $ do         channel <- newChannel-        let addHandler' k = addHandler $ k . toUniverse channel+        key     <- liftIO $ newUniverseKey+        let addHandler' k = addHandler $ k . toUniverse key         tell ([], [(channel, addHandler')], [])-        return $ input channel+        return $ input channel key     where     newChannel = do c <- get; put $! c+1; return c 

@@ -10,14 +10,17 @@ import Reactive.Banana.Model hiding (Event, Behavior, interpret) import qualified Reactive.Banana.Model as Model -import Reactive.Banana.Vault (Vault)-import qualified Reactive.Banana.Vault as Vault+import Data.Vault (Vault)+import qualified Data.Vault as Vault   import Control.Applicative+import Control.Monad+import Control.Monad.IO.Class       (liftIO)+import Control.Monad.Trans.Class    (lift) import Control.Monad.Trans.Identity-import Control.Monad.State-import Control.Monad.Writer+import Control.Monad.Trans.State+import Control.Monad.Trans.Writer import Data.Dynamic import Data.IORef import Data.Maybe@@ -98,9 +101,9 @@ -- helper functions for reading and writing keys into the vault cache writeVaultKey ref x = do     vault  <- get-    vault' <- liftIO $ Vault.insert ref x vault+    let vault' = Vault.insert ref x vault     put $ vault'-readVaultKey ref = liftIO . Vault.lookup ref =<< get+readVaultKey ref = Vault.lookup ref <$> get  {-----------------------------------------------------------------------------     Cache, particular reference types@@ -115,7 +118,7 @@  newCacheRef      = do     key <- liftIO $ Vault.newKey-    registerFinalizer $ put =<< liftIO . Vault.delete key =<< get+    registerFinalizer $ put . Vault.delete key =<< get     return key readCacheRef  = readVaultKey writeCacheRef = writeVaultKey@@ -130,7 +133,7 @@  newAccumRef x     = do     ref    <- liftIO $ Vault.newKey-    vault2 <- liftIO . Vault.insert ref x . vault =<< get+    vault2 <- Vault.insert ref x . vault <$> get     modify $ \cache -> cache { vault = vault2 }     return ref readAccumRef ref  = fromJust <$> readVaultKey ref@@ -186,7 +189,7 @@     Never     :: EventD t a          -- internal combinators-    Input         :: Typeable a => Channel -> EventD t a+    Input         :: Channel -> Key a -> EventD t a     Reactimate    :: Event t (IO ()) -> EventD t ()          ReadCache     :: Channel -> CacheRef a -> EventD t a@@ -213,17 +216,21 @@     ReadBehavior :: BehaviorRef a -> BehaviorD t a  {------------------------------------------------------------------------------    Dynamic types for input+    Storing heterogenous input values ------------------------------------------------------------------------------}-type Channel  = Integer-type Universe = (Channel, Dynamic)+type Channel  = Integer     -- identifies an input+type Key      = Vault.Key +type Universe = Vault.Vault -fromUniverse :: Typeable a => Channel -> Universe -> Maybe a-fromUniverse i (j,x) = if i == j then fromDynamic x else Nothing+newUniverseKey :: IO (Key a)+newUniverseKey = Vault.newKey -toUniverse :: Typeable a => Channel -> a -> Universe-toUniverse i x = (i, toDyn x)+fromUniverse :: Key a -> Universe -> Maybe a+fromUniverse = Vault.lookup +toUniverse :: Key a -> a -> Universe+toUniverse k a = Vault.insert k a Vault.empty+ {-----------------------------------------------------------------------------     Compilation ------------------------------------------------------------------------------}@@ -246,7 +253,7 @@     goE (ref, AccumE x e )      = (ref,) <$> (AccumE x   <$> goE e)     goE (ref, Reactimate e)     = (ref,) <$> (Reactimate <$> goE e)     goE (ref, Never)            = (ref,) <$> (pure Never)-    goE (ref, Input c)          = (ref,) <$> (pure $ Input c)+    goE (ref, Input c k)        = (ref,) <$> (pure $ Input c k)      -- almost boilerplate traversal for behaviors     goB :: Behavior Accum a -> CompileReadBehavior (Behavior Shared a)@@ -292,7 +299,7 @@     goE (_  , Reactimate e)       = map2 (Reactimate)      <$> goE e     goE (_  , Union e1 e2)        = (++) <$> goE e1 <*> goE e2     goE (_  , Never      )        = return []-    goE (_  , Input channel)      = return [(channel, Input channel)]+    goE (_  , Input channel key)  = return [(channel, Input channel key)]          compileAccumE :: a -> [EventLinear (a -> a)] -> Compile [EventLinear a]     compileAccumE x es = do@@ -345,8 +352,8 @@     goE (ReadCache c ref)    k =             (c, \_ -> readCacheRef ref >>= maybe (return ()) k)     goE (WriteCache ref e)   k = goE e $ \x -> writeCacheRef ref x >> k x-    goE (Input channel)      k =-            (channel, maybe (error "wrong channel") k . fromUniverse channel)+    goE (Input channel key)  k =+            (channel, maybe (error "wrong channel") k . fromUniverse key)          goB :: Behavior Linear a -> Run a     goB = compileBehaviorEvaluation

@@ -1,58 +0,0 @@-{------------------------------------------------------------------------------    Reactive Banana--    Helper Module: A typed, inhomogeneous storage.-    Uses  IORefs  to read and write.-------------------------------------------------------------------------------}-module Reactive.Banana.Vault (-    Vault, Key,-    empty, newKey, lookup, insert, delete,-    ) where--import Prelude hiding (lookup)-import Data.Map (Map)-import qualified Data.Map as Map-import Data.IORef-import Data.Unique---- | An inhomogeneous, type safe storage.-type Vault = Map Unique Item--- Values are stored in closures that write to a temporary IORef--- This way, we can "circumvent" the type system.-type Item  = IO ()---- Key for the vault-data Key a   = Key Unique (Item' a)--- Keeps track of the temporary IORef for reading and writing-type Item' a = IORef (Maybe a)---- | The empty vault.-empty :: Vault-empty = Map.empty---- | Create a new key for use with a vault.-newKey   :: IO (Key a)-newKey = do-    k   <- newUnique-    ref <- newIORef Nothing-    return $ Key k ref---- | Lookup the value of a key in the vault.-lookup :: Key a -> Vault -> IO (Maybe a)-lookup (Key k ref) vault = case Map.lookup k vault of-    Nothing   -> return Nothing-    Just item -> do-        item                    -- write into IORef-        mx <- readIORef ref     -- read the value-        writeIORef ref Nothing  -- clear IORef-        return mx---- | Insert a value for a given key. Overwrites any previous value.-insert :: Key a -> a -> Vault -> IO Vault-insert (Key k ref) x vault = return $-    Map.insert k (writeIORef ref $ Just x) vault---- | Delete a key from the vault.-delete :: Key a -> Vault -> IO Vault-delete (Key k ref) vault = return $ Map.delete k vault-