-- | `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 ]