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
|
module AggregateSpec (spec) where
import Control.Arrow
import Control.Concurrent (threadDelay)
import Control.Monad (forM_)
import Control.Monad.Trans (MonadIO, liftIO)
import Data.List (intersperse)
import Data.Sensor qualified as S
import Test.Hspec
import Text.Printf
spec :: SpecWith ()
spec = do
describe "current time" do
it "date" do
S.sample 1 date >>= (`shouldBe` ["1970-01-01"])
it "time" do
S.sample 1 time >>= (`shouldBe` ["00:00:00"])
it "date and time" do
S.sample 1 (S.concatS (intersperse (pure " ") [date, time]))
>>= (`shouldBe` [["1970-01-01", " ", "00:00:00"]])
describe "timing" do
it "fast, fast" do
S.sample 2 ((,) <$> count <*> count)
>>= (`shouldBe` [(1, 1), (2, 2)])
it "fast, slow" do
S.sample 4 ((,) <$> count <*> slowCount)
>>= (`shouldBe` [(1, 1), (2, 1), (2, 2), (3, 2)])
S.sample 3 (const <$> count <*> slowCount)
>>= (`shouldBe` [1, 2, 2])
S.sample 3 (flip const <$> count <*> slowCount)
>>= (`shouldBe` [1, 1, 2])
describe "square count" do
it "count" do
S.sample 2 count >>= (`shouldBe` [1, 2])
it "square" do
S.sample 2 (count >>> square) >>= (`shouldBe` [1, 4])
describe "diagram" do
it "count diagram" do
S.sample 3 (diagram 2 count)
>>= (`shouldBe` [[1 :: Int], [1, 2], [2, 3]])
S.sample 5 (diagram 2 slowCount <* count)
>>= (`shouldBe` [[1 :: Int], [1], [1, 2], [1, 2], [2, 3]])
diagram :: Int -> S.Sensor () a -> S.Sensor () [a]
diagram n sf = S.feedbackS [] $ proc ((), xs) -> do
x <- sf -< ()
returnA -< (reverse (x : xs), take (n - 1) (x : xs))
count :: S.Sensor () Int
count = S.sensor (\_ -> "Count") $ \_ yield -> do
forM_ [1, 2 ..] $ \n -> do
yield n
sleep
slowCount :: S.Sensor () Int
slowCount = S.sensor (\_ -> "SlowCount") $ \_ yield -> do
forM_ [1, 2 ..] $ \n -> do
yield n
sleepLong
sleep :: (MonadIO m) => m ()
sleep = liftIO (threadDelay 2_000)
sleepLong :: (MonadIO m) => m ()
sleepLong = liftIO (threadDelay 3_000)
square :: S.Sensor Int Int
square = S.sensor (\n -> printf "Square %d" n) $ \n yield ->
yield (n * n)
currentTime :: S.Sensor () UTCTime
currentTime = S.sensor (\_ -> "CurrentTime") $ \_ yield -> do
yield (UTCTime "1970-01-01" "00:00:00")
data UTCTime = UTCTime
{ date :: String,
time :: String
}
deriving (Show)
date :: S.Sensor () String
date = (.date) <$> currentTime
time :: S.Sensor () String
time = (.time) <$> currentTime
|
