diff --git a/dunai-frp-bearriver/CHANGELOG b/dunai-frp-bearriver/CHANGELOG index 36ab7efb..ae4bc59f 100644 --- a/dunai-frp-bearriver/CHANGELOG +++ b/dunai-frp-bearriver/CHANGELOG @@ -1,3 +1,7 @@ +2024-06-21 Ivan Perez + * Version bump (0.14.9) (#420). + * Offer all definitions from FRP.Yampa.Hybrid (#419). + 2024-04-23 Ivan Perez * Version bump (0.14.8) (#411). * Offer all definitions from FRP.Yampa.Loop (#407). diff --git a/dunai-frp-bearriver/bearriver.cabal b/dunai-frp-bearriver/bearriver.cabal index d291110b..70dd8a01 100644 --- a/dunai-frp-bearriver/bearriver.cabal +++ b/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 diff --git a/dunai-frp-bearriver/src/FRP/BearRiver/Hybrid.hs b/dunai-frp-bearriver/src/FRP/BearRiver/Hybrid.hs index 591bd382..52320e5a 100644 --- a/dunai-frp-bearriver/src/FRP/BearRiver/Hybrid.hs +++ b/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 diff --git a/dunai-test/CHANGELOG b/dunai-test/CHANGELOG index fc878426..69b0067e 100644 --- a/dunai-test/CHANGELOG +++ b/dunai-test/CHANGELOG @@ -1,3 +1,6 @@ +2024-06-21 Ivan Perez + * Version bump (0.13.0) (#420). + 2024-04-23 Ivan Perez * Version bump (0.12.3) (#411). diff --git a/dunai-test/dunai-test.cabal b/dunai-test/dunai-test.cabal index dff5ae8f..330e2950 100644 --- a/dunai-test/dunai-test.cabal +++ b/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 diff --git a/dunai/CHANGELOG b/dunai/CHANGELOG index e24a0d81..df3a5cd5 100644 --- a/dunai/CHANGELOG +++ b/dunai/CHANGELOG @@ -1,3 +1,7 @@ +2024-06-21 Ivan Perez + * Version bump (0.13.0) (#420). + * Implement List interface using list-transformer (#418). + 2024-04-23 Ivan Perez * Version bump (0.12.3) (#411). * Fix typo in documentation (#410). diff --git a/dunai/dunai.cabal b/dunai/dunai.cabal index ff545096..51fd7d59 100644 --- a/dunai/dunai.cabal +++ b/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 diff --git a/dunai/src/Control/Monad/Trans/MSF/List.hs b/dunai/src/Control/Monad/Trans/MSF/List.hs index 5c3aef67..2dd852b3 100644 --- a/dunai/src/Control/Monad/Trans/MSF/List.hs +++ b/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