Tests with timers

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
@@ -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)
+  ]