{-# LANGUAGE Arrows #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs #-}

module HomeAssistant.Controller
  ( Service(..)
  , HASSEff(..)
  , HASS
  , callService
  , entityChangeEvent
  , entityChangeEvent'
  , entityRead
  , entityRead'
  , entityBool
  , entityBool'
  , Ruuvi(..)
  , ruuvi
  , ruuviTemperatures
  , ruuviPressures
  , DoorState(..)
  , door
  , light
  , lightController
  , bedroomPresenceController
  ) where

import AFRP (Mealy, eff, Event(..), hold, events, changes, filterA, (>>|), toEvent)
import Control.Arrow (Arrow(..), returnA)
import Control.Category ((>>>))
import Data.Aeson (Value, object, (.=))
import qualified Data.Text as T
import Control.Lens (has, only, (^?), to)
import Data.Aeson.Lens (key, _String)
import qualified Data.Text.Lens as TL
import Data.Bool (bool)

data Service = Service
  { serviceDomain :: T.Text
  , serviceName :: T.Text
  , serviceData :: Maybe Value
  , serviceTarget :: [T.Text]
  }
  deriving (Show, Eq)

data HASSEff a where
  CallService :: Service -> HASSEff ()

type HASS a b = Mealy HASSEff a b

callService :: Service -> HASS a ()
callService service = eff (\_ -> CallService service)

ruuviTemperatures :: Mealy eff (Event Value) Double
ruuviTemperatures = entityRead @Double "sensor.ruuvitag_b168_temperature" >>> hold 0

ruuviPressures :: Mealy eff (Event Value) Double
ruuviPressures = entityRead "sensor.ruuvitag_b168_pressure" >>> hold 0

data Ruuvi = Ruuvi { ruuviTemperature :: Double, ruuviPressure :: Double }
            deriving (Show, Eq)

ruuvi :: Mealy eff (Event Value) (Event Ruuvi)
ruuvi = (Ruuvi <$> ruuviTemperatures <*> ruuviPressures) >>> changes

data DoorState = Open | Closed
  deriving (Show, Eq)

data Presence = Occupied | Unoccupied
  deriving (Show, Eq)

presence :: T.Text -> HASS (Event Value) (Event Presence)
presence entityId =entityBool entityId
  >>> arr (fmap (bool Unoccupied Occupied))

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= [] -- bedroomLights
  }


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 -< ()


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

-- Turn off lights when door is closed
light :: [T.Text] -> Bool -> Service
light entityIds b = Service
  { serviceDomain="light"
  , serviceName= bool "turn_off" "turn_on" b
  , serviceData=Nothing
  , serviceTarget=entityIds
  }

lightController :: HASS (Event Value) (Event DoorState)
lightController = proc ev -> do
  doorState <- door -< ev
  case doorState of
       Event Open -> callService (light ["light.bedroom_masse"] False) -< ()
       Event Closed -> callService (light ["light.bedroom_masse"] True) -< ()
       _ -> returnA -< ()
  returnA -< doorState

entityChangeEvent :: T.Text -> Mealy eff (Event Value) (Event Value)
entityChangeEvent entityId = entityChangeEvent' entityId >>> toEvent

entityChangeEvent' :: T.Text -> Mealy eff (Event Value) (Either () Value)
entityChangeEvent' entityId = events >>| filterA isEntity
  where
    isEntity :: Value -> Bool
    isEntity = has (key "event" . key "data" . key "entity_id" . _String . only entityId)

entityRead' :: (Read a) => T.Text -> Mealy eff (Event Value) (Either () a)
entityRead' entityId = entityChangeEvent' entityId >>| (arr state >>> arr (maybe (Left ()) Right))
  where
    state v = v ^? key "event" . key "data" . key "new_state" . key "state" . _String . TL.unpacked . to read

entityBool' :: T.Text -> Mealy eff (Event Value) (Either () Bool)
entityBool' entityId = entityChangeEvent' entityId >>| (arr state >>> arr (maybe (Left ()) Right))
  where
    state v = v ^? key "event" . key "data" . key "new_state" . key "state" . _String . TL.unpacked . to toBool
    toBool = \case
      "on" -> True
      "off" -> False
      _ -> False

entityRead :: (Read a) => T.Text -> Mealy eff (Event Value) (Event a)
entityRead entityId = entityRead' entityId >>> toEvent

entityBool :: T.Text -> Mealy eff (Event Value) (Event Bool)
entityBool entityId = entityBool' entityId >>> toEvent