Tests with timers
This commit is contained in:
+161
-3
@@ -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)
|
||||
]
|
||||
|
||||
Reference in New Issue
Block a user