diff --git a/reactive.cabal b/reactive.cabal --- a/reactive.cabal +++ b/reactive.cabal @@ -1,5 +1,5 @@ Name: reactive -Version: 0.10.3 +Version: 0.10.4 Synopsis: Simple foundation for functional reactive programming Category: reactivity, FRP Description: @@ -33,8 +33,8 @@ Library Build-Depends: base, old-time, random, QuickCheck < 2.0, TypeCompose>=0.6.3, vector-space>=0.5, - unamb>=0.1.2, checkers >= 0.1.2, - category-extras >= 0.53.5 + unamb>=0.1.2, checkers >= 0.1.3, + category-extras >= 0.53.5, Stream -- This library uses the ImpredicativeTypes flag, and it depends -- on vector-space, which needs ghc >= 6.9 if impl(ghc < 6.9) { @@ -60,6 +60,7 @@ FRP.Reactive.Internal.Behavior FRP.Reactive.Internal.Clock FRP.Reactive.Internal.Timing + FRP.Reactive.Internal.Chan FRP.Reactive.LegacyAdapters diff --git a/src/FRP/Reactive/Future.hs b/src/FRP/Reactive/Future.hs --- a/src/FRP/Reactive/Future.hs +++ b/src/FRP/Reactive/Future.hs @@ -95,6 +95,8 @@ withTimeF :: FutureG t a -> FutureG t (Time t, a) withTimeF = inFuture $ \ (t,a) -> (t,(t,a)) +-- withTimeF = inFuture duplicate (with Comonad) + -- TODO: Eliminate this Monoid instance. Derive Monoid along with all the -- other classes. And don't use mempty and mappend for the operations -- below. For one thing, the current instance makes Future a monoid but diff --git a/src/FRP/Reactive/Improving.hs b/src/FRP/Reactive/Improving.hs --- a/src/FRP/Reactive/Improving.hs +++ b/src/FRP/Reactive/Improving.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-} {-# OPTIONS_GHC -Wall #-} ---------------------------------------------------------------------- -- | @@ -13,34 +14,69 @@ module FRP.Reactive.Improving ( - Improving(..), exactly, minI, maxI + Improving(..), exactly, before, after, minI, maxI + , batch ) where import Data.Function (on) +import Text.Show.Functions () +import Control.Applicative (pure,(<$>)) import Data.Unamb (unamb,asAgree,parCommute) + +import Test.QuickCheck hiding (evaluate) +-- import Test.QuickCheck.Instances import Test.QuickCheck.Checkers +import Test.QuickCheck.Classes +import Test.QuickCheck.Instances.Num + {---------------------------------------------------------- Improving values ----------------------------------------------------------} -- | An improving value. data Improving a = Imp { exact :: a, compareI :: a -> Ordering } + -- deriving Show +instance Show a => Show (Improving a) where + show = ("Imp "++) . show . exact + -- | A known improving value (which doesn't really improve) exactly :: Ord a => a -> Improving a exactly a = Imp a (compare a) +-- | A value known to be @< x@. +before :: Ord a => a -> Improving a +before x = Imp undefined comp + where + comp y | x <= y = LT + | otherwise = undefined + +-- | A value known to be @> x@. +after :: Ord a => a -> Improving a +after x = Imp undefined comp + where + comp y | x >= y = GT + | otherwise = undefined + + instance Eq a => Eq (Improving a) where -- (==) = (==) `on` exact + -- This version can prove inequality without having to know both values + -- exactly. (==) = parCommute (\ u v -> u `compareI` exact v == EQ) instance Ord a => Ord (Improving a) where - s `min` t = fst (s `minI` t) - s <= t = snd (s `minI` t) + min = (result.result) fst minI + (<=) = (result.result) snd minI + max = (result.result) fst maxI +-- instance Ord a => Ord (Improving a) where +-- s `min` t = fst (s `minI` t) +-- s <= t = snd (s `minI` t) + -- | 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) @@ -76,7 +112,78 @@ -- TODO: Are the lazy patterns at all helpful? + +-- Experimental 'Bounded' instance. I'm curious about it as an +-- alternative to using 'AddBounds'. However, it seems to lose the +-- advantage of a knowably infinite value, which I use in a lot of +-- optimization, including filter/join. + +instance Bounded (Improving a) where + minBound = error "minBound not defined on Improving" + maxBound = Imp (error "exact maxBound") + (const GT) + +-- TODO: consider 'undefined' instead 'error', for 'unamb'. However, we +-- lose valuable information if the 'undefined' gets forced with no +-- 'unamb' to handle it. Maybe make 'unamb' handle more exceptions. + + +---- + + +-- Modify the result of a function. See +-- . +result :: (b -> b') -> ((a -> b) -> (a -> b')) +result = (.) + + +---- + +-- For now, generate exactly-knowable values. +-- TODO: generate trickier improving values. +instance (Ord a, Arbitrary a) => Arbitrary (Improving a) where + arbitrary = exactly <$> arbitrary + coarbitrary = coarbitrary . exact + +instance Model (Improving a) a where model = exact + instance EqProp a => EqProp (Improving a) where (=-=) = (=-=) `on` exact -- TODO: revisit (=-=). Maybe it doesn't have to test for full equality. + +genGE :: (Arbitrary a, Num a) => Improving a -> Gen (Improving a) +genGE i = add i <$> oneof [pure 0, positive] + +-- I didn't use nonNegative in genGE, because I want zero pretty often, +-- especially for the antiSymmetric law. + +add :: Num a => Improving a -> a -> Improving a +add (Imp x comp) dx = Imp (x + dx) (comp . subtract dx) + +batch :: TestBatch +batch = ( "Reactive.Improving" + , concatMap unbatch + [ ordI, semanticOrdI, partial ] + ) + where + ordI = ord (genGE :: Improving NumT -> Gen (Improving NumT)) + semanticOrdI = semanticOrd (undefined :: Improving NumT) + +partial :: TestBatch +partial = ( "Partial" + , [ ("min after" , property (minAL :: NumT -> NumT -> Bool)) + , ("max before", property (maxAL :: NumT -> NumT -> Bool)) + ] + ) + +minAL :: Ord a => a -> a -> Bool +minAL x y = after x `min` after y >= exactly (x `min` y) + +maxAL :: Ord a => a -> a -> Bool +maxAL x y = before x `max` before y <= exactly (x `max` y) + + +-- Now I realize that the Ord laws are implied by semantic Ord property, +-- assuming that the model satisfies the Ord laws. + diff --git a/src/FRP/Reactive/Internal/IVar.hs b/src/FRP/Reactive/Internal/IVar.hs --- a/src/FRP/Reactive/Internal/IVar.hs +++ b/src/FRP/Reactive/Internal/IVar.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wall #-} +-- {-# OPTIONS_GHC -fno-state-hack #-} ---------------------------------------------------------------------- -- | -- Module : FRP.Reactive.Internal.IVar @@ -12,17 +13,18 @@ ---------------------------------------------------------------------- module FRP.Reactive.Internal.IVar - ( IVar, newEmptyIVar, readIVar, tryReadIVar, writeIVar ) -where + ( IVar, newIVar, readIVar, tryReadIVar, writeIVar + ) where + import Control.Concurrent.MVar import Control.Applicative ((<$>)) import System.IO.Unsafe (unsafePerformIO) newtype IVar a = IVar (MVar a) -newEmptyIVar :: IO (IVar a) -newEmptyIVar = IVar <$> newEmptyMVar +newIVar :: IO (IVar a) +newIVar = IVar <$> newEmptyMVar -- | Returns the value in the IVar. The *value* will block -- until the variable becomes filled. @@ -42,3 +44,78 @@ -- block forever. writeIVar :: IVar a -> a -> IO () writeIVar (IVar v) x = putMVar v x + +{- + +-- From: Bertram Felgenhauer +-- to: conal@conal.net +-- date: Mon, Nov 10, 2008 at 1:02 PM +-- subject: About IVars + +-- Interestingly, the code triggers a bug in ghc; you have to compile +-- it with -fno-state-hack if you enable optimization. (Though Simon +-- Marlow says that it's not the state hack's fault. See +-- http://hackage.haskell.org/trac/ghc/ticket/2756) + +-- Hm: ghc balks at {-# OPTIONS_GHC -fno-state-hack #-} + + +-- with a few tweaks by conal + +import Control.Concurrent.MVar +import System.IO.Unsafe (unsafePerformIO) + +-- an IVar consists of +-- a) A lock for the writers. (This avoids the bug explained above.) +-- b) An MVar to put the value into +-- c) The value of the IVar. This is the main difference between +-- our implementations. +data IVar a = IVar (MVar ()) (MVar a) a + +-- Creating an IVar creates two MVars and sets up a suspended +-- takeMVar for reading the value. +-- It relies on unsafePerformIO to execute its body at most once; +-- As far as I know this is true since ghc 6.6.1 -- see +-- http://hackage.haskell.org/trac/ghc/ticket/986 +newIVar :: IO (IVar a) +newIVar = do + lock <- newMVar () + trans <- newEmptyMVar + let {-# NOINLINE value #-} + value = unsafePerformIO $ takeMVar trans + return (IVar lock trans value) + +-- Reading an IVar just returns its value. +readIVar :: IVar a -> a +readIVar (IVar _ _ value) = value + +-- Writing an IVar takes the writer's lock and writes the value. +-- (To match your interface, use takeMVar instead of tryTakeMVar) + +writeIVar :: IVar a -> a -> IO () +writeIVar (IVar lock trans _) value = do + a <- tryTakeMVar lock + case a of + Just () -> putMVar trans value + Nothing -> error "writeIVar: already written" + +-- writeIVar :: IVar a -> a -> IO Bool +-- writeIVar (IVar lock trans _) value = do +-- a <- tryTakeMVar lock +-- case a of +-- Just _ -> putMVar trans value >> return True +-- Nothing -> return False + +-- I didn't originally support tryReadIVar, but it's easily implemented, +-- too. +tryReadIVar :: IVar a -> IO (Maybe a) +tryReadIVar (IVar lock _ value) = fmap f (isEmptyMVar lock) + where + f True = Just value + f False = Nothing + +-- tryReadIVar (IVar lock _ value) = do +-- empty <- isEmptyMVar lock +-- if empty then return (Just value) else return Nothing + +-} diff --git a/src/FRP/Reactive/Internal/TVal.hs b/src/FRP/Reactive/Internal/TVal.hs --- a/src/FRP/Reactive/Internal/TVal.hs +++ b/src/FRP/Reactive/Internal/TVal.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ScopedTypeVariables, TypeOperators #-} {-# OPTIONS_GHC -Wall #-} ---------------------------------------------------------------------- -- | @@ -14,47 +14,57 @@ module FRP.Reactive.Internal.TVal ( - makeEvent, Fed, MkFed + makeEvent, ) where --- import Control.Arrow (first) -import Control.Applicative ((<$>)) -import Control.Monad (forever) -import Control.Concurrent (forkIO,yield,ThreadId) -import Control.Concurrent.Chan --- import System.Mem.Weak (mkWeakPtr,deRefWeak) -import System.IO.Unsafe (unsafePerformIO) +import Control.Applicative ((<$>),liftA2) +-- import Control.Monad (when) +import Control.Concurrent (forkIO,yield) -- ,ThreadId +-- import Control.Concurrent.Chan hiding (getChanContents) +import FRP.Reactive.Internal.Chan + +--import System.Mem.Weak (mkWeakPtr,deRefWeak) +import System.IO.Unsafe (unsafePerformIO, unsafeInterleaveIO) + +import Data.Stream (Stream(..)) + import Data.Unamb (unamb,assuming) import FRP.Reactive.Improving (Improving(..)) import FRP.Reactive.Future (FutureG,future) -import FRP.Reactive.Reactive (Event,TimeT) -import FRP.Reactive.PrimReactive (futuresE) +import FRP.Reactive.Reactive (Event,TimeT,ITime) +import FRP.Reactive.PrimReactive (futureStreamE) import FRP.Reactive.Internal.Misc (Sink) import FRP.Reactive.Internal.Clock import FRP.Reactive.Internal.Timing (sleepPast) import FRP.Reactive.Internal.IVar +-- | An @a@ that's fed by a @b@ +type b :--> a = (Sink b, a) + +-- | Make a '(:-->)'. +type b :+-> a = IO (b :--> a) + -- | A value that becomes defined at some time. 'timeVal' may block if --- forced before the time & value are knowable. 'undefinedAt' says --- whether the value is still undefined at a given time and likely blocks +-- forced before the time & value are knowable. 'definedAt' says whether +-- the value is defined at (and after) 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 } -makeTVal :: Clock TimeT -> MkFed (TVal TimeT a) a -makeTVal (Clock getT _) = f <$> newEmptyIVar +makeTVal :: Clock TimeT -> a :+-> TVal TimeT a +makeTVal (Clock getT _) = f <$> newIVar where - f v = (TVal (readIVar v) (unsafePerformIO . undefAt), sink) + f v = (sink, TVal (readIVar v) (unsafePerformIO . undefAt)) 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 +-- maybe False ((< t) . fst) <$> tryReadIVar v value <- tryReadIVar v case value of @@ -68,8 +78,8 @@ -- 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 +-- 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. @@ -84,60 +94,51 @@ where ta = fst (timeVal v) --- | An @a@ that's fed by a @b@ -type Fed a b = (a, Sink b) --- | 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) +-- -- | Make a new event and a sink that writes to it. Uses the given +-- -- clock to serialize and time-stamp. +-- makeEvent :: Clock TimeT -> a :+-> Event 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 +-- makeTVal :: Clock TimeT -> a :+-> TVal TimeT 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 +makeFuture :: Clock TimeT -> (a :+-> FutureG ITime a) +makeFuture = (fmap.fmap.fmap) tValFuture makeTVal -- | 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 = (fmap.first) futuresE (listSink (makeFuture clock)) +makeEvent :: Clock TimeT -> (a :+-> Event a) +makeEvent clock = (fmap.fmap) futureStreamE (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 - spin $ do - (a,snk) <- mk - writeChan chanA a - readChan chanB >>= snk - as <- getChanContents chanA - return (as, writeChanY chanB) - --} +listSink :: (b :+-> a) -> (b :+-> Stream a) -spin :: IO a -> IO ThreadId -spin = forkIO . forever +-- listSink mk = do chanA <- newChan +-- chanB <- newChan +-- spin $ do +-- (a,snk) <- mk +-- 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 @@ -153,28 +154,24 @@ -- 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) - --} +-- 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 "add value" +-- (a,snk) <- mk +-- writeChan ch a +-- readChan chanB >>= snk +-- loop +-- forkIO loop +-- as <- getChanContents chanA +-- return (writeChanY chanB, as) -- This attempt fails. The weak reference gets lost almost immediately. -- My hunch: ghc optimizes away the Chan representation when compiling @@ -184,3 +181,58 @@ -- -- Apparently this problem has popped up before. See -- http://haskell.org/ghc/docs/latest/html/libraries/base/System-Mem-Weak.html#v%3AaddFinalizer + + +listSink mk = do chanA <- newChan + chanB <- newChan + +-- let loop = do (snk,a) <- mk +-- -- putStrLn "sank" +-- writeChanY chanA a +-- readChan chanB >>= snk +-- loop + +-- wwriteA <- weakChanWriter chanA +-- let loop = do (snk,a) <- mk +-- mbw <- wwriteA +-- case mbw of +-- Nothing -> putStrLn "bailing" +-- Just writeA -> do writeA a >> yield +-- readChan chanB >>= snk +-- loop + + wwriteA <- weakChanWriter chanA + let loop = do mbw <- wwriteA + case mbw of + Nothing -> + do -- putStrLn "bailing" + return () + Just writeA -> + do (snk,a) <- mk + writeA a + -- yield + readChan chanB >>= snk + loop + + forkIO loop + as <- getChanStream chanA + return (writeChanY chanB, as) + + +-- I hadn't been yielding after writing to chanA. What implications? + + +-- | Variation on 'getChanContents', returning a stream instead of a +-- list. Note that 'getChanContents' only makes infinite lists. I'm +-- hoping to get some extra laziness by using irrefutable 'Cons' pattern +-- when consuming the stream. +getChanStream :: Chan a -> IO (Stream a) +getChanStream ch = unsafeInterleaveIO $ + liftA2 Cons (readChan ch) (getChanStream ch) + +-- getChanStream ch +-- = unsafeInterleaveIO (do +-- x <- readChan ch +-- xs <- getChanStream ch +-- return (Cons x xs) +-- ) diff --git a/src/FRP/Reactive/PrimReactive.hs b/src/FRP/Reactive/PrimReactive.hs --- a/src/FRP/Reactive/PrimReactive.hs +++ b/src/FRP/Reactive/PrimReactive.hs @@ -43,7 +43,7 @@ EventG, ReactiveG -- * Operations on events and reactive values , stepper, switcher, withTimeGE, withTimeGR - , futuresE, listEG, atTimesG, atTimeG + , futuresE, futureStreamE, listEG, atTimesG, atTimeG , snapshotWith, accumE, accumR, once , withRestE, untilE , justE, filterE @@ -67,6 +67,8 @@ import Data.Function (on) -- import Debug.Trace (trace) +import Data.Stream (Stream(..)) + import Control.Comonad -- TODO: eliminate the needs for this stuff. @@ -427,6 +429,12 @@ -- Internal/Reactive, I have to move the monoid instance there, which -- requires moving others as well. +-- | Convert a temporally monotonic stream of futures to an event. Like +-- 'futuresE' but it can be lazier, because there's not empty case. +futureStreamE :: Ord t => Stream (FutureG t a) -> EventG t a +futureStreamE (~(Cons (Future (t,a)) futs)) = + Event (Future (t, a `stepper` futureStreamE futs)) + -- | Event at given times. See also 'atTimeG'. atTimesG :: Ord t => [t] -> EventG t () atTimesG = listEG . fmap (flip (,) ()) @@ -435,6 +443,16 @@ atTimeG :: Ord t => t -> EventG t () atTimeG = atTimesG . pure +-- | 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) -> ReactiveG t b -> EventG t a -> EventG t c + +snapshotWith f e r = joinMaybes $ fmap h (e `snap` r) + where + h (Nothing,_) = Nothing + h (Just a ,b) = Just (f a b) + -- This variant of 'snapshot' has 'Nothing's where @b@ changed and @a@ -- didn't. snap :: forall a b t. Ord t => @@ -448,14 +466,33 @@ fa a (_,b) = (Just a , b) fb b _ = (Nothing, b) --- | 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) -> ReactiveG t b -> EventG t a -> EventG t c -snapshotWith f e r = joinMaybes $ fmap h (e `snap` r) - where - h (Nothing,_) = Nothing - h (Just a ,b) = Just (f a b) +-- This next version from Chuan-kai Lin, so that snapshot is lazy enough +-- for recursive cases. It leaks when the reactive changes faster than +-- the event occurs. + +-- snapshotWith f r e = +-- fmap snap $ accumE seed $ fmap advance $ withTimeGE e +-- where snap (a, sr) = f a (rInit sr) +-- seed = (undefined, r) +-- advance (a, t) (_, sr) = (a, skipRT sr t) + +-- -- | Skip reactive values until the given time. +-- skipRT :: Ord t => ReactiveG t a -> Time t -> ReactiveG t a +-- r@(_ `Stepper` Event (Future (t, r1))) `skipRT` start = +-- if t < start then r1 `skipRT` start else r + +-- From Beelsebob: + +-- snapshotWith f r e@(Event (Future (t,_ `Stepper` ne))) = +-- Event (Future (t, v' `stepper` snapshotWith f r ne)) +-- where +-- Event (Future (_,v' `Stepper` _)) = snapshotWith' f r e +-- snapshotWith' f' r' e' = joinMaybes $ fmap h (r' `snap` e') +-- where +-- h (Nothing,_) = Nothing +-- h (Just a ,b) = Just (f' a b) + + -- | Accumulating event, starting from an initial value and a -- update-function event. See also 'accumR'. diff --git a/src/FRP/Reactive/Reactive.hs b/src/FRP/Reactive/Reactive.hs --- a/src/FRP/Reactive/Reactive.hs +++ b/src/FRP/Reactive/Reactive.hs @@ -59,9 +59,9 @@ import Data.Max import Data.AddBounds -import FRP.Reactive.Future hiding (batch) +import FRP.Reactive.Future hiding (batch) import FRP.Reactive.PrimReactive hiding (batch) -import FRP.Reactive.Improving +import FRP.Reactive.Improving hiding (batch) -- | The type of finite time values. type TimeT = Double diff --git a/src/Test/Integ.hs b/src/Test/Integ.hs new file mode 100644 --- /dev/null +++ b/src/Test/Integ.hs @@ -0,0 +1,16 @@ +-- Simple test of recursive integrals, from Beelsebob + +import FRP.Reactive.Behavior +import FRP.Reactive.PrimReactive +import FRP.Reactive.Internal.Fun +import FRP.Reactive +import FRP.Reactive.Improving + +e = listE [(1,()),(2,()),(3,())] +b = integral e b :: Behavior Double +e' = listE [(0.5,0.5), (1,1), (1.5,1.5), (2,2), (2.5,2.5), (3,3)] + +snaps = b `snapshot_` e' + +-- (0.5,0.0)->(1.0,0.0)->(1.5,0.0)->(2.0,0.0)->(2.5,0.0)->(3.0,0.0) +