reactive-banana-automation 0.1.2 → 0.2.0

raw patch · 4 files changed

+77/−35 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +9/−0
• Reactive/Banana/Automation.hs +16/−4
• Reactive/Banana/Automation/Examples.hs +51/−30
• reactive-banana-automation.cabal +1/−1

@@ -1,3 +1,12 @@+reactive-banana-automation (0.2.0) upstream; urgency=medium++  * Automation is now a newtype. (API change)+  * Monoid instance for Automation to allow easily combining them.+    (Note that in 0.1, there were inherited Monoid and Monad instances+    for Automation, that did not work in a reasonable way.)++ -- Joey Hess <id@joeyh.name>  Thu, 03 May 2018 18:54:04 -0400+ reactive-banana-automation (0.1.2) upstream; urgency=medium    * Added ClockSignal and related functions.

@@ -17,7 +17,7 @@ -- of using this library. module Reactive.Banana.Automation ( 	-- * Framework-	Automation,+	Automation(..), 	MomentAutomation, 	runAutomation, 	observeAutomation,@@ -76,7 +76,7 @@ -- > data Actuators = FridgePower PowerChange deriving (Show) -- >  -- > fridge :: Automation Sensors Actuators--- > fridge sensors actuators = do+-- > fridge = Automation $ \sensors actuators -> do -- >	btemperature <- sensedBehavior (fridgeTemperature sensors) -- >	let bpowerchange = calcpowerchange <$> btemperature -- >	onBehaviorChange bpowerchange (actuators . FridgePower)@@ -87,8 +87,17 @@ -- >		| otherwise = Nothing -- >	calcpowerchange SensorUnavailable = Nothing -- >	allowedtemp = Range 1 4-type Automation sensors actuators = sensors -> (actuators -> IO ()) -> MomentAutomation ()+newtype Automation sensors actuators = Automation (sensors -> (actuators -> IO ()) -> MomentAutomation ()) +instance Sem.Semigroup (Automation sensors actuators) where+	Automation a <> Automation b = Automation $ \sensors actuators -> do+		a sensors actuators+		b sensors actuators++instance Monoid (Automation sensors actuators) where+	mempty = Automation $ \_sensors _actuators -> return ()+	mappend = (Sem.<>)+ -- | This is simply a wrapper around reactive-banana's `MomentIO`, -- but without the `MonadIO` instance, so an `Automation` using this monad -- is limited to using its sensors and actuators for IO. That allows@@ -116,7 +125,7 @@ 	liftMoment = MomentAutomation . liftMoment  setupAutomation :: Automation sensors actuators -> IO sensors -> (actuators -> IO ()) -> IO sensors-setupAutomation automation mksensors actutators = do+setupAutomation (Automation automation) mksensors actutators = do 	sensors <- mksensors 	network <- compile $ unMomentAutomation $ automation sensors actutators 	actuate network@@ -315,6 +324,9 @@ -- -- See `Reactive.Banana.Examples.nightLight` for an example -- of using clock signals, and how to test code that uses them.+--+-- It's recommended that any `Behavior` that contains a `ClockSignal`+-- be constructed to update whenever the clock signals an update. data ClockSignal a = ClockSignal a 	deriving (Show, Eq, Ord, Functor) 

@@ -1,5 +1,3 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}- -- | `Automation` examples. View source for the code. -- -- These examples are tested by doctest when building this library.@@ -12,7 +10,7 @@ import Reactive.Banana.Automation import Data.Time.Clock.POSIX import Data.Time.LocalTime-import Data.Time.Calendar -- imported for doctest examples+import Data.Time.Calendar  -- | We'll use a single Sensors type containing all the sensors -- used by the examples below.@@ -61,7 +59,7 @@ -- >>> runner $ \sensors -> fridgeTemperature sensors =: 0.5 -- [FridgePower PowerOff] fridge :: Automation Sensors Actuators-fridge sensors actuators = do+fridge = Automation $ \sensors actuators -> do 	-- Create a Behavior that reflects the most recently reported 	-- temperature of the fridge. 	btemperature <- sensedBehavior (fridgeTemperature sensors)@@ -97,7 +95,7 @@ -- >>> runner $ \sensors -> sensedAt 400 (motionSensor sensors) False -- [LightSwitch PowerOff] motionActivatedLight :: Automation Sensors Actuators-motionActivatedLight sensors actuators = do+motionActivatedLight = Automation $ \sensors actuators -> do 	-- Make an Event that contains the time elapsed since the last 	-- detected motion. 	timesincemotion <- elapsedTimeSince (== True)@@ -128,7 +126,7 @@ -- >>> runner $ \sensors -> clockSignalAt (LocalTime day midday) (clock sensors) -- [LightSwitch PowerOff] nightLight :: Automation Sensors Actuators-nightLight sensors actuators = do+nightLight = Automation $ \sensors actuators -> do 	bclock <- clockSignalBehavior (clock sensors) 	let bhour = (fmap . fmap) (todHour . localTimeOfDay) <$> bclock 	let lightchange = calcchange <$> bhour@@ -144,10 +142,10 @@ -- -- 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+showBehaviorLCDDisplay :: (a -> String) -> (Sensors -> MomentAutomation (Behavior a)) -> Automation Sensors Actuators+showBehaviorLCDDisplay fmt mkb = Automation $ \sensors actuators -> do 	b <- mkb sensors-	onBehaviorChange b (actuators . LCDDisplay . show)+	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`.@@ -155,7 +153,7 @@ -- -- To test this behavior, we can use `showBehaviorLCDDisplay`: ----- >>> runner <- observeAutomation (showBehaviorLCDDisplay totalRainfall) mkSensors+-- >>> runner <- observeAutomation (showBehaviorLCDDisplay show totalRainfall) mkSensors -- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) () -- [LCDDisplay "1"] -- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) ()@@ -167,13 +165,14 @@ 	tipevents <- sensedEvent (rainGaugeTipSensor sensors) 	accumB 0 $ const succ <$> tipevents --- | This behavior contains the total rainfall since a given `TimeOfDay`.+-- | 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 $ totalRainfallSince midnight) mkSensors+-- >>> 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) ()@@ -190,7 +189,7 @@ -- [LCDDisplay "1"] -- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) () -- [LCDDisplay "2"]-totalRainfallSince :: TimeOfDay -> Sensors -> MomentAutomation (Behavior Integer)+totalRainfallSince :: TimeOfDay -> Sensors -> MomentAutomation (Behavior (Timestamped (ClockSignal LocalTime) Integer)) totalRainfallSince tod sensors = do 	clockevents <- getEventFrom (clock sensors) 	bclock <- clockSignalBehavior (clock sensors)@@ -198,20 +197,22 @@ 	-- 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+	-- 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)-	fmap fst <$> (accumB (0, Nothing) $ go <$> combined)+	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)) (n, Just lastzero) =+	go (f, Just (ClockSignal t)) (Timestamped _ 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))+			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@@ -225,13 +226,13 @@ -- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) () -- [SprinklerSwitch PowerOff] -- >>> runner $ \sensors -> clockSignalAt (LocalTime day (TimeOfDay 0 1 0)) (clock sensors)--- [SprinklerSwitch PowerOff,SprinklerSwitch PowerOn]+-- [SprinklerSwitch PowerOn] -- >>> runner $ \sensors -> clockSignalAt (LocalTime day (TimeOfDay 0 2 0)) (clock sensors)--- [SprinklerSwitch PowerOn,SprinklerSwitch PowerOn]+-- [SprinklerSwitch PowerOn] -- >>> runner $ \sensors -> clockSignalAt (LocalTime day (TimeOfDay 1 2 0)) (clock sensors)--- [SprinklerSwitch PowerOn,SprinklerSwitch PowerOff]+-- [SprinklerSwitch PowerOff] -- >>> runner $ \sensors -> clockSignalAt (LocalTime day (TimeOfDay 1 3 0)) (clock sensors)--- [SprinklerSwitch PowerOff,SprinklerSwitch PowerOff]+-- [SprinklerSwitch PowerOff] -- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) () -- [SprinklerSwitch PowerOff] -- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) ()@@ -239,17 +240,37 @@ -- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) () -- [SprinklerSwitch PowerOff] -- >>> runner $ \sensors -> clockSignalAt (LocalTime day (TimeOfDay 0 1 0)) (clock sensors)--- [SprinklerSwitch PowerOff,SprinklerSwitch PowerOff]+-- [SprinklerSwitch PowerOff] sprinklersStartingAt :: TimeOfDay -> Automation Sensors Actuators-sprinklersStartingAt starttod sensors actuators = do+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-	bclock <- clockSignalBehavior (clock sensors)-	let b = calcchange <$> bclock <*> brainfall+	let b = calcchange <$> brainfall 	onBehaviorChangeMaybe b (actuators . SprinklerSwitch)   where 	stoptod = starttod { todHour = (todHour starttod + 1) `mod` 24 }-	calcchange (Just (ClockSignal t)) rain+	calcchange (Timestamped (ClockSignal t) rain) 		| rain >= 3 = Just PowerOff 		| localTimeOfDay t >= starttod && localTimeOfDay t < stoptod = Just PowerOn 		| otherwise = Just PowerOff-	calcchange Nothing _ = Nothing++-- | `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+	]

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