dunai-test 0.10.1 → 0.11.0

raw patch · 7 files changed

+276/−231 lines, 7 filesdep ~dunaiPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: dunai

API changes (from Hackage documentation)

Files

• CHANGELOG +4/−0
• dunai-test.cabal +2/−2
• src/FRP/Dunai/Debug.hs +3/−3
• src/FRP/Dunai/LTLFuture.hs +31/−28
• src/FRP/Dunai/LTLPast.hs +19/−30
• src/FRP/Dunai/QuickCheck.hs +109/−128
• src/FRP/Dunai/Stream.hs +108/−40

@@ -1,3 +1,7 @@+2023-04-21 Ivan Perez <ivan.perez@keera.co.uk>+        * Version bump (0.11.0) (#358).+        * Conformance with style guide (#348).+ 2023-02-21 Ivan Perez <ivan.perez@keera.co.uk>         * Version bump (0.10.1) (#345). 

@@ -30,7 +30,7 @@ build-type:    Simple  name:          dunai-test-version:       0.10.1+version:       0.11.0 author:        Ivan Perez maintainer:    ivan.perez@keera.co.uk homepage:      https://github.com/ivanperez-keera/dunai@@ -74,7 +74,7 @@    build-depends:       base >= 4 && < 5-    , dunai >= 0.5 && < 0.11+    , dunai >= 0.5 && < 0.12     , normaldistribution     , QuickCheck 

@@ -6,9 +6,9 @@ -- Debug FRP networks by inspecting their behaviour inside. module FRP.Dunai.Debug where -import Debug.Trace+-- External imports import Data.MonadicStreamFunction hiding (trace)-import System.IO.Unsafe+import Debug.Trace                (trace)  -- ** Debugging @@ -16,7 +16,7 @@ -- 'trace'. traceMSF :: Monad m          => Show a-        => MSF m a a+         => MSF m a a traceMSF = traceMSFWith show  -- | Monadic Stream Function that prints the value passing through using

@@ -23,15 +23,18 @@     )   where +-- External imports #if !MIN_VERSION_base(4,8,0)-import Control.Applicative (Applicative, (<$>), (<*>), pure)+import Control.Applicative (Applicative, pure, (<$>), (<*>)) #endif -import Control.Monad.Trans.MSF.Reader-import Data.MonadicStreamFunction+import Control.Monad.Trans.MSF.Reader          (ReaderT, readerS, runReaderS)+import Data.MonadicStreamFunction              (MSF) import Data.MonadicStreamFunction.InternalCore (unMSF)-import FRP.Dunai.Stream +-- Internal imports+import FRP.Dunai.Stream (DTime, SignalSampleStream)+ -- * Temporal Logics based on SFs  -- | Type representing future-time linear temporal logic with until and next.@@ -67,29 +70,31 @@ -- -- Returns 'True' if the temporal proposition is currently true. evalT :: (Functor m, Applicative m, Monad m)-      => TPred (ReaderT DTime m) a -> SignalSampleStream a -> m Bool-evalT (Prop sf)       [] = return False-evalT (And t1 t2)     [] = (&&) <$> evalT t1 [] <*> evalT t2 []-evalT (Or  t1 t2)     [] = (||) <$> evalT t1 [] <*> evalT t2 []-evalT (Not t1)        [] = not  <$> evalT t1 []-evalT (Implies t1 t2) [] = (||) <$> (not <$> evalT t1 []) <*> evalT t2 []-evalT (Always t1)     [] = return True-evalT (Eventually t1) [] = return False-evalT (Next t1)       [] = return False-evalT (Until t1 t2)   [] = (||) <$> evalT t1 [] <*> evalT t2 []+      => TPred (ReaderT DTime m) a+      -> SignalSampleStream a+      -> m Bool+evalT (Prop _sf)      []     = return False+evalT (And t1 t2)     []     = (&&) <$> evalT t1 [] <*> evalT t2 []+evalT (Or  t1 t2)     []     = (||) <$> evalT t1 [] <*> evalT t2 []+evalT (Not t1)        []     = not  <$> evalT t1 []+evalT (Implies t1 t2) []     = (||) <$> (not <$> evalT t1 []) <*> evalT t2 []+evalT (Always _t)     []     = return True+evalT (Eventually _t) []     = return False+evalT (Next _t)       []     = return False+evalT (Until t1 t2)   []     = (||) <$> evalT t1 [] <*> evalT t2 [] evalT op              (x:xs) = do   (r, op') <- stepF op x   case (r, xs) of     (Def x,    _) -> return x     (SoFar x, []) -> return x-    (SoFar x, xs) -> evalT op' xs+    (SoFar _, xs) -> evalT op' xs  -- ** Multi-valued temporal evaluation  -- | Multi-valued logic result data MultiRes-    = Def Bool    -- ^ Definite value known-    | SoFar Bool  -- ^ Value so far, but could change+  = Def Bool   -- ^ Definite value known+  | SoFar Bool -- ^ Value so far, but could change  -- | Multi-valued implementation of @and@. andM :: MultiRes -> MultiRes -> MultiRes@@ -97,10 +102,9 @@ andM _             (Def False)   = Def False andM (Def True)    x             = x andM x             (Def True)    = x-andM (SoFar False) (SoFar x)     = SoFar False-andM (SoFar x)     (SoFar False) = SoFar False+andM (SoFar False) (SoFar _)     = SoFar False+andM (SoFar _)     (SoFar False) = SoFar False andM (SoFar True)  (SoFar x)     = SoFar x-andM (SoFar x)     (SoFar True)  = SoFar x  -- | Multi-valued implementation of @or@. orM :: MultiRes -> MultiRes -> MultiRes@@ -108,10 +112,9 @@ orM _             (Def False)   = Def False orM (Def True)    x             = x orM x             (Def True)    = x-orM (SoFar False) (SoFar x)     = SoFar False-orM (SoFar x)     (SoFar False) = SoFar False+orM (SoFar False) (SoFar _)     = SoFar False+orM (SoFar _)     (SoFar False) = SoFar False orM (SoFar True)  (SoFar x)     = SoFar x-orM (SoFar x)     (SoFar True)  = SoFar x  -- | Perform one step of evaluation of a temporal predicate. stepF :: (Applicative m, Monad m)@@ -119,16 +122,16 @@       -> (DTime, a)       -> m (MultiRes, TPred (ReaderT DTime m) a) -stepF (Prop sf) x  = do+stepF (Prop sf) x = do   (b, sf') <- unMSF (runReaderS sf) x   return (Def b, Prop (readerS sf'))  stepF (Always sf) x = do   (b, sf') <- stepF sf x   case b of-    Def True    -> pure (SoFar True, Always sf')-    Def False   -> pure (Def False, Always sf')-    SoFar True  -> pure (SoFar True, Always sf')+    Def True    -> pure (SoFar True,  Always sf')+    Def False   -> pure (Def False,   Always sf')+    SoFar True  -> pure (SoFar True,  Always sf')     SoFar False -> pure (SoFar False, Always sf')  stepF (Eventually sf) x = do@@ -142,7 +145,7 @@ stepF (Not sf) x = do   (b, sf') <- stepF sf x   case b of-    Def x   -> pure (Def (not x), Not sf')+    Def x   -> pure (Def (not x),   Not sf')     SoFar x -> pure (SoFar (not x), Not sf')  stepF (And sf1 sf2) x = do

@@ -1,6 +1,11 @@ {-# LANGUAGE Arrows #-}--- | Past-time LTL using MSFs.+-- |+-- Copyright  : (c) Ivan Perez, 2017+-- License    : BSD3+-- Maintainer : ivan.perez@keera.co.uk --+-- Past-time LTL using MSFs.+-- -- This module provides ways of defining past-, discrete-time temporal -- predicates with MSFs. --@@ -9,9 +14,10 @@ -- (Past-time LTL as MSF combinators). module FRP.Dunai.LTLPast where -import Control.Monad.Trans.MSF.Maybe-import Data.Maybe-import Data.MonadicStreamFunction+-- External imports+import Control.Monad.Trans.MSF.Maybe (MaybeT, catchMaybe, inMaybeT)+import Data.MonadicStreamFunction    (MSF, arr, feedback, iPre, liftTransS,+                                      returnA, (&&&), (>>>), (^>>))  -- * Past-time linear temporal logic using MSFs. @@ -31,23 +37,23 @@  -- | Output True when the second input is True or the first one is False. impliesSF :: Monad m => MSF m (Bool, Bool) Bool-impliesSF = arr $ \(i,p) -> not i || p+impliesSF = arr $ \(i, p) -> not i || p  -- ** Temporal MSFs  -- | Output True when every input up until the current time has been True. ----- This corresponds to Historically, or the past-time version of Globally--- or Always.+-- This corresponds to Historically, or the past-time version of Globally or+-- Always. sofarSF :: Monad m => MSF m Bool Bool-sofarSF = feedback True $ arr $ \(n,o) -> let n' = o && n in (n', n')+sofarSF = feedback True $ arr $ \(n, o) -> let n' = o && n in (n', n')  -- | Output True when at least one input up until the current time has been -- True. -- -- This corresponds to Ever, or the past-time version of Eventually. everSF :: Monad m => MSF m Bool Bool-everSF = feedback False $ arr $ \(n,o) -> let n' = o || n in (n', n')+everSF = feedback False $ arr $ \(n, o) -> let n' = o || n in (n', n')  -- | Output True if the first element has always been True, or the second has -- been True ever since the first one became False.@@ -60,7 +66,7 @@      untilMaybeB :: Monad m => MSF m a (b, Bool) -> MSF (MaybeT m) a b     untilMaybeB msf = proc a -> do-      (b,c) <- liftTransS msf -< a+      (b, c) <- liftTransS msf -< a       inMaybeT -< if c then Nothing else Just b      cond ((i, u), o) = ((n, o && u), n)@@ -73,22 +79,6 @@ lastSF :: Monad m => MSF m Bool Bool lastSF = iPre False --- data UnclearResult = Possibly Bool | Definitely Bool------ causally :: SF a Bool -> SF a UnclearResult--- causally = (>>> arr Definitely)------ data TSF a = NonCausal (SF a UnclearResult)---            | Causal    (SF a Bool)------ evalTSF :: TSF a -> SignalSampleStream a -> Bool--- evalTSF (Causal sf)    ss = firstSample $ fst $ evalSF sf ss--- evalTSF (NonCausal sf) ss = clarifyResult $ lastSample $ fst $ evalSF sf ss------ clarifyResult :: UnclearResult -> Bool--- clarifyResult (Possibly x)   = x--- clarifyResult (Definitely x) = x- -- * Past-time linear temporal logic as MSF combinators.  -- | A signal predicate is an MSF whose output is a Boolean value.@@ -118,16 +108,15 @@ -- | Output True at a time if the input has always been True up until that -- time. ----- This corresponds to Historically, or the past-time version of Globally--- or Always.+-- This corresponds to Historically, or the past-time version of Globally or+-- Always. history' :: Monad m => SPred m a -> SPred m a history' sf = feedback True $ proc (a, last) -> do   b <- sf -< a   let cur = last && b   returnA -< (cur, cur) --- | Output True at a time if the input has ever been True up until that--- time.+-- | Output True at a time if the input has ever been True up until that time. -- -- This corresponds to Ever, or the past-time version of Eventually. ever' :: Monad m => SPred m a -> SPred m a

@@ -1,85 +1,53 @@ {-# LANGUAGE CPP                 #-}-{-# LANGUAGE MultiWayIf          #-} {-# LANGUAGE ScopedTypeVariables #-}--module FRP.Dunai.QuickCheck where---- Examples accompanying the ICFP 2017 paper.+-- |+-- Copyright  : (c) Ivan Perez, 2017-2023+-- License    : BSD3+-- Maintainer : ivan.perez@keera.co.uk ----- Changes with respect to the paper:+-- QuickCheck generators for input streams. ----- - The signature of ballTrulyFalling' in the paper was SF () Double. It's---   been changed to the intended meaning: TPred ()+-- Random stream generation can be customized usin three parameters:+--+-- - The distribution for the random time deltas ('Distribution').+-- - The maximum and minimum bounds for the time deltas ('Range').+-- - The maximum stream length ('Length').+--+-- The main function to generate streams is 'generateStream'. The specific time+-- deltas can be customized further using 'generateStreamWith'. Some helper+-- functions are provided to facilitate testing.+module FRP.Dunai.QuickCheck+    (+      -- * Random stream generation+      generateStream+    , generateStreamWith --- - The function uniDistStreamMaxDT had the wrong type and the name on the---   paper was: uniDistStream. This has been fixed.+      -- ** Parameters used to generate random input streams+    , Distribution(..)+    , Range+    , Length +      -- ** Helpers for common cases+    , uniDistStream+    , uniDistStreamMaxDT+    , fixedDelayStream+    , fixedDelayStreamWith+    )+  where++-- External imports #if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>), pure)+import Control.Applicative (pure, (<$>)) #endif -import Data.Random.Normal-import Data.MonadicStreamFunction-import FRP.Dunai.Stream-import Test.QuickCheck-import Test.QuickCheck.Gen---- * Random stream generation---- ** Parameters used to generate random input streams--data Distribution = DistConstant-                  | DistNormal (DTime, DTime)-                  | DistRandom--type Range = (Maybe DTime, Maybe DTime)--type Length = Maybe (Either Int DTime)---- ** Time delta generation---- | Generate a random delta according to some required specifications.-generateDeltas :: Distribution -> Range -> Length -> Gen DTime-generateDeltas DistConstant            (mn, mx) len = generateDelta mn mx-generateDeltas DistRandom              (mn, mx) len = generateDelta mn mx-generateDeltas (DistNormal (avg, dev)) (mn, mx) len =-  generateDSNormal avg dev mn mx---- | Generate one random delta, possibly within a range.-generateDelta :: Maybe DTime -> Maybe DTime -> Gen DTime-generateDelta (Just x)  (Just y)  = choose (x, y)-generateDelta (Just x)  Nothing   = (x+) . getPositive <$> arbitrary-generateDelta Nothing   (Just y)  = choose (2.2251e-308, y)-generateDelta Nothing   Nothing   = getPositive <$> arbitrary---- | Generate a random delta following a normal distribution,---   and possibly within a given range.-generateDSNormal :: DTime -> DTime -> Maybe DTime -> Maybe DTime -> Gen DTime-generateDSNormal avg stddev m n = suchThat gen (\x -> mx x && mn x)-  where-    gen = MkGen (\r _ -> let (x,_) = normal' (avg, stddev) r in x)-    mn  = maybe (const True) (<=) m-    mx  = maybe (const True) (>=) n---- | Generate random samples up until a max time.-timeStampsUntil :: DTime -> Gen [DTime]-timeStampsUntil = timeStampsUntilWith arbitrary+import Data.Random.Normal  (normal')+import Test.QuickCheck     (Arbitrary, arbitrary, getPositive)+import Test.QuickCheck.Gen (Gen (MkGen), choose, suchThat) --- | Generate random samples up until a max time, with a given time delta---   generation function.-timeStampsUntilWith :: Gen DTime -> DTime -> Gen [DTime]-timeStampsUntilWith arb = timeStampsUntilWith' arb []-  where-    -- Generate random samples up until a max time, with a given time delta-    -- generation function, and an initial suffix of time deltas.-    timeStampsUntilWith' :: Gen DTime -> [DTime] -> DTime -> Gen [DTime]-    timeStampsUntilWith' arb acc ds-      | ds < 0    = return acc-      | otherwise = do d <- arb-                       let acc' = acc `seq` (d:acc)-                       acc' `seq` timeStampsUntilWith' arb acc' (ds - d)+-- Internal imports+import FRP.Dunai.Stream (DTime, SignalSampleStream, groupDeltas) --- ** Random stream generation+-- * Random stream generation  -- | Generate random stream. generateStream :: Arbitrary a@@ -95,64 +63,40 @@                    -> Range                    -> Length                    -> Gen (SignalSampleStream a)--generateStreamWith arb DistConstant range  len     =+generateStreamWith arb DistConstant range len =   generateConstantStream arb =<< generateStreamLenDT range len--generateStreamWith arb DistRandom   (m, n) Nothing = do-  l <- arbitrary-  x <- arb 0 0-  ds <- vectorOfWith l (\_ -> generateDelta m n)-  let f n = arb n (ds!!(n-1))-  xs <- vectorOfWith l f-  return $ groupDeltas (x:xs) ds--generateStreamWith arb DistRandom (m, n) (Just (Left l)) = do-  x <- arb 0 0-  ds <- vectorOfWith l (\_ -> generateDelta m n)-  let f n = arb n (ds!!(n-1))-  xs <- vectorOfWith l f-  return $ groupDeltas (x:xs) ds+generateStreamWith arb dist (m, n) len = do+    ds <- generateDeltas len+    let l = length ds+    let f n = arb n (ds !! (n - 1))+    xs <- vectorOfWith l f -generateStreamWith arb DistRandom (m, n) (Just (Right maxds)) = do-  ds <- timeStampsUntilWith (generateDelta m n) maxds-  let l = length ds-  x  <- arb 0 0-  let f n = arb n (ds!!(n-1))-  xs <- vectorOfWith l f-  return $ groupDeltas (x:xs) ds+    x <- arb 0 0+    return $ groupDeltas (x:xs) ds -generateStreamWith arb (DistNormal (avg, stddev)) (m, n) Nothing = do-  l <- arbitrary-  x <- arb 0 0-  ds <- vectorOfWith l (\_ -> generateDSNormal avg stddev m n)-  let f n = arb n (ds!!(n-1))-  xs <- vectorOfWith l f-  return $ groupDeltas (x:xs) ds+  where -generateStreamWith arb (DistNormal (avg, stddev)) (m, n) (Just (Left l)) = do-  x <- arb 0 0-  ds <- vectorOfWith l (\_ -> generateDSNormal avg stddev m n)-  let f n = arb n (ds!!(n-1))-  xs <- vectorOfWith l f-  return $ groupDeltas (x:xs) ds+    deltaF :: Gen DTime+    deltaF = case dist of+               DistRandom -> generateDelta m n+               DistNormal (avg, stddev) -> generateDSNormal avg stddev m n+               _ -> error "dunai-test: generateStreamWith" -generateStreamWith arb (DistNormal (avg, stddev)) (m, n) (Just (Right maxds)) = do-  ds <- timeStampsUntilWith (generateDSNormal avg stddev m n) maxds-  let l = length ds-  x <- arb 0 0-  let f n = arb n (ds!!(n-1))-  xs <- vectorOfWith l f-  return $ groupDeltas (x:xs) ds+    generateDeltas :: Length -> Gen [DTime]+    generateDeltas Nothing              = do l <- arbitrary+                                             vectorOfWith l (\_ -> deltaF)+    generateDeltas (Just (Left l))      = vectorOfWith l (\_ -> deltaF)+    generateDeltas (Just (Right maxds)) = timeStampsUntilWith deltaF maxds  -- | Generate arbitrary stream with fixed length and constant delta. generateConstantStream :: (Int -> DTime -> Gen a)                        -> (DTime, Int)                        -> Gen (SignalSampleStream a) generateConstantStream arb (x, length) = do-  ys <- vectorOfWith length (`arb` x)-  let ds = repeat x-  return $ groupDeltas ys ds+    ys <- vectorOfWith length (`arb` x)+    return $ groupDeltas ys ds+  where+    ds = repeat x  -- | Generate arbitrary stream generateStreamLenDT :: (Maybe DTime, Maybe DTime)@@ -166,16 +110,53 @@          Just (Right ds) -> pure (floor (ds / x))   return (x, l) --- generateStreamLenDT (Just x,  Just y)  (Just (Left l))   = (,) <$> choose (x, y)        <*> pure l--- generateStreamLenDT (Just x,  Nothing) (Just (Left l))   = (,) <$> ((x+) <$> arbitrary) <*> pure l--- generateStreamLenDT (Nothing, Just y)  (Just (Left l))   = (,) <$> choose (0, y)        <*> pure l--- generateStreamLenDT (Just x,  _)       (Just (Right ts)) = (,) <$> pure x               <*> pure (floor (ts / x))--- generateStreamLenDT (Just x,  _)       Nothing           = (,) <$> pure x               <*> arbitrary--- generateStreamLenDT (Nothing, Nothing) Nothing           = (,) <$> arbitrary            <*> arbitrary--- generateStreamLenDT (Nothing, Nothing) (Just (Left l))   = (,) <$> arbitrary            <*> pure l--- generateStreamLenDT (Nothing, Nothing) (Just (Right ds)) = f2  <$> arbitrary---   where---     f2 l = (ds / fromIntegral l, l)+-- ** Time delta generation++-- | Generate one random delta, possibly within a range.+generateDelta :: Maybe DTime -> Maybe DTime -> Gen DTime+generateDelta (Just x) (Just y) = choose (x, y)+generateDelta (Just x) Nothing  = (x +) . getPositive <$> arbitrary+generateDelta Nothing  (Just y) = choose (2.2251e-308, y)+generateDelta Nothing  Nothing  = getPositive <$> arbitrary++-- | Generate a random delta following a normal distribution, and possibly+-- within a given range.+generateDSNormal :: DTime -> DTime -> Maybe DTime -> Maybe DTime -> Gen DTime+generateDSNormal avg stddev m n = suchThat gen (\x -> mx x && mn x)+  where+    gen = MkGen (\r _ -> fst $ normal' (avg, stddev) r)+    mn  = maybe (const True) (<=) m+    mx  = maybe (const True) (>=) n++-- | Generate random samples up until a max time, with a given time delta+-- generation function.+timeStampsUntilWith :: Gen DTime -> DTime -> Gen [DTime]+timeStampsUntilWith arb = timeStampsUntilWith' arb []+  where+    -- Generate random samples up until a max time, with a given time delta+    -- generation function, and an initial suffix of time deltas.+    timeStampsUntilWith' :: Gen DTime -> [DTime] -> DTime -> Gen [DTime]+    timeStampsUntilWith' arb acc ds+      | ds < 0    = return acc+      | otherwise = do d <- arb+                       let acc' = acc `seq` (d:acc)+                       acc' `seq` timeStampsUntilWith' arb acc' (ds - d)++-- ** Parameters used to generate random input streams++-- | Distributions used for time delta (DT) generation.+data Distribution+  = DistConstant              -- ^ Constant DT for the whole stream.+  | DistNormal (DTime, DTime) -- ^ Variable DT following normal distribution,+                              --   with an average and a standard deviation.+  | DistRandom                -- ^ Completely random (positive) DT.++-- | Upper and lower bounds of time deltas for random DT generation.+type Range = (Maybe DTime, Maybe DTime)++-- | Optional maximum length for a stream, given as a time, or a number of+-- samples.+type Length = Maybe (Either Int DTime)  -- ** Helpers for common cases 

@@ -1,22 +1,47 @@-{-# LANGUAGE MultiWayIf #-}+-- |+-- Copyright  : (c) Ivan Perez, 2017-2023+-- License    : BSD3+-- Maintainer : ivan.perez@keera.co.uk+--+-- Streams and stream manipulation API.+--+-- The evaluation of Dunai MSFs, especially for testing purposes, needs the+-- generation of suitable input streams.+--+-- While some streams can be generated randomly using QuickCheck, it is+-- sometimes useful to be able to preprend or adapt an input stream. It is also+-- useful to debug programs when you have recorded input streams using Haskell+-- Titan.+--+-- This module defines types for input streams, as well as an API to create,+-- examine and combine streams. It also provides evaluation functions that are+-- needed to apply an MSF to a stream and obtain an output stream and a+-- continuation MSF. module FRP.Dunai.Stream where -import Data.MonadicStreamFunction+-- External imports+import Control.Monad.Trans.MSF.Reader          (ReaderT, readerS, runReaderS)+import Data.MonadicStreamFunction              (MSF) import Data.MonadicStreamFunction.InternalCore (unMSF)-import Control.Monad.Trans.MSF.Reader  -- * Types++-- | A stream of samples, with their sampling times. type SignalSampleStream a = SampleStream (DTime, a)++-- | A stream of samples, with no sampling time. type SampleStream a = [a]-type DTime    = Double +-- | DTime is the time type for lengths of sample intervals. Conceptually,+-- DTime = R+ = { x in R | x > 0 }.+type DTime = Double  -- ** Creation  -- | Group a series of samples with a series of time deltas. -----   The first sample will have no delta. Unused samples and deltas will be---   dropped.+-- The first sample will have no delta. Unused samples and deltas will be+-- dropped. groupDeltas :: [a] -> [DTime] -> SignalSampleStream a groupDeltas xs ds = zip (0:ds) xs @@ -26,9 +51,11 @@ samples :: SignalSampleStream a -> [a] samples = map snd +-- | Return the first sample in a signal sample stream. firstSample :: SignalSampleStream a -> a firstSample = head . samples +-- | Return the last sample in a signal sample stream. lastSample :: SignalSampleStream a -> a lastSample = last . samples @@ -36,74 +63,115 @@  -- ** Merging -sMerge :: (a -> a -> a) -> SignalSampleStream a -> SignalSampleStream a -> SignalSampleStream a-sMerge f []              xs2             = xs2-sMerge f xs1             []              = xs1-sMerge f ((dt1, x1):xs1) ((dt2, x2):xs2)+-- | Merge two streams, using an auxiliary function to merge samples that fall+-- at the exact same sampling time.+sMerge :: (a -> a -> a)+       -> SignalSampleStream a+       -> SignalSampleStream a+       -> SignalSampleStream a+sMerge _ []                xs2               = xs2+sMerge _ xs1               []                = xs1+sMerge f ((dt1, x1) : xs1) ((dt2, x2) : xs2)   | dt1 == dt2 = (dt1, f x1 x2) : sMerge f xs1 xs2-  | dt1 <  dt2 = (dt1, x1) : sMerge f xs1 ((dt2-dt1, x2):xs2)-  | otherwise  = (dt2, x2) : sMerge f ((dt1-dt2, x1):xs1) xs2+  | dt1 <  dt2 = (dt1, x1) : sMerge f xs1 ((dt2 - dt1, x2) : xs2)+  | otherwise  = (dt2, x2) : sMerge f ((dt1 - dt2, x1) : xs1) xs2  -- ** Concatenating +-- | Concatenate two sample streams, separating them by a given time delta. sConcat :: SignalSampleStream a -> SignalSampleStream a -> SignalSampleStream a sConcat xs1 xs2 = xs1 ++ xs2  -- ** Refining++-- | Refine a signal sample stream by establishing the maximum time delta.+--+-- If two samples are separated by a time delta bigger than the given max DT,+-- the former is replicated as many times as necessary. sRefine :: DTime -> a -> SignalSampleStream a -> SignalSampleStream a-sRefine maxDT _ [] = []-sRefine maxDT a0 ((dt, a):as)-  | dt > maxDT = (maxDT, a0) : sRefine maxDT a0 ((dt - maxDT, a):as)+sRefine _     _  []             = []+sRefine maxDT a0 ((dt, a) : as)+  | dt > maxDT = (maxDT, a0) : sRefine maxDT a0 ((dt - maxDT, a) : as)   | otherwise  = (dt, a) : sRefine maxDT a as -refineWith :: (a -> a -> a) -> DTime -> a -> SignalSampleStream a -> SignalSampleStream a-refineWith interpolate maxDT _  [] = []-refineWith interpolate maxDT a0 ((dt, a):as)-  | dt > maxDT = let a' = interpolate a0 a-                 in (maxDT, interpolate a0 a) : refineWith interpolate maxDT a' ((dt - maxDT, a):as)-  | otherwise  = (dt, a) : refineWith interpolate maxDT a as+-- | Refine a stream by establishing the maximum time delta.+--+-- If two samples are separated by a time delta bigger than the given max DT,+-- the auxiliary interpolation function is used to determine the intermediate+-- sample.+refineWith :: (a -> a -> a)+           -> DTime+           -> a+           -> SignalSampleStream a+           -> SignalSampleStream a+refineWith _           _     _  []             = []+refineWith interpolate maxDT a0 ((dt, a) : as)+    | dt > maxDT+    = (maxDT, interpolate a0 a) :+        refineWith interpolate maxDT a' ((dt - maxDT, a) : as)+    | otherwise+    = (dt, a) : refineWith interpolate maxDT a as+  where+    a' = interpolate a0 a  -- ** Clipping (dropping samples) +-- | Clip a signal sample stream at a given number of samples. sClipAfterFrame :: Int -> SignalSampleStream a -> SignalSampleStream a sClipAfterFrame = take -sClipAfterTime dt [] = []-sClipAfterTime dt ((dt',x):xs)+-- | Clip a signal sample stream after a certain (non-zero) time.+sClipAfterTime :: DTime -> SignalSampleStream a -> SignalSampleStream a+sClipAfterTime _  []              = []+sClipAfterTime dt ((dt', x) : xs)   | dt < dt'  = []   | otherwise = (dt', x) : sClipAfterTime (dt - dt') xs +-- | Drop the first n samples of a signal sample stream. The time deltas are+-- not re-calculated. sClipBeforeFrame :: Int -> SignalSampleStream a -> SignalSampleStream a sClipBeforeFrame 0 xs@(_:_) = xs-sClipBeforeFrame n xs@[x]   = xs-sClipBeforeFrame n xs       = sClipBeforeFrame (n-1) xs+sClipBeforeFrame _ xs@[_]   = xs+sClipBeforeFrame n xs       = sClipBeforeFrame (n - 1) xs -sClipBeforeTime  :: DTime -> SignalSampleStream a -> SignalSampleStream a+-- | Drop the first samples of a signal sample stream up to a given time. The+-- time deltas are not re-calculated to match the original stream.+sClipBeforeTime :: DTime -> SignalSampleStream a -> SignalSampleStream a sClipBeforeTime dt xs-  | dt <= 0   = xs-  | otherwise = case xs of-                  [x]              -> xs-                  (_:(dt',x'):xs') -> if | dt < dt'  -> ((dt'- dt, x'):xs')-                                         | otherwise -> sClipBeforeTime (dt - dt') ((0,x'):xs')-+    | dt <= 0        = xs+    | length xs == 1 = xs+    | dt < dt'       = (dt' - dt, x') : xs'+    | otherwise      = sClipBeforeTime (dt - dt') ((0, x') : xs')+  where+    (_ : (dt', x') : xs') = xs +-- | Evaluate an SF with a 'SignalSampleStream', obtaining an output stream and+-- a continuation.+--+-- You should never use this for actual execution in your applications, only+-- for testing. evalSF :: Monad m        => MSF (ReaderT DTime m) a b        -> SignalSampleStream a        -> m (SampleStream b, MSF (ReaderT DTime m) a b) evalSF fsf as = do-  let msf'' = runReaderS fsf-  (ss, msf') <- evalMSF msf'' as-  return (ss, readerS msf')-+    (ss, msf') <- evalMSF msf'' as+    return (ss, readerS msf')+  where+    msf'' = runReaderS fsf +-- | Evaluate an MSF with a 'SampleStream', obtaining an output stream and a+-- continuation.+--+-- You should never use this for actual execution in your applications, only+-- for testing. evalMSF :: Monad m         => MSF m a b-       -> SampleStream a-       -> m (SampleStream b, MSF m a b)-evalMSF fsf [] = return ([], fsf)+        -> SampleStream a+        -> m (SampleStream b, MSF m a b)+evalMSF fsf []     = return ([], fsf) evalMSF fsf (a:as) = do   (b, fsf')   <- unMSF fsf a   (bs, fsf'') <- evalMSF fsf' as-  let outputStrm  = b : bs+  let outputStrm = b : bs   return (outputStrm, fsf'')