Merge branch 'release-0.13.0'. Refs #420.

Author: ivanperez-keera

dunai-frp-bearriver/CHANGELOG

@@ -1,3 +1,7 @@
+2024-06-21 Ivan Perez <ivan.perez@keera.co.uk>
+        * Version bump (0.14.9) (#420).
+        * Offer all definitions from FRP.Yampa.Hybrid (#419).
+
 2024-04-23 Ivan Perez <ivan.perez@keera.co.uk>
         * Version bump (0.14.8) (#411).
         * Offer all definitions from FRP.Yampa.Loop (#407).

dunai-frp-bearriver/bearriver.cabal

@@ -30,7 +30,7 @@ cabal-version: >= 1.10
 build-type:    Simple
 
 name:          bearriver
-version:       0.14.8
+version:       0.14.9
 author:        Ivan Perez, Manuel Bärenz
 maintainer:    ivan.perez@keera.co.uk
 homepage:      https://github.com/ivanperez-keera/dunai
@@ -99,11 +99,11 @@ library
   build-depends:
       base >= 4.6 && <5
     , deepseq             >= 1.3.0.0 && < 1.6
-    , dunai >= 0.6.0 && < 0.13
+    , dunai >= 0.6.0 && < 0.14
     , MonadRandom         >= 0.2   && < 0.7
     , mtl                 >= 2.1.2 && < 2.3
     , simple-affine-space >= 0.1   && < 0.3
-    , transformers >= 0.3 && < 0.6
+    , transformers >= 0.3 && < 0.7
 
   default-language:
     Haskell2010

dunai-frp-bearriver/src/FRP/BearRiver/Hybrid.hs

@@ -6,16 +6,34 @@
 -- Maintainer : ivan.perez@keera.co.uk
 --
 -- Discrete to continuous-time signal functions.
-module FRP.BearRiver.Hybrid where
+module FRP.BearRiver.Hybrid
+    (
+      -- * Wave-form generation
+      hold
+    , dHold
+    , trackAndHold
+    , dTrackAndHold
+
+      -- * Accumulators
+    , accum
+    , accumHold
+    , dAccumHold
+    , accumBy
+    , accumHoldBy
+    , dAccumHoldBy
+    , accumFilter
+    )
+  where
 
 -- External imports
-import Control.Arrow (arr, returnA, (<<<))
+import Control.Arrow (arr, returnA, (<<<), (>>>))
 
 -- Internal imports (dunai)
 import Data.MonadicStreamFunction (accumulateWith, feedback)
 
 -- Internal imports (bearriver)
 import FRP.BearRiver.Arrow        (dup)
+import FRP.BearRiver.Delays       (iPre)
 import FRP.BearRiver.Event        (Event (..), event)
 import FRP.BearRiver.InternalCore (SF)
 
@@ -36,8 +54,66 @@ hold :: Monad m => a -> SF m (Event a) a
 hold a = feedback a $ arr $ \(e, a') ->
   dup (event a' id e)
 
+-- | Zero-order hold with a delay.
+--
+-- 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 is used
+-- for time zero (until the first event occurs in the input signal), so 'dHold'
+-- shifts the discrete input by an infinitesimal delay.
+--
+-- >>> embed (dHold 1) (deltaEncode 0.1 [NoEvent, NoEvent, Event 2, NoEvent, Event 3, NoEvent])
+-- [1,1,1,2,2,3]
+dHold :: Monad m => a -> SF m (Event a) a
+dHold a0 = hold a0 >>> iPre a0
+
+-- | Tracks input signal when available, holding the last value when the input
+-- is 'Nothing'.
+--
+-- This behaves similarly to 'hold', but there is a conceptual difference, as it
+-- takes a signal of input @Maybe a@ (for some @a@) and not @Event@.
+--
+-- >>> embed (trackAndHold 1) (deltaEncode 0.1 [Nothing, Nothing, Just 2, Nothing, Just 3, Nothing])
+-- [1,1,2,2,3,3]
+trackAndHold :: Monad m => a -> SF m (Maybe a) a
+trackAndHold aInit = arr (maybe NoEvent Event) >>> hold aInit
+
+-- | Tracks input signal when available, holding the last value when the input
+-- is 'Nothing', with a delay.
+--
+-- This behaves similarly to 'hold', but there is a conceptual difference, as it
+-- takes a signal of input @Maybe a@ (for some @a@) and not @Event@.
+--
+-- >>> embed (dTrackAndHold 1) (deltaEncode 0.1 [Nothing, Nothing, Just 2, Nothing, Just 3, Nothing])
+-- [1,1,1,2,2,3]
+dTrackAndHold :: Monad m => a -> SF m (Maybe a) a
+dTrackAndHold aInit = trackAndHold aInit >>> iPre aInit
+
 -- ** Accumulators
 
+-- | Given an initial value in an accumulator, it returns a signal function that
+-- processes an event carrying transformation functions. Every time an 'Event'
+-- is received, the function inside it is applied to the accumulator, whose new
+-- value is outputted in an 'Event'.
+accum :: Monad m => a -> SF m (Event (a -> a)) (Event a)
+accum aInit = feedback aInit $ arr $ \(f, a) -> case f of
+    NoEvent -> (NoEvent, a)
+    Event f' -> let a' = f' a
+                in (Event a', a')
+
+-- | Zero-order hold accumulator (always produces the last outputted value until
+-- an event arrives).
+accumHold :: Monad m => a -> SF m (Event (a -> a)) a
+accumHold aInit = feedback aInit $ arr $ \(f, a) -> case f of
+    NoEvent -> (a, a)
+    Event f' -> let a' = f' a
+                in (a', a')
+
+-- | Zero-order hold accumulator with delayed initialization (always produces
+-- the last outputted value until an event arrives, but the very initial output
+-- is always the given accumulator).
+dAccumHold :: Monad m => a -> SF m (Event (a -> a)) a
+dAccumHold aInit = accumHold aInit >>> iPre aInit
+
 -- | 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
@@ -48,6 +124,25 @@ accumHoldBy f b = feedback b $ arr $ \(a, b') ->
   let b'' = event b' (f b') a
   in (b'', b'')
 
+-- | Zero-order hold accumulator parameterized by the accumulation function with
+-- delayed initialization (initial output sample is always the given
+-- accumulator).
+dAccumHoldBy :: Monad m => (b -> a -> b) -> b -> SF m (Event a) b
+dAccumHoldBy f aInit = accumHoldBy f aInit >>> iPre aInit
+
+-- | Accumulator parameterized by the accumulator function with filtering,
+-- possibly discarding some of the input events based on whether the second
+-- component of the result of applying the accumulation function is 'Nothing' or
+-- 'Just' x for some x.
+accumFilter :: Monad m
+            => (c -> a -> (c, Maybe b)) -> c -> SF m (Event a) (Event b)
+accumFilter g cInit = feedback cInit $ arr $ \(a, c) ->
+  case a of
+    NoEvent -> (NoEvent, c)
+    Event a' -> case g c a' of
+                  (c', Nothing) -> (NoEvent, c')
+                  (c', Just b)  -> (Event b, c')
+
 -- * Events
 
 -- | Apply an 'SF' to every input. Freezes temporarily if the input is

dunai-test/CHANGELOG

@@ -1,3 +1,6 @@
+2024-06-21 Ivan Perez <ivan.perez@keera.co.uk>
+        * Version bump (0.13.0) (#420).
+
 2024-04-23 Ivan Perez <ivan.perez@keera.co.uk>
         * Version bump (0.12.3) (#411).
 

dunai-test/dunai-test.cabal

@@ -30,7 +30,7 @@ cabal-version: >= 1.10
 build-type:    Simple
 
 name:          dunai-test
-version:       0.12.3
+version:       0.13.0
 author:        Ivan Perez
 maintainer:    ivan.perez@keera.co.uk
 homepage:      https://github.com/ivanperez-keera/dunai
@@ -77,7 +77,7 @@ library
 
   build-depends:
       base >= 4 && < 5
-    , dunai >= 0.5 && < 0.13
+    , dunai >= 0.5 && < 0.14
     , normaldistribution >= 1.0  && < 1.2
     , QuickCheck         >= 2.12 && < 2.15
 

dunai/CHANGELOG

@@ -1,3 +1,7 @@
+2024-06-21 Ivan Perez <ivan.perez@keera.co.uk>
+        * Version bump (0.13.0) (#420).
+        * Implement List interface using list-transformer (#418).
+
 2024-04-23 Ivan Perez <ivan.perez@keera.co.uk>
         * Version bump (0.12.3) (#411).
         * Fix typo in documentation (#410).

dunai/dunai.cabal

@@ -30,7 +30,7 @@ cabal-version: >= 1.10
 build-type:    Simple
 
 name:          dunai
-version:       0.12.3
+version:       0.13.0
 author:        Ivan Perez, Manuel Bärenz
 maintainer:    ivan.perez@keera.co.uk
 homepage:      https://github.com/ivanperez-keera/dunai
@@ -97,6 +97,10 @@ flag test-doc-coverage
   default:     False
   manual:      True
 
+flag list-transformer
+  description: Use list-transformer instead of transformers to implement the ListT combinators
+  default: False
+
 
 library
   exposed-modules:
@@ -147,6 +151,13 @@ library
       , transformers-compat >= 0.3 && < 0.8
       , void                >= 0.1 && < 0.8
 
+  if flag(list-transformer)
+    build-depends:
+        list-transformer >= 1.1.1 && < 1.2
+      , transformers     >= 0.3   && < 0.7
+
+    cpp-options: -DLIST_TRANSFORMER
+
 test-suite hlint
   type:
     exitcode-stdio-1.0

dunai/src/Control/Monad/Trans/MSF/List.hs

@@ -26,9 +26,8 @@
 -- additional constraints on the inner monad in order for the combination of
 -- the monad and the transformer to be a monad. Use at your own risk.
 module Control.Monad.Trans.MSF.List
-    {-# WARNING "This module uses the ListT transformer, which is considered deprecated." #-}
     ( module Control.Monad.Trans.MSF.List
-    , module Control.Monad.Trans.List
+    , module List
     )
   where
 
@@ -37,13 +36,54 @@ module Control.Monad.Trans.MSF.List
 import Control.Applicative ((<$>))
 #endif
 
-import Control.Monad.Trans.List hiding (liftCallCC, liftCatch)
+#ifdef LIST_TRANSFORMER
+import           Control.Monad    (sequence)
+import           List.Transformer (ListT (ListT, next), Step (..), fold, select)
+import qualified List.Transformer as List
+#else
+import Control.Monad.Trans.List as List hiding (liftCallCC, liftCatch)
+#endif
 
 -- Internal imports
 import Data.MonadicStreamFunction.InternalCore (MSF (MSF, unMSF))
 
 -- * List monad
 
+#ifdef LIST_TRANSFORMER
+
+-- | Run an 'MSF' in the 'ListT' transformer (i.e., multiple MSFs producing
+-- each producing one output), by applying the input stream to each MSF in the
+-- list transformer and concatenating the outputs of the MSFs together.
+--
+-- An MSF in the ListT transformer can spawn into more than one MSF, or none,
+-- so the outputs produced at each individual step are not guaranteed to all
+-- have the same length.
+widthFirst :: (Functor m, Monad m) => MSF (ListT m) a b -> MSF m a [b]
+widthFirst msf = widthFirst' [msf]
+  where
+    widthFirst' msfs = MSF $ \a -> do
+      (bs, msfs') <- unzip . concat <$> mapM (toList . flip unMSF a) msfs
+      return (bs, widthFirst' msfs')
+
+    toList :: (Functor m, Monad m) => ListT m a -> m [a]
+    toList = fmap reverse . fold (flip (:)) [] id
+
+-- | Build an 'MSF' in the 'ListT' transformer by broadcasting the input stream
+-- value to each MSF in a given list.
+sequenceS :: Monad m => [MSF m a b] -> MSF (ListT m) a b
+sequenceS msfs = MSF $ \a -> sequence' $ apply a <$> msfs
+  where
+    sequence' :: Monad m => [m a] -> ListT m a
+    sequence' xs = ListT $ next <$> select =<< sequence xs
+
+    apply :: Monad m => a -> MSF m a b -> m (b, MSF (ListT m) a b)
+    apply a msf = do
+      (b, msf') <- unMSF msf a
+      return (b, sequenceS [msf'])
+
+#else
+
+{-# DEPRECATED widthFirst "This ListT definition is deprecated. Use the list-transformer variant of this function instead." #-}
 -- | Run an 'MSF' in the 'ListT' transformer (i.e., multiple MSFs producing
 -- each producing one output), by applying the input stream to each MSF in the
 -- list transformer and concatenating the outputs of the MSFs together.
@@ -58,6 +98,7 @@ widthFirst msf = widthFirst' [msf]
       (bs, msfs') <- unzip . concat <$> mapM (runListT . flip unMSF a) msfs
       return (bs, widthFirst' msfs')
 
+{-# DEPRECATED sequenceS "This ListT definition is deprecated. Use the list-transformer variant of this function instead." #-}
 -- | Build an 'MSF' in the 'ListT' transformer by broadcasting the input stream
 -- value to each MSF in a given list.
 sequenceS :: Monad m => [MSF m a b] -> MSF (ListT m) a b
@@ -67,6 +108,8 @@ sequenceS msfs = MSF $ \a -> ListT $ sequence $ apply a <$> msfs
       (b, msf') <- unMSF msf a
       return (b, sequenceS [msf'])
 
+#endif
+
 -- | Apply an 'MSF' to every input.
 mapMSF :: Monad m => MSF m a b -> MSF m [a] [b]
 mapMSF = MSF . consume