diff options
Diffstat (limited to 'test')
-rw-r--r-- | test/AggregateSpec.hs | 102 | ||||
-rw-r--r-- | test/PureSpec.hs | 10 | ||||
-rw-r--r-- | test/Spec.hs | 1 |
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 #-} |