Update tests

test/AFRPSpec.hs

@@ -25,17 +25,24 @@ fakeRequest = Request (sec 0) utc nil
 sec :: Integer -> UTCTime
 sec n = UTCTime (toEnum 0) (fromIntegral n)
 
+untime :: SerializeUTCTime -> UTCTime
+untime (SerializeUTCTime t) = t
+
 runPure :: Mealy Identity a b -> [a] -> [b]
-runPure _ [] = []
-runPure m (a : as) = case runIdentity (AFRP.runMealy m id fakeRequest a) of
-  Pair b m' -> b : runPure m' as
+runPure m = go (runMealy m id)
+  where
+    go _ [] = []
+    go w (a : as) = case runIdentity (stepAuto w fakeRequest a) of
+      (b, w') -> b : go w' 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 (sec s) utc nil) a) of
-    Pair b m' -> b : runTimed m' as
+runTimed m = go (runMealy m id)
+  where
+    go _ [] = []
+    go w ((s, a) : as) =
+      case runIdentity (stepAuto w (Request (sec s) utc nil) a) of
+        (b, w') -> b : go w' as
 
 -- | A minimal State monad for observing effectful arrows (e.g. whenA gating).
 newtype St a = St { unSt :: Int -> (a, Int) }
@@ -54,12 +61,11 @@ instance MonadFix St where
   mfix f = St $ \s -> let (a, s') = unSt (f a) s in (a, s')
 
 runStEff :: Mealy St a b -> Int -> [a] -> ([b], Int)
-runStEff m s0 as = go m s0 as
+runStEff m = go (runMealy m id)
   where
     go _ s [] = ([], s)
-    go m' s (a : rest) =
-      case unSt (AFRP.runMealy m' id fakeRequest a) s of
-        (Pair b m'', s') -> let (bs, s'') = go m'' s' rest in (b : bs, s'')
+    go w s (a : rest) = case unSt (stepAuto w fakeRequest a) s of
+      ((b, w'), s') -> let (bs, s'') = go w' s' rest in (b : bs, s'')
 
 spec :: Spec
 spec = describe "AFRP" $ do
@@ -81,7 +87,6 @@ spec = describe "AFRP" $ do
   debounceSpec
   rollupSpec
   effSpec
-  switchSpec
   mapAccumRequestSpec
   preMapAccumRequestSpec
   whenASpec
@@ -411,41 +416,17 @@ effSpec = describe "eff" $ do
       let out = runPure (eff (\_ x -> Identity (x * 2))) xs
       out === map (* 2) xs
 
-switchSpec :: Spec
-switchSpec = describe "switch" $ do
-  it "switches to the continuation at the first Event" $
-    runPure (switch (arr (\x -> (x, if x >= (3 :: Int) then Event () else Tick)))
-                     (const (arr (const 99))))
-             [1, 2, 3, 4, 5]
-      `shouldBe` [1, 2, 99, 99, 99]
-
-  it "never switches if no Event is emitted" $
-    runPure (switch (arr (\x -> (x, Tick :: Event ())))
-                     (const (arr (const 99))))
-             [1, 2, 3]
-      `shouldBe` [1, 2, 3 :: Int]
-
-  it "prefix outputs come from the first arrow, suffix from the continuation" $
-    hedgehog $ do
-      threshold <- forAll $ Gen.int (Range.linear (-20) 20)
-      xs <- forAll $ Gen.list (Range.linear 0 30) (Gen.int (Range.linear (-20) 20))
-      let firstArr = arr (\x -> (x, if x >= threshold then Event () else Tick))
-          out = runPure (switch firstArr (const (arr (const 99)))) xs
-          (pre, _post) = break (>= threshold) xs
-      take (length pre) out === pre
-      drop (length pre) out === replicate (length xs - length pre) 99
-
 mapAccumRequestSpec :: Spec
 mapAccumRequestSpec = describe "mapAccumRequest" $ do
   it "accumulates request times, post-state extraction" $
-    runTimed (mapAccumRequest (\req s _ -> s ++ [requestTime req]) [] id)
+    runTimed (mapAccumRequest (\req s _ -> s ++ [SerializeUTCTime (requestTime req)]) [] (map untime))
              [(0, 'a'), (5, 'b'), (10, 'c')]
       `shouldBe` [ [sec 0], [sec 0, sec 5], [sec 0, sec 5, sec 10] ]
 
   it "output i is every request time seen so far" $
     hedgehog $ do
       secs' <- forAll $ Gen.list (Range.linear 0 30) (Gen.int (Range.linear 0 100))
-      let out = runTimed (mapAccumRequest (\req s _ -> s ++ [requestTime req]) [] id)
+      let out = runTimed (mapAccumRequest (\req s _ -> s ++ [SerializeUTCTime (requestTime req)]) [] (map untime))
                          [(fromIntegral s, ()) | s <- secs']
           expected = [ map (sec . fromIntegral) (take (i + 1) secs') | i <- [0 .. length secs' - 1] ]
       out === expected
@@ -453,14 +434,14 @@ mapAccumRequestSpec = describe "mapAccumRequest" $ do
 preMapAccumRequestSpec :: Spec
 preMapAccumRequestSpec = describe "preMapAccumRequest" $ do
   it "accumulates request times, pre-state extraction" $
-    runTimed (preMapAccumRequest (\req s _ -> s ++ [requestTime req]) [] id)
+    runTimed (preMapAccumRequest (\req s _ -> s ++ [SerializeUTCTime (requestTime req)]) [] (map untime))
              [(0, 'a'), (5, 'b'), (10, 'c')]
       `shouldBe` [ [], [sec 0], [sec 0, sec 5] ]
 
   it "output i is every request time before the current step" $
     hedgehog $ do
       secs' <- forAll $ Gen.list (Range.linear 0 30) (Gen.int (Range.linear 0 100))
-      let out = runTimed (preMapAccumRequest (\req s _ -> s ++ [requestTime req]) [] id)
+      let out = runTimed (preMapAccumRequest (\req s _ -> s ++ [SerializeUTCTime (requestTime req)]) [] (map untime))
                          [(fromIntegral s, ()) | s <- secs']
           expected = [ map (sec . fromIntegral) (take i secs') | i <- [0 .. length secs' - 1] ]
       out === expected
@@ -524,11 +505,11 @@ sampleSpec = describe "sample" $ do
 
 -- | A stateless arrow carrying a fixed entity set, for testing propagation.
 subscribed :: S.Set T.Text -> Mealy Identity Int Int
-subscribed ents = Mealy ents $ \_ _ a -> pure (Pair a (subscribed ents))
+subscribed ents = Mealy ents $ \_ -> Fun $ \_ a -> a
 
 -- | Same as 'subscribed' but yields a function, for testing '<*>'.
 subscribedF :: S.Set T.Text -> Mealy Identity Int (Int -> Int)
-subscribedF ents = Mealy ents $ \_ _ a -> pure (Pair (a +) (subscribedF ents))
+subscribedF ents = Mealy ents $ \_ -> Fun $ \_ a -> (a +)
 
 entitiesSpec :: Spec
 entitiesSpec = describe "entities" $ do
@@ -545,7 +526,7 @@ entitiesSpec = describe "entities" $ do
     entities (hold 'a') `shouldBe` S.empty
     entities (changes @Int) `shouldBe` S.empty
     entities edge `shouldBe` S.empty
-    entities (sliding (3 :: Int)) `shouldBe` S.empty
+    entities (sliding (3 :: Int) :: Mealy Identity (Event Int) [Int]) `shouldBe` S.empty
 
   it "Category (.) unions entity sets" $
     entities (subscribed (S.singleton "a") >>> subscribed (S.singleton "b"))