-- | `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
	{ Sensors -> EventSource (Sensed Double) ()
fridgeTemperature :: EventSource (Sensed Double) ()
	, Sensors -> EventSource (Sensed (Timestamped POSIXTime Bool)) ()
motionSensor :: EventSource (Sensed (Timestamped POSIXTime Bool)) ()
	, Sensors -> EventSource (ClockSignal LocalTime) ()
clock :: EventSource (ClockSignal LocalTime) ()
	, Sensors -> EventSource (Sensed ()) ()
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 (Int -> Actuators -> ShowS
[Actuators] -> ShowS
Actuators -> String
(Int -> Actuators -> ShowS)
-> (Actuators -> String)
-> ([Actuators] -> ShowS)
-> Show Actuators
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Actuators] -> ShowS
$cshowList :: [Actuators] -> ShowS
show :: Actuators -> String
$cshow :: Actuators -> String
showsPrec :: Int -> Actuators -> ShowS
$cshowsPrec :: Int -> Actuators -> ShowS
Show)

-- | For running the examples, you'll need this, to construct a `Sensors`
mkSensors :: IO Sensors
mkSensors :: IO Sensors
mkSensors = EventSource (Sensed Double) ()
-> EventSource (Sensed (Timestamped POSIXTime Bool)) ()
-> EventSource (ClockSignal LocalTime) ()
-> EventSource (Sensed ()) ()
-> Sensors
Sensors
	(EventSource (Sensed Double) ()
 -> EventSource (Sensed (Timestamped POSIXTime Bool)) ()
 -> EventSource (ClockSignal LocalTime) ()
 -> EventSource (Sensed ()) ()
 -> Sensors)
-> IO (EventSource (Sensed Double) ())
-> IO
     (EventSource (Sensed (Timestamped POSIXTime Bool)) ()
      -> EventSource (ClockSignal LocalTime) ()
      -> EventSource (Sensed ()) ()
      -> Sensors)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> () -> IO (EventSource (Sensed Double) ())
forall v a. v -> IO (EventSource a v)
newEventSource ()
	IO
  (EventSource (Sensed (Timestamped POSIXTime Bool)) ()
   -> EventSource (ClockSignal LocalTime) ()
   -> EventSource (Sensed ()) ()
   -> Sensors)
-> IO (EventSource (Sensed (Timestamped POSIXTime Bool)) ())
-> IO
     (EventSource (ClockSignal LocalTime) ()
      -> EventSource (Sensed ()) () -> Sensors)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> IO (EventSource (Sensed (Timestamped POSIXTime Bool)) ())
forall v a. v -> IO (EventSource a v)
newEventSource ()
	IO
  (EventSource (ClockSignal LocalTime) ()
   -> EventSource (Sensed ()) () -> Sensors)
-> IO (EventSource (ClockSignal LocalTime) ())
-> IO (EventSource (Sensed ()) () -> Sensors)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> IO (EventSource (ClockSignal LocalTime) ())
forall v a. v -> IO (EventSource a v)
newEventSource ()
	IO (EventSource (Sensed ()) () -> Sensors)
-> IO (EventSource (Sensed ()) ()) -> IO Sensors
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> IO (EventSource (Sensed ()) ())
forall v a. v -> IO (EventSource a v)
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 ()
fridge = do
	-- Create a Behavior that reflects the most recently reported
	-- temperature of the fridge.
	Behavior (Sensed Double)
btemperature <- (Sensors -> EventSource (Sensed Double) ())
-> Automation Sensors Actuators (Behavior (Sensed Double))
forall sensors a v actuators.
(sensors -> EventSource (Sensed a) v)
-> Automation sensors actuators (Behavior (Sensed a))
sensedBehavior Sensors -> EventSource (Sensed Double) ()
fridgeTemperature
	-- Calculate when the fridge should turn on and off.
	let bpowerchange :: Behavior (Maybe PowerChange)
bpowerchange = Sensed Double -> Maybe PowerChange
calcpowerchange (Sensed Double -> Maybe PowerChange)
-> Behavior (Sensed Double) -> Behavior (Maybe PowerChange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior (Sensed Double)
btemperature
	Behavior (Maybe PowerChange)
-> (PowerChange -> Actuators) -> Automation Sensors Actuators ()
forall a actuators sensors.
Behavior (Maybe a)
-> (a -> actuators) -> Automation sensors actuators ()
actuateBehaviorMaybe Behavior (Maybe PowerChange)
bpowerchange PowerChange -> Actuators
FridgePower
  where
	calcpowerchange :: Sensed Double -> Maybe PowerChange
calcpowerchange (Sensed Double
temp)
		| Double
temp Double -> Range Double -> Bool
forall t. Ord t => t -> Range t -> Bool
`belowRange` Range Double
allowedtemp = PowerChange -> Maybe PowerChange
forall a. a -> Maybe a
Just PowerChange
PowerOff
		| Double
temp Double -> Range Double -> Bool
forall t. Ord t => t -> Range t -> Bool
`aboveRange` Range Double
allowedtemp = PowerChange -> Maybe PowerChange
forall a. a -> Maybe a
Just PowerChange
PowerOn
		| Bool
otherwise = Maybe PowerChange
forall a. Maybe a
Nothing
	calcpowerchange Sensed Double
SensorUnavailable = Maybe PowerChange
forall a. Maybe a
Nothing
	allowedtemp :: Range Double
allowedtemp = Double -> Double -> Range Double
forall t. t -> t -> Range t
Range Double
1 Double
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 ()
motionActivatedLight = do
	-- Make an Event that contains the time elapsed since the last
	-- detected motion.
	Event POSIXTime
timesincemotion <- (Bool -> Bool)
-> Event (Timestamped POSIXTime Bool)
-> Automation Sensors Actuators (Event POSIXTime)
forall t a sensors actuators.
(Num t, Timestamp t) =>
(a -> Bool)
-> Event (Timestamped t a)
-> Automation sensors actuators (Event t)
elapsedTimeSince (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True)
		(Event (Timestamped POSIXTime Bool)
 -> Automation Sensors Actuators (Event POSIXTime))
-> Automation
     Sensors Actuators (Event (Timestamped POSIXTime Bool))
-> Automation Sensors Actuators (Event POSIXTime)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Sensors -> EventSource (Sensed (Timestamped POSIXTime Bool)) ())
-> Automation
     Sensors Actuators (Event (Timestamped POSIXTime Bool))
forall sensors a v actuators.
(sensors -> EventSource (Sensed a) v)
-> Automation sensors actuators (Event a)
sensedEvent Sensors -> EventSource (Sensed (Timestamped POSIXTime Bool)) ()
motionSensor
	-- Make a Behavior for the light switch.
	Behavior (Maybe PowerChange)
lightchange <- Maybe PowerChange
-> Event (Maybe PowerChange)
-> Automation Sensors Actuators (Behavior (Maybe PowerChange))
forall (m :: * -> *) a.
MonadMoment m =>
a -> Event a -> m (Behavior a)
stepper Maybe PowerChange
forall a. Maybe a
Nothing (Event (Maybe PowerChange)
 -> Automation Sensors Actuators (Behavior (Maybe PowerChange)))
-> Event (Maybe PowerChange)
-> Automation Sensors Actuators (Behavior (Maybe PowerChange))
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Maybe PowerChange
forall a. (Num a, Ord a) => a -> Maybe PowerChange
calcchange (POSIXTime -> Maybe PowerChange)
-> Event POSIXTime -> Event (Maybe PowerChange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event POSIXTime
timesincemotion
	Behavior (Maybe PowerChange)
-> (PowerChange -> Actuators) -> Automation Sensors Actuators ()
forall a actuators sensors.
Behavior (Maybe a)
-> (a -> actuators) -> Automation sensors actuators ()
actuateBehaviorMaybe Behavior (Maybe PowerChange)
lightchange PowerChange -> Actuators
LightSwitch
  where
	calcchange :: a -> Maybe PowerChange
calcchange a
t
		| a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = PowerChange -> Maybe PowerChange
forall a. a -> Maybe a
Just PowerChange
PowerOn -- motion was just detected
		| a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
300 = PowerChange -> Maybe PowerChange
forall a. a -> Maybe a
Just PowerChange
PowerOff -- 5 minutes since last motion
		| Bool
otherwise = Maybe PowerChange
forall a. Maybe a
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 ()
nightLight = do
	Behavior (Maybe (ClockSignal LocalTime))
bclock <- (Sensors -> EventSource (ClockSignal LocalTime) ())
-> Automation
     Sensors Actuators (Behavior (Maybe (ClockSignal LocalTime)))
forall t sensors v actuators.
Timestamp t =>
(sensors -> EventSource (ClockSignal t) v)
-> Automation sensors actuators (Behavior (Maybe (ClockSignal t)))
clockSignalBehavior Sensors -> EventSource (ClockSignal LocalTime) ()
clock
	let bhour :: Behavior (Maybe (ClockSignal Int))
bhour = ((ClockSignal LocalTime -> ClockSignal Int)
-> Maybe (ClockSignal LocalTime) -> Maybe (ClockSignal Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ClockSignal LocalTime -> ClockSignal Int)
 -> Maybe (ClockSignal LocalTime) -> Maybe (ClockSignal Int))
-> ((LocalTime -> Int) -> ClockSignal LocalTime -> ClockSignal Int)
-> (LocalTime -> Int)
-> Maybe (ClockSignal LocalTime)
-> Maybe (ClockSignal Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalTime -> Int) -> ClockSignal LocalTime -> ClockSignal Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (TimeOfDay -> Int
todHour (TimeOfDay -> Int) -> (LocalTime -> TimeOfDay) -> LocalTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> TimeOfDay
localTimeOfDay) (Maybe (ClockSignal LocalTime) -> Maybe (ClockSignal Int))
-> Behavior (Maybe (ClockSignal LocalTime))
-> Behavior (Maybe (ClockSignal Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior (Maybe (ClockSignal LocalTime))
bclock
	let lightchange :: Behavior (Maybe PowerChange)
lightchange = Maybe (ClockSignal Int) -> Maybe PowerChange
forall a.
(Ord a, Num a) =>
Maybe (ClockSignal a) -> Maybe PowerChange
calcchange (Maybe (ClockSignal Int) -> Maybe PowerChange)
-> Behavior (Maybe (ClockSignal Int))
-> Behavior (Maybe PowerChange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior (Maybe (ClockSignal Int))
bhour
	Behavior (Maybe PowerChange)
-> (PowerChange -> Actuators) -> Automation Sensors Actuators ()
forall a actuators sensors.
Behavior (Maybe a)
-> (a -> actuators) -> Automation sensors actuators ()
actuateBehaviorMaybe Behavior (Maybe PowerChange)
lightchange PowerChange -> Actuators
LightSwitch
  where
	calcchange :: Maybe (ClockSignal a) -> Maybe PowerChange
calcchange (Just (ClockSignal a
t))
		| a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
18 = PowerChange -> Maybe PowerChange
forall a. a -> Maybe a
Just PowerChange
PowerOn
		| a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
6 = PowerChange -> Maybe PowerChange
forall a. a -> Maybe a
Just PowerChange
PowerOn
		| Bool
otherwise = PowerChange -> Maybe PowerChange
forall a. a -> Maybe a
Just PowerChange
PowerOff
	calcchange Maybe (ClockSignal a)
Nothing = Maybe PowerChange
forall a. Maybe a
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) -> Automation Sensors Actuators (Behavior a) -> Automation Sensors Actuators ()
showBehaviorLCDDisplay :: (a -> String)
-> Automation Sensors Actuators (Behavior a)
-> Automation Sensors Actuators ()
showBehaviorLCDDisplay a -> String
fmt Automation Sensors Actuators (Behavior a)
mkb = do
	Behavior a
b <- Automation Sensors Actuators (Behavior a)
mkb
	Behavior a -> (a -> Actuators) -> Automation Sensors Actuators ()
forall a actuators sensors.
Behavior a -> (a -> actuators) -> Automation sensors actuators ()
actuateBehavior Behavior a
b (String -> Actuators
LCDDisplay (String -> Actuators) -> (a -> String) -> a -> Actuators
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
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 :: Automation Sensors Actuators (Behavior Integer)
totalRainfall :: Automation Sensors Actuators (Behavior Integer)
totalRainfall = do
	Event ()
tipevents <- (Sensors -> EventSource (Sensed ()) ())
-> Automation Sensors Actuators (Event ())
forall sensors a v actuators.
(sensors -> EventSource (Sensed a) v)
-> Automation sensors actuators (Event a)
sensedEvent Sensors -> EventSource (Sensed ()) ()
rainGaugeTipSensor
	Integer
-> Event (Integer -> Integer)
-> Automation Sensors Actuators (Behavior Integer)
forall (m :: * -> *) a.
MonadMoment m =>
a -> Event (a -> a) -> m (Behavior a)
accumB Integer
0 (Event (Integer -> Integer)
 -> Automation Sensors Actuators (Behavior Integer))
-> Event (Integer -> Integer)
-> Automation Sensors Actuators (Behavior Integer)
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer) -> () -> Integer -> Integer
forall a b. a -> b -> a
const Integer -> Integer
forall a. Enum a => a -> a
succ (() -> Integer -> Integer)
-> Event () -> Event (Integer -> Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event ()
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 -> Automation Sensors Actuators (Behavior (Timestamped (ClockSignal LocalTime) Integer))
totalRainfallSince :: TimeOfDay
-> Automation
     Sensors
     Actuators
     (Behavior (Timestamped (ClockSignal LocalTime) Integer))
totalRainfallSince TimeOfDay
tod = do
	Event (ClockSignal LocalTime)
clockevents <- (Sensors -> EventSource (ClockSignal LocalTime) ())
-> Automation Sensors Actuators (Event (ClockSignal LocalTime))
forall sensors a v actuators.
(sensors -> EventSource a v)
-> Automation sensors actuators (Event a)
getEventFrom Sensors -> EventSource (ClockSignal LocalTime) ()
clock
	Behavior (Maybe (ClockSignal LocalTime))
bclock <- (Sensors -> EventSource (ClockSignal LocalTime) ())
-> Automation
     Sensors Actuators (Behavior (Maybe (ClockSignal LocalTime)))
forall t sensors v actuators.
Timestamp t =>
(sensors -> EventSource (ClockSignal t) v)
-> Automation sensors actuators (Behavior (Maybe (ClockSignal t)))
clockSignalBehavior Sensors -> EventSource (ClockSignal LocalTime) ()
clock
	Event ()
tipevents <- (Sensors -> EventSource (Sensed ()) ())
-> Automation Sensors Actuators (Event ())
forall sensors a v actuators.
(sensors -> EventSource (Sensed a) v)
-> Automation sensors actuators (Event a)
sensedEvent Sensors -> EventSource (Sensed ()) ()
rainGaugeTipSensor
	-- The tip events, with the tip signal replaced with
	-- the clock time when it occurred.
	let tiptimes :: Event (Maybe (ClockSignal LocalTime))
tiptimes = Behavior (Maybe (ClockSignal LocalTime))
bclock Behavior (Maybe (ClockSignal LocalTime))
-> Event () -> Event (Maybe (ClockSignal LocalTime))
forall b a. Behavior b -> Event a -> Event b
<@ Event ()
tipevents
	-- Combine clock ticks and tip events, with a function
	-- to apply to the running total for each.
	let combined :: Event (Integer -> Integer, Maybe (ClockSignal LocalTime))
combined = ((Integer -> Integer, Maybe (ClockSignal LocalTime))
 -> (Integer -> Integer, Maybe (ClockSignal LocalTime))
 -> (Integer -> Integer, Maybe (ClockSignal LocalTime)))
-> Event (Integer -> Integer, Maybe (ClockSignal LocalTime))
-> Event (Integer -> Integer, Maybe (ClockSignal LocalTime))
-> Event (Integer -> Integer, Maybe (ClockSignal LocalTime))
forall a. (a -> a -> a) -> Event a -> Event a -> Event a
unionWith (\(Integer -> Integer
f1, Maybe (ClockSignal LocalTime)
t1) (Integer -> Integer
f2, Maybe (ClockSignal LocalTime)
t2) -> (Integer -> Integer
f1 (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
f2, Maybe (ClockSignal LocalTime)
-> Maybe (ClockSignal LocalTime) -> Maybe (ClockSignal LocalTime)
forall a. Ord a => a -> a -> a
max Maybe (ClockSignal LocalTime)
t1 Maybe (ClockSignal LocalTime)
t2))
		((\Maybe (ClockSignal LocalTime)
e -> (Integer -> Integer
forall a. a -> a
id, Maybe (ClockSignal LocalTime)
e)) (Maybe (ClockSignal LocalTime)
 -> (Integer -> Integer, Maybe (ClockSignal LocalTime)))
-> Event (Maybe (ClockSignal LocalTime))
-> Event (Integer -> Integer, Maybe (ClockSignal LocalTime))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ClockSignal LocalTime -> Maybe (ClockSignal LocalTime))
-> Event (ClockSignal LocalTime)
-> Event (Maybe (ClockSignal LocalTime))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClockSignal LocalTime -> Maybe (ClockSignal LocalTime)
forall a. a -> Maybe a
Just Event (ClockSignal LocalTime)
clockevents)
		((\Maybe (ClockSignal LocalTime)
e -> (Integer -> Integer
forall a. Enum a => a -> a
succ, Maybe (ClockSignal LocalTime)
e)) (Maybe (ClockSignal LocalTime)
 -> (Integer -> Integer, Maybe (ClockSignal LocalTime)))
-> Event (Maybe (ClockSignal LocalTime))
-> Event (Integer -> Integer, Maybe (ClockSignal LocalTime))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event (Maybe (ClockSignal LocalTime))
tiptimes)
	let epoch :: LocalTime
epoch = Day -> TimeOfDay -> LocalTime
LocalTime (Integer -> Int -> Int -> Day
fromGregorian Integer
1 Int
1 Int
1) TimeOfDay
midnight
	let initial :: (Timestamped (ClockSignal LocalTime) Integer, Maybe a)
initial = (ClockSignal LocalTime
-> Integer -> Timestamped (ClockSignal LocalTime) Integer
forall t a. t -> a -> Timestamped t a
Timestamped (LocalTime -> ClockSignal LocalTime
forall a. a -> ClockSignal a
ClockSignal LocalTime
epoch) Integer
0, Maybe a
forall a. Maybe a
Nothing)
	((Timestamped (ClockSignal LocalTime) Integer, Maybe Day)
 -> Timestamped (ClockSignal LocalTime) Integer)
-> Behavior
     (Timestamped (ClockSignal LocalTime) Integer, Maybe Day)
-> Behavior (Timestamped (ClockSignal LocalTime) Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Timestamped (ClockSignal LocalTime) Integer, Maybe Day)
-> Timestamped (ClockSignal LocalTime) Integer
forall a b. (a, b) -> a
fst (Behavior (Timestamped (ClockSignal LocalTime) Integer, Maybe Day)
 -> Behavior (Timestamped (ClockSignal LocalTime) Integer))
-> Automation
     Sensors
     Actuators
     (Behavior (Timestamped (ClockSignal LocalTime) Integer, Maybe Day))
-> Automation
     Sensors
     Actuators
     (Behavior (Timestamped (ClockSignal LocalTime) Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Timestamped (ClockSignal LocalTime) Integer, Maybe Day)
-> Event
     ((Timestamped (ClockSignal LocalTime) Integer, Maybe Day)
      -> (Timestamped (ClockSignal LocalTime) Integer, Maybe Day))
-> Automation
     Sensors
     Actuators
     (Behavior (Timestamped (ClockSignal LocalTime) Integer, Maybe Day))
forall (m :: * -> *) a.
MonadMoment m =>
a -> Event (a -> a) -> m (Behavior a)
accumB (Timestamped (ClockSignal LocalTime) Integer, Maybe Day)
forall a. (Timestamped (ClockSignal LocalTime) Integer, Maybe a)
initial (Event
   ((Timestamped (ClockSignal LocalTime) Integer, Maybe Day)
    -> (Timestamped (ClockSignal LocalTime) Integer, Maybe Day))
 -> Automation
      Sensors
      Actuators
      (Behavior
         (Timestamped (ClockSignal LocalTime) Integer, Maybe Day)))
-> Event
     ((Timestamped (ClockSignal LocalTime) Integer, Maybe Day)
      -> (Timestamped (ClockSignal LocalTime) Integer, Maybe Day))
-> Automation
     Sensors
     Actuators
     (Behavior (Timestamped (ClockSignal LocalTime) Integer, Maybe Day))
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer, Maybe (ClockSignal LocalTime))
-> (Timestamped (ClockSignal LocalTime) Integer, Maybe Day)
-> (Timestamped (ClockSignal LocalTime) Integer, Maybe Day)
forall a.
Num a =>
(a -> a, Maybe (ClockSignal LocalTime))
-> (Timestamped (ClockSignal LocalTime) a, Maybe Day)
-> (Timestamped (ClockSignal LocalTime) a, Maybe Day)
go ((Integer -> Integer, Maybe (ClockSignal LocalTime))
 -> (Timestamped (ClockSignal LocalTime) Integer, Maybe Day)
 -> (Timestamped (ClockSignal LocalTime) Integer, Maybe Day))
-> Event (Integer -> Integer, Maybe (ClockSignal LocalTime))
-> Event
     ((Timestamped (ClockSignal LocalTime) Integer, Maybe Day)
      -> (Timestamped (ClockSignal LocalTime) Integer, Maybe Day))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event (Integer -> Integer, Maybe (ClockSignal LocalTime))
combined)
  where
	go :: (a -> a, Maybe (ClockSignal LocalTime))
-> (Timestamped (ClockSignal LocalTime) a, Maybe Day)
-> (Timestamped (ClockSignal LocalTime) a, Maybe Day)
go (a -> a
f, Just (ClockSignal LocalTime
t)) (Timestamped ClockSignal LocalTime
_ a
n, Just Day
lastzero) =
		let nextzero :: Day
nextzero = Day -> Day
forall a. Enum a => a -> a
succ Day
lastzero
		in if LocalTime
t LocalTime -> LocalTime -> Bool
forall a. Ord a => a -> a -> Bool
> Day -> TimeOfDay -> LocalTime
LocalTime Day
nextzero TimeOfDay
tod
			then (ClockSignal LocalTime -> a -> Timestamped (ClockSignal LocalTime) a
forall t a. t -> a -> Timestamped t a
Timestamped (LocalTime -> ClockSignal LocalTime
forall a. a -> ClockSignal a
ClockSignal LocalTime
t) a
0, Day -> Maybe Day
forall a. a -> Maybe a
Just Day
nextzero)
			else (ClockSignal LocalTime -> a -> Timestamped (ClockSignal LocalTime) a
forall t a. t -> a -> Timestamped t a
Timestamped (LocalTime -> ClockSignal LocalTime
forall a. a -> ClockSignal a
ClockSignal LocalTime
t) (a -> a
f a
n), Day -> Maybe Day
forall a. a -> Maybe a
Just Day
lastzero)
	go (a -> a
f, Just (ClockSignal LocalTime
t)) ((Timestamped ClockSignal LocalTime
_ a
n), Maybe Day
Nothing) =
		(ClockSignal LocalTime -> a -> Timestamped (ClockSignal LocalTime) a
forall t a. t -> a -> Timestamped t a
Timestamped (LocalTime -> ClockSignal LocalTime
forall a. a -> ClockSignal a
ClockSignal LocalTime
t) (a -> a
f a
n), Day -> Maybe Day
forall a. a -> Maybe a
Just (LocalTime -> Day
localDay LocalTime
t))
	go (a -> a
_, Maybe (ClockSignal LocalTime)
Nothing) (Timestamped (ClockSignal LocalTime) a, Maybe Day)
v = (Timestamped (ClockSignal LocalTime) a, Maybe Day)
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 :: TimeOfDay -> Automation Sensors Actuators ()
sprinklersStartingAt TimeOfDay
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.
	Behavior (Timestamped (ClockSignal LocalTime) Integer)
brainfall <- TimeOfDay
-> Automation
     Sensors
     Actuators
     (Behavior (Timestamped (ClockSignal LocalTime) Integer))
totalRainfallSince TimeOfDay
starttod
	let b :: Behavior (Maybe PowerChange)
b = Timestamped (ClockSignal LocalTime) Integer -> Maybe PowerChange
forall a.
(Ord a, Num a) =>
Timestamped (ClockSignal LocalTime) a -> Maybe PowerChange
calcchange (Timestamped (ClockSignal LocalTime) Integer -> Maybe PowerChange)
-> Behavior (Timestamped (ClockSignal LocalTime) Integer)
-> Behavior (Maybe PowerChange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior (Timestamped (ClockSignal LocalTime) Integer)
brainfall
	Behavior (Maybe PowerChange)
-> (PowerChange -> Actuators) -> Automation Sensors Actuators ()
forall a actuators sensors.
Behavior (Maybe a)
-> (a -> actuators) -> Automation sensors actuators ()
actuateBehaviorMaybe Behavior (Maybe PowerChange)
b PowerChange -> Actuators
SprinklerSwitch
  where
	stoptod :: TimeOfDay
stoptod = TimeOfDay
starttod { todHour :: Int
todHour = (TimeOfDay -> Int
todHour TimeOfDay
starttod Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
24 }
	calcchange :: Timestamped (ClockSignal LocalTime) a -> Maybe PowerChange
calcchange (Timestamped (ClockSignal LocalTime
t) a
rain)
		| a
rain a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
3 = PowerChange -> Maybe PowerChange
forall a. a -> Maybe a
Just PowerChange
PowerOff
		| LocalTime -> TimeOfDay
localTimeOfDay LocalTime
t TimeOfDay -> TimeOfDay -> Bool
forall a. Ord a => a -> a -> Bool
>= TimeOfDay
starttod Bool -> Bool -> Bool
&& LocalTime -> TimeOfDay
localTimeOfDay LocalTime
t TimeOfDay -> TimeOfDay -> Bool
forall a. Ord a => a -> a -> Bool
< TimeOfDay
stoptod = PowerChange -> Maybe PowerChange
forall a. a -> Maybe a
Just PowerChange
PowerOn
		| Bool
otherwise = PowerChange -> Maybe PowerChange
forall a. a -> Maybe a
Just PowerChange
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 :: Automation Sensors Actuators ()
thisHouse = [Automation Sensors Actuators ()]
-> Automation Sensors Actuators ()
forall a. Monoid a => [a] -> a
mconcat
	[ Automation Sensors Actuators ()
fridge
	, Automation Sensors Actuators ()
nightLight
	, Automation Sensors Actuators ()
motionActivatedLight
	, TimeOfDay -> Automation Sensors Actuators ()
sprinklersStartingAt TimeOfDay
midnight
	]