{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Arrows #-}
module HomeAssistant.Controller.Kitchen where
import HomeAssistant.Controller
import AFRP (Event (..))
import qualified AFRP
import Data.Aeson (Value)
import Control.Arrow ((>>>), Arrow (..), returnA)
import Prelude hiding (id)
import Data.Time (LocalTime(..), TimeOfDay (..))
import Data.Default (def)


-- Kitchen has two "presence" sensors. One IKEA motion sensor and one SwitchBot presence sensor

kitchenPresence :: HASS (Event Value) Presence
kitchenPresence = motion "binary_sensor.kitchen_movement_occupancy" >>> motionToPresence 500

kitchenCeilingController :: HASS (Event Value) ()
kitchenCeilingController = proc x -> do
  now <- AFRP.currentTime -< ()
  p <- kitchenPresence -< x
  ev <- lightingModeEvents -< p
  traceEvent -< ev
  case ev of
       Event LightingOn | lightsAllowed now -> callServiceDyn (light [EntityId "light.kitchen_ceiling"]) -< On def
       Event LightingOff -> callServiceDyn (light [EntityId "light.kitchen_ceiling"]) -< Off
       _ -> returnA -< ()
  where
    lightsAllowed (LocalTime _ tod) = not (tod > TimeOfDay 1 45 0 && tod < TimeOfDay 5 0 0)


dinnerLightLevel :: HASS (Event Value) Int
dinnerLightLevel = entityRead "sensor.sijainti_keittio_light_level" >>> AFRP.hold 0

dinnerPresence :: HASS (Event Value) Presence
dinnerPresence = presence "binary_sensor.sijainti_keittio_occupancy" >>> AFRP.hold Unoccupied

dinnerLightEvents :: HASS (Event Value) (Event LightingMode)
dinnerLightEvents =
  ((,) <$> dinnerLightLevel <*> dinnerPresence)
  >>> arr lightWanted
  >>> (sleepEvent &&& offEvent &&& onEvent)
  >>> arr (\(s, (o, n)) -> s `AFRP.lMerge` o `AFRP.lMerge` n)
  where
    lightWanted (lightLevel, occ) = occ == Occupied && lightLevel < 13

    onEvent =
      AFRP.edge
      >>> arr (fmap (const LightingOn))

    sleepEvent =
      arr not
      >>> AFRP.edge
      >>> arr (fmap (const LightingSleep))

    offEvent =
      arr not
      >>> AFRP.waitFor 300
      >>> arr (fmap (const LightingOff))

dinnerTableController :: HASS (Event Value) ()
dinnerTableController = proc x -> do
  ev <- dinnerLightEvents -< x
  case ev of
       Event LightingOn -> do
         sleep -< False
         callServiceDyn (light [EntityId "light.kitchen_dining_large"]) -< On def
       Event LightingOff -> do
         sleep -< False
         callServiceDyn (light [EntityId "light.kitchen_dining_large"]) -< Off
       Event LightingSleep -> do
         sleep -< True
       _ -> returnA -< ()
  where
    sleep = callServiceDyn (switchService [EntityId "switch.adaptive_lighting_ruokapoydan_valot_sleep_mode"])

kitchenMotionController :: HASS (Event Value) ()
kitchenMotionController = kitchenCeilingController <> dinnerTableController