reactive-banana-automation 0.3.0 → 0.4.0

raw patch · 4 files changed

+122/−104 lines, 4 filesdep +transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• CHANGELOG +9/−0
• Reactive/Banana/Automation.hs +81/−73
• Reactive/Banana/Automation/Examples.hs +29/−29
• reactive-banana-automation.cabal +3/−2

@@ -1,3 +1,12 @@+reactive-banana-automation (0.4.0) upstream; urgency=medium++  * Simplified using ReaderT, so sensors and actuators do not need to be+    manually passed around. (API change)+  * Add Ord and Eq instances for Sensed.+  * Renamed onBehaviorChange to actuateBehavior.++ -- Joey Hess <id@joeyh.name>  Wed, 09 May 2018 12:12:08 -0400+ reactive-banana-automation (0.3.0) upstream; urgency=medium    * EventSource is now a data type with an extra value for expansion.

@@ -1,4 +1,4 @@-{-# LANGUAGE TypeSynonymInstances, LambdaCase, DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, LambdaCase, DeriveFunctor #-}  -- | Home (etc) automation using reactive-banana. --@@ -17,8 +17,7 @@ -- of using this library. module Reactive.Banana.Automation ( 	-- * Framework-	Automation(..),-	MomentAutomation,+	Automation, 	runAutomation, 	observeAutomation, 	-- * Events@@ -49,8 +48,8 @@ 	clockSignalBehavior, 	-- * Actuators 	PowerChange(..),-	onBehaviorChange,-	onBehaviorChangeMaybe,+	actuateBehavior,+	actuateBehaviorMaybe, 	-- * Ranges 	Range(..), 	belowRange,@@ -63,6 +62,8 @@ import Reactive.Banana.Frameworks import Data.Semigroup as Sem import Control.Monad.Fix+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Class import Control.Concurrent.STM import Data.Time.Clock import Data.Time.Clock.POSIX@@ -80,11 +81,11 @@ -- > data Sensors = Sensors { fridgeTemperature :: EventSource (Sensed Double) () } -- > data Actuators = FridgePower PowerChange deriving (Show) -- > --- > fridge :: Automation Sensors Actuators--- > fridge = Automation $ \sensors actuators -> do--- >	btemperature <- sensedBehavior (fridgeTemperature sensors)+-- > fridge :: Automation Sensors Actuators ()+-- > fridge = do+-- >	btemperature <- sensedBehavior fridgeTemperature -- >	let bpowerchange = calcpowerchange <$> btemperature--- >	onBehaviorChange bpowerchange (actuators . FridgePower)+-- >	actuateBehavior bpowerchange FridgePower -- >   where -- >	calcpowerchange (Sensed temp) -- >		| temp `belowRange` allowedtemp = Just PowerOff@@ -92,47 +93,41 @@ -- >		| otherwise = Nothing -- >	calcpowerchange SensorUnavailable = Nothing -- >	allowedtemp = Range 1 4-newtype Automation sensors actuators = Automation (sensors -> (actuators -> IO ()) -> MomentAutomation ())+-- +-- Automation is a wrapper around reactive-banana's `MomentIO`,+-- but without the `MonadIO` instance, so this monad+-- is limited to using its sensors and actuators for IO. That allows+-- it to be fully tested using `observeAutomation`.+newtype Automation sensors actuators a = Automation+	{ unAutomation :: ReaderT (sensors, actuators -> IO ()) MomentIO a } -instance Sem.Semigroup (Automation sensors actuators) where-	Automation a <> Automation b = Automation $ \sensors actuators -> do-		a sensors actuators-		b sensors actuators+instance Sem.Semigroup (Automation sensors actuators ()) where+	Automation a <> Automation b = Automation (a >> b) -instance Monoid (Automation sensors actuators) where-	mempty = Automation $ \_sensors _actuators -> return ()+instance Monoid (Automation sensors actuators ()) where+	mempty = Automation (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--- it to be fully tested using `observeAutomation`.------ All of "Reactive.Banana.Combinators" can be used with this monad.-newtype MomentAutomation a = MomentAutomation-	{ unMomentAutomation :: MomentIO a }--instance Functor MomentAutomation where-	fmap f = MomentAutomation . fmap f . unMomentAutomation+instance Functor (Automation sensors actuators) where+	fmap f = Automation . fmap f . unAutomation -instance Monad MomentAutomation where-	return  = MomentAutomation . return-	m >>= g = MomentAutomation $-		unMomentAutomation m >>= unMomentAutomation . g-instance Applicative MomentAutomation where-	pure = MomentAutomation . pure-	f <*> a = MomentAutomation $-		unMomentAutomation f <*> unMomentAutomation a-instance MonadFix MomentAutomation where-	mfix f = MomentAutomation $ mfix (unMomentAutomation . f)+instance Monad (Automation sensors actuators) where+	return  = Automation . return+	m >>= g = Automation $ unAutomation m >>= unAutomation . g+instance Applicative (Automation sensors actuators) where+	pure = Automation . pure+	f <*> a = Automation $ unAutomation f <*> unAutomation a+instance MonadFix (Automation sensors actuators) where+	mfix f = Automation $ mfix (unAutomation . f) -instance MonadMoment MomentAutomation where-	liftMoment = MomentAutomation . liftMoment+-- | All of "Reactive.Banana.Combinators" can be used with this monad.+instance MonadMoment (Automation sensors actuators) where+	liftMoment = Automation . lift . liftMoment -setupAutomation :: Automation sensors actuators -> IO sensors -> (actuators -> IO ()) -> IO sensors-setupAutomation (Automation automation) mksensors actutators = do+setupAutomation :: Automation sensors actuators () -> IO sensors -> (actuators -> IO ()) -> IO sensors+setupAutomation automation mksensors actuators = do 	sensors <- mksensors-	network <- compile $ unMomentAutomation $ automation sensors actutators+	network <- compile $ flip runReaderT (sensors, actuators) $ unAutomation automation 	actuate network 	return sensors @@ -156,7 +151,7 @@ -- -- Note that this function does not return; the sensor feeding action is -- run in a loop.-runAutomation :: Automation sensors actuators -> IO sensors -> (actuators -> IO ()) -> (sensors -> IO ()) -> IO ()+runAutomation :: Automation sensors actuators () -> IO sensors -> (actuators -> IO ()) -> (sensors -> IO ()) -> IO () runAutomation automation mksensors actuators poller = do 	sensors <- setupAutomation automation mksensors actuators 	mainloop sensors@@ -183,7 +178,7 @@ -- > [FridgeRelay PowerOff] -- -- Note that internal state is maintained between calls to the runner.-observeAutomation :: Automation sensors actuators -> IO sensors -> IO ((sensors -> IO ()) -> IO [actuators])+observeAutomation :: Automation sensors actuators () -> IO sensors -> IO ((sensors -> IO ()) -> IO [actuators]) observeAutomation automation mksensors = do 	tv <- newTVarIO [] 	lck <- newEmptyTMVarIO@@ -223,41 +218,43 @@ gotEvent = snd . getEventSource  -- | Get an Event from an EventSource.-getEventFrom :: EventSource a v -> MomentAutomation (Event a)-getEventFrom = MomentAutomation . fromAddHandler . addHandler+getEventFrom :: (sensors -> EventSource a v) -> Automation sensors actuators (Event a)+getEventFrom getsensor = Automation $ do+	sensor <- getsensor . fst <$> ask+	lift $ fromAddHandler $ addHandler sensor  -- | Runs an action when an event occurs.-onEvent :: Event a -> (a -> IO ()) -> MomentAutomation ()-onEvent e a = MomentAutomation . reactimate $ fmap a e+onEvent :: Event a -> (a -> IO ()) -> Automation sensors actuators ()+onEvent e a = Automation . lift . reactimate $ fmap a e  -- | A value read from a sensor. -- -- Sensors are sometimes not available, or have not provided a value -- yet. data Sensed a = SensorUnavailable | Sensed a-	deriving (Show, Functor)+	deriving (Show, Functor, Ord, Eq)  -- | Create an Event from sensed values. -- -- The Event only contains values when the sensor provided a reading, -- not times when it was unavailable.-sensedEvent :: EventSource (Sensed a) v -> MomentAutomation (Event a)-sensedEvent s = do-	e <- getEventFrom s+sensedEvent :: (sensors -> EventSource (Sensed a) v) -> Automation sensors actuators (Event a)+sensedEvent getsensor = do+	e <- getEventFrom getsensor 	return $ filterJust $ flip fmap e $ \case 		SensorUnavailable -> Nothing 		Sensed a -> Just a  -- | Create a Behavior from sensed values.-sensedBehavior :: EventSource (Sensed a) v -> MomentAutomation (Behavior (Sensed a))-sensedBehavior s = sensedEventBehavior =<< getEventFrom s+sensedBehavior :: (sensors -> EventSource (Sensed a) v) -> Automation sensors actuators (Behavior (Sensed a))+sensedBehavior getsensor = sensedEventBehavior =<< getEventFrom getsensor -sensedEventBehavior :: Event (Sensed a) -> MomentAutomation (Behavior (Sensed a))+sensedEventBehavior :: Event (Sensed a) -> Automation sensors actuators (Behavior (Sensed a)) sensedEventBehavior = automationStepper SensorUnavailable --- | `stepper` lifted into `MomentAutomation`-automationStepper :: a -> Event a -> MomentAutomation (Behavior a)-automationStepper a e = MomentAutomation $ stepper a e+-- | `stepper` lifted into `Automation`+automationStepper :: a -> Event a -> Automation sensors actuators (Behavior a)+automationStepper a e = Automation $ lift $ stepper a e  -- | Call when a sensor has sensed a value. --@@ -335,7 +332,7 @@ 	:: (Num t, Timestamp t) 	=> (a -> Bool) 	-> Event (Timestamped t a)-	-> MomentAutomation (Event t)+	-> Automation sensors actuators (Event t) elapsedTimeSince f event = fmap (fmap reduce) $ accumE Nothing $ go <$> event   where 	go v' (Just (t, _v))@@ -368,27 +365,38 @@  -- | 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) v -> MomentAutomation (Behavior (Maybe (ClockSignal t)))-clockSignalBehavior s = MomentAutomation . stepper Nothing -	=<< fmap Just <$> getEventFrom s+clockSignalBehavior+	:: Timestamp t+	=> (sensors -> EventSource (ClockSignal t) v)+	-> Automation sensors actuators (Behavior (Maybe (ClockSignal t)))+clockSignalBehavior getsensor = Automation $ do+	sensor <- getsensor . fst <$> ask+	e <- fmap Just <$> lift (fromAddHandler $ addHandler sensor)+	lift $ stepper Nothing e  -- | For controlling relays and other things that can have -- their power turned on and off. data PowerChange = PowerOff | PowerOn 	deriving (Show) --- | Runs an action when a behavior's value changes.-onBehaviorChange :: Behavior a -> (a -> IO ()) -> MomentAutomation ()-onBehaviorChange b a = MomentAutomation $ do-	c <- changes b-	reactimate' $ fmap a <$> c+-- | Makes a Behavior drive an actuator. This will happen when the+-- Behavior's value changes, but possibly more often as well, depending on+-- how the Behavior is constructed.+actuateBehavior :: Behavior a -> (a -> actuators) -> Automation sensors actuators ()+actuateBehavior b getactuator = Automation $ do+	actuators <- snd <$> ask+	c <- lift $ changes b+	lift $ reactimate' $+		fmap (actuators . getactuator) <$> c --- | Variant of `onBehaviorChange` that does nothing when a behavior--- changes to Nothing.-onBehaviorChangeMaybe :: Behavior (Maybe a) -> (a -> IO ()) -> MomentAutomation ()-onBehaviorChangeMaybe b a = MomentAutomation $ do-	c <- changes b-	reactimate' $ fmap (maybe (return ()) a) <$> c+-- | Variant of `actuateBehavior` that does nothing when a behavior+-- is Nothing.+actuateBehaviorMaybe :: Behavior (Maybe a) -> (a -> actuators) -> Automation sensors actuators ()+actuateBehaviorMaybe b getactuator = Automation $ do+	actuators <- snd <$> ask+	c <- lift $ changes b+	lift $ reactimate' $+		fmap (maybe (return ()) (actuators . getactuator)) <$> c  -- | The range between two values (inclusive). --

@@ -57,14 +57,14 @@ -- [] -- >>> runner $ \sensors -> fridgeTemperature sensors =: 0.5 -- [FridgePower PowerOff]-fridge :: Automation Sensors Actuators-fridge = Automation $ \sensors actuators -> do+fridge :: Automation Sensors Actuators ()+fridge = do 	-- Create a Behavior that reflects the most recently reported 	-- temperature of the fridge.-	btemperature <- sensedBehavior (fridgeTemperature sensors)+	btemperature <- sensedBehavior fridgeTemperature 	-- Calculate when the fridge should turn on and off. 	let bpowerchange = calcpowerchange <$> btemperature-	onBehaviorChangeMaybe bpowerchange (actuators . FridgePower)+	actuateBehaviorMaybe bpowerchange FridgePower   where 	calcpowerchange (Sensed temp) 		| temp `belowRange` allowedtemp = Just PowerOff@@ -93,15 +93,15 @@ -- [] -- >>> runner $ \sensors -> sensedAt 400 (motionSensor sensors) False -- [LightSwitch PowerOff]-motionActivatedLight :: Automation Sensors Actuators-motionActivatedLight = Automation $ \sensors actuators -> do+motionActivatedLight :: Automation Sensors Actuators ()+motionActivatedLight = do 	-- Make an Event that contains the time elapsed since the last 	-- detected motion. 	timesincemotion <- elapsedTimeSince (== True)-		=<< sensedEvent (motionSensor sensors)+		=<< sensedEvent motionSensor 	-- Make a Behavior for the light switch. 	lightchange <- stepper Nothing $ calcchange <$> timesincemotion-	onBehaviorChangeMaybe lightchange (actuators . LightSwitch)+	actuateBehaviorMaybe lightchange LightSwitch   where 	calcchange t 		| t == 0 = Just PowerOn -- motion was just detected@@ -124,12 +124,12 @@ -- [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)+nightLight :: Automation Sensors Actuators ()+nightLight = do+	bclock <- clockSignalBehavior clock 	let bhour = (fmap . fmap) (todHour . localTimeOfDay) <$> bclock 	let lightchange = calcchange <$> bhour-	onBehaviorChangeMaybe lightchange (actuators . LightSwitch)+	actuateBehaviorMaybe lightchange LightSwitch   where 	calcchange (Just (ClockSignal t)) 		| t > 18 = Just PowerOn@@ -141,10 +141,10 @@ -- -- 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)+showBehaviorLCDDisplay :: (a -> String) -> Automation Sensors Actuators (Behavior a) -> Automation Sensors Actuators ()+showBehaviorLCDDisplay fmt mkb = do+	b <- mkb+	actuateBehavior b (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`.@@ -159,9 +159,9 @@ -- [LCDDisplay "2"] -- >>> runner $ \sensors -> sensed (rainGaugeTipSensor sensors) () -- [LCDDisplay "3"]-totalRainfall :: Sensors -> MomentAutomation (Behavior Integer)-totalRainfall sensors = do-	tipevents <- sensedEvent (rainGaugeTipSensor sensors)+totalRainfall :: Automation Sensors Actuators (Behavior Integer)+totalRainfall = do+	tipevents <- sensedEvent rainGaugeTipSensor 	accumB 0 $ const succ <$> tipevents  -- | This behavior contains the total rainfall since a specified `TimeOfDay`,@@ -188,11 +188,11 @@ -- [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)+totalRainfallSince :: TimeOfDay -> Automation Sensors Actuators (Behavior (Timestamped (ClockSignal LocalTime) Integer))+totalRainfallSince tod = do+	clockevents <- getEventFrom clock+	bclock <- clockSignalBehavior clock+	tipevents <- sensedEvent rainGaugeTipSensor 	-- The tip events, with the tip signal replaced with 	-- the clock time when it occurred. 	let tiptimes = bclock <@ tipevents@@ -240,14 +240,14 @@ -- [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+sprinklersStartingAt :: TimeOfDay -> Automation Sensors Actuators ()+sprinklersStartingAt starttod = 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+	brainfall <- totalRainfallSince starttod 	let b = calcchange <$> brainfall-	onBehaviorChangeMaybe b (actuators . SprinklerSwitch)+	actuateBehaviorMaybe b SprinklerSwitch   where 	stoptod = starttod { todHour = (todHour starttod + 1) `mod` 24 } 	calcchange (Timestamped (ClockSignal t) rain)@@ -266,7 +266,7 @@ -- [FridgePower PowerOn] -- >>> runner $ \sensors -> sensedAt 0 (motionSensor sensors) True -- [LightSwitch PowerOn]-thisHouse :: Automation Sensors Actuators+thisHouse :: Automation Sensors Actuators () thisHouse = mconcat 	[ fridge 	, nightLight

@@ -1,5 +1,5 @@ Name: reactive-banana-automation-Version: 0.3.0+Version: 0.4.0 Cabal-Version: >= 1.8 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -32,7 +32,8 @@     base (>= 4.6 && < 5.0),     reactive-banana (>= 1.1 && < 1.3),     time (>= 1.6 && < 1.9),-    stm (>= 2.4 && < 2.5)+    stm (>= 2.4 && < 2.5),+    transformers (>= 0.5 && < 0.6)   Exposed-Modules:     Reactive.Banana.Automation     Reactive.Banana.Automation.Examples