-- | `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 = do
	-- Create a Behavior that reflects the most recently reported
	-- temperature of the fridge.
	btemperature <- sensedBehavior fridgeTemperature
	-- Calculate when the fridge should turn on and off.
	let bpowerchange = calcpowerchange <$> btemperature
	actuateBehaviorMaybe bpowerchange 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 = do
	-- Make an Event that contains the time elapsed since the last
	-- detected motion.
	timesincemotion <- elapsedTimeSince (== True)
		=<< sensedEvent motionSensor
	-- Make a Behavior for the light switch.
	lightchange <- stepper Nothing $ calcchange <$> timesincemotion
	actuateBehaviorMaybe lightchange 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 = do
	bclock <- clockSignalBehavior clock
	let bhour = (fmap . fmap) (todHour . localTimeOfDay) <$> bclock
	let lightchange = calcchange <$> bhour
	actuateBehaviorMaybe lightchange 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) -> 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`.
-- 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 = do
	tipevents <- sensedEvent rainGaugeTipSensor
	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 -> 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
	-- 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 = 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
	let b = calcchange <$> brainfall
	actuateBehaviorMaybe b 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
	]