reactive 0.9.1 → 0.9.3
raw patch · 13 files changed
+312/−126 lines, 13 filesdep ~checkersdep ~unamb
Dependency ranges changed: checkers, unamb
Files
- reactive.cabal +8/−7
- src/Data/Max.hs +2/−2
- src/Data/Min.hs +2/−2
- src/FRP/Reactive.hs +6/−5
- src/FRP/Reactive/Behavior.hs +29/−15
- src/FRP/Reactive/Future.hs +10/−7
- src/FRP/Reactive/Improving.hs +8/−5
- src/FRP/Reactive/Internal/Future.hs +0/−5
- src/FRP/Reactive/Internal/Misc.hs +1/−4
- src/FRP/Reactive/Internal/Reactive.hs +2/−2
- src/FRP/Reactive/Internal/TVal.hs +117/−39
- src/FRP/Reactive/PrimReactive.hs +107/−14
- src/FRP/Reactive/Reactive.hs +20/−19
reactive.cabal view
@@ -1,5 +1,5 @@ Name: reactive-Version: 0.9.1+Version: 0.9.3 Synopsis: Simple foundation for functional reactive programming Category: reactivity, FRP Description:@@ -14,13 +14,12 @@ . Please see the project wiki page: <http://haskell.org/haskellwiki/reactive> .- The module documentation pages have links to colorized source code and- to wiki pages where you can read and contribute user comments. Enjoy!- . © 2007-2008 by Conal Elliott; BSD3 license. .- Contributions from: Thomas Davie, Luke Palmer, David Sankel. (Please let me- know if I've forgotten to list you.)+ With contributions from: Robin Green, Thomas Davie, Luke Palmer, David+ Sankel, Jules Bean, Creighton Hogg, and Chuan-kai Lin. Please let me+ know if I've forgotten to list you.+ Author: Conal Elliott Maintainer: conal@conal.net Homepage: http://haskell.org/haskellwiki/reactive@@ -33,7 +32,8 @@ Extra-Source-Files: Library Build-Depends: base, old-time, random, QuickCheck < 2.0,- TypeCompose>=0.6.0, vector-space>=0.5, unamb, checkers+ TypeCompose>=0.6.0, vector-space>=0.5,+ unamb>=0.1.2, checkers >= 0.1.2 -- This library uses the ImpredicativeTypes flag, and it depends -- on vector-space, which needs ghc >= 6.9 if impl(ghc < 6.9) {@@ -70,4 +70,5 @@ FRP.Reactive.Internal.IVar FRP.Reactive.Internal.Serial FRP.Reactive.Internal.TVal+ ghc-options: -Wall
src/Data/Max.hs view
@@ -17,8 +17,8 @@ import Data.Monoid (Monoid(..)) -import Test.QuickCheck-import Test.QuickCheck.Checkers+import Test.QuickCheck (Arbitrary)+import Test.QuickCheck.Checkers (EqProp) -- | Ordered monoid under 'max'.
src/Data/Min.hs view
@@ -16,8 +16,8 @@ import Data.Monoid (Monoid(..)) -import Test.QuickCheck-import Test.QuickCheck.Checkers+import Test.QuickCheck (Arbitrary)+import Test.QuickCheck.Checkers (EqProp) -- | Ordered monoid under 'min'. newtype Min a = Min { getMin :: a }
src/FRP/Reactive.hs view
@@ -18,22 +18,23 @@ , EventG, Event , accumE , withTimeE, withTimeE_- , pairE, scanlE, monoidE- , stateE, stateE_, countE, countE_, diffE+ , zipE, scanlE, monoidE+ , mealy, mealy_, countE, countE_, diffE , withPrevE, withPrevEWith- , whenE, eitherE+ , eitherE -- ** More esoteric , listE, atTimes, atTime, once , firstRestE, firstE, restE, snapRemainderE , withRestE, untilE , splitE, switchE+ , justE, filterE -- ** Useful with events. , joinMaybes, filterMP -- * Behaviors , BehaviorG, Behavior , time , stepper, switcher --, select- , snapshotWith, snapshot, snapshot_+ , snapshotWith, snapshot, snapshot_, whenE , accumB , scanlB, monoidB, maybeB, flipFlop, countB , sumB, integral@@ -42,7 +43,7 @@ -- Reactive.Reactive exports reactive values as well. Filter them out. import FRP.Reactive.Reactive hiding- (stepper,switcher,snapshotWith,snapshot,snapshot_,flipFlop,integral)+ (stepper,switcher,snapshotWith,snapshot,snapshot_,whenE,flipFlop,integral) import FRP.Reactive.Behavior import FRP.Reactive.VectorSpace () import FRP.Reactive.Num ()
src/FRP/Reactive/Behavior.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables, FlexibleContexts, TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances, CPP #-} {-# OPTIONS_GHC -Wall #-} ---------------------------------------------------------------------- -- |@@ -17,20 +18,19 @@ BehaviorG, Behavior , time , stepper, switcher --, select- , snapshotWith, snapshot, snapshot_- , accumB- , scanlB, monoidB, maybeB, flipFlop, countB+ , snapshotWith, snapshot, snapshot_, whenE+ , accumB, scanlB, monoidB, maybeB, flipFlop, countB , sumB, integral ) where import Data.Monoid (Monoid(..))-import Control.Applicative (Applicative,pure,(<$>))+import Control.Applicative (Applicative,(<$>),pure) -- import Control.Monad (join) import Data.VectorSpace import qualified FRP.Reactive.Reactive as R-import FRP.Reactive.Reactive (TimeT, ITime, Event, withTimeE, onceRestE, diffE)+import FRP.Reactive.Reactive (TimeT, ITime, Event, withTimeE, onceRestE, diffE,joinMaybes,result) import FRP.Reactive.Fun import FRP.Reactive.Internal.Behavior @@ -54,7 +54,7 @@ -- | Discretely changing behavior, based on an initial value and a -- new-value event. stepper :: a -> Event a -> Behavior a-stepper = (fmap.fmap) rToB R.stepper+stepper = (result.result) rToB R.stepper -- Suggested by Robin Green: @@ -83,7 +83,7 @@ -- Alternative implementations: -- snapshotWith c e b = uncurry c <$> snapshot e b--- snapshotWith c = (fmap.fmap.fmap) (uncurry c) snapshot+-- snapshotWith c = (result.result.fmap) (uncurry c) snapshot -- | Like 'snapshot' but discarding event data (often @a@ is '()'). snapshot_ :: Event a -> Behavior b -> Event b@@ -91,21 +91,28 @@ -- Alternative implementations -- e `snapshot_` src = snd <$> (e `snapshot` src)--- snapshot_ = (fmap.fmap.fmap) snd snapshot+-- snapshot_ = (result.result.fmap) snd snapshot +-- | Filter an event according to whether a reactive boolean is true.+whenE :: Event a -> Behavior Bool -> Event a+whenE e = joinMaybes . fmap h . snapshot e+ where+ h (a,True) = Just a+ h (_,False) = Nothing+ -- | Behavior from an initial value and an updater event. See also -- 'accumE'. accumB :: a -> Event (a -> a) -> Behavior a-accumB = (fmap.fmap) rToB R.accumR+accumB = (result.result) rToB R.accumR -- -- | Like 'scanl' for behaviors. See also 'scanlE'. -- scanlB :: (a -> b -> a) -> a -> Event b -> Behavior a--- scanlB = (fmap.fmap.fmap) rToB R.scanlR+-- scanlB = (result.result.result) rToB R.scanlR -- -- | Accumulate values from a monoid-valued event. Specialization of -- -- 'scanlB', using 'mappend' and 'mempty'. See also 'monoidE'. -- monoidB :: Monoid a => Event a -> Behavior a--- monoidB = fmap rToB R.monoidR+-- monoidB = result rToB R.monoidR ---- The next versions are more continuous:@@ -146,22 +153,22 @@ -- | Like 'sum' for behaviors. sumB :: VectorSpace v => Event v -> Behavior v-sumB = fmap rToB R.sumR+sumB = result rToB R.sumR -- | Start out blank ('Nothing'), latching onto each new @a@, and blanking -- on each @b@. If you just want to latch and not blank, then use -- 'mempty' for the second event. maybeB :: Event a -> Event b -> Behavior (Maybe a)-maybeB = (fmap.fmap) rToB R.maybeR+maybeB = (result.result) rToB R.maybeR -- | Flip-flopping behavior. Turns true whenever first event occurs and -- false whenever the second event occurs. flipFlop :: Event a -> Event b -> Behavior Bool-flipFlop = (fmap.fmap) rToB R.flipFlop+flipFlop = (result.result) rToB R.flipFlop -- | Count occurrences of an event. See also 'countE'. countB :: Num n => Event a -> Behavior n-countB = fmap rToB R.countR+countB = result rToB R.countR -- | Euler integral. integral :: (VectorSpace v, Scalar v ~ TimeT) =>@@ -174,3 +181,10 @@ -- -- Early experiments suggest that recursive integration gets stuck. -- Investigate.+++-- Standard instances for applicative functors++-- #define APPLICATIVE Behavior+-- #include "Num-inc.hs"+
src/FRP/Reactive/Future.hs view
@@ -101,13 +101,6 @@ Future (s,a) `mappend` Future (t,b) = Future (s `min` t, if s <= t then a else b) --- -- A future known never to happen (by construction), i.e., infinite time.--- isNever :: FutureG t a -> Bool--- isNever = isMaxBound . futTime--- where--- isMaxBound (Max MaxBound) = True--- isMaxBound _ = False- -- Consider the following simpler definition: -- -- fa@(Future (s,_)) `mappend` fb@(Future (t,_)) =@@ -124,6 +117,16 @@ -- and '(<=)', so the 'mappend' definition is sub-optimal. In particular, -- 'Improving' has 'minI'. ++-- -- A future known never to happen (by construction), i.e., infinite time.+-- isNever :: FutureG t a -> Bool+-- isNever = isMaxBound . futTime+-- where+-- isMaxBound (Max MaxBound) = True+-- isMaxBound _ = False+-- +-- This function is an abstraction leak. Don't export it to library+-- users. {----------------------------------------------------------
src/FRP/Reactive/Improving.hs view
@@ -17,9 +17,9 @@ ) where -import Data.Function (on)+-- import Data.Function (on) -import Data.Unamb (unamb,asAgree)+import Data.Unamb (unamb,asAgree,parCommute) import Test.QuickCheck.Checkers {----------------------------------------------------------@@ -34,7 +34,8 @@ exactly a = Imp a (compare a) instance Eq a => Eq (Improving a) where- (==) = (==) `on` exact+ -- (==) = (==) `on` exact+ (==) = parCommute (\ u v -> u `compareI` exact v == EQ) instance Ord a => Ord (Improving a) where s `min` t = fst (s `minI` t)@@ -42,7 +43,7 @@ -- | Efficient combination of 'min' and '(<=)' minI :: Ord a => Improving a -> Improving a -> (Improving a,Bool)-Imp u uComp `minI` Imp v vComp = (Imp uMinV wComp, uLeqV)+~(Imp u uComp) `minI` ~(Imp v vComp) = (Imp uMinV wComp, uLeqV) where uMinV = if uLeqV then u else v -- u <= v: Try @v `compare` u /= LT@ and @u `compare` v /= GT@.@@ -54,7 +55,7 @@ -- | Efficient combination of 'max' and '(>=)' maxI :: Ord a => Improving a -> Improving a -> (Improving a,Bool)-Imp u uComp `maxI` Imp v vComp = (Imp uMaxV wComp, uGeqV)+~(Imp u uComp) `maxI` ~(Imp v vComp) = (Imp uMaxV wComp, uGeqV) where uMaxV = if uGeqV then u else v -- u >= v: Try @v `compare` u /= GT@ and @u `compare` v /= LT@.@@ -74,6 +75,8 @@ -- No. Don't implement & export improveMbs. If it's being used, then -- we're not benefitting from this fancy multi-threaded implementation of -- Improving.++-- TODO: Are the lazy patterns at all helpful? instance (EqProp a) => EqProp (Improving a) where (Imp a _) =-= (Imp b _) = a =-= b
src/FRP/Reactive/Internal/Future.hs view
@@ -46,11 +46,6 @@ -- TODO: see if the following definition is really necessary, instead of deriving. --- -- This instance needs to be lazy; automatic deriving doesn't work.--- -- Probably the other instances need this too! TODO (find out).--- instance Functor (FutureG t) where--- fmap f (Future ~(t,x)) = Future (t, f x)- -- The 'Applicative' and 'Monad' instances rely on the 'Monoid' instance -- of 'Max'.
src/FRP/Reactive/Internal/Misc.hs view
@@ -10,10 +10,7 @@ -- Misc Reactive internal defs ---------------------------------------------------------------------- -module FRP.Reactive.Internal.Misc- (- Action, Sink- ) where+module FRP.Reactive.Internal.Misc (Action, Sink) where -- | Convenient alias for dropping parentheses.
src/FRP/Reactive/Internal/Reactive.hs view
@@ -132,7 +132,7 @@ -- representation. inREvent :: (EventG s a -> EventG t a) -> (ReactiveG s a -> ReactiveG t a)-inREvent f (a `Stepper` e) = a `Stepper` f e+inREvent f ~(a `Stepper` e) = a `Stepper` f e -- | Apply a unary function inside the future reactive inside a 'Reactive' -- representation.@@ -189,7 +189,7 @@ -- | Run an event in the current thread. Use the given time sink to sync -- time, i.e., to wait for an output time before performing the action. runE :: forall t. Ord t => Sink t -> Sink (EventG t Action)-runE sync (Event (Future (Max bt,r))) = tsync bt (runR sync r)+runE sync ~(Event (Future (Max bt,r))) = tsync bt (runR sync r) where tsync :: AddBounds t -> Sink Action tsync MinBound = id -- no wait
src/FRP/Reactive/Internal/TVal.hs view
@@ -14,22 +14,23 @@ module FRP.Reactive.Internal.TVal (- makeFuture, makeEvent, Fed, MkFed+ makeEvent, Fed, MkFed ) where -import Control.Arrow (first)+-- import Control.Arrow (first) import Control.Applicative ((<$>)) import Control.Monad (forever)-import Control.Concurrent (forkIO,yield)+import Control.Concurrent (forkIO,yield,ThreadId) import Control.Concurrent.Chan+-- import System.Mem.Weak (mkWeakPtr,deRefWeak) import System.IO.Unsafe (unsafePerformIO) import Data.Unamb (unamb,assuming) import FRP.Reactive.Improving (Improving(..)) import FRP.Reactive.Future (FutureG,future)-import FRP.Reactive.Reactive (Event,TimeT,ITime)+import FRP.Reactive.Reactive (Event,TimeT) import FRP.Reactive.PrimReactive (futuresE) import FRP.Reactive.Internal.Misc (Sink)@@ -38,42 +39,48 @@ import FRP.Reactive.Internal.IVar -- | A value that becomes defined at some time. 'timeVal' may block if--- forced before the time & value are knowable. 'definedAt' says whether--- the value is defined at (and after) a given time and likely blocks+-- forced before the time & value are knowable. 'undefinedAt' says+-- whether the value is still undefined at a given time and likely blocks -- until the earlier of the query time and the value's actual time. data TVal t a = TVal { timeVal :: (t,a), definedAt :: t -> Bool } --- | Make a 'TVal' and a sink to write to it (at most once).-makeTVal :: Clock TimeT -> IO (TVal TimeT a, Sink a)-makeTVal (Clock getT serial) = f <$> newEmptyIVar- where- f v = ( TVal (readIVar v)- (\ t -> unsafePerformIO $ do - sleepPast getT t- do value <- tryReadIVar v- return $ case value of- -- We're past t, so if it's not - -- defined now, it wasn't at t.- Nothing -> False- -- If it became defined before- -- t, then it's defined now.- Just (t',_) -> t' < t)- , \ a -> serial (getT >>= \ t -> writeIVar v (t,a))- )+makeTVal :: Clock TimeT -> MkFed (TVal TimeT a) a+makeTVal (Clock getT _) = f <$> newEmptyIVar+ where+ f v = (TVal (readIVar v) (unsafePerformIO . undefAt), sink)+ where + undefAt t =+ -- Read v after time t. If it's undefined, then it wasn't defined+ -- at t. If it is defined, then see whether it was defined before t.+ do -- ser $ putStrLn $ "sleepPast " ++ show t+ sleepPast getT t+-- maybe True ((> t) . fst) <$> tryReadIVar v+ + value <- tryReadIVar v+ case value of+ -- We're past t, if it's not defined now, it wasn't at t.+ Nothing -> return False+ -- If it became defined before t, then it's defined now.+ Just (t',_) -> return (t' < t) --- TODO: oops - the definedAt in makeTVal always waits until the given--- time. It could also grab the time and compare with t. Currently that--- comparison is done in tValImp. How can we avoid the redundant test? We--- don't really have to avoid it, since makeTVal isn't exported.+ sink a = do t <- getT+ writeIVar v (t,a) + -- sink a = getT >>= writeIVar v . flip (,) a++-- TODO: oops - the undefAt in makeTVal always waits until the given time.+-- It could also grab the time and compare with t. Currently that+-- comparison is done in tValImp. How can we avoid the redundant test?+-- We don't really have to avoid it, since makeTVal isn't exported.+ -- | 'TVal' as 'Future' tValFuture :: Ord t => TVal t a -> FutureG (Improving t) a tValFuture v = future (tValImp v) (snd (timeVal v)) -- | 'TVal' as 'Improving' tValImp :: Ord t => TVal t a -> Improving t-tValImp v = Imp ta (\ t -> assuming (not (definedAt v t)) GT- `unamb` (ta `compare` t))+tValImp v = Imp ta (\ t' -> assuming (not (definedAt v t')) GT+ `unamb` (ta `compare` t')) where ta = fst (timeVal v) @@ -83,6 +90,30 @@ -- | Make a 'Fed'. type MkFed a b = IO (Fed a b) ++-- The 'listSink' version of 'makeEvent' is not revealing the finiteness+-- of future times until those times are known exactly. Since many+-- 'Event' operations (including 'mappend' and 'join') check for infinite+-- time (Max MaxBound) before anything else, they'll get stuck immediately.++-- | Make a new event and a sink that writes to it. Uses the given+-- clock to serialize and time-stamp.+makeEvent :: Clock TimeT -> MkFed (Event a) a+makeEvent clock =+ do chanA <- newChan+ chanF <- newChan+ spin $ do+ (tval,snka) <- makeTVal clock+ writeChan chanF (tValFuture tval)+ readChan chanA >>= snka+ futs <- getChanContents chanF+ return (futuresE futs, writeChanY chanA)++-- makeTVal :: Clock TimeT -> MkFed (TVal TimeT a) a+++{-+ -- | Make a connected sink/future pair. The sink may only be written to once. makeFuture :: Clock TimeT -> MkFed (FutureG ITime a) a makeFuture = (fmap.fmap.first) tValFuture makeTVal@@ -92,17 +123,64 @@ makeEvent :: Clock TimeT -> MkFed (Event a) a makeEvent clock = (fmap.first) futuresE (listSink (makeFuture clock)) +-- Turn a single-feedable into a multi-feedable listSink :: MkFed a b -> MkFed [a] b listSink mk = do chanA <- newChan chanB <- newChan- forkIO . forever $ do+ spin $ do (a,snk) <- mk- writeChan chanB a- readChan chanA >>= snk- as <- getChanContents chanB- return (as, writeChanY chanA)- where- -- Yield control after each input write. Helps responsiveness- -- tremendously.- writeChanY ch x = writeChan ch x >> yield- -- writeChanY = (fmap.fmap) (>> yield) writeChan+ writeChan chanA a+ readChan chanB >>= snk+ as <- getChanContents chanA+ return (as, writeChanY chanB)++-}++spin :: IO a -> IO ThreadId+spin = forkIO . forever+++-- Yield control after channel write. Helps responsiveness+-- tremendously.+writeChanY :: Chan a -> Sink a+writeChanY ch x = writeChan ch x >> yield+-- Equivalently:+-- writeChanY = (fmap.fmap) (>> yield) writeChan+++++-- I want to quit gathing input when no one is listening, to eliminate a+-- space leak. Here's my first attempt:++{-++listSink :: MkFed a b -> MkFed [a] b+listSink mk = do chanA <- newChan+ chanB <- newChan+ wchanA <- mkWeakPtr chanA Nothing+ let loop =+ do mbch <- deRefWeak wchanA+ case mbch of+ Nothing -> do putStrLn "qutting"+ return ()+ Just ch ->+ do putStrLn "something"+ (a,snk) <- mk+ writeChan ch a+ readChan chanB >>= snk+ loop+ forkIO loop+ as <- getChanContents chanA+ return (as, writeChanY chanB)++-}++-- This attempt fails. The weak reference gets lost almost immediately.+-- My hunch: ghc optimizes away the Chan representation when compiling+-- getChanContents, and just holds onto the read and write ends (mvars),+-- via a technique described at ICFP 07. I don't know how to get a+-- reliable weak reference, without altering Control.Concurrent.Chan.+-- +-- Apparently this problem has popped up before. See+-- http://haskell.org/ghc/docs/latest/html/libraries/base/System-Mem-Weak.html#v%3AaddFinalizer
src/FRP/Reactive/PrimReactive.hs view
@@ -46,11 +46,12 @@ , futuresE, listEG, atTimesG, atTimeG , snapshotWith, accumE, accumR, once , withRestE, untilE+ , justE, filterE -- , traceE, traceR -- , mkEvent, mkEventTrace, mkEventShow , eventOcc -- * To be moved elsewhere- , joinMaybes, filterMP+ , joinMaybes, filterMP, result -- * To be removed when it gets used somewhere , isMonotoneR -- * Testing@@ -61,8 +62,10 @@ import Data.Monoid import Control.Applicative+import Control.Arrow import Control.Monad import Data.Function (on)+-- import Debug.Trace (trace) -- TODO: eliminate the needs for this stuff. import Control.Concurrent (threadDelay)@@ -151,12 +154,18 @@ -- | Merge two 'Future' streams into one. merge :: Ord t => Binop (FutureG t (ReactiveG t a))+ -- The following two lines seem to be too strict and are causing -- reactive to lock up. I.e. the time argument of one of these -- must have been _|_, so when we pattern match against it, we -- block.+-- +-- On the other hand, they patch a massive space leak in filterE. Perhaps+-- there's an unamb solution.+ Future (Max MaxBound,_) `merge` v = v u `merge` Future (Max MaxBound,_) = u+ u `merge` v = (inFutR (`merge` v) <$> u) `mappend` (inFutR (u `merge`) <$> v) @@ -170,10 +179,10 @@ -- Define functor instances in terms of each other. instance Functor (EventG t) where- fmap f = inEvent $ (fmap.fmap) f+ fmap = inEvent.fmap.fmap instance Functor (ReactiveG t) where- fmap f (a `Stepper` e) = f a `stepper` fmap f e+ fmap f ~(a `Stepper` e) = f a `stepper` fmap f e -- standard instance instance Ord t => Applicative (EventG t) where@@ -204,6 +213,7 @@ return a = Event (pure (pure a)) e >>= f = joinE (fmap f e) + -- happy a t b. Same as (a `mappend` b) except takes advantage of knowledge -- that t is a lower bound for the occurences of b. This allows for extra -- laziness.@@ -217,7 +227,6 @@ | t0 <= t = (Event (Future (t0, e `Stepper` (happy ee' t b)))) | otherwise = a `mappend` b - -- Note, joinE should not be called with an infinite list of events that all -- occur at the same time. It can't decide which occurs first. joinE :: (Ord t) => EventG t (EventG t a) -> EventG t a@@ -232,17 +241,25 @@ -- adjustE t0h e `mappend` adjustTopE t0h (joinE ee') adjustTopE :: Ord t => Time t -> EventG t t1 -> EventG t t1-adjustTopE t0h (Event (Future (tah, r))) =- Event (Future (t0h `max` tah,r))+adjustTopE t0h = (inEvent.inFuture.first) (max t0h) +-- adjustTopE t0h (Event (Future (tah, r))) =+-- Event (Future (t0h `max` tah,r))+ adjustE :: Ord t => Time t -> EventG t t1 -> EventG t t1+ adjustE _ e@(Event (Future (Max MaxBound, _))) = e adjustE t0h (Event (Future (tah, a `Stepper` e))) = Event (Future (t1h,a `Stepper` adjustE t1h e))- where- t1h = t0h `max` tah+ where+ t1h = t0h `max` tah +-- The two-caseness of adjustE prevents the any info from coming out until+-- tah is known to be Max or non-Max. Problem?++-- Is the MaxBound case really necessary?+ -- TODO: add adjustE explanation. What's going on and why t1 in the -- recursive call? David's comment: -- If we have an event [t1, t2] we know t2 >= t1 so (max t t2) == (max (max t t1) t2).@@ -266,6 +283,26 @@ t1h = t0h `max` tah -} +-- From Jules Bean (quicksilver):++-- joinE :: (Ord t) => EventG t (EventG t a) -> EventG t a+-- joinE (Event u) =+-- Event . join $+-- fmap (\ (e `Stepper` ee) ->+-- let (Event uu) = (e `mappend` joinE ee) in uu)+-- u++-- plus some fiddling:++-- joinE :: (Ord t) => EventG t (EventG t a) -> EventG t a+-- joinE = inEvent (>>= g)+-- where +-- g ~(e `Stepper` ee) = eFuture (e `mappend` joinE ee)+++-- These two joinE defs both lock up in my tests.++ instance Ord t => MonadPlus (EventG t) where { mzero = mempty; mplus = mappend } -- Standard instance for Applicative w/ join@@ -274,6 +311,54 @@ r >>= f = joinR (f <$> r) +-- | Pass through the 'Just' occurrences, stripped. Experimental+-- specialization of 'joinMaybes'.+justE :: Ord t => EventG t (Maybe a) -> EventG t a+justE (Event (Future (ta, Just a `Stepper` e'))) =+ Event (Future (ta, a `Stepper` justE e'))+justE (Event (Future (ta, Nothing `Stepper` e'))) =+ adjustE ta (justE e')++-- The adjustE lets consumers know that the resulting event occurs no+-- earlier than ta.++-- | Pass through values satisfying a given predicate. Experimental+-- specialization of 'filterMP'.+filterE :: (Ord t, Show a) => (a -> Bool) -> EventG t a -> EventG t a++-- filterE p e = joinMaybes (f <$> e)+-- where+-- f a | p a = Just a+-- | otherwise = Nothing++filterE _ e@(Event (Future (Max MaxBound, _))) = e++filterE p (Event (Future (ta, a `Stepper` e'))) = h (filterE p e')+ where + h | p a = -- trace ("pass " ++ show a) $+ \ e'' -> Event (Future (ta, a `Stepper` e''))+ | otherwise = -- trace ("skip " ++ show a) $+ adjustTopE ta++-- Or maybe move the adjustTopE to the second filterE++-- adjustTopE t0h = (inEvent.inFuture.first) (max t0h)+++-- Laziness problem: no information at all can come out of filterE's+-- result until @p a@ is known.++-- filterE p ~(Event (Future (ta, a `Stepper` e'))) =+-- Event (Future (ta', r'))+-- where+-- ta' +-- +-- if p a then+-- Event (Future (ta, a `Stepper` filterE p e'))+-- else+-- adjustE ta (filterE p e')++ {-------------------------------------------------------------------- Operations on events and reactive values --------------------------------------------------------------------}@@ -361,7 +446,8 @@ -- | Snapshot a reactive value whenever an event occurs and apply a -- combining function to the event and reactive's values.-snapshotWith :: Ord t => (a -> b -> c) -> EventG t a -> ReactiveG t b -> EventG t c+snapshotWith :: Ord t =>+ (a -> b -> c) -> EventG t a -> ReactiveG t b -> EventG t c snapshotWith f e r = joinMaybes $ fmap h (e `snap` r) where h (Nothing,_) = Nothing@@ -379,7 +465,7 @@ -- | Just the first occurrence of an event. once :: Ord t => EventG t a -> EventG t a-once = inEvent $ fmap $ pure . rInit+once = (inEvent.fmap) (pure . rInit) -- | Extract a future representing the first occurrence of the event together -- with the event of all occurrences after that one.@@ -389,7 +475,7 @@ -- | Access the remainder with each event occurrence. withRestE :: EventG t a -> EventG t (a, EventG t a)-withRestE = inEvent $ fmap $+withRestE = (inEvent.fmap) $ \ (a `Stepper` e') -> (a,e') `stepper` withRestE e' @@ -400,6 +486,7 @@ -- | Truncate first event at the given time. untilET :: Ord t => EventG t a -> Time t -> EventG t a + -- Event (Future (ta, ~(a `Stepper` e'))) `untilET` t = -- if ta < t then -- Event (Future (ta, a `Stepper` (e' `untilET` t)))@@ -422,6 +509,8 @@ -- I'm not sure about @<@ vs @<=@ above. ++ -- | Sample a reactive value at a sequence of monotonically non-decreasing -- times. Deprecated, because it does not reveal when value is known to -- be repeated in the output. Those values won't be recomputed, but they@@ -484,6 +573,13 @@ -- where -- guarded p x = guard (p x) >> return x ++-- | Apply a given function inside the results of other functions.+-- Equivalent to '(.)', but has a nicer reading when composed+result :: (b -> b') -> ((a -> b) -> (a -> b'))+result = (.)++ {-------------------------------------------------------------------- Tests --------------------------------------------------------------------}@@ -497,9 +593,6 @@ [ ("monotonicity", [ monotonicity2 "<*>" ((<*>) :: ApTy (EventG NumT) T T)--- :: EventG NumT (T -> T)--- -> EventG NumT T--- -> EventG NumT T , monotonicity2 "adjustE" (adjustE :: Time NumT -> EventG NumT NumT
src/FRP/Reactive/Reactive.hs view
@@ -24,11 +24,11 @@ , Event , withTimeE, withTimeE_ , atTime, atTimes, listE- , {-mbsEvent,-} pairE, scanlE, monoidE+ , {-mbsEvent,-} zipE, scanlE, monoidE , firstRestE, firstE, restE , remainderR, snapRemainderE, onceRestE , withPrevE, withPrevEWith, withNextE, withNextEWith- , stateE, stateE_, countE, countE_, diffE+ , mealy, mealy_, countE, countE_, diffE -- * Reactive values , Reactive , Source@@ -101,7 +101,7 @@ -- | Access occurrence times in an event. Discard the rest. See also -- 'withTimeE'. withTimeE_ :: Event a -> Event TimeT-withTimeE_ = (fmap.fmap) snd withTimeE+withTimeE_ = (result.fmap) snd withTimeE timeT :: Ord t => Time t -> t timeT (Max (NoBound t)) = t@@ -121,9 +121,10 @@ listE = listEG . fmap (first exactly) -- | Generate a pair-valued event, given a pair of initial values and a--- pair of events. See also 'pair' on 'Reactive'.-pairE :: Ord t => (c,d) -> (EventG t c, EventG t d) -> EventG t (c,d)-pairE cd cde = cd `accumE` pairEdit cde+-- pair of events. See also 'pair' on 'Reactive'. Not quite a 'zip',+-- because of the initial pair required.+zipE :: Ord t => (c,d) -> (EventG t c, EventG t d) -> EventG t (c,d)+zipE cd cde = cd `accumE` pairEdit cde -- | Like 'scanl' for events. scanlE :: Ord t => (a -> b -> a) -> a -> EventG t b -> EventG t a@@ -197,7 +198,7 @@ -- | Pair each event value with the next one one. The second result is -- the next one. withNextE :: Ord t => EventG t a -> EventG t (a,a)-withNextE = (fmap.fmap.fmap) firstE withRestE+withNextE = (result.fmap.second) firstE withRestE -- Alt. def. -- withNextE = fmap (second firstE) . withRestE @@ -208,30 +209,30 @@ -- | State machine, given initial value and transition function. Carries--- along event data. See also 'stateE_'. TODO: better name.-stateE :: Ord t => s -> (s -> s) -> EventG t b -> EventG t (b,s)-stateE s0 f = scanlE h (b0,s0)+-- along event data. See also 'mealy_'.+mealy :: Ord t => s -> (s -> s) -> EventG t b -> EventG t (b,s)+mealy s0 f = scanlE h (b0,s0) where- b0 = error "stateE: no initial value"+ b0 = error "mealy: no initial value" h (_,s) b = (b, f s) --- | State machine, given initial value and transition function. See also--- 'stateE'.-stateE_ :: Ord t => s -> (s -> s) -> EventG t b -> EventG t s-stateE_ = (fmap.fmap.fmap.fmap) snd stateE+-- | State machine, given initial value and transition function.+-- Forgetful version of 'mealy'.+mealy_ :: Ord t => s -> (s -> s) -> EventG t b -> EventG t s+mealy_ = (result.result.result.fmap) snd mealy --- stateE_ s0 f e = snd <$> stateE s0 f e+-- mealy_ s0 f e = snd <$> mealy s0 f e -- | Count occurrences of an event, remembering the occurrence values. -- See also 'countE_'. countE :: (Ord t, Num n) => EventG t b -> EventG t (b,n)-countE = stateE 0 (+1)+countE = mealy 0 (+1) -- | Count occurrences of an event, forgetting the occurrence values. See -- also 'countE'. countE_ :: (Ord t, Num n) => EventG t b -> EventG t n-countE_ = (fmap.fmap) snd countE+countE_ = (result.fmap) snd countE -- countE_ e = snd <$> countE e @@ -269,7 +270,7 @@ -- Alternative implementations -- e `snapshot_` src = snd <$> (e `snapshot` src)--- snapshot_ = (fmap.fmap.fmap) snd snapshot+-- snapshot_ = (result.result.fmap) snd snapshot -- | Filter an event according to whether a reactive boolean is true. whenE :: Ord t => EventG t a -> ReactiveG t Bool -> EventG t a