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