reactive-banana 1.2.0.0 → 1.2.1.0

raw patch · 17 files changed

+178/−68 lines, 17 filesdep ~containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: containers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• reactive-banana.cabal +6/−4
• src/Control/Event/Handler.hs +5/−4
• src/Control/Monad/Trans/RWSIO.hs +18/−3
• src/Control/Monad/Trans/ReaderWriterIO.hs +10/−2
• src/Reactive/Banana/Combinators.hs +3/−14
• src/Reactive/Banana/Internal/Combinators.hs +26/−8
• src/Reactive/Banana/Prim/Cached.hs +1/−2
• src/Reactive/Banana/Prim/Combinators.hs +9/−6
• src/Reactive/Banana/Prim/Compile.hs +6/−7
• src/Reactive/Banana/Prim/Dependencies.hs +1/−0
• src/Reactive/Banana/Prim/Evaluation.hs +7/−3
• src/Reactive/Banana/Prim/Graph.hs +9/−4
• src/Reactive/Banana/Prim/IO.hs +4/−2
• src/Reactive/Banana/Prim/Plumbing.hs +10/−5
• src/Reactive/Banana/Prim/Types.hs +20/−4
• src/Reactive/Banana/Types.hs +35/−0

@@ -1,6 +1,14 @@ Changelog for the `reactive-banana** package ------------------------------------------- +**version 1.2.1.0**++* Add `Num`, `Floating`, `Fractional`, and `IsString` instances for `Behavior`. [#34][]+* Support `containers-0.6`. [#191][]++  [#34]: https://github.com/HeinrichApfelmus/reactive-banana/pull/34+  [#191]: https://github.com/HeinrichApfelmus/reactive-banana/pull/191+ **version 1.2.0.0**  * Make `MonadFix` superclass of `MonadMoment`. [#128][]

@@ -1,5 +1,5 @@ Name:                reactive-banana-Version:             1.2.0.0+Version:             1.2.1.0 Synopsis:            Library for functional reactive programming (FRP). Description:     Reactive-banana is a library for Functional Reactive Programming (FRP).@@ -23,8 +23,10 @@ Author:              Heinrich Apfelmus Maintainer:          Heinrich Apfelmus <apfelmus quantentunnel de> Category:            FRP-Cabal-version:       >= 1.18+Cabal-version:       1.18 Build-type:          Simple+Tested-with:         GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1, GHC == 8.0.1,+                     GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1  extra-source-files:     CHANGELOG.md,                         doc/examples/*.hs,@@ -43,7 +45,7 @@      build-depends:      base >= 4.2 && < 5,                         semigroups >= 0.13 && < 0.19,-                        containers >= 0.5 && < 0.6,+                        containers >= 0.5 && < 0.7,                         transformers >= 0.2 && < 0.6,                         vault == 0.3.*,                         unordered-containers >= 0.2.1.0 && < 0.3,@@ -58,7 +60,7 @@                         Reactive.Banana.Model,                         Reactive.Banana.Prim,                         Reactive.Banana.Prim.Cached-    +     other-modules:                         Control.Monad.Trans.ReaderWriterIO,                         Control.Monad.Trans.RWSIO,

@@ -2,7 +2,7 @@     -- * Synopsis     -- | <http://en.wikipedia.org/wiki/Event-driven_programming Event-driven programming>     -- in the traditional imperative style.-    +     -- * Documentation     Handler, AddHandler(..), newAddHandler,     mapIO, filterIO,@@ -24,10 +24,10 @@  -- | The type 'AddHandler' represents a facility for registering -- event handlers. These will be called whenever the event occurs.--- +-- -- When registering an event handler, you will also be given an action -- that unregisters this handler again.--- +-- -- > do unregisterMyHandler <- register addHandler myHandler -- newtype AddHandler a = AddHandler { register :: Handler a -> IO (IO ()) }@@ -40,7 +40,7 @@  -- | Map the event value with an 'IO' action. mapIO :: (a -> IO b) -> AddHandler a -> AddHandler b-mapIO f e = AddHandler $ \h -> register e $ \x -> f x >>= h +mapIO f e = AddHandler $ \h -> register e $ \x -> f x >>= h  -- | Filter event values that don't return 'True'. filterIO :: (a -> IO Bool) -> AddHandler a -> AddHandler a@@ -71,4 +71,5 @@             mapM_ ($ a) . map snd . Map.toList =<< readIORef handlers     return (AddHandler register, runHandlers) +atomicModifyIORef_ :: IORef a -> (a -> a) -> IO () atomicModifyIORef_ ref f = atomicModifyIORef ref $ \x -> (f x, ())

@@ -2,7 +2,7 @@     -- * Synopsis     -- | An implementation of the reader/writer/state monad transformer     -- using an 'IORef'.-    +     -- * Documentation     RWSIOT(..), Tuple(..), rwsT, runRWSIOT, tell, ask, get, put,     ) where@@ -27,7 +27,7 @@ instance Applicative m => Applicative (RWSIOT r w s m) where     pure  = pureR     (<*>) = apR-    + instance Monad m => Monad (RWSIOT r w s m) where     return = returnR     (>>=)  = bindR@@ -39,13 +39,28 @@ {-----------------------------------------------------------------------------     Functions ------------------------------------------------------------------------------}+liftIOR :: MonadIO m => IO a -> RWSIOT r w s m a liftIOR m = R $ \_ -> liftIO m++liftR :: m a -> RWSIOT r w s m a liftR   m = R $ \_ -> m++fmapR :: Functor m => (a -> b) -> RWSIOT r w s m a -> RWSIOT r w s m b fmapR f m = R $ \x -> fmap f (run m x)++returnR :: Monad m => a -> RWSIOT r w s m a returnR a = R $ \_ -> return a++bindR :: Monad m => RWSIOT r w s m a -> (a -> RWSIOT r w s m b) -> RWSIOT r w s m b bindR m k = R $ \x -> run m x >>= \a -> run (k a) x++mfixR :: MonadFix m => (a -> RWSIOT r w s m a) -> RWSIOT r w s m a mfixR f   = R $ \x -> mfix (\a -> run (f a) x)++pureR :: Applicative m => a -> RWSIOT r w s m a pureR a   = R $ \_ -> pure a++apR :: Applicative m => RWSIOT r w s m (a -> b) -> RWSIOT r w s m a -> RWSIOT r w s m b apR f a   = R $ \x -> run f x <*> run a x  rwsT :: (MonadIO m, Monoid w) => (r -> s -> IO (a, s, w)) -> RWSIOT r w s m a@@ -60,7 +75,7 @@ runRWSIOT :: (MonadIO m, Monoid w) => RWSIOT r w s m a -> (r -> s -> m (a,s,w)) runRWSIOT m r s = do     w' <- liftIO $ newIORef mempty-    s' <- liftIO $ newIORef s +    s' <- liftIO $ newIORef s     a  <- run m (Tuple r w' s')     s  <- liftIO $ readIORef s'     w  <- liftIO $ readIORef w'

@@ -3,7 +3,7 @@     -- * Synopsis     -- | An implementation of the reader/writer monad transformer     -- using an 'IORef' for the writer.-    +     -- * Documentation     ReaderWriterIOT, readerWriterIOT, runReaderWriterIOT, tell, listen, ask, local,     ) where@@ -27,7 +27,7 @@ instance Applicative m => Applicative (ReaderWriterIOT r w m) where     pure  = pureR     (<*>) = apR-    + instance Monad m => Monad (ReaderWriterIOT r w m) where     return = returnR     (>>=)  = bindR@@ -46,20 +46,28 @@ {-----------------------------------------------------------------------------     Functions ------------------------------------------------------------------------------}+liftIOR :: MonadIO m => IO a -> ReaderWriterIOT r w m a liftIOR m = ReaderWriterIOT $ \x y -> liftIO m +liftR :: m a -> ReaderWriterIOT r w m a liftR m = ReaderWriterIOT $ \x y -> m +fmapR :: Functor m => (a -> b) -> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m b fmapR f m = ReaderWriterIOT $ \x y -> fmap f (run m x y) +returnR :: Monad m => a -> ReaderWriterIOT r w m a returnR a = ReaderWriterIOT $ \_ _ -> return a +bindR :: Monad m => ReaderWriterIOT r w m a -> (a -> ReaderWriterIOT r w m b) -> ReaderWriterIOT r w m b bindR m k = ReaderWriterIOT $ \x y -> run m x y >>= \a -> run (k a) x y +mfixR :: MonadFix m => (a -> ReaderWriterIOT r w m a) -> ReaderWriterIOT r w m a mfixR f = ReaderWriterIOT $ \x y -> mfix (\a -> run (f a) x y) +pureR :: Applicative m => a -> ReaderWriterIOT r w m a pureR a = ReaderWriterIOT $ \_ _ -> pure a +apR :: Applicative m => ReaderWriterIOT r w m (a -> b) -> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m b apR f a = ReaderWriterIOT $ \x y -> run f x y <*> run a x y  readerWriterIOT :: (MonadIO m, Monoid w) =>

@@ -276,20 +276,6 @@ {-----------------------------------------------------------------------------     Derived Combinators ------------------------------------------------------------------------------}-{---Unfortunately, we can't make a  Num  instance because that would-require  Eq  and  Show .--instance Num a => Num (Behavior t a) where-    (+) = liftA2 (+)-    (-) = liftA2 (-)-    (*) = liftA2 (*)-    negate = fmap negate-    abs    = fmap abs-    signum = fmap signum-    fromInteger = pure . fromInteger--} infixl 4 <@>, <@  -- | Infix synonym for the 'apply' combinator. Similar to '<*>'.@@ -320,8 +306,11 @@ split :: Event (Either a b) -> (Event a, Event b) split e = (filterJust $ fromLeft <$> e, filterJust $ fromRight <$> e)     where+    fromLeft :: Either a b -> Maybe a     fromLeft  (Left  a) = Just a     fromLeft  (Right b) = Nothing++    fromRight :: Either a b -> Maybe b     fromRight (Left  a) = Nothing     fromRight (Right b) = Just b 

@@ -74,7 +74,7 @@     (output, s0) <-                             -- compile initial graph         Prim.compile (runReaderT setup eventNetwork) Prim.emptyNetwork     putMVar s s0                                -- set initial state-        +     return $ eventNetwork  fromAddHandler :: AddHandler a -> Moment (Event a)@@ -112,23 +112,38 @@ {-----------------------------------------------------------------------------     Combinators - basic ------------------------------------------------------------------------------}-never       = don'tCache  $ liftBuild $ Prim.neverP+never :: Event a+never = don'tCache  $ liftBuild $ Prim.neverP++unionWith :: (a -> a -> a) -> Event a -> Event a -> Event a unionWith f = liftCached2 $ (liftBuild .) . Prim.unionWithP f++filterJust :: Event (Maybe a) -> Event a filterJust  = liftCached1 $ liftBuild . Prim.filterJustP-mapE f      = liftCached1 $ liftBuild . Prim.mapP f-applyE      = liftCached2 $ \(~(lf,_)) px -> liftBuild $ Prim.applyP lf px -changesB    = liftCached1 $ \(~(lx,px)) -> liftBuild $ Prim.tagFuture lx px+mapE :: (a -> b) -> Event a -> Event b+mapE f = liftCached1 $ liftBuild . Prim.mapP f +applyE :: Behavior (a -> b) -> Event a -> Event b+applyE = liftCached2 $ \(~(lf,_)) px -> liftBuild $ Prim.applyP lf px++changesB :: Behavior a -> Event (Future a)+changesB = liftCached1 $ \(~(lx,px)) -> liftBuild $ Prim.tagFuture lx px++pureB :: a -> Behavior a pureB a = cache $ do     p <- runCached never     return (Prim.pureL a, p)-applyB  = liftCached2 $ \(~(l1,p1)) (~(l2,p2)) -> liftBuild $ do++applyB :: Behavior (a -> b) -> Behavior a -> Behavior b+applyB = liftCached2 $ \(~(l1,p1)) (~(l2,p2)) -> liftBuild $ do     p3 <- Prim.unionWithP const p1 p2     let l3 = Prim.applyL l1 l2     return (l3,p3)-mapB f  = applyB (pureB f) +mapB :: (a -> b) -> Behavior a -> Behavior b+mapB f = applyB (pureB f)+ {-----------------------------------------------------------------------------     Combinators - accumulation ------------------------------------------------------------------------------}@@ -147,6 +162,7 @@     Prim.buildLater $ void $ runReaderT (runCached c) r     return c +stepperB :: a -> Event a -> Moment (Behavior a) stepperB a e = cacheAndSchedule $ do     p0 <- runCached e     liftBuild $ do@@ -155,6 +171,7 @@         (l,_) <- Prim.accumL a p1         return (l,p2) +accumE :: a -> Event (a -> a) -> Moment (Event a) accumE a e1 = cacheAndSchedule $ do     p0 <- runCached e1     liftBuild $ do@@ -184,7 +201,7 @@         p2 <- Prim.mapP runReaderT p1         Prim.executeP p2 r -observeE :: Event (Moment a) -> Event a +observeE :: Event (Moment a) -> Event a observeE = liftCached1 $ executeP  executeE :: Event (Moment a) -> Moment (Event a)@@ -217,4 +234,5 @@         pr <- merge c1 =<< merge c2 c3         return (lr, pr) +merge :: Pulse () -> Pulse () -> Build (Pulse ()) merge = Prim.unionWithP (\_ _ -> ())

@@ -5,7 +5,7 @@ module Reactive.Banana.Prim.Cached (     -- | Utility for executing monadic actions once     -- and then retrieving values from a cache.-    -- +    --     -- Very useful for observable sharing.     Cached, runCached, cache, fromPure, don'tCache,     liftCached1, liftCached2,@@ -63,4 +63,3 @@     a <- runCached ca     b <- runCached cb     f a b-

@@ -1,7 +1,7 @@ {-----------------------------------------------------------------------------     reactive-banana ------------------------------------------------------------------------------}-{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE RecursiveDo, ScopedTypeVariables #-} module Reactive.Banana.Prim.Combinators where  import Control.Applicative@@ -15,7 +15,7 @@     , readPulseP, readLatchP, readLatchFutureP, liftBuildP,     ) import qualified Reactive.Banana.Prim.Plumbing (pureL)-import           Reactive.Banana.Prim.Types    (Latch, Future, Pulse, Build)+import           Reactive.Banana.Prim.Types    (Latch, Future, Pulse, Build, EvalP)  import Debug.Trace -- debug s = trace s@@ -47,17 +47,18 @@     p2 `dependOn` p1     return p2 -unsafeMapIOP :: (a -> IO b) -> Pulse a -> Build (Pulse b)+unsafeMapIOP :: forall a b. (a -> IO b) -> Pulse a -> Build (Pulse b) unsafeMapIOP f p1 = do         p2 <- newPulse "unsafeMapIOP" $             {-# SCC unsafeMapIOP #-} eval =<< readPulseP p1         p2 `dependOn` p1         return p2     where+    eval :: Maybe a -> EvalP (Maybe b)     eval (Just x) = Just <$> liftIO (f x)     eval Nothing  = return Nothing -unionWithP :: (a -> a -> a) -> Pulse a -> Pulse a -> Build (Pulse a)+unionWithP :: forall a. (a -> a -> a) -> Pulse a -> Pulse a -> Build (Pulse a) unionWithP f px py = do         p <- newPulse "unionWithP" $             {-# SCC unionWithP #-} eval <$> readPulseP px <*> readPulseP py@@ -65,6 +66,7 @@         p `dependOn` py         return p     where+    eval :: Maybe a -> Maybe a -> Maybe a     eval (Just x) (Just y) = Just (f x y)     eval (Just x) Nothing  = Just x     eval Nothing  (Just y) = Just y@@ -111,12 +113,13 @@     x <- stepperL l pl     return $ cachedLatch $ getValueL x >>= getValueL -executeP :: Pulse (b -> Build a) -> b -> Build (Pulse a)+executeP :: forall a b. Pulse (b -> Build a) -> b -> Build (Pulse a) executeP p1 b = do         p2 <- newPulse "executeP" $ {-# SCC executeP #-} eval =<< readPulseP p1         p2 `dependOn` p1         return p2     where+    eval :: Maybe (b -> Build a) -> EvalP (Maybe a)     eval (Just x) = Just <$> liftBuildP (x b)     eval Nothing  = return Nothing @@ -134,7 +137,7 @@             return Nothing         -- fetch value from old parent         eval = readPulseP =<< readLatchP lp-    +     p1 <- newPulse "switchP_in" switch :: Build (Pulse ())     p1 `dependOn` pp     p2 <- newPulse "switchP_out" eval

@@ -18,7 +18,7 @@ {-----------------------------------------------------------------------------    Compilation ------------------------------------------------------------------------------}--- | Change a 'Network' of pulses and latches by +-- | Change a 'Network' of pulses and latches by -- executing a 'BuildIO' action. compile :: BuildIO a -> Network -> IO (a, Network) compile m state1 = do@@ -59,7 +59,7 @@             pout       <- liftBuild $ mapP return pmid             liftBuild $ addHandler pout (writeIORef o . Just)             return sin-    +     -- compile initial network     (sin, state) <- compile network emptyNetwork @@ -70,13 +70,13 @@             ma <- readIORef o       -- read output             writeIORef o Nothing             return (ma,s2)-    +     mapAccumM go state xs         -- run several steps  -- | Execute an FRP network with a sequence of inputs. -- Make sure that outputs are evaluated, but don't display their values.--- --- Mainly useful for testing whether there are space leaks. +--+-- Mainly useful for testing whether there are space leaks. runSpaceProfile :: Show b => (Pulse a -> BuildIO (Pulse b)) -> [a] -> IO () runSpaceProfile f xs = do     let g = do@@ -91,7 +91,7 @@             (outputs, s2) <- step x s1             outputs                     -- don't forget to execute outputs             return ((), s2)-    +     mapAccumM_ fire network xs  -- | 'mapAccum' for a monad.@@ -108,4 +108,3 @@ mapAccumM_ f !s0 (x:xs) = do     (_,s1) <- f x s0     mapAccumM_ f s1 xs-

@@ -35,6 +35,7 @@     sequence_ [x `doAddChild` y | x <- Graph.listParents gr, y <- Graph.getChildren gr x]     sequence_ [x `doChangeParent` y | (P x, P y) <- parents]     where+    gr :: Graph.Graph SomeNode     gr = f Graph.emptyGraph  {-----------------------------------------------------------------------------

@@ -46,7 +46,10 @@      doit latchUpdates                           -- update latch values from pulses     doit topologyUpdates                        -- rearrange graph topology-    let actions = OB.inOrder outputs outputs1   -- EvalO actions in proper order+    let actions :: [(Output, EvalO)]+        actions = OB.inOrder outputs outputs1   -- EvalO actions in proper order++        state2 :: Network         state2  = Network             { nTime    = next time1             , nOutputs = OB.inserts outputs1 os@@ -64,7 +67,7 @@ evaluatePulses :: [SomeNode] -> EvalP () evaluatePulses roots = wrapEvalP $ \r -> go r =<< insertNodes r roots Q.empty     where-    -- go :: Queue SomeNode -> EvalP ()+    go :: RWS.Tuple BuildR (EvalPW, BuildW) Lazy.Vault -> Queue SomeNode -> IO ()     go r q = {-# SCC go #-}         case ({-# SCC minView #-} Q.minView q) of             Nothing         -> return ()@@ -104,9 +107,10 @@     return []  -- | Insert nodes into the queue--- insertNode :: [SomeNode] -> Queue SomeNode -> EvalP (Queue SomeNode)+insertNodes :: RWS.Tuple BuildR (EvalPW, BuildW) Lazy.Vault -> [SomeNode] -> Queue SomeNode -> IO (Queue SomeNode) insertNodes (RWS.Tuple (time,_) _ _) = {-# SCC insertNodes #-} go     where+    go :: [SomeNode] -> Queue SomeNode -> IO (Queue SomeNode)     go []              q = return q     go (node@(P p):xs) q = do         Pulse{..} <- readRef p

@@ -1,8 +1,10 @@ {-----------------------------------------------------------------------------     reactive-banana-    +     Implementation of graph-related functionality ------------------------------------------------------------------------------}+{-# language ScopedTypeVariables#-}+ module Reactive.Banana.Prim.Graph where  import           Control.Monad@@ -42,13 +44,15 @@ getParents gr x = maybe [] id . Map.lookup x . parents $ gr  -- | List all nodes such that each parent is listed before all of its children.-listParents :: (Eq a, Hashable a) => Graph a -> [a]+listParents :: forall a. (Eq a, Hashable a) => Graph a -> [a] listParents gr = list     where     -- all nodes without children+    ancestors :: [a]     ancestors = [x | x <- Set.toList $ nodes gr, null (getParents gr x)]     -- all nodes in topological order "parents before children"-    list      = runIdentity $ dfs' ancestors (Identity . getChildren gr)+    list :: [a]+    list = runIdentity $ dfs' ancestors (Identity . getChildren gr)  {-----------------------------------------------------------------------------     Graph traversal@@ -63,9 +67,10 @@  -- | Depth-first serach, refined version. -- INVARIANT: None of the nodes in the initial list have a predecessor.-dfs' :: (Eq a, Hashable a, Monad m) => [a] -> GraphM m a -> m [a]+dfs' :: forall a m. (Eq a, Hashable a, Monad m) => [a] -> GraphM m a -> m [a] dfs' xs succs = liftM fst $ go xs [] Set.empty     where+    go :: [a] -> [a] -> Set.HashSet a -> m ([a], Set.HashSet a)     go []     ys seen            = return (ys, seen)    -- all nodes seen     go (x:xs) ys seen         | x `Set.member` seen    = go xs ys seen

@@ -2,6 +2,7 @@     reactive-banana ------------------------------------------------------------------------------} {-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE ScopedTypeVariables #-} module Reactive.Banana.Prim.IO where  import           Control.Monad.IO.Class@@ -24,7 +25,7 @@ -- -- Together with 'addHandler', this function can be used to operate with -- pulses as with standard callback-based events.-newInput :: Build (Pulse a, a -> Step)+newInput :: forall a. Build (Pulse a, a -> Step) newInput = mdo     always <- alwaysP     key    <- liftIO $ Lazy.newKey@@ -38,7 +39,8 @@         , _nameP     = "newInput"         }     -- Also add the  alwaysP  pulse to the inputs.-    let run a = step ([P pulse, P always], Lazy.insert key (Just a) Lazy.empty)+    let run :: a -> Step+        run a = step ([P pulse, P always], Lazy.insert key (Just a) Lazy.empty)     return (pulse, run)  -- | Register a handler to be executed whenever a pulse occurs.

@@ -1,7 +1,7 @@ {-----------------------------------------------------------------------------     reactive-banana ------------------------------------------------------------------------------}-{-# LANGUAGE RecordWildCards, RecursiveDo, BangPatterns #-}+{-# LANGUAGE RecordWildCards, RecursiveDo, BangPatterns, ScopedTypeVariables #-} module Reactive.Banana.Prim.Plumbing where  import           Control.Monad                                (join)@@ -72,7 +72,7 @@     }  -- | Make new 'Latch' that can be updated by a 'Pulse'-newLatch :: a -> Build (Pulse a -> Build (), Latch a)+newLatch :: forall a. a -> Build (Pulse a -> Build (), Latch a) newLatch a = mdo     latch <- liftIO $ newRef $ Latch         { _seenL  = beginning@@ -84,8 +84,10 @@         }     let         err        = error "incorrect Latch write"++        updateOn :: Pulse a -> Build ()         updateOn p = do-            w  <- liftIO $ mkWeakRefValue latch latch +            w  <- liftIO $ mkWeakRefValue latch latch             lw <- liftIO $ newRef $ LatchWrite                 { _evalLW  = maybe err id <$> readPulseP p                 , _latchLW = w@@ -93,7 +95,7 @@             -- writer is alive only as long as the latch is alive             _  <- liftIO $ mkWeakRefValue latch lw             (P p) `addChild` (L lw)-    +     return (updateOn, latch)  -- | Make a new 'Latch' that caches a previous computation.@@ -245,5 +247,8 @@ rememberOutput x = RWS.tell ((mempty,[x]),mempty)  -- worker wrapper to break sharing and support better inlining+unwrapEvalP :: RWS.Tuple r w s -> RWS.RWSIOT r w s m a -> m a unwrapEvalP r m = RWS.run m r-wrapEvalP   m   = RWS.R m++wrapEvalP :: (RWS.Tuple r w s -> m a) -> RWS.RWSIOT r w s m a+wrapEvalP m = RWS.R m

@@ -34,6 +34,7 @@ type EvalNetwork a = Network -> IO (a, Network) type Step          = EvalNetwork (IO ()) +emptyNetwork :: Network emptyNetwork = Network     { nTime    = next beginning     , nOutputs = OB.empty@@ -82,7 +83,11 @@  -- | Lens-like functionality. data Lens s a = Lens (s -> a) (a -> s -> s)-set    (Lens _   set)   = set++set :: Lens s a -> a -> s -> s+set (Lens _   set)   = set++update :: Lens s a -> (a -> a) -> s -> s update (Lens get set) f = \s -> set (f $ get s) s  {-----------------------------------------------------------------------------@@ -142,11 +147,22 @@ mkWeakNodeValue (O x) = mkWeakRefValue x  -- Lenses for various parameters-seenP  = Lens _seenP  (\a s -> s { _seenP = a })-seenL  = Lens _seenL  (\a s -> s { _seenL = a })+seenP :: Lens (Pulse' a) Time+seenP = Lens _seenP  (\a s -> s { _seenP = a })++seenL :: Lens (Latch' a) Time+seenL = Lens _seenL  (\a s -> s { _seenL = a })++valueL :: Lens (Latch' a) a valueL = Lens _valueL (\a s -> s { _valueL = a })-parentsP  = Lens _parentsP (\a s -> s { _parentsP = a })++parentsP :: Lens (Pulse' a) [Weak SomeNode]+parentsP = Lens _parentsP (\a s -> s { _parentsP = a })++childrenP :: Lens (Pulse' a) [Weak SomeNode] childrenP = Lens _childrenP (\a s -> s { _childrenP = a })++levelP :: Lens (Pulse' a) Int levelP = Lens _levelP (\a s -> s { _levelP = a })  -- | Evaluation monads.

@@ -13,6 +13,7 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Fix+import Data.String (IsString(..))  import qualified Reactive.Banana.Internal.Combinators as Prim @@ -93,6 +94,40 @@ instance Functor Behavior where     fmap = liftA +instance Num a => Num (Behavior a) where+    (+) = liftA2 (+)+    (-) = liftA2 (-)+    (*) = liftA2 (*)+    abs = fmap abs+    signum = fmap signum+    fromInteger = pure . fromInteger+    negate = fmap negate++instance Fractional a => Fractional (Behavior a) where+    (/) = liftA2 (/)+    fromRational = pure . fromRational+    recip = fmap recip++instance Floating a => Floating (Behavior a) where+    (**) = liftA2 (**)+    acos = fmap acos+    acosh = fmap acosh+    asin = fmap asin+    asinh = fmap asinh+    atan = fmap atan+    atanh = fmap atanh+    cos = fmap cos+    cosh = fmap cosh+    exp = fmap exp+    log = fmap log+    logBase = liftA2 logBase+    pi = pure pi+    sin = fmap sin+    sinh = fmap sinh+    sqrt = fmap sqrt++instance IsString a => IsString (Behavior a) where+    fromString = pure . fromString  -- | The 'Future' monad is just a helper type for the 'changes' function. --