summaryrefslogtreecommitdiffstats
path: root/test/AggregateSpec.hs
blob: 71bf420b9d18f9eb7891c3e6175118ecce5d553e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
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