reactive-banana-automation 0.1.1 → 0.1.2

raw patch · 4 files changed

+213/−14 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG +12/−0
• Reactive/Banana/Automation.hs +43/−9
• Reactive/Banana/Automation/Examples.hs +157/−4
• reactive-banana-automation.cabal +1/−1

@@ -1,3 +1,15 @@+reactive-banana-automation (0.1.2) upstream; urgency=medium++  * Added ClockSignal and related functions.+  * Functor instances for Sensed and Timestamped.+  * Added more Timestamp instances.+  * Generalized sensedAt to work with any Timestamp.+  * Added several more examples, including a night light,+    a behavior for a tipping bucket rain gauge, and sprinkers+    that only run when it's not rained recently.++ -- Joey Hess <id@joeyh.name>  Thu, 03 May 2018 17:28:32 -0400+ reactive-banana-automation (0.1.1) upstream; urgency=medium    * Fix build with ghc 8.2 and reactive-banana 1.2.

@@ -1,4 +1,4 @@-{-# LANGUAGE TypeSynonymInstances, LambdaCase #-}+{-# LANGUAGE TypeSynonymInstances, LambdaCase, DeriveFunctor #-}  -- | Home (etc) automation using reactive-banana. --@@ -38,6 +38,10 @@ 	sensedNow, 	sensedAt, 	elapsedTimeSince,+	ClockSignal(..),+	clockSignal,+	clockSignalAt,+	clockSignalBehavior, 	-- * Actuators 	PowerChange(..), 	onBehaviorChange,@@ -57,6 +61,7 @@ import Control.Concurrent.STM import Data.Time.Clock import Data.Time.Clock.POSIX+import Data.Time.LocalTime  -- | An Automation receives `Event`s from some sensors and decides what -- to do, controlling the actuators. It is implemented as a reactive-banana@@ -204,7 +209,7 @@ -- Sensors are sometimes not available, or have not provided a value -- yet. data Sensed a = SensorUnavailable | Sensed a-	deriving (Show)+	deriving (Show, Functor)  -- | Create an Event from sensed values. --@@ -218,8 +223,6 @@ 		Sensed a -> Just a  -- | Create a Behavior from sensed values.------ This is essentially just an application of the `stepper` combinator. sensedBehavior :: EventSource (Sensed a) -> MomentAutomation (Behavior (Sensed a)) sensedBehavior s =  	MomentAutomation . stepper SensorUnavailable =<< getEventFrom s@@ -253,19 +256,28 @@ instance (Show t, Show a) => Show (Timestamped t a) where 	show (Timestamped t a) = show t ++ " " ++ show a +instance Functor (Timestamped t) where+	fmap f (Timestamped t a) = Timestamped t (f a)+ -- | Class of values that are timestamps. class Timestamp t where 	getCurrentTimestamp :: IO t-	getTimestamp :: POSIXTime -> t  instance Timestamp POSIXTime where 	getCurrentTimestamp = getPOSIXTime-	getTimestamp = id  instance Timestamp UTCTime where 	getCurrentTimestamp = getCurrentTime-	getTimestamp = posixSecondsToUTCTime +instance Timestamp ZonedTime where+	getCurrentTimestamp = getZonedTime++instance Timestamp LocalTime where+	getCurrentTimestamp = zonedTimeToLocalTime <$> getZonedTime++instance Timestamp TimeOfDay where+	getCurrentTimestamp = localTimeOfDay <$> getCurrentTimestamp+ -- | Call when a sensor has sensed a value, which will be `Timestamped` with -- the current time. sensedNow :: Timestamp t => EventSource (Sensed (Timestamped t a)) -> a -> IO ()@@ -274,8 +286,8 @@ 	gotEvent es (Sensed (Timestamped now a))  -- | Call when a sensor sensed a value with a particular timestamp.-sensedAt :: Timestamp t => POSIXTime -> EventSource (Sensed (Timestamped t a)) -> a -> IO ()-sensedAt ts es a = gotEvent es (Sensed (Timestamped (getTimestamp ts) a))+sensedAt :: Timestamp t => t -> EventSource (Sensed (Timestamped t a)) -> a -> IO ()+sensedAt ts es a = gotEvent es (Sensed (Timestamped ts a))  -- | Given a `Timestamped` `Event` and a function, produces an `Event` -- that contains the elapsed time since the function last matched the@@ -298,6 +310,28 @@ 		| otherwise = Nothing 	reduce (Just (t, v)) = timestamp v - t 	reduce Nothing = 0++-- | A clock signal.+--+-- See `Reactive.Banana.Examples.nightLight` for an example+-- of using clock signals, and how to test code that uses them.+data ClockSignal a = ClockSignal a+	deriving (Show, Eq, Ord, Functor)++-- | Call repeatedly to feed a clock signal to an `Automation`+-- that needs to know what time it is.+clockSignal :: Timestamp t => EventSource (ClockSignal t) -> IO ()+clockSignal es = gotEvent es . ClockSignal =<< getCurrentTimestamp++-- | Call to feed a particular time to an `Automation`.+clockSignalAt :: Timestamp t => t -> EventSource (ClockSignal t) -> IO ()+clockSignalAt t es = gotEvent es (ClockSignal t)++-- | Create a Behavior from a ClockSignal. It will initially be Nothing,+-- and then updates with each incoming clock signal.+clockSignalBehavior :: Timestamp t => EventSource (ClockSignal t) -> MomentAutomation (Behavior (Maybe (ClockSignal t)))+clockSignalBehavior s = MomentAutomation . stepper Nothing +	=<< fmap Just <$> getEventFrom s  -- | For controlling relays and other things that can have -- their power turned on and off.

@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+ -- | `Automation` examples. View source for the code. -- -- These examples are tested by doctest when building this library.@@ -9,12 +11,16 @@ import Reactive.Banana.Frameworks import Reactive.Banana.Automation import Data.Time.Clock.POSIX+import Data.Time.LocalTime+import Data.Time.Calendar -- imported for doctest examples  -- | 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@@ -22,6 +28,8 @@ data Actuators 	= FridgePower PowerChange 	| LightSwitch PowerChange+	| SprinklerSwitch PowerChange+	| LCDDisplay String 	deriving (Show)  -- | For running the examples, you'll need this, to construct a `Sensors`@@ -29,6 +37,8 @@ mkSensors = Sensors 	<$> newAddHandler 	<*> newAddHandler+	<*> newAddHandler+	<*> newAddHandler  -- | A fridge, containing the `fridgeTemperature` sensor and with -- its power controlled by the `FridgePower` actuator.@@ -66,11 +76,11 @@ 	calcpowerchange SensorUnavailable = Nothing 	allowedtemp = Range 1 4 --- | A light that comes on when the `motionSensor` detects movement,--- and remains on for 5 minutes after the last movement.+-- | 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 be triggered--- by running `sensedNow`.+-- 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:@@ -100,3 +110,146 @@ 		| 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 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 :: Show a => (Sensors -> MomentAutomation (Behavior a)) -> Automation Sensors Actuators+showBehaviorLCDDisplay mkb sensors actuators = do+	b <- mkb sensors+	onBehaviorChange b (actuators . LCDDisplay . show)++-- | 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 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 given `TimeOfDay`.+--+-- To test this behavior, we can use `showBehaviorLCDDisplay`,+-- providing both clock signals and `rainGaugeTipSensor` events:+--+-- >>> let day = fromGregorian 2018 1 1+-- >>> runner <- observeAutomation (showBehaviorLCDDisplay $ 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 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 the 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)+	fmap fst <$> (accumB (0, Nothing) $ go <$> combined)+  where+	go (f, Just (ClockSignal t)) (n, Just lastzero) =+		let nextzero = succ lastzero+		in if t > LocalTime nextzero tod+			then (0, Just nextzero)+			else (f n, Just lastzero)+	go (f, Just (ClockSignal t)) (n, Nothing) =+		(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 PowerOff,SprinklerSwitch PowerOn]+-- >>> runner $ \sensors -> clockSignalAt (LocalTime day (TimeOfDay 0 2 0)) (clock sensors)+-- [SprinklerSwitch PowerOn,SprinklerSwitch PowerOn]+-- >>> runner $ \sensors -> clockSignalAt (LocalTime day (TimeOfDay 1 2 0)) (clock sensors)+-- [SprinklerSwitch PowerOn,SprinklerSwitch PowerOff]+-- >>> runner $ \sensors -> clockSignalAt (LocalTime day (TimeOfDay 1 3 0)) (clock sensors)+-- [SprinklerSwitch PowerOff,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,SprinklerSwitch PowerOff]+sprinklersStartingAt :: TimeOfDay -> Automation Sensors Actuators+sprinklersStartingAt starttod sensors actuators = do+	brainfall <- totalRainfallSince starttod sensors+	bclock <- clockSignalBehavior (clock sensors)+	let b = calcchange <$> bclock <*> brainfall+	onBehaviorChangeMaybe b (actuators . SprinklerSwitch)+  where+	stoptod = starttod { todHour = (todHour starttod + 1) `mod` 24 }+	calcchange (Just (ClockSignal t)) rain+		| rain >= 3 = Just PowerOff+		| localTimeOfDay t >= starttod && localTimeOfDay t < stoptod = Just PowerOn+		| otherwise = Just PowerOff+	calcchange Nothing _ = Nothing

@@ -1,5 +1,5 @@ Name: reactive-banana-automation-Version: 0.1.1+Version: 0.1.2 Cabal-Version: >= 1.8 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>