summaryrefslogtreecommitdiffstats
path: root/test
diff options
context:
space:
mode:
Diffstat (limited to 'test')
-rw-r--r--test/AggregateSpec.hs102
-rw-r--r--test/PureSpec.hs10
-rw-r--r--test/Spec.hs1
3 files changed, 113 insertions, 0 deletions
diff --git a/test/AggregateSpec.hs b/test/AggregateSpec.hs
new file mode 100644
index 0000000..71bf420
--- /dev/null
+++ b/test/AggregateSpec.hs
@@ -0,0 +1,102 @@
+module AggregateSpec (spec) where
+
+import Control.Arrow
+import Control.Concurrent (threadDelay)
+import Control.Monad (forM_)
+import Control.Monad.Trans (MonadIO, liftIO)
+import Data.List (intercalate)
+import Data.Sensor qualified as S
+import Test.Hspec
+
+spec :: SpecWith ()
+spec = do
+ describe "current time" do
+ it "date" do
+ S.runSensorT (S.sample 1 date) >>= (`shouldBe` ["1970-01-01"])
+ it "time" do
+ S.runSensorT (S.sample 1 time) >>= (`shouldBe` ["00:00:00"])
+ it "date and time" do
+ S.runSensorT (S.sample 1 (intercalate " " <$> sequence [date, time]))
+ >>= (`shouldBe` ["1970-01-01 00:00:00"])
+ describe "timing" do
+ it "fast, fast" do
+ S.runSensorT (S.sample 2 ((,) <$> count <*> count))
+ >>= (`shouldBe` [(1, 1), (2, 2)])
+ it "fast, slow" do
+ S.runSensorT (S.sample 4 ((,) <$> count <*> slowCount))
+ >>= (`shouldBe` [(1, 1), (2, 1), (2, 2), (3, 2)])
+ S.runSensorT (S.sample 3 (const <$> count <*> slowCount))
+ >>= (`shouldBe` [1, 2, 2])
+ S.runSensorT (S.sample 3 (flip const <$> count <*> slowCount))
+ >>= (`shouldBe` [1, 1, 2])
+ describe "square count" do
+ it "count" do
+ S.runSensorT (S.sample 2 count) >>= (`shouldBe` [1, 2])
+ it "square" do
+ S.runSensorT (S.sample 2 (count >>= square)) >>= (`shouldBe` [1, 4])
+ describe "diagram" do
+ it "count diagram" do
+ S.runSensorT (S.sample 3 (diagram 2 count))
+ >>= (`shouldBe` [[1 :: Int], [1, 2], [2, 3]])
+ S.runSensorT (S.sample 5 (diagram 2 slowCount <* count))
+ >>= (`shouldBe` [[1 :: Int], [1], [1, 2], [1, 2], [2, 3]])
+
+diagram :: (Monad m) => Int -> S.Sensor m () a -> S.Sensor m () [a]
+diagram n sf = S.feedbackS [] $ proc ((), xs) -> do
+ x <- sf -< ()
+ returnA -< (reverse (x : xs), take (n - 1) (x : xs))
+
+count :: (S.MonadSensor m) => S.Sensor m () Int
+count = S.sensor Count
+
+data Count = Count deriving (Show)
+
+instance (S.MonadSensor m) => S.Aggregate m Count Int where
+ aggregate _ = forM_ [1, 2 ..] $ \n -> do
+ S.yield n
+ sleep
+
+slowCount :: (S.MonadSensor m) => S.Sensor m () Int
+slowCount = S.sensor SlowCount
+
+data SlowCount = SlowCount deriving (Show)
+
+instance (S.MonadSensor m) => S.Aggregate m SlowCount Int where
+ aggregate _ = forM_ [1, 2 ..] $ \n -> do
+ S.yield n
+ sleepLong
+
+sleep :: (MonadIO m) => m ()
+sleep = liftIO (threadDelay 2_000)
+
+sleepLong :: (MonadIO m) => m ()
+sleepLong = liftIO (threadDelay 3_000)
+
+square :: (S.MonadSensor m) => Int -> S.Sensor m () Int
+square = S.sensor . Square
+
+data Square = Square Int deriving (Show)
+
+instance (S.MonadSensor m) => S.Aggregate m Square Int where
+ aggregate (Square n) = do
+ S.yield (n * n)
+
+currentTime :: (S.MonadSensor m) => S.Sensor m () UTCTime
+currentTime = S.sensor CurrentTime
+
+data CurrentTime = CurrentTime deriving (Show)
+
+data UTCTime = UTCTime
+ { date :: String,
+ time :: String
+ }
+ deriving (Show)
+
+instance (S.MonadSensor m) => S.Aggregate m CurrentTime UTCTime where
+ aggregate _ = S.yield (UTCTime "1970-01-01" "00:00:00")
+
+date :: (S.MonadSensor m) => S.Sensor m () String
+date = (.date) <$> currentTime
+
+time :: (S.MonadSensor m) => S.Sensor m () String
+time = (.time) <$> currentTime
diff --git a/test/PureSpec.hs b/test/PureSpec.hs
new file mode 100644
index 0000000..5f718e7
--- /dev/null
+++ b/test/PureSpec.hs
@@ -0,0 +1,10 @@
+module PureSpec (spec) where
+
+import Data.Sensor qualified as S
+import Test.Hspec
+
+spec :: Spec
+spec = do
+ describe "Pure" do
+ it "pure" do
+ S.runSensorT (S.sample 1 (pure "")) >>= (`shouldBe` [""])
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
index 0000000..a824f8c
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}