bearriver 0.14.9 → 0.14.10

raw patch · 8 files changed

+638/−123 lines, 8 filesdep +randomdep ~MonadRandomdep ~mtlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: random

Dependency ranges changed: MonadRandom, mtl

API changes (from Hackage documentation)

Files

• CHANGELOG +10/−0
• bearriver.cabal +6/−3
• src/FRP/BearRiver.hs +7/−115
• src/FRP/BearRiver/Integration.hs +51/−4
• src/FRP/BearRiver/Random.hs +84/−0
• src/FRP/BearRiver/Simulation.hs +292/−0
• src/FRP/BearRiver/Task.hs +187/−0
• src/FRP/Yampa.hs +1/−1

@@ -1,3 +1,13 @@+2024-08-21 Ivan Perez <ivan.perez@keera.co.uk>+        * Version bump (0.14.10) (#430).+        * Offer all definitions from FRP.Yampa.Integration (#422).+        * Offer all definitions from FRP.Yampa.Random (#423).+        * Offer all definitions from FRP.Yampa.Task (#424).+        * Increase upper bounds on mtl (#427).+        * Offer all definitions from FRP.Yampa.Simulation (#425).+        * Implement integral using trapezoid rule (#429).+        * Thanks to @tomsmeding.+ 2024-06-21 Ivan Perez <ivan.perez@keera.co.uk>         * Version bump (0.14.9) (#420).         * Offer all definitions from FRP.Yampa.Hybrid (#419).

@@ -30,7 +30,7 @@ build-type:    Simple  name:          bearriver-version:       0.14.9+version:       0.14.10 author:        Ivan Perez, Manuel Bärenz maintainer:    ivan.perez@keera.co.uk homepage:      https://github.com/ivanperez-keera/dunai@@ -88,8 +88,11 @@     FRP.BearRiver.Hybrid     FRP.BearRiver.Integration     FRP.BearRiver.Loop+    FRP.BearRiver.Random     FRP.BearRiver.Scan+    FRP.BearRiver.Simulation     FRP.BearRiver.Switches+    FRP.BearRiver.Task     FRP.BearRiver.Time     FRP.Yampa @@ -100,8 +103,8 @@       base >= 4.6 && <5     , deepseq             >= 1.3.0.0 && < 1.6     , dunai >= 0.6.0 && < 0.14-    , MonadRandom         >= 0.2   && < 0.7-    , mtl                 >= 2.1.2 && < 2.3+    , mtl                 >= 2.1.2 && < 2.4+    , random              >= 1.1   && < 1.3     , simple-affine-space >= 0.1   && < 0.3     , transformers >= 0.3 && < 0.7 

@@ -22,7 +22,6 @@  -- External imports import Control.Arrow         as X-import Control.Monad.Random  (MonadRandom) import Data.Functor.Identity (Identity (..)) import Data.Maybe            (fromMaybe) import Data.VectorSpace      as X@@ -30,8 +29,10 @@ -- Internal imports (dunai) import           Control.Monad.Trans.MSF                 hiding (dSwitch) import qualified Control.Monad.Trans.MSF                 as MSF-import           Data.MonadicStreamFunction              as X hiding (iPre,-                                                               once, reactimate,+import           Data.MonadicStreamFunction              as X hiding (count,+                                                               embed, iPre,+                                                               next, once,+                                                               reactimate,                                                                repeatedly,                                                                switch, trace) import qualified Data.MonadicStreamFunction              as MSF@@ -45,8 +46,11 @@ import           FRP.BearRiver.Hybrid                    as X import           FRP.BearRiver.Integration               as X import           FRP.BearRiver.InternalCore              as X+import           FRP.BearRiver.Random                    as X import           FRP.BearRiver.Scan                      as X+import           FRP.BearRiver.Simulation                as X import           FRP.BearRiver.Switches                  as X+import           FRP.BearRiver.Task                      as X import           FRP.BearRiver.Time                      as X  -- Internal imports (dunai, instances)@@ -77,115 +81,3 @@ -- | Loop with an initial value for the signal being fed back. loopPre :: Monad m => c -> SF m (a, c) (b, c) -> SF m a b loopPre = feedback---- * Noise (random signal) sources and stochastic event sources---- | Stochastic event source with events occurring on average once every tAvg--- seconds. However, no more than one event results from any one sampling--- interval in the case of relatively sparse sampling, thus avoiding an "event--- backlog" should sampling become more frequent at some later point in time.-occasionally :: MonadRandom m-             => Time -- ^ The time /q/ after which the event should be produced-                     -- on average-             -> b    -- ^ Value to produce at time of event-             -> SF m a (Event b)-occasionally tAvg b-    | tAvg <= 0-    = error "bearriver: Non-positive average interval in occasionally."--    | otherwise = proc _ -> do-        r   <- getRandomRS (0, 1) -< ()-        dt  <- timeDelta          -< ()-        let p = 1 - exp (-(dt / tAvg))-        returnA -< if r < p then Event b else NoEvent-  where-    timeDelta :: Monad m => SF m a DTime-    timeDelta = constM ask---- * Execution/simulation---- ** Reactimation---- | Convenience function to run a signal function indefinitely, using a IO--- actions to obtain new input and process the output.------ This function first runs the initialization action, which provides the--- initial input for the signal transformer at time 0.------ Afterwards, an input sensing action is used to obtain new input (if any) and--- the time since the last iteration. The argument to the input sensing--- function indicates if it can block. If no new input is received, it is--- assumed to be the same as in the last iteration.------ After applying the signal function to the input, the actuation IO action is--- executed. The first argument indicates if the output has changed, the second--- gives the actual output). Actuation functions may choose to ignore the first--- argument altogether. This action should return True if the reactimation must--- stop, and False if it should continue.------ Note that this becomes the program's /main loop/, which makes using this--- function incompatible with GLUT, Gtk and other graphics libraries. It may--- also impose a sizeable constraint in larger projects in which different--- subparts run at different time steps. If you need to control the main loop--- yourself for these or other reasons, use 'reactInit' and 'react'.-reactimate :: Monad m-           => m a-           -> (Bool -> m (DTime, Maybe a))-           -> (Bool -> b -> m Bool)-           -> SF Identity a b-           -> m ()-reactimate senseI sense actuate sf = do-    MSF.reactimateB $ senseSF >>> sfIO >>> actuateSF-    return ()-  where-    sfIO = morphS (return.runIdentity) (runReaderS sf)--    -- Sense-    senseSF = MSF.dSwitch senseFirst senseRest--    -- Sense: First sample-    senseFirst = constM senseI >>> arr (\x -> ((0, x), Just x))--    -- Sense: Remaining samples-    senseRest a = constM (sense True) >>> (arr id *** keepLast a)--    keepLast :: Monad m => a -> MSF m (Maybe a) a-    keepLast a = MSF $ \ma ->-      let a' = fromMaybe a ma-      in a' `seq` return (a', keepLast a')--    -- Consume/render-    actuateSF = arr (\x -> (True, x)) >>> arrM (uncurry actuate)---- * Debugging / Step by step simulation---- | Evaluate an SF, and return an output and an initialized SF.------ /WARN/: Do not use this function for standard simulation. This function is--- intended only for debugging/testing. Apart from being potentially slower and--- consuming more memory, it also breaks the FRP abstraction by making samples--- discrete and step based.-evalAtZero :: SF Identity a b -> a -> (b, SF Identity a b)-evalAtZero sf a = runIdentity $ runReaderT (unMSF sf a) 0---- | Evaluate an initialized SF, and return an output and a continuation.------ /WARN/: Do not use this function for standard simulation. This function is--- intended only for debugging/testing. Apart from being potentially slower and--- consuming more memory, it also breaks the FRP abstraction by making samples--- discrete and step based.-evalAt :: SF Identity a b -> DTime -> a -> (b, SF Identity a b)-evalAt sf dt a = runIdentity $ runReaderT (unMSF sf a) dt---- | Given a signal function and time delta, it moves the signal function into--- the future, returning a new uninitialized SF and the initial output.------ While the input sample refers to the present, the time delta refers to the--- future (or to the time between the current sample and the next sample).------ /WARN/: Do not use this function for standard simulation. This function is--- intended only for debugging/testing. Apart from being potentially slower and--- consuming more memory, it also breaks the FRP abstraction by making samples--- discrete and step based.-evalFuture :: SF Identity a b -> a -> DTime -> (b, SF Identity a b)-evalFuture sf = flip (evalAt sf)

@@ -5,12 +5,31 @@ -- License    : BSD3 -- Maintainer : ivan.perez@keera.co.uk ----- Implementation of integrals and derivatives using Monadic Stream Processing--- library.+-- Integration and derivation of input signals.+--+-- In continuous time, these primitives define SFs that integrate/derive the+-- input signal. Since this is subject to the sampling resolution, simple+-- versions are implemented (like the rectangle rule for the integral).+--+-- In discrete time, all we do is count the number of events.+--+-- The combinator 'iterFrom' gives enough flexibility to program your own+-- leak-free integration and derivation SFs.+--+-- Many primitives and combinators in this module require instances of+-- simple-affine-spaces's 'VectorSpace'. BearRiver does not enforce the use of a+-- particular vector space implementation, meaning you could use 'integral' for+-- example with other vector types like V2, V1, etc. from the library linear.+-- For an example, see+-- <https://gist.github.com/walseb/1e0a0ca98aaa9469ab5da04e24f482c2 this gist>. module FRP.BearRiver.Integration     (       -- * Integration       integral+    , imIntegral+    , trapezoidIntegral+    , impulseIntegral+    , count        -- * Differentiation     , derivative@@ -19,7 +38,7 @@   where  -- External imports-import Control.Arrow    (returnA)+import Control.Arrow    (returnA, (***), (>>^)) import Data.VectorSpace (VectorSpace, zeroVector, (*^), (^+^), (^-^), (^/))  -- Internal imports (dunai)@@ -28,9 +47,11 @@ import Data.MonadicStreamFunction.InternalCore (MSF (MSF))  -- Internal imports+import FRP.BearRiver.Event        (Event)+import FRP.BearRiver.Hybrid       (accumBy, accumHoldBy) import FRP.BearRiver.InternalCore (DTime, SF) --- * Integration and differentiation+-- * Integration  -- | Integration using the rectangle rule. integral :: (Monad m, Fractional s, VectorSpace a s) => SF m a a@@ -43,6 +64,32 @@ integralFrom a0 = proc a -> do   dt <- constM ask        -< ()   accumulateWith (^+^) a0 -< realToFrac dt *^ a++-- | \"Immediate\" integration (using the function's value at the current time).+imIntegral :: (Fractional s, VectorSpace a s, Monad m)+           => a -> SF m a a+imIntegral = ((\_ a' dt v -> v ^+^ realToFrac dt *^ a') `iterFrom`)++-- | Trapezoid integral (using the average between the value at the last time+-- and the value at the current time).+trapezoidIntegral :: (Fractional s, VectorSpace a s, Monad m) => SF m a a+trapezoidIntegral =+  iterFrom (\a a' dt v -> v ^+^ (realToFrac dt / 2) *^ (a ^+^ a')) zeroVector++-- | Integrate the first input signal and add the /discrete/ accumulation (sum)+-- of the second, discrete, input signal.+impulseIntegral :: (Fractional k, VectorSpace a k, Monad m)+                => SF m (a, Event a) a+impulseIntegral = (integral *** accumHoldBy (^+^) zeroVector) >>^ uncurry (^+^)++-- | Count the occurrences of input events.+--+-- >>> embed count (deltaEncode 1 [Event 'a', NoEvent, Event 'b'])+-- [Event 1,NoEvent,Event 2]+count :: (Integral b, Monad m) => SF m (Event a) (Event b)+count = accumBy (\n _ -> n + 1) 0++-- * Differentiation  -- | A very crude version of a derivative. It simply divides the value -- difference by the time difference. Use at your own risk.

@@ -0,0 +1,84 @@+-- |+-- Module      : FRP.BearRiver.Random+-- Copyright   : (c) Ivan Perez, 2014-2024+--               (c) George Giorgidze, 2007-2012+--               (c) Henrik Nilsson, 2005-2006+--               (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004+-- License     : BSD3+--+-- Maintainer  : ivan.perez@keera.co.uk+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+--+-- Signals and signal functions with noise and randomness.+--+-- The Random number generators are re-exported from "System.Random".+module FRP.BearRiver.Random+    (+      -- * Random number generators+      RandomGen(..)+    , Random(..)++      -- * Noise, random signals, and stochastic event sources+    , noise+    , noiseR+    , occasionally+    )+  where++-- External imports+import System.Random (Random (..), RandomGen (..))++-- Internal imports (dunai)+import Control.Monad.Trans.MSF.Except (dSwitch)+import Control.Monad.Trans.MSF.Reader (readerS)+import Data.MonadicStreamFunction     (MSF, constM, feedback)++-- Internal imports+import FRP.BearRiver.Event        (Event (..))+import FRP.BearRiver.InternalCore (DTime, SF, Time, arr)++-- * Noise (i.e. random signal generators) and stochastic processes++-- | Noise (random signal) with default range for type in question; based on+-- "randoms".+noise :: (RandomGen g, Random b, Monad m) => g -> SF m a b+noise g0 = streamToSF (randoms g0)++-- | Noise (random signal) with specified range; based on "randomRs".+noiseR :: (RandomGen g, Random b, Monad m) => (b, b) -> g -> SF m a b+noiseR range g0 = streamToSF (randomRs range g0)++-- | Turn an infinite list of elements into an SF producing those elements. The+-- SF ignores its input.+streamToSF :: Monad m => [b] -> SF m a b+streamToSF ls = feedback ls $ arr $ fAux . snd+  where+    fAux []     = error "BearRiver: streamToSF: Empty list!"+    fAux (b:bs) = (b, bs)++-- | Stochastic event source with events occurring on average once every tAvg+-- seconds. However, no more than one event results from any one sampling+-- interval in the case of relatively sparse sampling, thus avoiding an "event+-- backlog" should sampling become more frequent at some later point in time.+occasionally :: (RandomGen g, Monad m) => g -> Time -> b -> SF m a (Event b)+occasionally g tAvg x | tAvg > 0  = tf0+                      | otherwise = error $ "BearRiver: occasionally: "+                                         ++ "Non-positive average interval."+  where+    -- Generally, if events occur with an average frequency of f, the+    -- probability of at least one event occurring in an interval of t is given+    -- by (1 - exp (-f*t)). The goal in the following is to decide whether at+    -- least one event occurred in the interval of size dt preceding the current+    -- sample point. For the first point, we can think of the preceding interval+    -- as being 0, implying no probability of an event occurring.+    tf0 = dSwitch+            (constM $ return (NoEvent, Just ()))+            (const $ feedback (randoms g :: [Time]) $ readerS $ arr occAux)++    -- occAux :: (DTime, (a, [Time])) -> (Event b, [Time])+    occAux (_, (_, []))    = error "BearRiver: occasionally: Empty list!"+    occAux (dt, (_, r:rs)) =+        (if r < p then Event x else NoEvent, rs)+      where+        p = 1 - exp (- (dt / tAvg)) -- Probability for at least one event.

@@ -0,0 +1,292 @@+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Module      : FRP.BearRiver.Simulation+-- Copyright   : (c) Ivan Perez, 2014-2024+--               (c) George Giorgidze, 2007-2012+--               (c) Henrik Nilsson, 2005-2006+--               (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004+-- License     : BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  : ivan.perez@keera.co.uk+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+--+-- Execution/simulation of signal functions.+--+-- SFs can be executed in two ways: by running them, feeding input samples one+-- by one, obtained from a monadic environment (presumably, @IO@), or by passing+-- an input stream and calculating an output stream. The former is called+-- /reactimation/, and the latter is called /embedding/.+--+-- * Running:+-- Normally, to run an SF, you would use 'reactimate', providing input samples,+-- and consuming the output samples in the 'IO' monad. This function takes over+-- the program, implementing a "main loop". If you want more control over the+-- evaluation loop (for instance, if you are using BearRiver in combination+-- with a backend that also implements some main loop), you may want to use the+-- lower-level API for reactimation ('ReactHandle', 'reactInit', 'react').+--+-- * Embedding:+-- You can use 'embed' for testing, to evaluate SFs in a terminal, and to embed+-- an SF inside a larger system. The helper functions 'deltaEncode' and+-- 'deltaEncodeBy' facilitate producing input /signals/ from plain lists of+-- input samples.+--+-- This module also includes debugging aids needed to execute signal functions+-- step by step, which are used by BearRiver's testing facilities.+module FRP.BearRiver.Simulation+    (+      -- * Reactimation+      reactimate++      -- ** Low-level reactimation interface+    , ReactHandle+    , reactInit+    , react++      -- * Embedding+    , embed+    , embedSynch+    , deltaEncode+    , deltaEncodeBy++      -- * Debugging / Step by step simulation++    , FutureSF+    , evalAtZero+    , evalAt+    , evalFuture+    )+  where++-- External imports+import Control.Arrow             (arr, (***), (>>>))+import Control.Monad             (unless)+import Control.Monad.Fail        (MonadFail)+import Control.Monad.Trans.Class (lift)+import Data.Functor.Identity     (Identity, runIdentity)+import Data.IORef                (IORef, newIORef, readIORef, writeIORef)+import Data.Maybe                (fromMaybe)++-- Internal imports: dunai+import           Control.Monad.Trans.MSF                 hiding (dSwitch)+import qualified Control.Monad.Trans.MSF                 as MSF+import           Data.MonadicStreamFunction              hiding (embed,+                                                          reactimate)+import qualified Data.MonadicStreamFunction              as MSF+import           Data.MonadicStreamFunction.InternalCore (MSF (MSF, unMSF))++-- Internal imports+import FRP.BearRiver.InternalCore (DTime, SF (..))++-- * Reactimation++-- | Convenience function to run a signal function indefinitely, using a IO+-- actions to obtain new input and process the output.+--+-- This function first runs the initialization action, which provides the+-- initial input for the signal transformer at time 0.+--+-- Afterwards, an input sensing action is used to obtain new input (if any) and+-- the time since the last iteration. The argument to the input sensing function+-- indicates if it can block. If no new input is received, it is assumed to be+-- the same as in the last iteration.+--+-- After applying the signal function to the input, the actuation IO action is+-- executed. The first argument indicates if the output has changed, the second+-- gives the actual output). Actuation functions may choose to ignore the first+-- argument altogether. This action should return True if the reactimation must+-- stop, and False if it should continue.+--+-- Note that this becomes the program's /main loop/, which makes using this+-- function incompatible with GLUT, Gtk and other graphics libraries. It may+-- also impose a sizeable constraint in larger projects in which different+-- subparts run at different time steps. If you need to control the main loop+-- yourself for these or other reasons, use 'reactInit' and 'react'.+reactimate :: Monad m+           => m a                          -- ^ Initialization action+           -> (Bool -> m (DTime, Maybe a)) -- ^ Input sensing action+           -> (Bool -> b -> m Bool)        -- ^ Actuation (output processing)+                                           --   action+           -> SF m a b                     -- ^ Signal function+           -> m ()+reactimate senseI sense actuate sf = do+    MSF.reactimateB $ senseSF >>> sfIO >>> actuateSF+    return ()+  where+    sfIO = runReaderS sf++    -- Sense+    senseSF = MSF.dSwitch senseFirst senseRest++    -- Sense: First sample+    senseFirst = constM senseI >>> arr (\x -> ((0, x), Just x))++    -- Sense: Remaining samples+    senseRest a = constM (sense True) >>> (arr id *** keepLast a)++    keepLast :: Monad m => a -> MSF m (Maybe a) a+    keepLast a = MSF $ \ma ->+      let a' = fromMaybe a ma+      in a' `seq` return (a', keepLast a')++    -- Consume/render+    actuateSF = arr (\x -> (True, x)) >>> arrM (uncurry actuate)++-- An API for animating a signal function when some other library needs to own+-- the top-level control flow:++-- reactimate's state, maintained across samples:+data ReactState a b = ReactState+  { rsActuate :: ReactHandle a b -> Bool -> b -> IO Bool+  , rsSF      :: SF Identity a b+  , rsA       :: a+  , rsB       :: b+  }++-- | A reference to reactimate's state, maintained across samples.+newtype ReactHandle a b = ReactHandle+  { reactHandle :: IORef (ReactState a b) }++-- | Initialize a top-level reaction handle.+reactInit :: IO a                                      -- init+          -> (ReactHandle a b -> Bool -> b -> IO Bool) -- actuate+          -> SF Identity a b+          -> IO (ReactHandle a b)+reactInit init actuate (MSF tf0) = do+  a0 <- init+  let (b0, sf) = runReader (tf0 a0) 0+  -- TODO: really need to fix this interface, since right now we just ignore+  -- termination at time 0:+  r' <- newIORef (ReactState { rsActuate = actuate, rsSF = sf+                             , rsA = a0, rsB = b0+                             }+                 )+  let r = ReactHandle r'+  _ <- actuate r True b0+  return r++-- | Process a single input sample.+react :: ReactHandle a b+      -> (DTime, Maybe a)+      -> IO Bool+react rh (dt, ma') = do+  rs <- readIORef (reactHandle rh)+  let ReactState {rsActuate = actuate, rsSF = sf, rsA = a, rsB = _b } = rs++  let a' = fromMaybe a ma'+      (b', sf') = runReader (unMSF sf a') dt+  writeIORef (reactHandle rh) (rs {rsSF = sf', rsA = a', rsB = b'})+  done <- actuate rh True b'+  return done++-- * Embedding++-- | Given a signal function and a pair with an initial input sample for the+-- input signal, and a list of sampling times, possibly with new input samples+-- at those times, it produces a list of output samples.+--+-- This is a simplified, purely-functional version of 'reactimate'.+embed :: Monad m => SF m a b -> (a, [(DTime, Maybe a)]) -> m [b]+embed sf0 (a0, dtas) = do+    (b0, sf) <- runReaderT (unMSF sf0 a0) 0+    bs <- loop a0 sf dtas+    return $ b0 : bs+  where+    loop _ _ [] = return []+    loop aPrev sf ((dt, ma) : dtas) = do+      let a = fromMaybe aPrev ma+      (b, sf') <- runReaderT (unMSF sf a) dt+      bs <- loop a sf' dtas+      return $ a `seq` b `seq` (b : bs)++-- | Synchronous embedding. The embedded signal function is run on the supplied+-- input and time stream at a given (but variable) ratio >= 0 to the outer time+-- flow. When the ratio is 0, the embedded signal function is paused.+embedSynch :: forall m a b+            . (Monad m, MonadFail m)+           => SF m a b -> (a, [(DTime, Maybe a)]) -> SF m Double b+embedSynch sf0 (a0, dtas) = MSF tf0+  where+    tts = scanl (\t (dt, _) -> t + dt) 0 dtas++    tf0 :: Double -> ReaderT DTime m (b, SF m Double b)+    tf0 _ = do+      bbs@(b:_) <- lift (embed sf0 (a0, dtas))+      return (b, esAux 0 (zip tts bbs))++    esAux :: Double -> [(DTime, b)] -> SF m Double b+    esAux _      []    = error "BearRiver: embedSynch: Empty list!"+    -- Invarying below since esAux [] is an error.+    esAux tpPrev tbtbs = MSF tf -- True+      where+        tf r | r < 0     = error "BearRiver: embedSynch: Negative ratio."+             | otherwise = do+                 dt <- ask+                 let tp          = tpPrev + dt * r+                     (b, tbtbs') = advance tp tbtbs+                 return (b, esAux tp tbtbs')++    -- Advance the time stamped stream to the perceived time tp. Under the+    -- assumption that the perceived time never goes backwards (non-negative+    -- ratio), advance maintains the invariant that the perceived time is always+    -- >= the first time stamp.+    advance _  tbtbs@[(_, b)] = (b, tbtbs)+    advance tp tbtbtbs@((_, b) : tbtbs@((t', _) : _))+      | tp <  t' = (b, tbtbtbs)+      | t' <= tp = advance tp tbtbs+    advance _ _ = undefined++-- | Spaces a list of samples by a fixed time delta, avoiding unnecessary+-- samples when the input has not changed since the last sample.+deltaEncode :: Eq a => DTime -> [a] -> (a, [(DTime, Maybe a)])+deltaEncode _  []        = error "BearRiver: deltaEncode: Empty input list."+deltaEncode dt aas@(_:_) = deltaEncodeBy (==) dt aas++-- | 'deltaEncode' parameterized by the equality test.+deltaEncodeBy :: (a -> a -> Bool) -> DTime -> [a] -> (a, [(DTime, Maybe a)])+deltaEncodeBy _  _  []      = error "BearRiver: deltaEncodeBy: Empty input list."+deltaEncodeBy eq dt (a0:as) = (a0, zip (repeat dt) (debAux a0 as))+  where+    debAux _     []                    = []+    debAux aPrev (a:as) | a `eq` aPrev = Nothing : debAux a as+                        | otherwise    = Just a  : debAux a as++-- * Debugging / Step by step simulation++-- | A wrapper around an initialized SF (continuation), needed for testing and+-- debugging purposes.+newtype FutureSF m a b = FutureSF { unsafeSF :: SF m a b }++-- * Debugging / Step by step simulation++-- | Evaluate an SF, and return an output and an initialized SF.+--+-- /WARN/: Do not use this function for standard simulation. This function is+-- intended only for debugging/testing. Apart from being potentially slower and+-- consuming more memory, it also breaks the FRP abstraction by making samples+-- discrete and step based.+evalAtZero :: SF Identity a b -> a -> (b, SF Identity a b)+evalAtZero sf a = runIdentity $ runReaderT (unMSF sf a) 0++-- | Evaluate an initialized SF, and return an output and a continuation.+--+-- /WARN/: Do not use this function for standard simulation. This function is+-- intended only for debugging/testing. Apart from being potentially slower and+-- consuming more memory, it also breaks the FRP abstraction by making samples+-- discrete and step based.+evalAt :: SF Identity a b -> DTime -> a -> (b, SF Identity a b)+evalAt sf dt a = runIdentity $ runReaderT (unMSF sf a) dt++-- | Given a signal function and time delta, it moves the signal function into+-- the future, returning a new uninitialized SF and the initial output.+--+-- While the input sample refers to the present, the time delta refers to the+-- future (or to the time between the current sample and the next sample).+--+-- /WARN/: Do not use this function for standard simulation. This function is+-- intended only for debugging/testing. Apart from being potentially slower and+-- consuming more memory, it also breaks the FRP abstraction by making samples+-- discrete and step based.+evalFuture :: SF Identity a b -> a -> DTime -> (b, SF Identity a b)+evalFuture sf = flip (evalAt sf)

@@ -0,0 +1,187 @@+{-# LANGUAGE CPP        #-}+{-# LANGUAGE Rank2Types #-}+-- |+-- Module      : FRP.BearRiver.Task+-- Copyright   : (c) Ivan Perez, 2014-2024+--               (c) George Giorgidze, 2007-2012+--               (c) Henrik Nilsson, 2005-2006+--               (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004+-- License     : BSD3+--+-- Maintainer  : ivan.perez@keera.co.uk+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+--+-- Task abstraction on top of signal transformers.+module FRP.BearRiver.Task+    (+      -- * The Task type+      Task+    , mkTask+    , runTask+    , runTask_+    , taskToSF++      -- * Basic tasks+    , constT+    , sleepT+    , snapT++    -- * Basic tasks combinators+    , timeOut+    , abortWhen+    )+  where++-- External imports+#if __GLASGOW_HASKELL__ < 710+import Control.Applicative (Applicative(..))+#endif++-- Internal imports+import FRP.BearRiver.Basic        (constant)+import FRP.BearRiver.Event        (Event, lMerge)+import FRP.BearRiver.EventS       (after, edgeBy, never, snap)+import FRP.BearRiver.InternalCore (SF, Time, arr, first, (&&&), (>>>))+import FRP.BearRiver.Switches     (switch)++infixl 0 `timeOut`, `abortWhen`++-- * The Task type++-- | A task is a partially SF that may terminate with a result.+newtype Task m a b c =+  -- CPS-based representation allowing termination to be detected. Note the+  -- rank 2 polymorphic type! The representation can be changed if necessary,+  -- but the Monad laws follow trivially in this case.+  Task (forall d . (c -> SF m a (Either b d)) -> SF m a (Either b d))++unTask :: Monad m+       => Task m a b c -> ((c -> SF m a (Either b d)) -> SF m a (Either b d))+unTask (Task f) = f++-- | Creates a 'Task' from an SF that returns, as a second output, an 'Event'+-- when the SF terminates. See 'switch'.+mkTask :: Monad m => SF m a (b, Event c) -> Task m a b c+mkTask st = Task (switch (st >>> first (arr Left)))++-- | Runs a task.+--+-- The output from the resulting signal transformer is tagged with Left while+-- the underlying task is running. Once the task has terminated, the output+-- goes constant with the value Right x, where x is the value of the+-- terminating event.++-- Check name.+runTask :: Monad m => Task m a b c -> SF m a (Either b c)+runTask tk = (unTask tk) (constant . Right)++-- | Runs a task that never terminates.+--+-- The output becomes undefined once the underlying task has terminated.+--+-- Convenience function for tasks which are known not to terminate.+runTask_ :: Monad m => Task m a b c -> SF m a b+runTask_ tk =+  runTask tk+  >>> arr (either id (error "BearRiverTask: runTask_: Task terminated!"))++-- | Creates an SF that represents an SF and produces an event when the task+-- terminates, and otherwise produces just an output.+taskToSF :: Monad m => Task m a b c -> SF m a (b, Event c)+taskToSF tk =+    runTask tk+    >>> (arr (either id (error "BearRiverTask: runTask_: Task terminated!"))+         &&& edgeBy isEdge (Left undefined))+  where+    isEdge (Left _) (Right c) = Just c+    isEdge _        _         = Nothing++-- * Functor, Applicative and Monad instance++instance Monad m => Functor (Task m a b) where+  fmap f tk = Task (\k -> unTask tk (k . f))++instance Monad m => Applicative (Task m a b) where+  pure x  = Task (\k -> k x)+  f <*> v = Task (\k -> (unTask f) (\c -> unTask v (k . c)))++instance Monad m => Monad (Task m a b) where+  tk >>= f = Task (\k -> unTask tk (\c -> unTask (f c) k))+  return   = pure++-- Let's check the monad laws:+--+--   t >>= return+--   = \k -> t (\c -> return c k)+--   = \k -> t (\c -> (\x -> \k -> k x) c k)+--   = \k -> t (\c -> (\x -> \k' -> k' x) c k)+--   = \k -> t (\c -> k c)+--   = \k -> t k+--   = t+--   QED+--+--   return x >>= f+--   = \k -> (return x) (\c -> f c k)+--   = \k -> (\k -> k x) (\c -> f c k)+--   = \k -> (\k' -> k' x) (\c -> f c k)+--   = \k -> (\c -> f c k) x+--   = \k -> f x k+--   = f x+--   QED+--+--   (t >>= f) >>= g+--   = \k -> (t >>= f) (\c -> g c k)+--   = \k -> (\k' -> t (\c' -> f c' k')) (\c -> g c k)+--   = \k -> t (\c' -> f c' (\c -> g c k))+--   = \k -> t (\c' -> (\x -> \k' -> f x (\c -> g c k')) c' k)+--   = \k -> t (\c' -> (\x -> f x >>= g) c' k)+--   = t >>= (\x -> f x >>= g)+--   QED+--+-- No surprises (obviously, since this is essentially just the CPS monad).++-- * Basic tasks++-- | Non-terminating task with constant output b.+constT :: Monad m => b -> Task m a b c+constT b = mkTask (constant b &&& never)++-- | "Sleeps" for t seconds with constant output b.+sleepT :: Monad m => Time -> b -> Task m a b ()+sleepT t b = mkTask (constant b &&& after t ())++-- | Takes a "snapshot" of the input and terminates immediately with the input+-- value as the result.+--+-- No time passes; therefore, the following must hold:+--+-- @snapT >> snapT = snapT@+snapT :: Monad m => Task m a b a+snapT = mkTask (constant (error "BearRiverTask: snapT: Bad switch?") &&& snap)++-- * Basic tasks combinators++-- | Impose a time out on a task.+timeOut :: Monad m => Task m a b c -> Time -> Task m a b (Maybe c)+tk `timeOut` t = mkTask ((taskToSF tk &&& after t ()) >>> arr aux)+  where+    aux ((b, ec), et) = (b, lMerge (fmap Just ec) (fmap (const Nothing) et))++-- | Run a "guarding" event source (SF m a (Event b)) in parallel with a+-- (possibly non-terminating) task.+--+-- The task will be aborted at the first occurrence of the event source (if it+-- has not terminated itself before that).+--+-- Useful for separating sequencing and termination concerns.  E.g. we can do+-- something "useful", but in parallel watch for a (exceptional) condition+-- which should terminate that activity, without having to check for that+-- condition explicitly during each and every phase of the activity.+--+-- Example: @tsk `abortWhen` lbp@+abortWhen :: Monad m+          => Task m a b c -> SF m a (Event d) -> Task m a b (Either c d)+tk `abortWhen` est = mkTask ((taskToSF tk &&& est) >>> arr aux)+  where+    aux ((b, ec), ed) = (b, lMerge (fmap Left ec) (fmap Right ed))

@@ -9,7 +9,7 @@ import Data.Functor.Identity (Identity)  -- Internal imports-import           FRP.BearRiver as X hiding (SF)+import           FRP.BearRiver as X hiding (FutureSF, SF) import qualified FRP.BearRiver as BR  -- | Signal function (conceptually, a function between signals that respects