From 7a9f30e1be392f0053301b518762fe7b5142c575 Mon Sep 17 00:00:00 2001 From: Mats Rauhala Date: Tue, 25 Aug 2026 11:36:13 +0300 Subject: [PATCH] Tests with timers --- test/AFRPSpec.hs | 164 ++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 161 insertions(+), 3 deletions(-) diff --git a/test/AFRPSpec.hs b/test/AFRPSpec.hs index 1206a57..7f0d23a 100644 --- a/test/AFRPSpec.hs +++ b/test/AFRPSpec.hs @@ -4,7 +4,8 @@ import Control.Category ((>>>)) import Data.Foldable (for_) import AFRP import Data.Functor.Identity (Identity (..)) -import Data.Time (UTCTime (..)) +import Data.List (sort) +import Data.Time (NominalDiffTime, UTCTime (..), addUTCTime, diffUTCTime) import Data.UUID (nil) import Hedgehog import qualified Hedgehog.Gen as Gen @@ -20,6 +21,15 @@ runPure _ [] = [] runPure m (a : as) = case runIdentity (AFRP.runMealy m id fakeRequest a) of (b, m') -> b : runPure m' as +-- | Run a Mealy with a per-step wall clock (seconds since the day-0 epoch). +runTimed :: Mealy Identity a b -> [(Integer, a)] -> [b] +runTimed _ [] = [] +runTimed m ((s, a) : as) = + case runIdentity (AFRP.runMealy m id (Request (t s) nil) a) of + (b, m') -> b : runTimed m' as + where + t n = UTCTime (toEnum 0) (fromIntegral n) + spec :: Spec spec = describe "AFRP" $ do holdSpec @@ -34,7 +44,11 @@ spec = describe "AFRP" $ do slidingSpec mapAccumSpec preMapAccumSpec - -- time-dependent: delayEvent, debounce, rollup, fixed — skipped for now + durationSpec + delayEventSpec + debounceSpec + rollupSpec + fixedSpec holdSpec :: Spec holdSpec = describe "hold" $ do @@ -197,7 +211,7 @@ mapAccumSpec = describe "mapAccum" $ do for_ (zip3 [0 ..] xs out) $ \(i, _x, cur) -> cur === sum (take (i + 1) xs) -preMapAccumSpec :: Spec + preMapAccumSpec :: Spec preMapAccumSpec = describe "preMapAccum" $ do it "running sum with pre-state extraction" $ runPure (preMapAccum (+) (0 :: Int) id) [1, 2, 3] @@ -214,3 +228,147 @@ preMapAccumSpec = describe "preMapAccum" $ do length out === length xs for_ (zip3 [0 ..] xs out) $ \(i, _x, cur) -> cur === sum (take i xs) + +durationSpec :: Spec +durationSpec = describe "duration" $ do + it "first sample is 0, then elapsed time since first sample" $ + runTimed duration [(0, 'a'), (5, 'b'), (10, 'c')] + `shouldBe` [0, 5, 10] + + it "measures from the first observation, not the most recent" $ + runTimed duration [(2, 'a'), (3, 'b'), (7, 'c')] + `shouldBe` [0, 1, 5] + + it "output i equals times[i] - times[0]" $ + hedgehog $ do + secs <- forAll $ Gen.list (Range.linear 0 50) (Gen.int (Range.linear 0 1000)) + let out = runTimed duration [(fromIntegral s, ()) | s <- secs] + length out === length secs + case secs of + [] -> pure () + (t0 : _) -> for_ (zip secs out) $ \(s, d) -> + d === fromIntegral (s - t0) + +delayEventSpec :: Spec +delayEventSpec = describe "delayEvent" $ do + let delay = 5 :: NominalDiffTime + + it "emits a queued event once the delay has elapsed" $ + runTimed (delayEvent delay) + [(0, Event 'a'), (3, Tick), (6, Tick)] + `shouldBe` [Tick, Tick, Event 'a'] + + it "preserves order when multiple events are queued" $ + runTimed (delayEvent delay) + [(0, Event 'a'), (1, Event 'b'), (10, Tick), (12, Tick)] + `shouldBe` [Tick, Tick, Event 'a', Event 'b'] + + it "emits nothing on pure Tick input" $ + runTimed (delayEvent delay) [(0, Tick :: Event Char), (10, Tick)] + `shouldBe` [Tick, Tick] + + it "emits exactly one output Event per input Event" $ + hedgehog $ do + evs <- forAll $ Gen.list (Range.linear 0 30) eventGen + let evs' = evs ++ replicate 3 Tick + n = length [() | Event _ <- evs] + out = runTimed (delayEvent (1 :: NominalDiffTime)) + (zip [0, 2 ..] evs') + length [() | Event _ <- out] === n + +debounceSpec :: Spec +debounceSpec = describe "debounce" $ do + let delay = 5 :: NominalDiffTime + + it "fires the last event after the quiet period" $ + runTimed (debounce delay) + [(0, Event 'a'), (3, Tick), (6, Tick)] + `shouldBe` [Tick, Tick, Event 'a'] + + it "a newer event before firing resets the timer" $ + runTimed (debounce delay) + [(0, Event 'a'), (3, Event 'b'), (6, Tick), (8, Tick)] + `shouldBe` [Tick, Tick, Tick, Event 'b'] + + it "collapses a burst into a single emission" $ + runTimed (debounce delay) + [(0, Event 'a'), (1, Event 'b'), (2, Event 'c'), (10, Tick)] + `shouldBe` [Tick, Tick, Tick, Event 'c'] + + it "emits no more output Events than input Events" $ + hedgehog $ do + evs <- forAll $ Gen.list (Range.linear 0 30) eventGen + let nIn = length [() | Event _ <- evs] + out = runTimed (debounce (1 :: NominalDiffTime)) + (zip [0, 2 ..] evs) + nOut = length [() | Event _ <- out] + assert (nOut <= nIn) + +rollupSpec :: Spec +rollupSpec = describe "rollup" $ do + it "passes the first `limit` events through immediately, then bursts" $ + runTimed (rollup 2 10) + [ (0, Event 'a'), (1, Event 'b') + , (2, Event 'c'), (3, Event 'd') + , (12, Tick) + ] + `shouldBe` [ Event ['a'], Event ['b'] + , Tick, Tick + , Event ['c', 'd'] + ] + + it "flushes the accumulator when the window ends on a Tick" $ + runTimed (rollup 1 10) + [(0, Event 'a'), (1, Event 'b'), (2, Tick), (12, Tick)] + `shouldBe` [Event ['a'], Tick, Tick, Event ['b']] + + it "is idle (Tick) until the first Event" $ + runTimed (rollup 2 10) [(0, Tick :: Event Char), (1, Tick)] + `shouldBe` [Tick, Tick] + + it "every input Event appears exactly once across the outputs" $ + hedgehog $ do + limit <- forAll $ Gen.int (Range.constant 1 5) + evs <- forAll $ Gen.list (Range.linear 0 30) eventGen + let evs' = evs ++ replicate 10 Tick + times = [0 ..] + out = runTimed (rollup limit 5) (zip times evs') + emitted = concat [xs | Event xs <- out] + sort emitted === sort [x | Event x <- evs] + +fixedSpec :: Spec +fixedSpec = describe "fixed" $ do + it "accumulates events within a window and rolls over on expiry" $ + runTimed (fixed 10) + [ (0, Event 'a'), (1, Event 'b'), (2, Tick) + , (12, Event 'c'), (13, Tick) + ] + `shouldBe` [ ['a'], ['a', 'b'], ['a', 'b'] + , ['c'], ['c'] + ] + + it "starts a window even on a leading Tick" $ + runTimed (fixed 10) + [ (0, Tick), (1, Event 'a') + , (12, Tick), (13, Tick) + , (25, Event 'b') + ] + `shouldBe` [ [], ['a'], [], [], ['b'] ] + + it "output is always the current window's accumulated list" $ + hedgehog $ do + w <- forAll $ Gen.int (Range.constant 1 10) + evs <- forAll $ Gen.list (Range.linear 0 30) eventGen + let out = runTimed (fixed w) (zip [0 ..] evs) + expected = + [ [ x | Event x <- take (i - lo + 1) (drop lo evs) ] + | i <- [0 .. length evs - 1] + , let lo = (i `div` w) * w + ] + out === expected + +eventGen :: Gen (Event Char) +eventGen = Gen.frequency + [ (3, Event <$> Gen.alpha) + , (1, pure Tick) + ]