reactive-banana-automation-0.1.1: home (etc) automation using reactive-banana

Safe HaskellNone
LanguageHaskell98

Reactive.Banana.Automation

Contents

Description

Home (etc) automation using reactive-banana.

Functional Reactive Programming is a natural fit for home automation, which involves sensor values that vary over time and are used to control actuators.

This library provides a framework and some useful types for using the reactive-banana FRP library for home automation.

Its main abstraction is the Automation which describes how to process Events from Sensors and how to drive actuators such as lights, and relays in response.

See Reactive.Banana.Automation.Examples for several examples of using this library.

Synopsis

Framework

type Automation sensors actuators = sensors -> (actuators -> IO ()) -> MomentAutomation () Source #

An Automation receives Events from some sensors and decides what to do, controlling the actuators. It is implemented as a reactive-banana event network description.

For example, let's make an automation for a fridge, which has a temperature sensor and a relay controlling its power, and should run as needed to keep the temperature in a safe range, while minimizing compressor starts.

 data Sensors = Sensors { fridgeTemperature :: EventSource (Sensed Double) }
 data Actuators = FridgePower PowerChange deriving (Show)
 
 fridge :: Automation Sensors Actuators
 fridge sensors actuators = do
	btemperature <- sensedBehavior (fridgeTemperature sensors)
	let bpowerchange = calcpowerchange <$> btemperature
	onBehaviorChange 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

data MomentAutomation a Source #

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.

runAutomation :: Automation sensors actuators -> IO sensors -> (actuators -> IO ()) -> (sensors -> IO ()) -> IO () Source #

Runs an Automation, given a constructor for the sensors, an IO action to drive the actuators, and an IO action that feeds data into the sensors.

Continuing the above example of a fridge, here's how to run it:

mkSensors :: IO Sensors
mkSensors = Sensors <$> newAddHandler

driveActuators :: Actuators -> IO ()
driveActuators = print

getFridgeTemperature :: IO Double
getFridgeTemperature = ...

main = runAutomation fridge mkSensors driveActuators $ \sensors -> do
	getFridgeTemperature >>= sensed (fridgeTemperature sensors)

Note that this function does not return; the sensor feeding action is run in a loop.

observeAutomation :: Automation sensors actuators -> IO sensors -> IO ((sensors -> IO ()) -> IO [actuators]) Source #

Allows observing what an Automation does. Designed to be especially useful for testing.

The Automation is started, and a runner action is returned. The runner allows updating the sensors, and returns what the Automation wants to do in response.

For example, in ghci:

> runner <- observeAutomation fridge mkSensors
> runner $ \sensors -> fridgeTemperature sensors =: 6
[FridgeRelay PowerOn]
> runner $ \sensors -> fridgeTemperature sensors =: 3
[]
> runner $ \sensors -> fridgeTemperature sensors =: 0.5
[FridgeRelay PowerOff]

Note that internal state is maintained between calls to the runner.

Events

type EventSource a = (AddHandler a, a -> IO ()) Source #

A source of events.

gotEvent :: EventSource a -> a -> IO () Source #

Call this to trigger an event.

getEventFrom :: EventSource a -> MomentAutomation (Event a) Source #

Get an Event from an EventSource.

onEvent :: Event a -> (a -> IO ()) -> MomentAutomation () Source #

Runs an action when an event occurs.

Sensors

data Sensed a Source #

A value read from a sensor.

Sensors are sometimes not available, or have not provided a value yet.

Constructors

SensorUnavailable 
Sensed a 

Instances

Show a => Show (Sensed a) Source # 

Methods

showsPrec :: Int -> Sensed a -> ShowS #

show :: Sensed a -> String #

showList :: [Sensed a] -> ShowS #

sensedEvent :: EventSource (Sensed a) -> MomentAutomation (Event a) Source #

Create an Event from sensed values.

The Event only contains values when the sensor provided a reading, not times when it was unavailable.

sensedBehavior :: EventSource (Sensed a) -> MomentAutomation (Behavior (Sensed a)) Source #

Create a Behavior from sensed values.

This is essentially just an application of the stepper combinator.

sensed :: EventSource (Sensed a) -> a -> IO () Source #

Call when a sensor has sensed a value.

getFridgeTemperature >>= sensed (fridgeTemperature sensors)

(=:) :: EventSource (Sensed a) -> a -> IO () Source #

Same as sensed

fridgeTemperature sensors =: 0

Time

data Timestamped t a Source #

A timestamped value.

In reactive-banana, an Event is tagged with its time of occurrence, but that internal representation of time is never exposed. It can be useful to have an Event timestamped as occurring at a specific wall clock time.

See motionActivatedLight for an example of using timestamped values, and how to test code that uses them.

Constructors

Timestamped 

Fields

Instances

(Show t, Show a) => Show (Timestamped t a) Source # 

Methods

showsPrec :: Int -> Timestamped t a -> ShowS #

show :: Timestamped t a -> String #

showList :: [Timestamped t a] -> ShowS #

sensedNow :: Timestamp t => EventSource (Sensed (Timestamped t a)) -> a -> IO () Source #

Call when a sensor has sensed a value, which will be Timestamped with the current time.

sensedAt :: Timestamp t => POSIXTime -> EventSource (Sensed (Timestamped t a)) -> a -> IO () Source #

Call when a sensor sensed a value with a particular timestamp.

elapsedTimeSince :: (Num t, Timestamp t) => (a -> Bool) -> Event (Timestamped t a) -> MomentAutomation (Event t) Source #

Given a Timestamped Event and a function, produces an Event that contains the elapsed time since the function last matched the event's value.

motionActivatedLight has a good example of using this.

Actuators

data PowerChange Source #

For controlling relays and other things that can have their power turned on and off.

Constructors

PowerOff 
PowerOn 

onBehaviorChange :: Behavior a -> (a -> IO ()) -> MomentAutomation () Source #

Runs an action when a behavior's value changes.

onBehaviorChangeMaybe :: Behavior (Maybe a) -> (a -> IO ()) -> MomentAutomation () Source #

Variant of onBehaviorChange that does nothing when a behavior changes to Nothing.

Ranges

data Range t Source #

The range between two values (inclusive).

Note that the position of the two values in the Range constructor is not significant; Range 1 10 == Range 10 1

Constructors

Range t t 

Instances

Eq t => Eq (Range t) Source # 

Methods

(==) :: Range t -> Range t -> Bool #

(/=) :: Range t -> Range t -> Bool #

Show t => Show (Range t) Source # 

Methods

showsPrec :: Int -> Range t -> ShowS #

show :: Range t -> String #

showList :: [Range t] -> ShowS #

Ord t => Semigroup (Range t) Source #

Combining two ranges yields a range between their respective lowest and highest values.

Methods

(<>) :: Range t -> Range t -> Range t #

sconcat :: NonEmpty (Range t) -> Range t #

stimes :: Integral b => b -> Range t -> Range t #

belowRange :: Ord t => t -> Range t -> Bool Source #

Check if a value is below a range.

aboveRange :: Ord t => t -> Range t -> Bool Source #

Check if a value is above a range.

inRange :: Ord t => t -> Range t -> Bool Source #

Check if a value is within a range.

extendRange :: Ord t => Range t -> t -> Range t Source #

Extends a range up/down to a value.