summaryrefslogtreecommitdiff
path: root/Reactive/Banana/Automation/Examples.hs
blob: 99e1c4c1aef0551306f73f33cceb50dea57666f7 (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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
-- | `Automation` examples. View source for the code.
--
-- These examples are tested by doctest when building this library.
--
-- Patches adding examples welcomed!
module Reactive.Banana.Automation.Examples where

import Reactive.Banana
import Reactive.Banana.Automation
import Data.Time.Clock.POSIX
import Data.Time.LocalTime
import Data.Time.Calendar

-- | We'll use a single Sensors type containing all the sensors
-- used by the examples below.
data Sensors = Sensors
	{ fridgeTemperature :: EventSource (Sensed Double) ()
	, motionSensor :: EventSource (Sensed (Timestamped POSIXTime Bool)) ()
	, clock :: EventSource (ClockSignal LocalTime) ()
	, rainGaugeTipSensor :: EventSource (Sensed ()) ()
	}

-- | And a single Actuators type containing all the actuators used by the
-- examples below.
data Actuators
	= FridgePower PowerChange
	| LightSwitch PowerChange
	| SprinklerSwitch PowerChange
	| LCDDisplay String
	deriving (Show)

-- | For running the examples, you'll need this, to construct a `Sensors`
mkSensors :: IO Sensors
mkSensors = Sensors
	<$> newEventSource ()
	<*> newEventSource ()
	<*> newEventSource ()
	<*> newEventSource ()

-- | A fridge, containing the `fridgeTemperature` sensor and with
-- its power controlled by the `FridgePower` actuator.
--
-- The fridge starts running when its temperature exceeds a maximum
-- safe value. Once the temperature falls below a minimim value, the fridge
-- stops running. Note that opening the door of this fridge for a minute
-- typically won't cause it to run, unless it was already close to being
-- too warm. This behavior was chosen to minimise starts of the compressor,
-- but of course other fridge behaviors are also possible; this is only an
-- example.
--
-- To give this example a try, import this module in ghci and run:
--
-- >>> runner <- observeAutomation fridge mkSensors
-- >>> runner $ \sensors -> fridgeTemperature sensors =: 6
-- [FridgePower PowerOn]
-- >>> runner $ \sensors -> fridgeTemperature sensors =: 3
-- []
-- >>> runner $ \sensors -> fridgeTemperature sensors =: 0.5
-- [FridgePower PowerOff]
fridge :: Automation Sensors Actuators
fridge = Automation $ \sensors actuators -> do
	-- Create a Behavior that reflects the most recently reported
	-- temperature of the fridge.
	btemperature <- sensedBehavior (fridgeTemperature sensors)
	-- Calculate when the fridge should turn on and off.
	let bpowerchange = calcpowerchange <$> btemperature
	onBehaviorChangeMaybe bpowerchange (actuators . FridgePower)
  where
	calcpowerchange (Sensed temp)
		| temp `belowRange` allowedtemp = Just PowerOff
		| temp `aboveRange` allowedtemp = Just PowerOn
		| otherwise = Nothing
	calcpowerchange SensorUnavailable = Nothing
	allowedtemp = Range 1 4

-- | Turns on a light when the `motionSensor` detects movement,
-- and leaves it on for 5 minutes after the last movement.
--
-- If this were run in real code, the motion sensor would trigger
-- calls to `sensedNow`.
--
-- But, for testing, it's useful to specify the time that the sensor
-- is triggered, using `sensedAt`. Import this module in ghci and run:
--
-- >>> runner <- observeAutomation motionActivatedLight mkSensors
-- >>> runner $ \sensors -> sensedAt 0 (motionSensor sensors) True
-- [LightSwitch PowerOn]
-- >>> runner $ \sensors -> sensedAt 30 (motionSensor sensors) False
-- []
-- >>> runner $ \sensors -> sensedAt 60 (motionSensor sensors) True
-- [LightSwitch PowerOn]
-- >>> runner $ \sensors -> sensedAt 120 (motionSensor sensors) False
-- []
-- >>> runner $ \sensors -> sensedAt 400 (motionSensor sensors) False
-- [LightSwitch PowerOff]
motionActivatedLight :: Automation Sensors Actuators
motionActivatedLight = Automation $ \sensors actuators -> do
	-- Make an Event that contains the time elapsed since the last
	-- detected motion.
	timesincemotion <- elapsedTimeSince (== True)
		=<< sensedEvent (motionSensor sensors)
	-- Make a Behavior for the light switch.
	lightchange <- stepper Nothing $ calcchange <$> timesincemotion
	onBehaviorChangeMaybe lightchange (actuators . LightSwitch)
  where
	calcchange t
		| t == 0 = Just PowerOn -- motion was just detected
		| t > 300 = Just PowerOff -- 5 minutes since last motion
		| otherwise = Nothing


-- | Turns on a light at night (after 6 pm), and off during the day (after
-- 6 am).
--
-- If this were run in real code, the clock would be fed
-- by running clockSignal every so often.
--
-- But, for testing, it's useful to specify the time, using 
-- `clockSignalAt`. Import this module in ghci and run:
--
-- >>> let day = fromGregorian 2018 1 1
-- >>> runner <- observeAutomation nightLight mkSensors
-- >>> runner $ \sensors -> clockSignalAt (LocalTime day midnight) (clock sensors)
-- [LightSwitch PowerOn]
-- >>> runner $ \sensors -> clockSignalAt (LocalTime day midday) (clock sensors)
-- [LightSwitch PowerOff]
nightLight :: Automation Sensors Actuators
nightLight = Automation $ \sensors actuators -> do
	bclock <- clockSignalBehavior (clock sensors)
	let bhour = (fmap . fmap) (todHour . localTimeOfDay) <$> bclock
	let lightchange = calcchange <$> bhour
	onBehaviorChangeMaybe lightchange (actuators . LightSwitch)
  where
	calcchange (Just (ClockSignal t))
		| t > 18 = Just PowerOn
		| t < 6 = Just PowerOn
		| otherwise = Just PowerOff
	calcchange Nothing = Nothing

-- | Displays a Behavior on the LCD display actuator.
--
-- While it could be used to drive a real LCD, this is mostly useful
-- for testing behaviors.
showBehaviorLCDDisplay :: (a -> String) -> (Sensors -> MomentAutomation (Behavior a)) -> Automation Sensors Actuators
showBehaviorLCDDisplay fmt mkb = Automation $ \sensors actuators -> do
	b <- mkb sensors
	onBehaviorChange b (actuators . LCDDisplay . fmt)

-- | The rain gauge sensor is a tipping bucket type; the bucket collects 0.01
-- inches of rain and then tips, which triggers the `rainGaugeTipSensor`.
-- This behavior sums up the total rainfall, in hundredths of an inch.
--
-- To test this behavior, we can use `showBehaviorLCDDisplay`:
--
-- >>> runner <- observeAutomation (showBehaviorLCDDisplay show totalRainfall) mkSensors
-- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) ()
-- [LCDDisplay "1"]
-- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) ()
-- [LCDDisplay "2"]
-- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) ()
-- [LCDDisplay "3"]
totalRainfall :: Sensors -> MomentAutomation (Behavior Integer)
totalRainfall sensors = do
	tipevents <- sensedEvent (rainGaugeTipSensor sensors)
	accumB 0 $ const succ <$> tipevents

-- | This behavior contains the total rainfall since a specified `TimeOfDay`,
-- and is timestamped with the last clock signal.
--
-- To test this behavior, we can use `showBehaviorLCDDisplay`,
-- providing both clock signals and `rainGaugeTipSensor` events:
--
-- >>> let day = fromGregorian 2018 1 1
-- >>> runner <- observeAutomation (showBehaviorLCDDisplay (show . value) $ totalRainfallSince midnight) mkSensors
-- >>> runner $ \sensors -> clockSignalAt (LocalTime day (TimeOfDay 13 0 0)) (clock sensors)
-- [LCDDisplay "0"]
-- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) ()
-- [LCDDisplay "1"]
-- >>> runner $ \sensors -> clockSignalAt (LocalTime day (TimeOfDay 14 0 0)) (clock sensors)
-- [LCDDisplay "1"]
-- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) ()
-- [LCDDisplay "2"]
-- >>> runner $ \sensors -> clockSignalAt (LocalTime (succ day) (TimeOfDay 1 0 0)) (clock sensors)
-- [LCDDisplay "0"]
-- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) ()
-- [LCDDisplay "1"]
-- >>> runner $ \sensors -> clockSignalAt (LocalTime (succ day) (TimeOfDay 2 0 0)) (clock sensors)
-- [LCDDisplay "1"]
-- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) ()
-- [LCDDisplay "2"]
totalRainfallSince :: TimeOfDay -> Sensors -> MomentAutomation (Behavior (Timestamped (ClockSignal LocalTime) Integer))
totalRainfallSince tod sensors = do
	clockevents <- getEventFrom (clock sensors)
	bclock <- clockSignalBehavior (clock sensors)
	tipevents <- sensedEvent (rainGaugeTipSensor sensors)
	-- The tip events, with the tip signal replaced with
	-- the clock time when it occurred.
	let tiptimes = bclock <@ tipevents
	-- Combine clock ticks and tip events, with a function
	-- to apply to the running total for each.
	let combined = unionWith (\(f1, t1) (f2, t2) -> (f1 . f2, max t1 t2))
		((\e -> (id, e)) <$> fmap Just clockevents)
		((\e -> (succ, e)) <$> tiptimes)
	let epoch = LocalTime (fromGregorian 1 1 1) midnight
	let initial = (Timestamped (ClockSignal epoch) 0, Nothing)
	fmap fst <$> (accumB initial $ go <$> combined)
  where
	go (f, Just (ClockSignal t)) (Timestamped _ n, Just lastzero) =
		let nextzero = succ lastzero
		in if t > LocalTime nextzero tod
			then (Timestamped (ClockSignal t) 0, Just nextzero)
			else (Timestamped (ClockSignal t) (f n), Just lastzero)
	go (f, Just (ClockSignal t)) ((Timestamped _ n), Nothing) =
		(Timestamped (ClockSignal t) (f n), Just (localDay t))
	go (_, Nothing) v = v

-- | Turns on the sprinklers for an hour each day starting from
-- the specified `TimeOfDay`, but only if the rain gauge collected 
-- less than 0.03 inches of rain over the past day.
--
-- >>> let day = fromGregorian 2018 1 1
-- >>> runner <- observeAutomation (sprinklersStartingAt midnight) mkSensors
-- >>> runner $ \sensors -> clockSignalAt (LocalTime day (TimeOfDay 13 0 0)) (clock sensors)
-- [SprinklerSwitch PowerOff]
-- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) ()
-- [SprinklerSwitch PowerOff]
-- >>> runner $ \sensors -> clockSignalAt (LocalTime day (TimeOfDay 0 1 0)) (clock sensors)
-- [SprinklerSwitch PowerOn]
-- >>> runner $ \sensors -> clockSignalAt (LocalTime day (TimeOfDay 0 2 0)) (clock sensors)
-- [SprinklerSwitch PowerOn]
-- >>> runner $ \sensors -> clockSignalAt (LocalTime day (TimeOfDay 1 2 0)) (clock sensors)
-- [SprinklerSwitch PowerOff]
-- >>> runner $ \sensors -> clockSignalAt (LocalTime day (TimeOfDay 1 3 0)) (clock sensors)
-- [SprinklerSwitch PowerOff]
-- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) ()
-- [SprinklerSwitch PowerOff]
-- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) ()
-- [SprinklerSwitch PowerOff]
-- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) ()
-- [SprinklerSwitch PowerOff]
-- >>> runner $ \sensors -> clockSignalAt (LocalTime day (TimeOfDay 0 1 0)) (clock sensors)
-- [SprinklerSwitch PowerOff]
sprinklersStartingAt :: TimeOfDay -> Automation Sensors Actuators
sprinklersStartingAt starttod = Automation $ \sensors actuators -> do
	-- This contains a ClockSignal, so we know it should update
	-- whenever the clock does, and so we don't need to add in a
	-- separate behavior for the clock.
	brainfall <- totalRainfallSince starttod sensors
	let b = calcchange <$> brainfall
	onBehaviorChangeMaybe b (actuators . SprinklerSwitch)
  where
	stoptod = starttod { todHour = (todHour starttod + 1) `mod` 24 }
	calcchange (Timestamped (ClockSignal t) rain)
		| rain >= 3 = Just PowerOff
		| localTimeOfDay t >= starttod && localTimeOfDay t < stoptod = Just PowerOn
		| otherwise = Just PowerOff

-- | `Automation` is a `Monoid`, so it's easy to combine several
-- smaller automations like those above into a larger one.
--
-- >>> let day = fromGregorian 2018 1 1
-- >>> runner <- observeAutomation thisHouse mkSensors 
-- >>> runner $ \sensors -> clockSignalAt (LocalTime day midnight) (clock sensors)
-- [LightSwitch PowerOn,SprinklerSwitch PowerOn]
-- >>> runner $ \sensors -> fridgeTemperature sensors =: 6
-- [FridgePower PowerOn]
-- >>> runner $ \sensors -> sensedAt 0 (motionSensor sensors) True
-- [LightSwitch PowerOn]
thisHouse :: Automation Sensors Actuators
thisHouse = mconcat
	[ fridge
	, nightLight
	, motionActivatedLight
	, sprinklersStartingAt midnight
	]