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

import HomeAssistant.Controller
import qualified Data.Text as T
import AFRP (Event (..), (>>|), toEvent, lMerge, duration, edge)
import Data.Aeson (Value, object, (.=))
import Control.Arrow ((>>>), returnA, arr, Arrow (..))
import Control.Lens ((^?), to, traversed)
import Data.Aeson.Lens (key, _String)
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= []
  }


activateScene :: T.Text -> Service
activateScene sceneId = Service
  { serviceDomain="scene"
  , serviceName= "turn_on"
  , serviceTarget= [EntityId sceneId]
  , serviceData = Nothing
  }

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

bedroomPresenceController :: HASS (Event Value) ()
bedroomPresenceController = proc x -> do
  p <- bedroomPresence -< x
  case p of
       Event Unoccupied -> callService createBedroomScene >>> callService (light bedroomLights False) -< ()
       Event Occupied -> callService (activateScene "makuuhuone_lights_snapshot") -< ()
       _ -> returnA -< ()

data IkeaGesture
  = ShortClick
  | ShortRelease
  | DoubleClick
  | LongClick
  deriving Show
data IkeaButton a = OnButton !a | OffButton !a
  deriving Show


toIkeaQuickButton :: T.Text -> Maybe (IkeaButton IkeaGesture)
toIkeaQuickButton = \case
  -- 1 is on, 2 is off side of the button
  "1_initial_press" -> Just $ OnButton ShortClick
  "1_short_release" -> Just $ OnButton ShortRelease
  "1_double_press" -> Just $ OnButton DoubleClick
  "1_long_press" -> Just $ OnButton LongClick
  "2_initial_press" -> Just $ OffButton ShortClick
  "2_short_release" -> Just $ OffButton ShortRelease
  "2_double_press" -> Just $ OffButton DoubleClick
  "2_long_press" -> Just $ OffButton LongClick
  _ -> Nothing

ikeaQuickButton :: T.Text -> HASS (Event Value) (Event (IkeaButton IkeaGesture))
ikeaQuickButton entityId =
  entityChangeEvent' entityId
  >>| arr (maybe (Left ()) Right . eventType)
  >>> toEvent
  where
    eventType v = v ^? key "event" . key "variables" . key "trigger" . key "to_state" . key "attributes" . key "event_type" . _String . to toIkeaQuickButton . traversed


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


bedroomButton :: HASS (Event Value) (Event BedroomControls)
bedroomButton = (masseButton &&& enishenButton) >>> arr (uncurry lMerge)
  where
    masseButton = fmap Masse <$> ikeaQuickButton "event.bedroom_quick_remote_masse_action"
    enishenButton = fmap Enishen <$> ikeaQuickButton "event.bedroom_quick_jemina_action"

bedroomButtonController :: HASS (Event Value) ()
bedroomButtonController = proc x -> do
  ev <- bedroomButton >>> traceEvent -< x
  case ev of
       Event (Masse (OnButton ShortRelease)) -> callService (activateScene "scene.makuuhuone_masse") -< ()
       Event (Masse (OnButton DoubleClick)) -> callService (activateScene "scene.makuuhuone_keski") -< ()
       Event (Masse (OnButton LongClick)) -> callService (activateScene "scene.makuuhuone_kirkas") -< ()
       Event (Masse (OffButton _)) -> callService (light [AreaId "makuuhuone"] False) -< ()
       Event (Enishen (OnButton ShortRelease)) -> callService (activateScene "scene.makuuhuone_jemina") -< ()
       Event (Enishen (OnButton DoubleClick)) -> callService (activateScene "scene.makuuhuone_keski") -< ()
       Event (Enishen (OnButton LongClick)) -> callService (activateScene "scene.makuuhuone_kirkas") -< ()
       Event (Enishen (OffButton _)) -> callService (light [AreaId "makuuhuone"] False) -< ()
       _ -> returnA -< ()



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
  >>> traceEvent

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"]
      }