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

import HomeAssistant.Controller
import qualified Data.Text as T
import AFRP (Event (..), (>>|), toEvent, lMerge)
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)



bedroomLights :: [T.Text]
bedroomLights = ["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" .= bedroomLights
      ]
  , serviceTarget= []
  }


activateScene :: T.Text -> Service
activateScene sceneId = Service
  { serviceDomain="scene"
  , serviceName= "turn_on"
  , serviceTarget= [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 "data" . key "new_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") -< () -- this should be on release
       Event (Masse (OnButton DoubleClick)) -> callService (activateScene "scene.makuuhuone_keski") -< ()
       Event (Masse (OnButton LongClick)) -> callService (activateScene "scene.makuuhuone_kirkas") -< ()
       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") -< ()
       _ -> 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 -< x
  case st of
       Event Open -> callService (switch [entity] True) -< ()
       Event Closed -> callService (switch [entity] False) -< ()
       _ -> returnA -< ()
  where
    entity = "bedroom_drawer_light_masse"