bearriver 0.14.4 → 0.14.5

raw patch · 9 files changed

+943/−553 lines, 9 filesdep ~deepseqdep ~dunaiPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: deepseq, dunai

API changes (from Hackage documentation)

Files

• CHANGELOG +8/−0
• bearriver.cabal +9/−3
• src/FRP/BearRiver.hs +19/−550
• src/FRP/BearRiver/Conditional.hs +70/−0
• src/FRP/BearRiver/Delays.hs +107/−0
• src/FRP/BearRiver/Event.hs +286/−0
• src/FRP/BearRiver/EventS.hs +206/−0
• src/FRP/BearRiver/Scan.hs +54/−0
• src/FRP/BearRiver/Switches.hs +184/−0

@@ -1,3 +1,11 @@+2023-10-21 Ivan Perez <ivan.perez@keera.co.uk>+        * Version bump (0.14.5) (#388).+        * Offer all definitions from FRP.Yampa.Event (#380).+        * Offer all definitions from FRP.Yampa.Conditional (#382).+        * Offer all definitions from FRP.Yampa.Scan (#383).+        * Offer all definitions from FRP.Yampa.Delays (#384).+        * Relax upper version constraint on deepseq (#386).+ 2023-08-21 Ivan Perez <ivan.perez@keera.co.uk>         * Version bump (0.14.4) (#377).         * Offer all definitions from FRP.Yampa.Basic (#376).

@@ -30,7 +30,7 @@ build-type:    Simple  name:          bearriver-version:       0.14.4+version:       0.14.5 author:        Ivan Perez, Manuel Bärenz maintainer:    ivan.perez@keera.co.uk homepage:      https://github.com/ivanperez-keera/dunai@@ -78,6 +78,12 @@     FRP.BearRiver     FRP.BearRiver.Arrow     FRP.BearRiver.Basic+    FRP.BearRiver.Conditional+    FRP.BearRiver.Delays+    FRP.BearRiver.Event+    FRP.BearRiver.EventS+    FRP.BearRiver.Scan+    FRP.BearRiver.Switches     FRP.Yampa    other-modules:@@ -85,8 +91,8 @@    build-depends:       base >= 4.6 && <5-    , deepseq             >= 1.3.0.0 && < 1.5-    , dunai >= 0.6.0 && < 0.12+    , deepseq             >= 1.3.0.0 && < 1.6+    , dunai >= 0.6.0 && < 0.13     , MonadRandom         >= 0.2   && < 0.7     , mtl                 >= 2.1.2 && < 2.3     , simple-affine-space >= 0.1   && < 0.3

@@ -21,104 +21,35 @@   where  -- External imports-#if !MIN_VERSION_base(4,8,0)-import           Control.Applicative       (Applicative (..), (<$>))-#endif-import           Control.Applicative       (Alternative (..))-import           Control.Arrow             as X-import           Control.DeepSeq           (NFData (..))-import qualified Control.Monad.Fail        as Fail-import           Control.Monad.Random      (MonadRandom)-import           Data.Functor.Identity     (Identity (..))-import           Data.Maybe                (fromMaybe)-import           Data.Traversable          as T-import           Data.VectorSpace          as X+import Control.Arrow         as X+import Control.Monad.Random  (MonadRandom)+import Data.Functor.Identity (Identity (..))+import Data.Maybe            (fromMaybe)+import Data.VectorSpace      as X  -- Internal imports (dunai)-import           Control.Monad.Trans.MSF                 hiding (dSwitch,-                                                          switch)+import           Control.Monad.Trans.MSF                 hiding (dSwitch) import qualified Control.Monad.Trans.MSF                 as MSF-import           Control.Monad.Trans.MSF.List            (sequenceS, widthFirst)-import           Data.MonadicStreamFunction              (iPre)-import           Data.MonadicStreamFunction              as X hiding-                                                              (reactimate,+import           Data.MonadicStreamFunction              as X hiding (iPre,+                                                               once, reactimate,                                                                repeatedly,-                                                               trace)+                                                               switch, trace)+import qualified Data.MonadicStreamFunction              as MSF import           Data.MonadicStreamFunction.InternalCore (MSF (MSF, unMSF)) import           FRP.BearRiver.Arrow                     as X import           FRP.BearRiver.Basic                     as X+import           FRP.BearRiver.Conditional               as X+import           FRP.BearRiver.Delays                    as X+import           FRP.BearRiver.Event                     as X+import           FRP.BearRiver.EventS                    as X import           FRP.BearRiver.InternalCore              as X+import           FRP.BearRiver.Scan                      as X+import           FRP.BearRiver.Switches                  as X  -- Internal imports (dunai, instances) import Data.MonadicStreamFunction.Instances.ArrowLoop () -- not needed, just                                                          -- re-exported-                                                         -- --- * Basic definitions---- | A single possible event occurrence, that is, a value that may or may not--- occur. Events are used to represent values that are not produced--- continuously, such as mouse clicks (only produced when the mouse is clicked,--- as opposed to mouse positions, which are always defined).-data Event a = Event a | NoEvent-  deriving (Eq, Ord, Show)---- | The type 'Event' is isomorphic to 'Maybe'. The 'Functor' instance of--- 'Event' is analogous to the 'Functor' instance of 'Maybe', where the given--- function is applied to the value inside the 'Event', if any.-instance Functor Event where-  fmap _ NoEvent   = NoEvent-  fmap f (Event c) = Event (f c)---- | The type 'Event' is isomorphic to 'Maybe'. The 'Applicative' instance of--- 'Event' is analogous to the 'Applicative' instance of 'Maybe', where the--- lack of a value (i.e., 'NoEvent') causes '(<*>)' to produce no value--- ('NoEvent').-instance Applicative Event where-  pure = Event--  Event f <*> Event x = Event (f x)-  _       <*> _       = NoEvent---- | The type 'Event' is isomorphic to 'Maybe'. The 'Monad' instance of 'Event'--- is analogous to the 'Monad' instance of 'Maybe', where the lack of a value--- (i.e., 'NoEvent') causes bind to produce no value ('NoEvent').-instance Monad Event where-  return = pure--  Event x >>= f = f x-  NoEvent >>= _ = NoEvent---- | MonadFail instance-instance Fail.MonadFail Event where-  -- | Fail with 'NoEvent'.-  fail _ = NoEvent---- | Alternative instance-instance Alternative Event where-  -- | An empty alternative carries no event, so it is ignored.-  empty = NoEvent-  -- | Merge favouring the left event ('NoEvent' only if both are 'NoEvent').-  NoEvent <|> r = r-  l       <|> _ = l---- | NFData instance-instance NFData a => NFData (Event a) where-  -- | Evaluate value carried by event.-  rnf NoEvent   = ()-  rnf (Event a) = rnf a `seq` ()---- ** Lifting---- | Lifts a pure function into a signal function (applied pointwise).-arrPrim :: Monad m => (a -> b) -> SF m a b-arrPrim = arr---- | Lifts a pure function into a signal function applied to events (applied--- pointwise).-arrEPrim :: Monad m => (Event a -> b) -> SF m (Event a) b-arrEPrim = arr- -- * Signal functions  -- ** Basic signal functions@@ -131,103 +62,6 @@ time :: Monad m => SF m a Time time = localTime ---- * Simple, stateful signal processing---- | Applies a function point-wise, using the last output as next input. This--- creates a well-formed loop based on a pure, auxiliary function.-sscan :: Monad m => (b -> a -> b) -> b -> SF m a b-sscan f bInit = feedback bInit u-  where-    u = undefined -- (arr f >>^ dup)---- | Generic version of 'sscan', in which the auxiliary function produces an--- internal accumulator and an "held" output.------ Applies a function point-wise, using the last known 'Just' output to form--- the output, and next input accumulator. If the output is 'Nothing', the last--- known accumulators are used. This creates a well-formed loop based on a--- pure, auxiliary function.-sscanPrim :: Monad m => (c -> a -> Maybe (c, b)) -> c -> b -> SF m a b-sscanPrim f cInit bInit = MSF $ \a -> do-  let o = f cInit a-  case o of-    Nothing       -> return (bInit, sscanPrim f cInit bInit)-    Just (c', b') -> return (b',    sscanPrim f c' b')---- | Event source that never occurs.-never :: Monad m => SF m a (Event b)-never = constant NoEvent---- | Event source with a single occurrence at time 0. The value of the event is--- given by the function argument.-now :: Monad m => b -> SF m a (Event b)-now b0 = Event b0 --> never---- | Event source with a single occurrence at or as soon after (local) time /q/--- as possible.-after :: Monad m-      => Time -- ^ The time /q/ after which the event should be produced-      -> b    -- ^ Value to produce at that time-      -> SF m a (Event b)-after q x = feedback q go-  where-    go = MSF $ \(_, t) -> do-           dt <- ask-           let t' = t - dt-               e  = if t > 0 && t' < 0 then Event x else NoEvent-               ct = if t' < 0 then constant (NoEvent, t') else go-           return ((e, t'), ct)---- | Event source with repeated occurrences with interval q.------ Note: If the interval is too short w.r.t. the sampling intervals, the result--- will be that events occur at every sample. However, no more than one event--- results from any sampling interval, thus avoiding an "event backlog" should--- sampling become more frequent at some later point in time.-repeatedly :: Monad m => Time -> b -> SF m a (Event b)-repeatedly q x-    | q > 0     = afterEach qxs-    | otherwise = error "bearriver: repeatedly: Non-positive period."-  where-    qxs = (q, x):qxs---- | Event source with consecutive occurrences at the given intervals.------ Should more than one event be scheduled to occur in any sampling interval,--- only the first will in fact occur to avoid an event backlog.---- After all, after, repeatedly etc. are defined in terms of afterEach.-afterEach :: Monad m => [(Time, b)] -> SF m a (Event b)-afterEach qxs = afterEachCat qxs >>> arr (fmap head)---- | Event source with consecutive occurrences at the given intervals.------ Should more than one event be scheduled to occur in any sampling interval,--- the output list will contain all events produced during that interval.-afterEachCat :: Monad m => [(Time, b)] -> SF m a (Event [b])-afterEachCat = afterEachCat' 0-  where-    afterEachCat' :: Monad m => Time -> [(Time, b)] -> SF m a (Event [b])-    afterEachCat' _ []  = never-    afterEachCat' t qxs = MSF $ \_ -> do-      dt <- ask-      let (ev, t', qxs') = fireEvents [] (t + dt) qxs-          ev' = if null ev-                  then NoEvent-                  else Event (reverse ev)--      return (ev', afterEachCat' t' qxs')--    fireEvents :: [b] -> Time -> [(Time, b)] -> ([b], Time, [(Time, b)])-    fireEvents ev t []       = (ev, t, [])-    fireEvents ev t (qx:qxs)-        | fst qx < 0   = error "bearriver: afterEachCat: Non-positive period."-        | overdue >= 0 = fireEvents (snd qx:ev) overdue qxs-        | otherwise    = (ev, t, qx:qxs)-      where-        overdue = t - fst qx- -- * Events  -- | Apply an 'MSF' to every input. Freezes temporarily if the input is@@ -254,371 +88,6 @@ boolToEvent True  = Event () boolToEvent False = NoEvent --- * Hybrid SF m combinators---- | A rising edge detector. Useful for things like detecting key presses. It--- is initialised as /up/, meaning that events occurring at time 0 will not be--- detected.-edge :: Monad m => SF m Bool (Event ())-edge = edgeFrom True---- | A rising edge detector that can be initialized as up ('True', meaning that--- events occurring at time 0 will not be detected) or down ('False', meaning--- that events occurring at time 0 will be detected).-iEdge :: Monad m => Bool -> SF m Bool (Event ())-iEdge = edgeFrom---- | Like 'edge', but parameterized on the tag value.------ From Yampa-edgeTag :: Monad m => a -> SF m Bool (Event a)-edgeTag a = edge >>> arr (`tag` a)---- | Edge detector particularized for detecting transitions on a 'Maybe'--- signal from 'Nothing' to 'Just'.------ From Yampa---- !!! 2005-07-09: To be done or eliminated--- !!! Maybe could be kept as is, but could be easy to implement directly in--- !!! terms of sscan?-edgeJust :: Monad m => SF m (Maybe a) (Event a)-edgeJust = edgeBy isJustEdge (Just undefined)-  where-    isJustEdge Nothing  Nothing     = Nothing-    isJustEdge Nothing  ma@(Just _) = ma-    isJustEdge (Just _) (Just _)    = Nothing-    isJustEdge (Just _) Nothing     = Nothing---- | Edge detector parameterized on the edge detection function and initial--- state, i.e., the previous input sample. The first argument to the edge--- detection function is the previous sample, the second the current one.-edgeBy :: Monad m => (a -> a -> Maybe b) -> a -> SF m a (Event b)-edgeBy isEdge aPrev = MSF $ \a ->-  return (maybeToEvent (isEdge aPrev a), edgeBy isEdge a)---- | Convert a maybe value into a event ('Event' is isomorphic to 'Maybe').-maybeToEvent :: Maybe a -> Event a-maybeToEvent = maybe NoEvent Event---- | A rising edge detector that can be initialized as up ('True', meaning that--- events occurring at time 0 will not be detected) or down ('False', meaning--- that events occurring at time 0 will be detected).-edgeFrom :: Monad m => Bool -> SF m Bool (Event())-edgeFrom prev = MSF $ \a -> do-  let res | prev      = NoEvent-          | a         = Event ()-          | otherwise = NoEvent-      ct  = edgeFrom a-  return (res, ct)---- * Stateful event suppression---- | Suppression of initial (at local time 0) event.-notYet :: Monad m => SF m (Event a) (Event a)-notYet = feedback False $ arr (\(e, c) ->-  if c then (e, True) else (NoEvent, True))---- | Suppress all but the first event.-once :: Monad m => SF m (Event a) (Event a)-once = takeEvents 1---- | Suppress all but the first n events.-takeEvents :: Monad m => Int -> SF m (Event a) (Event a)-takeEvents n | n <= 0 = never-takeEvents n = dSwitch (arr dup) (const (NoEvent >-- takeEvents (n - 1)))---- | Suppress first n events.---- Here dSwitch or switch does not really matter.-dropEvents :: Monad m => Int -> SF m (Event a) (Event a)-dropEvents n | n <= 0 = identity-dropEvents n =-  dSwitch (never &&& identity) (const (NoEvent >-- dropEvents (n - 1)))---- * Pointwise functions on events---- | Make the NoEvent constructor available. Useful e.g. for initialization,--- ((-->) & friends), and it's easily available anyway (e.g. mergeEvents []).-noEvent :: Event a-noEvent = NoEvent---- | Suppress any event in the first component of a pair.-noEventFst :: (Event a, b) -> (Event c, b)-noEventFst (_, b) = (NoEvent, b)---- | Suppress any event in the second component of a pair.-noEventSnd :: (a, Event b) -> (a, Event c)-noEventSnd (a, _) = (a, NoEvent)---- | An event-based version of the maybe function.-event :: a -> (b -> a) -> Event b -> a-event _ f (Event x) = f x-event x _ NoEvent   = x---- | Extract the value from an event. Fails if there is no event.-fromEvent :: Event a -> a-fromEvent (Event x) = x-fromEvent _         = error "fromEvent NoEvent"---- | Tests whether the input represents an actual event.-isEvent :: Event a -> Bool-isEvent (Event _) = True-isEvent _         = False---- | Negation of 'isEvent'.-isNoEvent :: Event a -> Bool-isNoEvent (Event _) = False-isNoEvent _         = True---- | Tags an (occurring) event with a value ("replacing" the old value).------ Applicative-based definition:--- tag = ($>)-tag :: Event a -> b -> Event b-tag NoEvent   _ = NoEvent-tag (Event _) b = Event b---- | Tags an (occurring) event with a value ("replacing" the old value). Same--- as 'tag' with the arguments swapped.------ Applicative-based definition:--- tagWith = (<$)-tagWith :: b -> Event a -> Event b-tagWith = flip tag---- | Attaches an extra value to the value of an occurring event.-attach :: Event a -> b -> Event (a, b)-e `attach` b = fmap (\a -> (a, b)) e---- | Left-biased event merge (always prefer left event, if present).-lMerge :: Event a -> Event a -> Event a-lMerge = mergeBy (\e1 _ -> e1)---- | Right-biased event merge (always prefer right event, if present).-rMerge :: Event a -> Event a -> Event a-rMerge = flip lMerge---- | Unbiased event merge: simultaneous occurrence is an error.-merge :: Event a -> Event a -> Event a-merge = mergeBy $ error "Bearriver: merge: Simultaneous event occurrence."---- Applicative-based definition:--- mergeBy f le re = (f <$> le <*> re) <|> le <|> re-mergeBy :: (a -> a -> a) -> Event a -> Event a -> Event a-mergeBy _       NoEvent      NoEvent      = NoEvent-mergeBy _       le@(Event _) NoEvent      = le-mergeBy _       NoEvent      re@(Event _) = re-mergeBy resolve (Event l)    (Event r)    = Event (resolve l r)---- | A generic event merge-map utility that maps event occurrences, merging the--- results. The first three arguments are mapping functions, the third of which--- will only be used when both events are present. Therefore, 'mergeBy' =--- 'mapMerge' 'id' 'id'------ Applicative-based definition:--- mapMerge lf rf lrf le re = (f <$> le <*> re) <|> (lf <$> le) <|> (rf <$> re)-mapMerge :: (a -> c)-            -- ^ Mapping function used when first event is present.-         -> (b -> c)-            -- ^ Mapping function used when second event is present.-         -> (a -> b -> c)-            -- ^ Mapping function used when both events are present.-         -> Event a-            -- ^ First event-         -> Event b-            -- ^ Second event-         -> Event c-mapMerge _  _  _   NoEvent   NoEvent   = NoEvent-mapMerge lf _  _   (Event l) NoEvent   = Event (lf l)-mapMerge _  rf _   NoEvent   (Event r) = Event (rf r)-mapMerge _  _  lrf (Event l) (Event r) = Event (lrf l r)---- | Merge a list of events; foremost event has priority.------ Foldable-based definition:--- mergeEvents :: Foldable t => t (Event a) -> Event a--- mergeEvents =  asum-mergeEvents :: [Event a] -> Event a-mergeEvents = foldr lMerge NoEvent---- | Collect simultaneous event occurrences; no event if none.-catEvents :: [Event a] -> Event [a]-catEvents eas = case [ a | Event a <- eas ] of-                  [] -> NoEvent-                  as -> Event as---- | Join (conjunction) of two events. Only produces an event if both events--- exist.------ Applicative-based definition:--- joinE = liftA2 (,)-joinE :: Event a -> Event b -> Event (a, b)-joinE NoEvent   _         = NoEvent-joinE _         NoEvent   = NoEvent-joinE (Event l) (Event r) = Event (l, r)---- | Split event carrying pairs into two events.-splitE :: Event (a, b) -> (Event a, Event b)-splitE NoEvent        = (NoEvent, NoEvent)-splitE (Event (a, b)) = (Event a, Event b)----------------------------------------------------------------------------------- Event filtering----------------------------------------------------------------------------------- | Filter out events that don't satisfy some predicate.-filterE :: (a -> Bool) -> Event a -> Event a-filterE p e@(Event a) = if p a then e else NoEvent-filterE _ NoEvent     = NoEvent---- | Combined event mapping and filtering. Note: since 'Event' is a 'Functor',--- see 'fmap' for a simpler version of this function with no filtering.-mapFilterE :: (a -> Maybe b) -> Event a -> Event b-mapFilterE _ NoEvent   = NoEvent-mapFilterE f (Event a) = case f a of-                           Nothing -> NoEvent-                           Just b  -> Event b---- | Enable/disable event occurrences based on an external condition.-gate :: Event a -> Bool -> Event a-_ `gate` False = NoEvent-e `gate` True  = e---- * Switching---- ** Basic switchers---- | Basic switch.------ By default, the first signal function is applied. Whenever the second value--- in the pair actually is an event, the value carried by the event is used to--- obtain a new signal function to be applied *at that time and at future--- times*. Until that happens, the first value in the pair is produced in the--- output signal.------ Important note: at the time of switching, the second signal function is--- applied immediately. If that second SF can also switch at time zero, then a--- double (nested) switch might take place. If the second SF refers to the--- first one, the switch might take place infinitely many times and never be--- resolved.------ Remember: The continuation is evaluated strictly at the time--- of switching!-switch :: Monad m => SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b-switch sf sfC = MSF $ \a -> do-  (o, ct) <- unMSF sf a-  case o of-    (_, Event c) -> local (const 0) (unMSF (sfC c) a)-    (b, NoEvent) -> return (b, switch ct sfC)---- | Switch with delayed observation.------ By default, the first signal function is applied.------ Whenever the second value in the pair actually is an event, the value--- carried by the event is used to obtain a new signal function to be applied--- *at future times*.------ Until that happens, the first value in the pair is produced in the output--- signal.------ Important note: at the time of switching, the second signal function is used--- immediately, but the current input is fed by it (even though the actual--- output signal value at time 0 is discarded).------ If that second SF can also switch at time zero, then a double (nested)--- switch might take place. If the second SF refers to the first one, the--- switch might take place infinitely many times and never be resolved.------ Remember: The continuation is evaluated strictly at the time--- of switching!-dSwitch :: Monad m => SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b-dSwitch sf sfC = MSF $ \a -> do-  (o, ct) <- unMSF sf a-  case o of-    (b, Event c) -> do (_, ct') <- local (const 0) (unMSF (sfC c) a)-                       return (b, ct')-    (b, NoEvent) -> return (b, dSwitch ct sfC)---- * Parallel composition and switching---- ** Parallel composition and switching over collections with broadcasting--#if MIN_VERSION_base(4,8,0)-parB :: Monad m => [SF m a b] -> SF m a [b]-#else-parB :: (Functor m, Monad m) => [SF m a b] -> SF m a [b]-#endif--- ^ Spatial parallel composition of a signal function collection. Given a--- collection of signal functions, it returns a signal function that broadcasts--- its input signal to every element of the collection, to return a signal--- carrying a collection of outputs. See 'par'.------ For more information on how parallel composition works, check--- <https://www.antonycourtney.com/pubs/hw03.pdf>-parB = widthFirst . sequenceS---- | Decoupled parallel switch with broadcasting (dynamic collection of signal--- functions spatially composed in parallel). See 'dpSwitch'.------ For more information on how parallel composition works, check--- <https://www.antonycourtney.com/pubs/hw03.pdf>-dpSwitchB :: (Functor m, Monad m, Traversable col)-          => col (SF m a b)-          -> SF m (a, col b) (Event c)-          -> (col (SF m a b) -> c -> SF m a (col b))-          -> SF m a (col b)-dpSwitchB sfs sfF sfCs = MSF $ \a -> do-  res <- T.mapM (`unMSF` a) sfs-  let bs   = fmap fst res-      sfs' = fmap snd res-  (e, sfF') <- unMSF sfF (a, bs)-  ct <- case e of-          Event c -> snd <$> unMSF (sfCs sfs c) a-          NoEvent -> return (dpSwitchB sfs' sfF' sfCs)-  return (bs, ct)---- ** Parallel composition over collections---- | Apply an SF to every element of a list.------ Example:------ >>> embed (parC integral) (deltaEncode 0.1 [[1, 2], [2, 4], [3, 6], [4.0, 8.0 :: Float]])--- [[0.0,0.0],[0.1,0.2],[0.3,0.6],[0.6,1.2]]------ The number of SFs or expected inputs is determined by the first input--- list, and not expected to vary over time.------ If more inputs come in a subsequent list, they are ignored.------ >>> embed (parC (arr (+1))) (deltaEncode 0.1 [[0], [1, 1], [3, 4], [6, 7, 8], [1, 1], [0, 0], [1, 9, 8]])--- [[1],[2],[4],[7],[2],[1],[2]]------ If less inputs come in a subsequent list, an exception is thrown.------ >>> embed (parC (arr (+1))) (deltaEncode 0.1 [[0, 0], [1, 1], [3, 4], [6, 7, 8], [1, 1], [0, 0], [1, 9, 8]])--- [[1,1],[2,2],[4,5],[7,8],[2,2],[1,1],[2,10]]-parC :: Monad m => SF m a b -> SF m [a] [b]-parC = parC0-  where-    parC0 :: Monad m => SF m a b -> SF m [a] [b]-    parC0 sf0 = MSF $ \as -> do-      os <- T.mapM (\(a, sf) -> unMSF sf a) $-              zip as (replicate (length as) sf0)--      let bs  = fmap fst os-          cts = fmap snd os-      return (bs, parC' cts)--    parC' :: Monad m => [SF m a b] -> SF m [a] [b]-    parC' sfs = MSF $ \as -> do-      os <- T.mapM (\(a, sf) -> unMSF sf a) $ zip as sfs-      let bs  = fmap fst os-          cts = fmap snd os-      return (bs, parC' cts)- -- * Discrete to continuous-time signal functions  -- ** Wave-form generation@@ -681,9 +150,9 @@ -- Starts from a given value for the input signal at time zero. derivativeFrom :: (Monad m, Fractional s, VectorSpace a s) => a -> SF m a a derivativeFrom a0 = proc a -> do-  dt   <- constM ask -< ()-  aOld <- iPre a0    -< a-  returnA            -< (a ^-^ aOld) ^/ realToFrac dt+  dt   <- constM ask  -< ()+  aOld <- MSF.iPre a0 -< a+  returnA             -< (a ^-^ aOld) ^/ realToFrac dt  -- | Integrate using an auxiliary function that takes the current and the last -- input, the time between those samples, and the last output, and returns a

@@ -0,0 +1,70 @@+-- |+-- Module      : FRP.Yampa+-- Copyright   : (c) Ivan Perez, 2014-2022+--               (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)+--+-- Apply SFs only under certain conditions.+module FRP.BearRiver.Conditional+    (+      -- * Guards and automata-oriented combinators+      provided++      -- * Variable pause+    , pause+    )+  where++-- External imports+import Control.Arrow ((&&&), (^>>))++import Data.MonadicStreamFunction.InternalCore (MSF (MSF, unMSF))++-- Internal imports+import FRP.BearRiver.Basic        (constant)+import FRP.BearRiver.EventS       (edge, snap)+import FRP.BearRiver.InternalCore (SF (..))+import FRP.BearRiver.Switches     (switch)++-- * Guards and automata-oriented combinators++-- | Runs a signal function only when a given predicate is satisfied, otherwise+-- runs the other signal function.+--+-- This is similar to 'ArrowChoice', except that this resets the SFs after each+-- transition.+--+-- For example, the following integrates the incoming input numbers, using one+-- integral if the numbers are even, and another if the input numbers are odd.+-- Note how, every time we "switch", the old value of the integral is discarded.+--+-- >>> embed (provided (even . round) integral integral) (deltaEncode 1 [1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2 :: Double])+-- [0.0,1.0,2.0,0.0,2.0,4.0,0.0,1.0,2.0,0.0,2.0,4.0]+provided :: Monad m => (a -> Bool) -> SF m a b -> SF m a b -> SF m a b+provided p sft sff =+    switch (constant undefined &&& snap) $ \a0 ->+      if p a0 then stt else stf+  where+    stt = switch (sft &&& (not . p ^>> edge)) (const stf)+    stf = switch (sff &&& (p ^>> edge)) (const stt)++-- * Variable pause++-- | Given a value in an accumulator (b), a predicate signal function (sfC),+-- and a second signal function (sf), pause will produce the accumulator b if+-- sfC input is True, and will transform the signal using sf otherwise. It acts+-- as a pause with an accumulator for the moments when the transformation is+-- paused.+pause :: Monad m => b -> SF m a Bool -> SF m a b -> SF m a b+pause b sfC sf = MSF $ \a0 -> do+   (p, sfC') <- unMSF sfC a0+   case p of+     True  -> return (b, pause b sfC' sf)+     False -> do (b', sf') <- unMSF sf a0+                 return (b', pause b' sfC' sf')

@@ -0,0 +1,107 @@+-- |+-- Module      : FRP.BearRiver.Delays+-- Copyright   : (c) Ivan Perez, 2014-2023+--               (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)+--+-- SF primitives and combinators to delay signals, introducing new values in+-- them.+module FRP.BearRiver.Delays+    (+      -- * Basic delays+      pre+    , iPre+    , fby++      -- * Timed delays+    , delay+    )+  where++-- External imports+import Control.Arrow ((>>>))++-- Internal imports (dunai)+import Control.Monad.Trans.MSF                 (ask)+import Data.MonadicStreamFunction.InternalCore (MSF (..))++-- Internal imports+import FRP.BearRiver.Basic        (identity, (-->))+import FRP.BearRiver.InternalCore (SF (..), Time)+import FRP.BearRiver.Scan         (sscanPrim)++infixr 0 `fby`++-- * Delays++-- | Uninitialized delay operator.+--+-- The output has an infinitesimal delay (1 sample), and the value at time zero+-- is undefined.+pre :: Monad m => SF m a a+pre = sscanPrim f uninit uninit+  where+    f c a = Just (a, c)+    uninit = error "bearriver: pre: Uninitialized pre operator."++-- | Initialized delay operator.+--+-- Creates an SF that delays the input signal, introducing an infinitesimal+-- delay (one sample), using the given argument to fill in the initial output at+-- time zero.+iPre :: Monad m => a -> SF m a a+iPre = (--> pre)++-- | Lucid-Synchrone-like initialized delay (read "followed by").+--+-- Initialized delay combinator, introducing an infinitesimal delay (one sample)+-- in given 'SF', using the given argument to fill in the initial output at time+-- zero.+--+-- The difference with 'iPre' is that 'fby' takes an 'SF' as argument.+fby :: Monad m => b -> SF m a b -> SF m a b+b0 `fby` sf = b0 --> sf >>> pre++-- * Timed delays++-- | Delay a signal by a fixed time 't', using the second parameter to fill in+-- the initial 't' seconds.+delay :: Monad m => Time -> a -> SF m a a+delay q aInit | q < 0     = error "bearriver: delay: Negative delay."+              | q == 0    = identity+              | otherwise = MSF tf0+  where+    tf0 a0 = return (aInit, delayAux [] [(q, a0)] 0 aInit)++    -- Invariants:+    -- tDiff measure the time since the latest output sample ideally should have+    -- been output. Whenever that equals or exceeds the time delta for the next+    -- buffered sample, it is time to output a new sample (although not+    -- necessarily the one first in the queue: it might be necessary to "catch+    -- up" by discarding samples.  0 <= tDiff < bdt, where bdt is the buffered+    -- time delta for the sample on the front of the buffer queue.+    --+    -- Sum of time deltas in the queue >= q.+    delayAux _ [] _ _ = undefined+    delayAux rbuf buf@((bdt, ba) : buf') tDiff aPrev = MSF tf -- True+      where+        tf a = do+          dt <- ask+          let tDiff' = tDiff + dt+              rbuf'  = (dt, a) : rbuf+          if (tDiff' < bdt)+            then return (aPrev, delayAux rbuf' buf tDiff' aPrev)+            else nextSmpl rbuf' buf' (tDiff' - bdt) ba+          where++            nextSmpl rbuf [] tDiff a =+              nextSmpl [] (reverse rbuf) tDiff a+            nextSmpl rbuf buf@((bdt, ba) : buf') tDiff a+              | tDiff < bdt = return (a, delayAux rbuf buf tDiff a)+              | otherwise   = nextSmpl rbuf buf' (tDiff - bdt) ba

@@ -0,0 +1,286 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : FRP.BearRiver.Event+-- Copyright   : (c) Ivan Perez, 2014-2022+--               (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 : portable+--+-- Events in BearRiver represent discrete time-signals, meaning those that do+-- not change continuously. Examples of event-carrying signals would be mouse+-- clicks (in between clicks it is assumed that there is no click), some+-- keyboard events, button presses on wiimotes or window-manager events.+--+-- The type 'Event' is isomorphic to 'Maybe' (@Event a = NoEvent | Event a@)+-- but, semantically, a 'Maybe'-carrying signal could change continuously,+-- whereas an 'Event'-carrying signal should not: for two events in subsequent+-- samples, there should be an small enough sampling frequency such that we+-- sample between those two samples and there are no 'Event's between them.+-- Nevertheless, no mechanism in Yampa will check this or misbehave if this+-- assumption is violated.+--+-- Events are essential for many other BearRiver constructs, like switches (see+-- 'FRP.BearRiver.Switches.switch' for details).+module FRP.BearRiver.Event+    (+      -- * The Event type+      Event(..)+    , noEvent+    , noEventFst+    , noEventSnd++      -- * Utility functions similar to those available for Maybe+    , event+    , fromEvent+    , isEvent+    , isNoEvent++      -- * Event tagging+    , tag+    , tagWith+    , attach++      -- * Event merging (disjunction) and joining (conjunction)+    , lMerge+    , rMerge+    , merge+    , mergeBy+    , mapMerge+    , mergeEvents+    , catEvents+    , joinE+    , splitE++      -- * Event filtering+    , filterE+    , mapFilterE+    , gate++      -- * Utilities for easy event construction+    , maybeToEvent++    )+  where++-- External imports+#if !MIN_VERSION_base(4,8,0)+import           Control.Applicative (Applicative (..), (<$>))+#endif+import           Control.Applicative (Alternative (..))+import           Control.DeepSeq     (NFData (..))+import qualified Control.Monad.Fail  as Fail++infixl 8 `tag`, `attach`, `gate`+infixl 7 `joinE`+infixl 6 `lMerge`, `rMerge`, `merge`++-- * The Event type++-- | A single possible event occurrence, that is, a value that may or may not+-- occur. Events are used to represent values that are not produced+-- continuously, such as mouse clicks (only produced when the mouse is clicked,+-- as opposed to mouse positions, which are always defined).+data Event a = Event a | NoEvent+  deriving (Eq, Ord, Show)++-- | Make the NoEvent constructor available. Useful e.g. for initialization,+-- ((-->) & friends), and it's easily available anyway (e.g. mergeEvents []).+noEvent :: Event a+noEvent = NoEvent++-- | Suppress any event in the first component of a pair.+noEventFst :: (Event a, b) -> (Event c, b)+noEventFst (_, b) = (NoEvent, b)++-- | Suppress any event in the second component of a pair.+noEventSnd :: (a, Event b) -> (a, Event c)+noEventSnd (a, _) = (a, NoEvent)+++-- | Functor instance (could be derived).+instance Functor Event where+  -- | Apply function to value carried by 'Event', if any.+  fmap _ NoEvent   = NoEvent+  fmap f (Event c) = Event (f c)++-- | Applicative instance (similar to 'Maybe').+instance Applicative Event where+  -- | Wrap a pure value in an 'Event'.+  pure = Event+  -- | If any value (function or arg) is 'NoEvent', everything is.+  Event f <*> Event x = Event (f x)+  _       <*> _       = NoEvent++-- | Monad instance.+instance Monad Event where+  -- | Combine events, return 'NoEvent' if any value in the sequence is+  -- 'NoEvent'.+  Event x >>= f = f x+  NoEvent >>= _ = NoEvent++  -- | See 'pure'.+  return = pure++-- | MonadFail instance+instance Fail.MonadFail Event where+  -- | Fail with 'NoEvent'.+  fail _ = NoEvent++-- | Alternative instance.+instance Alternative Event where+  -- | An empty alternative carries no event, so it is ignored.+  empty = NoEvent+  -- | Merge favouring the left event ('NoEvent' only if both are 'NoEvent').+  NoEvent <|> r = r+  l       <|> _ = l++-- | NFData instance.+instance NFData a => NFData (Event a) where+  -- | Evaluate value carried by event.+  rnf NoEvent   = ()+  rnf (Event a) = rnf a `seq` ()++-- * Utility functions similar to those available for Maybe++-- | An event-based version of the maybe function.+event :: a -> (b -> a) -> Event b -> a+event _ f (Event x) = f x+event x _ NoEvent   = x++-- | Extract the value from an event. Fails if there is no event.+fromEvent :: Event a -> a+fromEvent (Event x) = x+fromEvent _         = error "fromEvent NoEvent"++-- | Tests whether the input represents an actual event.+isEvent :: Event a -> Bool+isEvent (Event _) = True+isEvent _         = False++-- | Negation of 'isEvent'.+isNoEvent :: Event a -> Bool+isNoEvent = not . isEvent++-- * Event tagging++-- | Tags an (occurring) event with a value ("replacing" the old value).+--+-- Applicative-based definition: tag = ($>)+tag :: Event a -> b -> Event b+e `tag` b = fmap (const b) e++-- | Tags an (occurring) event with a value ("replacing" the old value). Same as+-- 'tag' with the arguments swapped.+--+-- Applicative-based definition: tagWith = (<$)+tagWith :: b -> Event a -> Event b+tagWith = flip tag++-- | Attaches an extra value to the value of an occurring event.+attach :: Event a -> b -> Event (a, b)+e `attach` b = fmap (\a -> (a, b)) e++-- * Event merging (disjunction) and joining (conjunction)++-- | Left-biased event merge (always prefer left event, if present).+lMerge :: Event a -> Event a -> Event a+lMerge = (<|>)++-- | Right-biased event merge (always prefer right event, if present).+rMerge :: Event a -> Event a -> Event a+rMerge = flip (<|>)++-- | Unbiased event merge: simultaneous occurrence is an error.+merge :: Event a -> Event a -> Event a+merge = mergeBy $ error "Bearriver: merge: Simultaneous event occurrence."++-- | Event merge parameterized by a conflict resolution function.+--+-- Applicative-based definition:+-- mergeBy f le re = (f <$> le <*> re) <|> le <|> re+mergeBy :: (a -> a -> a) -> Event a -> Event a -> Event a+mergeBy _       NoEvent      NoEvent      = NoEvent+mergeBy _       le@(Event _) NoEvent      = le+mergeBy _       NoEvent      re@(Event _) = re+mergeBy resolve (Event l)    (Event r)    = Event (resolve l r)++-- | A generic event merge-map utility that maps event occurrences, merging the+-- results. The first three arguments are mapping functions, the third of which+-- will only be used when both events are present. Therefore, 'mergeBy' =+-- 'mapMerge' 'id' 'id'.+--+-- Applicative-based definition:+-- mapMerge lf rf lrf le re = (f <$> le <*> re) <|> (lf <$> le) <|> (rf <$> re)+mapMerge :: (a -> c)+            -- ^ Mapping function used when first event is present.+         -> (b -> c)+            -- ^ Mapping function used when second event is present.+         -> (a -> b -> c)+            -- ^ Mapping function used when both events are present.+         -> Event a+            -- ^ First event+         -> Event b+            -- ^ Second event+         -> Event c+mapMerge _  _  _   NoEvent   NoEvent   = NoEvent+mapMerge lf _  _   (Event l) NoEvent   = Event (lf l)+mapMerge _  rf _   NoEvent   (Event r) = Event (rf r)+mapMerge _  _  lrf (Event l) (Event r) = Event (lrf l r)++-- | Merge a list of events; foremost event has priority.+--+-- Foldable-based definition:+-- mergeEvents :: Foldable t => t (Event a) -> Event a+-- mergeEvents =  asum+mergeEvents :: [Event a] -> Event a+mergeEvents = foldr lMerge NoEvent++-- | Collect simultaneous event occurrences; no event if none.+catEvents :: [Event a] -> Event [a]+catEvents eas = case [ a | Event a <- eas ] of+                  [] -> NoEvent+                  as -> Event as++-- | Join (conjunction) of two events. Only produces an event if both events+-- exist.+--+-- Applicative-based definition:+-- joinE = liftA2 (,)+joinE :: Event a -> Event b -> Event (a, b)+joinE NoEvent   _         = NoEvent+joinE _         NoEvent   = NoEvent+joinE (Event l) (Event r) = Event (l, r)++-- | Split event carrying pairs into two events.+splitE :: Event (a, b) -> (Event a, Event b)+splitE NoEvent        = (NoEvent, NoEvent)+splitE (Event (a, b)) = (Event a, Event b)++-- * Event filtering++-- | Filter out events that don't satisfy some predicate.+filterE :: (a -> Bool) -> Event a -> Event a+filterE p e@(Event a) = if p a then e else NoEvent+filterE _ NoEvent     = NoEvent++-- | Combined event mapping and filtering. Note: since 'Event' is a 'Functor',+-- see 'fmap' for a simpler version of this function with no filtering.+mapFilterE :: (a -> Maybe b) -> Event a -> Event b+mapFilterE f e = e >>= (maybeToEvent . f)++-- | Enable/disable event occurrences based on an external condition.+gate :: Event a -> Bool -> Event a+_ `gate` False = NoEvent+e `gate` True  = e++-- * Utilities for easy event construction++-- | Convert a maybe value into a event ('Event' is isomorphic to 'Maybe').+maybeToEvent :: Maybe a -> Event a+maybeToEvent Nothing  = NoEvent+maybeToEvent (Just a) = Event a

@@ -0,0 +1,206 @@+-- |+-- Copyright  : (c) Ivan Perez, 2019-2022+--              (c) Ivan Perez and Manuel Baerenz, 2016-2018+-- License    : BSD3+-- Maintainer : ivan.perez@keera.co.uk+--+-- Event Signal Functions and SF combinators.+--+-- Events represent values that only exist instantaneously, at discrete points+-- in time. Examples include mouse clicks, zero-crosses of monotonic continuous+-- signals, and square waves.+--+-- For signals that carry events, there should be a limit in the number of+-- events we can observe in a time period, no matter how much we increase the+-- sampling frequency.+module FRP.BearRiver.EventS+    (+      -- * Basic event sources+      never+    , now+    , after+    , repeatedly+    , afterEach+    , afterEachCat+    , edge+    , iEdge+    , edgeTag+    , edgeJust+    , edgeBy++      -- * Stateful event suppression+    , notYet+    , once+    , takeEvents+    , dropEvents++      -- * Hybrid SF combinators+    , snap+    )+  where++-- External imports+import Control.Arrow (arr, (&&&), (>>>), (>>^))++-- Internal imports (dunai)+import Control.Monad.Trans.MSF                 (ask)+import Data.MonadicStreamFunction              (feedback)+import Data.MonadicStreamFunction.InternalCore (MSF (MSF, unMSF))++-- Internal imports+import FRP.BearRiver.Arrow        (dup)+import FRP.BearRiver.Basic        (constant, identity, (-->), (>--))+import FRP.BearRiver.Event        (Event (..), maybeToEvent, tag)+import FRP.BearRiver.InternalCore (SF, Time)+import FRP.BearRiver.Switches     (dSwitch, switch)++-- | Event source that never occurs.+never :: Monad m => SF m a (Event b)+never = constant NoEvent++-- | Event source with a single occurrence at time 0. The value of the event is+-- given by the function argument.+now :: Monad m => b -> SF m a (Event b)+now b0 = Event b0 --> never++-- | Event source with a single occurrence at or as soon after (local) time /q/+-- as possible.+after :: Monad m+      => Time -- ^ The time /q/ after which the event should be produced+      -> b    -- ^ Value to produce at that time+      -> SF m a (Event b)+after q x = feedback q go+  where+    go = MSF $ \(_, t) -> do+           dt <- ask+           let t' = t - dt+               e  = if t > 0 && t' < 0 then Event x else NoEvent+               ct = if t' < 0 then constant (NoEvent, t') else go+           return ((e, t'), ct)++-- | Event source with repeated occurrences with interval q.+--+-- Note: If the interval is too short w.r.t. the sampling intervals, the result+-- will be that events occur at every sample. However, no more than one event+-- results from any sampling interval, thus avoiding an "event backlog" should+-- sampling become more frequent at some later point in time.+repeatedly :: Monad m => Time -> b -> SF m a (Event b)+repeatedly q x+    | q > 0     = afterEach qxs+    | otherwise = error "bearriver: repeatedly: Non-positive period."+  where+    qxs = (q, x):qxs++-- | Event source with consecutive occurrences at the given intervals.+--+-- Should more than one event be scheduled to occur in any sampling interval,+-- only the first will in fact occur to avoid an event backlog.++-- After all, after, repeatedly etc. are defined in terms of afterEach.+afterEach :: Monad m => [(Time, b)] -> SF m a (Event b)+afterEach qxs = afterEachCat qxs >>> arr (fmap head)++-- | Event source with consecutive occurrences at the given intervals.+--+-- Should more than one event be scheduled to occur in any sampling interval,+-- the output list will contain all events produced during that interval.+afterEachCat :: Monad m => [(Time, b)] -> SF m a (Event [b])+afterEachCat = afterEachCat' 0+  where+    afterEachCat' :: Monad m => Time -> [(Time, b)] -> SF m a (Event [b])+    afterEachCat' _ []  = never+    afterEachCat' t qxs = MSF $ \_ -> do+      dt <- ask+      let (ev, t', qxs') = fireEvents [] (t + dt) qxs+          ev' = if null ev+                  then NoEvent+                  else Event (reverse ev)++      return (ev', afterEachCat' t' qxs')++    fireEvents :: [b] -> Time -> [(Time, b)] -> ([b], Time, [(Time, b)])+    fireEvents ev t []       = (ev, t, [])+    fireEvents ev t (qx:qxs)+        | fst qx < 0   = error "bearriver: afterEachCat: Non-positive period."+        | overdue >= 0 = fireEvents (snd qx:ev) overdue qxs+        | otherwise    = (ev, t, qx:qxs)+      where+        overdue = t - fst qx++-- | A rising edge detector. Useful for things like detecting key presses. It is+-- initialised as /up/, meaning that events occurring at time 0 will not be+-- detected.+edge :: Monad m => SF m Bool (Event ())+edge = edgeFrom True++-- | A rising edge detector that can be initialized as up ('True', meaning that+-- events occurring at time 0 will not be detected) or down ('False', meaning+-- that events occurring at time 0 will be detected).+iEdge :: Monad m => Bool -> SF m Bool (Event ())+iEdge = edgeFrom++-- | A rising edge detector that can be initialized as up ('True', meaning that+-- events occurring at time 0 will not be detected) or down ('False', meaning+-- that events occurring at time 0 will be detected).+edgeFrom :: Monad m => Bool -> SF m Bool (Event())+edgeFrom prev = MSF $ \a -> do+  let res | prev      = NoEvent+          | a         = Event ()+          | otherwise = NoEvent+      ct  = edgeFrom a+  return (res, ct)++-- | Like 'edge', but parameterized on the tag value.+edgeTag :: Monad m => a -> SF m Bool (Event a)+edgeTag a = edge >>> arr (`tag` a)++-- | Edge detector particularized for detecting transitions on a 'Maybe' signal+-- from 'Nothing' to 'Just'.+edgeJust :: Monad m => SF m (Maybe a) (Event a)+edgeJust = edgeBy isJustEdge (Just undefined)+  where+    isJustEdge Nothing  Nothing     = Nothing+    isJustEdge Nothing  ma@(Just _) = ma+    isJustEdge (Just _) (Just _)    = Nothing+    isJustEdge (Just _) Nothing     = Nothing++-- | Edge detector parameterized on the edge detection function and initial+-- state, i.e., the previous input sample. The first argument to the edge+-- detection function is the previous sample, the second the current one.+edgeBy :: Monad m => (a -> a -> Maybe b) -> a -> SF m a (Event b)+edgeBy isEdge aPrev = MSF $ \a ->+  return (maybeToEvent (isEdge aPrev a), edgeBy isEdge a)++-- * Stateful event suppression++-- | Suppression of initial (at local time 0) event.+notYet :: Monad m => SF m (Event a) (Event a)+notYet = feedback False $ arr (\(e, c) ->+  if c then (e, True) else (NoEvent, True))++-- | Suppress all but the first event.+once :: Monad m => SF m (Event a) (Event a)+once = takeEvents 1++-- | Suppress all but the first n events.+takeEvents :: Monad m => Int -> SF m (Event a) (Event a)+takeEvents n | n <= 0 = never+takeEvents n = dSwitch (arr dup) (const (NoEvent >-- takeEvents (n - 1)))++-- | Suppress first n events.+dropEvents :: Monad m => Int -> SF m (Event a) (Event a)+dropEvents n | n <= 0 = identity+dropEvents n =+  -- Here dSwitch or switch does not really matter.+  dSwitch (never &&& identity)+          (const (NoEvent >-- dropEvents (n - 1)))++-- ** Hybrid continuous-to-discrete SF combinators.++-- | Event source with a single occurrence at time 0. The value of the event is+-- obtained by sampling the input at that time.+snap :: Monad m => SF m a (Event a)+snap =+  -- switch ensures that the entire signal function will become just+  -- "constant" once the sample has been taken.+  switch (never &&& (identity &&& now () >>^ \(a, e) -> e `tag` a)) now

@@ -0,0 +1,54 @@+-- |+-- Module      : FRP.Yampa.Scan+-- Copyright   : (c) Ivan Perez, 2014-2023+--               (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)+--+-- Simple, stateful signal processing.+--+-- Scanning implements elementary, step-based accumulating over signal functions+-- by means of an auxiliary function applied to each input and to an+-- accumulator. For comparison with other FRP libraries and with stream+-- processing abstractions, think of fold.+module FRP.BearRiver.Scan+    ( sscan+    , sscanPrim+    )+  where++-- Internal imports (dunai)+import Data.MonadicStreamFunction.InternalCore (MSF (..))++-- Internal imports+import FRP.BearRiver.InternalCore (SF (..))++-- * Simple, stateful signal processing++-- | Applies a function point-wise, using the last output as next input. This+-- creates a well-formed loop based on a pure, auxiliary function.+sscan :: Monad m => (b -> a -> b) -> b -> SF m a b+sscan f bInit = sscanPrim f' bInit bInit+  where+    f' b a = Just (b', b')+      where+        b' = f b a++-- | Generic version of 'sscan', in which the auxiliary function produces an+-- internal accumulator and an "held" output.+--+-- Applies a function point-wise, using the last known 'Just' output to form the+-- output, and next input accumulator. If the output is 'Nothing', the last+-- known accumulators are used. This creates a well-formed loop based on a pure,+-- auxiliary function.+sscanPrim :: Monad m => (c -> a -> Maybe (c, b)) -> c -> b -> SF m a b+sscanPrim f cInit bInit = MSF $ \a -> do+  let o = f cInit a+  case o of+    Nothing       -> return (bInit, sscanPrim f cInit bInit)+    Just (c', b') -> return (b',    sscanPrim f c' b')

@@ -0,0 +1,184 @@+{-# LANGUAGE CPP #-}+-- The following warning is disabled so that we do not see warnings due to+-- using ListT on an MSF to implement parallelism with broadcasting.+#if __GLASGOW_HASKELL__ < 800+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+#else+{-# OPTIONS_GHC -Wno-deprecations #-}+#endif++-- |+-- Copyright  : (c) Ivan Perez, 2019-2022+--              (c) Ivan Perez and Manuel Baerenz, 2016-2018+-- License    : BSD3+-- Maintainer : ivan.perez@keera.co.uk+--+-- Switches allow you to change the signal function being applied.+--+-- The basic idea of switching is formed by combining a subordinate signal+-- function and a signal function continuation parameterised over some initial+-- data.+module FRP.BearRiver.Switches+    (+      -- * Basic switching+      switch,  dSwitch++      -- * Parallel composition\/switching (collections)+      -- ** With broadcasting+    , parB+    , dpSwitchB++      -- * Parallel composition\/switching (lists)+++      -- ** With replication+    , parC+    )+  where++-- External imports+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative (Applicative (..), (<$>))+#endif+import Data.Traversable as T++-- Internal imports (dunai)+import Control.Monad.Trans.MSF                 (local)+import Control.Monad.Trans.MSF.List            (sequenceS, widthFirst)+import Data.MonadicStreamFunction.InternalCore (MSF (MSF, unMSF))++-- Internal imports+import FRP.BearRiver.Event        (Event (..))+import FRP.BearRiver.InternalCore (SF)++-- * Basic switches++-- | Basic switch.+--+-- By default, the first signal function is applied. Whenever the second value+-- in the pair actually is an event, the value carried by the event is used to+-- obtain a new signal function to be applied *at that time and at future+-- times*. Until that happens, the first value in the pair is produced in the+-- output signal.+--+-- Important note: at the time of switching, the second signal function is+-- applied immediately. If that second SF can also switch at time zero, then a+-- double (nested) switch might take place. If the second SF refers to the+-- first one, the switch might take place infinitely many times and never be+-- resolved.+--+-- Remember: The continuation is evaluated strictly at the time+-- of switching!+switch :: Monad m => SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b+switch sf sfC = MSF $ \a -> do+  (o, ct) <- unMSF sf a+  case o of+    (_, Event c) -> local (const 0) (unMSF (sfC c) a)+    (b, NoEvent) -> return (b, switch ct sfC)++-- | Switch with delayed observation.+--+-- By default, the first signal function is applied.+--+-- Whenever the second value in the pair actually is an event, the value+-- carried by the event is used to obtain a new signal function to be applied+-- *at future times*.+--+-- Until that happens, the first value in the pair is produced in the output+-- signal.+--+-- Important note: at the time of switching, the second signal function is used+-- immediately, but the current input is fed by it (even though the actual+-- output signal value at time 0 is discarded).+--+-- If that second SF can also switch at time zero, then a double (nested)+-- switch might take place. If the second SF refers to the first one, the+-- switch might take place infinitely many times and never be resolved.+--+-- Remember: The continuation is evaluated strictly at the time+-- of switching!+dSwitch :: Monad m => SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b+dSwitch sf sfC = MSF $ \a -> do+  (o, ct) <- unMSF sf a+  case o of+    (b, Event c) -> do (_, ct') <- local (const 0) (unMSF (sfC c) a)+                       return (b, ct')+    (b, NoEvent) -> return (b, dSwitch ct sfC)++-- * Parallel composition and switching++-- ** Parallel composition and switching over collections with broadcasting++#if MIN_VERSION_base(4,8,0)+parB :: Monad m => [SF m a b] -> SF m a [b]+#else+parB :: (Functor m, Monad m) => [SF m a b] -> SF m a [b]+#endif+-- ^ Spatial parallel composition of a signal function collection. Given a+-- collection of signal functions, it returns a signal function that broadcasts+-- its input signal to every element of the collection, to return a signal+-- carrying a collection of outputs. See 'par'.+--+-- For more information on how parallel composition works, check+-- <https://www.antonycourtney.com/pubs/hw03.pdf>+parB = widthFirst . sequenceS++-- | Decoupled parallel switch with broadcasting (dynamic collection of signal+-- functions spatially composed in parallel). See 'dpSwitch'.+--+-- For more information on how parallel composition works, check+-- <https://www.antonycourtney.com/pubs/hw03.pdf>+dpSwitchB :: (Functor m, Monad m, Traversable col)+          => col (SF m a b)+          -> SF m (a, col b) (Event c)+          -> (col (SF m a b) -> c -> SF m a (col b))+          -> SF m a (col b)+dpSwitchB sfs sfF sfCs = MSF $ \a -> do+  res <- T.mapM (`unMSF` a) sfs+  let bs   = fmap fst res+      sfs' = fmap snd res+  (e, sfF') <- unMSF sfF (a, bs)+  ct <- case e of+          Event c -> snd <$> unMSF (sfCs sfs c) a+          NoEvent -> return (dpSwitchB sfs' sfF' sfCs)+  return (bs, ct)++-- ** Parallel composition over collections++-- | Apply an SF to every element of a list.+--+-- Example:+--+-- >>> embed (parC integral) (deltaEncode 0.1 [[1, 2], [2, 4], [3, 6], [4.0, 8.0 :: Float]])+-- [[0.0,0.0],[0.1,0.2],[0.3,0.6],[0.6,1.2]]+--+-- The number of SFs or expected inputs is determined by the first input list,+-- and not expected to vary over time.+--+-- If more inputs come in a subsequent list, they are ignored.+--+-- >>> embed (parC (arr (+1))) (deltaEncode 0.1 [[0], [1, 1], [3, 4], [6, 7, 8], [1, 1], [0, 0], [1, 9, 8]])+-- [[1],[2],[4],[7],[2],[1],[2]]+--+-- If less inputs come in a subsequent list, an exception is thrown.+--+-- >>> embed (parC (arr (+1))) (deltaEncode 0.1 [[0, 0], [1, 1], [3, 4], [6, 7, 8], [1, 1], [0, 0], [1, 9, 8]])+-- [[1,1],[2,2],[4,5],[7,8],[2,2],[1,1],[2,10]]+parC :: Monad m => SF m a b -> SF m [a] [b]+parC = parC0+  where+    parC0 :: Monad m => SF m a b -> SF m [a] [b]+    parC0 sf0 = MSF $ \as -> do+      os <- T.mapM (\(a, sf) -> unMSF sf a) $+              zip as (replicate (length as) sf0)++      let bs  = fmap fst os+          cts = fmap snd os+      return (bs, parC' cts)++    parC' :: Monad m => [SF m a b] -> SF m [a] [b]+    parC' sfs = MSF $ \as -> do+      os <- T.mapM (\(a, sf) -> unMSF sf a) $ zip as sfs+      let bs  = fmap fst os+          cts = fmap snd os+      return (bs, parC' cts)