{-# 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
  ) where

import AFRP (Mealy, eff, Event(..), hold, events, changes, filterA, (>>|), toEvent)
import Control.Arrow (Arrow(..), returnA)
import Control.Category ((>>>))
import Data.Aeson (Value)
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

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

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)

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 :: Bool -> Service
light b = Service
  { serviceDomain="light"
  , serviceName= bool "turn_off" "turn_on" b
  , serviceData=Nothing
  , serviceTarget="light.bedroom_masse"
  }

lightController :: HASS (Event Value) (Event DoorState)
lightController = proc ev -> do
  doorState <- door -< ev
  case doorState of
       Event Open -> callService (light False) -< ()
       Event Closed -> callService (light 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