{-# LANGUAGE Arrows #-}
{-# LANGUAGE OverloadedStrings #-}
module HomeAssistant.Controller.Bedroom where

import HomeAssistant.Controller
import qualified Data.Text as T
import AFRP (Event (..), lMerge, duration, edge)
import Data.Aeson (Value, object, (.=))
import Control.Arrow ((>>>), returnA, arr, Arrow (..))
import Data.Bool (bool)
import Data.Time (NominalDiffTime)
import qualified AFRP



bedroomLights :: [Target]
bedroomLights = map EntityId ["light.bedroom_masse","light.bedroom_jemina","light.bedroom_ceiling","light.bedroom_led_switch"]

createBedroomScene :: Service
createBedroomScene = Service
  { serviceDomain="scene"
  , serviceName= "create"
  , serviceData= Just $ object
      [ "scene_id" .= ("makuuhuone_lights_snapshot" :: T.Text)
      , "snapshot_entities" .= [l | EntityId l <- bedroomLights]
      ]
  , serviceTarget= []
  }

data PresenceLights
  = LightsOn -- Restore lights
  | LightsOff -- Timer expired, darkness
  | LightsSleep -- No presence detected, sleep mode
  deriving Show

-- Bedroom presence
bedroomPresence :: HASS (Event Value) (Event Presence)
bedroomPresence = presence "binary_sensor.presence_sensor_bedroom_occupancy"

presenceLightEvents :: HASS (Event Value) (Event PresenceLights)
presenceLightEvents =
  bedroomPresence >>> AFRP.hold Unoccupied
  >>> arr lightWanted
  >>> (sleepEvent &&& offEvent &&& onEvent)
  >>> arr (\(s,(o,n)) -> s `AFRP.lMerge` o `AFRP.lMerge` n)
  where
    lightWanted o = o == Occupied
    sleepEvent = arr not >>> AFRP.edge >>> arr (AFRP.tag LightsSleep)
    onEvent = AFRP.edge >>> arr (AFRP.tag LightsOn)
    offEvent = arr not >>> AFRP.waitFor 300 >>> arr (AFRP.tag LightsOff)

bedroomPresenceController :: HASS (Event Value) ()
bedroomPresenceController = proc x -> do
  p <- presenceLightEvents >>> traceEvent -< x
  case p of
       Event LightsOff -> do
         callService (light bedroomLights Off) -< ()
       Event LightsOn -> do
         callService (activateSceneWith "scene.makuuhuone_lights_snapshot" transition) -< ()
       Event LightsSleep -> do
         callService createBedroomScene -< ()
         callService (activateSceneWith "scene.makuuhuone_lepotila" transition) -< ()
       _ -> returnA -< ()
  where
    transition = Just $ object ["transition" .= (1:: Int)]


data BedroomControls
  = Masse (IkeaButton IkeaGesture)
  | Enishen (IkeaButton IkeaGesture)
  | Central IkeaController
  deriving Show


bedroomButton :: HASS (Event Value) (Event BedroomControls)
bedroomButton = (masseButton &&& enishenButton &&& centralButton)
  >>> arr (\(a,(b,c)) -> a `lMerge` b `lMerge` c)
  where
    masseButton = fmap Masse <$> ikeaQuickButton "event.bedroom_quick_remote_masse_action"
    enishenButton = fmap Enishen <$> ikeaQuickButton "event.bedroom_quick_jemina_action"
    centralButton = fmap Central <$> ikeaBoxRemote "event.bedroom_remote_action"

bedroomButtonController :: HASS (Event Value) ()
bedroomButtonController = proc x -> do
  ev <- bedroomButton >>> traceEvent -< x
  -- Any event will cause the sleep mode to be turned off
  case ev of
       Event (Masse (OnButton ShortRelease)) -> do
         callService (activateSceneWith "scene.makuuhuone_masse" transition) -< ()
       Event (Masse (OnButton DoubleClick)) -> do
         callService (activateSceneWith "scene.makuuhuone_keski" transition) -< ()
       Event (Masse (OnButton LongClick)) -> do
         callService (activateSceneWith "scene.makuuhuone_kirkas" transition) -< ()
       Event (Masse (OffButton _)) -> do
         callService (light [AreaId "makuuhuone"] Off) -< ()
       Event (Enishen (OnButton ShortRelease)) -> do
         callService (activateSceneWith "scene.makuuhuone_jemina" transition) -< ()
       Event (Enishen (OnButton DoubleClick)) -> do
         callService (activateSceneWith "scene.makuuhuone_keski" transition) -< ()
       Event (Enishen (OnButton LongClick)) -> do
         callService (activateSceneWith "scene.makuuhuone_kirkas" transition) -< ()
       Event (Enishen (OffButton _)) -> do
         callService (light [AreaId "makuuhuone"] Off) -< ()
       _ -> returnA -< ()
  where
    transition = Just $ object ["transition" .= (1 :: Int)]



drawer :: HASS (Event Value) (Event DoorState)
drawer = entityBool "binary_sensor.bedroom_nightstand_drawer_sensor_masse_contact"
  >>> arr (fmap (bool Closed Open))

bedroomDrawerController :: HASS (Event Value) ()
bedroomDrawerController = proc x -> do
  st <- drawer >>> traceEvent -< x
  case st of
       Event Open -> callService (switch [entity] True) -< ()
       Event Closed -> callService (switch [entity] False) -< ()
       _ -> returnA -< ()
  where
    entity = EntityId "switch.bedroom_drawer_light_masse"

door :: HASS (Event Value) (Event DoorState)
door = entityBool "binary_sensor.makuuhuone_ovi_contact"
  >>> arr (fmap (bool Closed Open))

waitFor :: NominalDiffTime -> HASS a (Event ())
waitFor n = duration >>> arr (> n) >>> edge


delayedDoor :: HASS (Event Value) (Event DoorState)
delayedDoor = door
  >>> AFRP.debounce 15
  >>> AFRP.hold Open
  >>> AFRP.changes

humidifierController :: HASS (Event Value) ()
humidifierController = proc x -> do
  st <- delayedDoor -< x
  case st of
       -- Turn the humidifier on when the door is closed
       -- the humidifier is low-powered, no point in losing all the humidity
       Event Open -> callService (humidifier False) -< ()
       Event Closed -> callService (humidifier True) -< ()
       _ -> returnA -< ()
  where
    humidifier state = Service
      { serviceDomain="humidifier"
      , serviceName= bool "turn_off" "turn_on" state
      , serviceData= Nothing
      , serviceTarget= [EntityId "humidifier.makuuhuone_ilmankostutin"]
      }