bearriver 0.14.6 → 0.14.7

raw patch · 5 files changed

+204/−51 lines, 5 filesdep ~transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: transformers

API changes (from Hackage documentation)

Files

• CHANGELOG +5/−0
• bearriver.cabal +3/−2
• src/FRP/BearRiver.hs +1/−38
• src/FRP/BearRiver/EventS.hs +137/−11
• src/FRP/BearRiver/Hybrid.hs +58/−0

@@ -1,3 +1,8 @@+2024-02-21 Ivan Perez <ivan.perez@keera.co.uk>+        * Version bump (0.14.7) (#398).+        * Limit version of transformers to < 0.6 (#405).+        * Offer all definitions from FRP.Yampa.EventS (#400).+ 2023-12-21 Ivan Perez <ivan.perez@keera.co.uk>         * Version bump (0.14.6) (#395).         * Offer all definitions from FRP.Yampa.Time (#391).

@@ -30,7 +30,7 @@ build-type:    Simple  name:          bearriver-version:       0.14.6+version:       0.14.7 author:        Ivan Perez, Manuel Bärenz maintainer:    ivan.perez@keera.co.uk homepage:      https://github.com/ivanperez-keera/dunai@@ -85,6 +85,7 @@     FRP.BearRiver.Delays     FRP.BearRiver.Event     FRP.BearRiver.EventS+    FRP.BearRiver.Hybrid     FRP.BearRiver.Integration     FRP.BearRiver.Scan     FRP.BearRiver.Switches@@ -101,7 +102,7 @@     , MonadRandom         >= 0.2   && < 0.7     , mtl                 >= 2.1.2 && < 2.3     , simple-affine-space >= 0.1   && < 0.3-    , transformers >= 0.3 && < 0.7+    , transformers >= 0.3 && < 0.6    default-language:     Haskell2010

@@ -42,6 +42,7 @@ import           FRP.BearRiver.Delays                    as X import           FRP.BearRiver.Event                     as X import           FRP.BearRiver.EventS                    as X+import           FRP.BearRiver.Hybrid                    as X import           FRP.BearRiver.Integration               as X import           FRP.BearRiver.InternalCore              as X import           FRP.BearRiver.Scan                      as X@@ -52,15 +53,6 @@ import Data.MonadicStreamFunction.Instances.ArrowLoop () -- not needed, just                                                          -- re-exported --- * Events---- | Apply an 'MSF' to every input. Freezes temporarily if the input is--- 'NoEvent', and continues as soon as an 'Event' is received.-mapEventS :: Monad m => MSF m a b -> MSF m (Event a) (Event b)-mapEventS msf = proc eventA -> case eventA of-  Event a -> arr Event <<< msf -< a-  NoEvent -> returnA           -< NoEvent- -- ** Relation to other types  -- | Convert an 'Event' into a 'Maybe' value.@@ -77,35 +69,6 @@ boolToEvent :: Bool -> Event () boolToEvent True  = Event () boolToEvent False = NoEvent---- * Discrete to continuous-time signal functions---- ** Wave-form generation---- | Zero-order hold.------ Converts a discrete-time signal into a continuous-time signal, by holding--- the last value until it changes in the input signal. The given parameter may--- be used for time zero, and until the first event occurs in the input signal,--- so hold is always well-initialized.------ >>> embed (hold 1) (deltaEncode 0.1 [NoEvent, NoEvent, Event 2, NoEvent, Event 3, NoEvent])--- [1,1,2,2,3,3]-hold :: Monad m => a -> SF m (Event a) a-hold a = feedback a $ arr $ \(e, a') ->-  dup (event a' id e)---- ** Accumulators---- | Accumulator parameterized by the accumulation function.-accumBy :: Monad m => (b -> a -> b) -> b -> SF m (Event a) (Event b)-accumBy f b = mapEventS $ accumulateWith (flip f) b---- | Zero-order hold accumulator parameterized by the accumulation function.-accumHoldBy :: Monad m => (b -> a -> b) -> b -> SF m (Event a) b-accumHoldBy f b = feedback b $ arr $ \(a, b') ->-  let b'' = event b' (f b') a-  in (b'', b'')  -- * State keeping combinators 

@@ -22,6 +22,8 @@     , repeatedly     , afterEach     , afterEachCat+    , delayEvent+    , delayEventCat     , edge     , iEdge     , edgeTag@@ -36,6 +38,13 @@        -- * Hybrid SF combinators     , snap+    , snapAfter+    , sample+    , sampleWindow++      -- * Repetition and switching+    , recur+    , andThen     )   where @@ -45,12 +54,13 @@ -- Internal imports (dunai) import Control.Monad.Trans.MSF                 (ask) import Data.MonadicStreamFunction              (feedback)-import Data.MonadicStreamFunction.InternalCore (MSF (MSF, unMSF))+import Data.MonadicStreamFunction.InternalCore (MSF (MSF))  -- Internal imports import FRP.BearRiver.Arrow        (dup) import FRP.BearRiver.Basic        (constant, identity, (-->), (>--)) import FRP.BearRiver.Event        (Event (..), maybeToEvent, tag)+import FRP.BearRiver.Hybrid       (accumBy) import FRP.BearRiver.InternalCore (SF, Time) import FRP.BearRiver.Switches     (dSwitch, switch) @@ -91,19 +101,15 @@   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.+-- | 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. 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.+-- | 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@@ -127,6 +133,85 @@       where         overdue = t - fst qx ++-- | Delay for events. (Consider it a triggered after, hence /basic/.)+delayEvent :: Monad m => Time -> SF m (Event a) (Event a)+delayEvent q | q < 0     = error "bearriver: delayEvent: Negative delay."+             | q == 0    = identity+             | otherwise = delayEventCat q >>> arr (fmap head)++-- | Delay an event by a given delta and catenate events that occur so closely+-- so as to be /inseparable/.+delayEventCat :: Monad m => Time -> SF m (Event a) (Event [a])+delayEventCat q | q < 0     = error "bearriver: delayEventCat: Negative delay."+                | q == 0    = arr (fmap (:[]))+                | otherwise = MSF noPendingEvent+  where+    noPendingEvent e+          = return+               ( NoEvent+               , case e of+                   NoEvent -> MSF $ noPendingEvent+                   Event x -> MSF (pendingEvents (-q) [] [] (-q) x)+               )++    -- tNext is the present time w.r.t. the next scheduled event.+    -- tLast is the present time w.r.t. the last scheduled event.+    -- In the event queues, events are associated with their time+    -- w.r.t. to preceding event (positive).+    pendingEvents tLast rqxs qxs tNext x = tf -- True+      where+        tf e = do dt <- ask+                  return (tf' dt e)++        tf' dt e+            | tNext' >= 0+            = emitEventsScheduleNext e tLast' rqxs qxs tNext' [x]+            | otherwise+            = (NoEvent, MSF (pendingEvents tLast'' rqxs' qxs tNext' x))+          where+            tNext' = tNext + dt+            tLast' = tLast + dt+            (tLast'', rqxs') =+              case e of+                NoEvent  -> (tLast', rqxs)+                Event x' -> (-q,     (tLast' + q, x') : rqxs)++    -- tNext is the present time w.r.t. the *scheduled* time of the event that+    -- is about to be emitted (i.e. >= 0).+    -- The time associated with any event at the head of the event queue is also+    -- given w.r.t. the event that is about to be emitted.  Thus, tNext - q' is+    -- the present time w.r.t. the event at the head of the event queue.+    emitEventsScheduleNext e _ [] [] _ rxs =+      ( Event (reverse rxs)+      , case e of+          NoEvent -> MSF $ noPendingEvent+          Event x -> MSF $ pendingEvents (-q) [] [] (-q) x+      )+    emitEventsScheduleNext e tLast rqxs [] tNext rxs =+      emitEventsScheduleNext e tLast [] (reverse rqxs) tNext rxs+    emitEventsScheduleNext e tLast rqxs ((q', x') : qxs') tNext rxs+      | q' > tNext = ( Event (reverse rxs)+                     , case e of+                         NoEvent -> MSF $+                           pendingEvents tLast+                                         rqxs+                                         qxs'+                                         (tNext - q')+                                         x'+                         Event x'' -> MSF $+                           pendingEvents (-q)+                                         ((tLast + q, x'') : rqxs)+                                         qxs'+                                         (tNext - q')+                                         x'+                      )+      | otherwise  = emitEventsScheduleNext e+                                            tLast+                                            rqxs+                                            qxs'+                                            (tNext - q')+                                            (x' : rxs) -- | 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.@@ -204,3 +289,44 @@   -- 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++-- | Event source with a single occurrence at or as soon after (local) time+-- @tEv@ as possible. The value of the event is obtained by sampling the input a+-- that time.+snapAfter :: Monad m => Time -> SF m a (Event a)+snapAfter tEv =+  switch (never &&& (identity &&& after tEv () >>^ \(a, e) -> e `tag` a)) now++-- | Sample a signal at regular intervals.+sample :: Monad m => Time -> SF m a (Event a)+sample pEv = identity &&& repeatedly pEv () >>^ \(a, e) -> e `tag` a++-- | Window sampling.+--+-- First argument is the window length wl, second is the sampling interval t.+-- The output list should contain (min (truncate (T/t) wl)) samples, where T is+-- the time the signal function has been running. This requires some care in+-- case of sparse sampling. In case of sparse sampling, the current input value+-- is assumed to have been present at all points where sampling was missed.+sampleWindow :: Monad m => Int -> Time -> SF m a (Event [a])+sampleWindow wl q =+    identity &&& afterEachCat (repeat (q, ()))+    >>> arr (\(a, e) -> fmap (map (const a)) e)+    >>> accumBy updateWindow []+  where+    updateWindow w as = drop (max (length w' - wl) 0) w'+      where+        w' = w ++ as++-- * Repetition and switching++-- | Makes an event source recurring by restarting it as soon as it has an+-- occurrence.+recur :: Monad m => SF m a (Event b) -> SF m a (Event b)+recur sfe = switch (never &&& sfe) $ \b -> Event b --> recur (NoEvent --> sfe)++-- | Apply the first SF until it produces an event, and, afterwards, switch to+-- the second SF. This is just a convenience function, used to write what+-- sometimes is more understandable switch-based code.+andThen :: Monad m => SF m a (Event b) -> SF m a (Event b) -> SF m a (Event b)+sfe1 `andThen` sfe2 = dSwitch (sfe1 >>^ dup) (const sfe2)

@@ -0,0 +1,58 @@+{-# LANGUAGE Arrows #-}+-- |+-- Copyright  : (c) Ivan Perez, 2019-2022+--              (c) Ivan Perez and Manuel Baerenz, 2016-2018+-- License    : BSD3+-- Maintainer : ivan.perez@keera.co.uk+--+-- Discrete to continuous-time signal functions.+module FRP.BearRiver.Hybrid where++-- External imports+import Control.Arrow (arr, returnA, (<<<))++-- Internal imports (dunai)+import Data.MonadicStreamFunction (accumulateWith, feedback)++-- Internal imports (bearriver)+import FRP.BearRiver.Arrow        (dup)+import FRP.BearRiver.Event        (Event (..), event)+import FRP.BearRiver.InternalCore (SF)++-- * Discrete to continuous-time signal functions++-- ** Wave-form generation++-- | Zero-order hold.+--+-- Converts a discrete-time signal into a continuous-time signal, by holding+-- the last value until it changes in the input signal. The given parameter may+-- be used for time zero, and until the first event occurs in the input signal,+-- so hold is always well-initialized.+--+-- >>> embed (hold 1) (deltaEncode 0.1 [NoEvent, NoEvent, Event 2, NoEvent, Event 3, NoEvent])+-- [1,1,2,2,3,3]+hold :: Monad m => a -> SF m (Event a) a+hold a = feedback a $ arr $ \(e, a') ->+  dup (event a' id e)++-- ** Accumulators++-- | Accumulator parameterized by the accumulation function.+accumBy :: Monad m => (b -> a -> b) -> b -> SF m (Event a) (Event b)+accumBy f b = mapEventS $ accumulateWith (flip f) b++-- | Zero-order hold accumulator parameterized by the accumulation function.+accumHoldBy :: Monad m => (b -> a -> b) -> b -> SF m (Event a) b+accumHoldBy f b = feedback b $ arr $ \(a, b') ->+  let b'' = event b' (f b') a+  in (b'', b'')++-- * Events++-- | Apply an 'SF' to every input. Freezes temporarily if the input is+-- 'NoEvent', and continues as soon as an 'Event' is received.+mapEventS :: Monad m => SF m a b -> SF m (Event a) (Event b)+mapEventS msf = proc eventA -> case eventA of+  Event a -> arr Event <<< msf -< a+  NoEvent -> returnA           -< NoEvent