88 lines
2.9 KiB
Haskell
88 lines
2.9 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE Arrows #-}
|
|
module HomeAssistant.Controller.Kitchen where
|
|
import HomeAssistant.Controller
|
|
import AFRP (Event (..))
|
|
import qualified AFRP
|
|
import Data.Aeson (Value)
|
|
import Control.Arrow ((>>>), Arrow (..), returnA)
|
|
import Prelude hiding (id)
|
|
import Data.Time (LocalTime(..), TimeOfDay (..))
|
|
|
|
|
|
-- Kitchen has two "presence" sensors. One IKEA motion sensor and one SwitchBot presence sensor
|
|
|
|
data Lights = LightsOn | LightsOff | LightsSleep
|
|
deriving (Show)
|
|
|
|
kitchenPresence :: HASS (Event Value) Presence
|
|
kitchenPresence = motion "binary_sensor.kitchen_movement_occupancy" >>> motionToPresence 500
|
|
|
|
eventLights :: HASS Presence (Event Lights)
|
|
eventLights = AFRP.changes >>> arr (fmap presenceLights)
|
|
where
|
|
presenceLights Occupied = LightsOn
|
|
presenceLights Unoccupied = LightsOff
|
|
|
|
kitchenCeilingController :: HASS (Event Value) ()
|
|
kitchenCeilingController = proc x -> do
|
|
now <- AFRP.currentTime -< ()
|
|
p <- kitchenPresence -< x
|
|
ev <- eventLights -< p
|
|
traceEvent -< ev
|
|
case ev of
|
|
Event LightsOn | lightsAllowed now -> callServiceDyn (light [EntityId "light.kitchen_ceiling"]) -< On Nothing
|
|
Event LightsOff -> callServiceDyn (light [EntityId "light.kitchen_ceiling"]) -< Off
|
|
_ -> returnA -< ()
|
|
where
|
|
lightsAllowed (LocalTime _ tod) = not (tod > TimeOfDay 1 45 0 && tod < TimeOfDay 5 0 0)
|
|
|
|
|
|
dinnerLightLevel :: HASS (Event Value) Int
|
|
dinnerLightLevel = entityRead "sensor.sijainti_keittio_light_level" >>> AFRP.hold 0
|
|
|
|
dinnerPresence :: HASS (Event Value) Presence
|
|
dinnerPresence = presence "binary_sensor.sijainti_keittio_occupancy" >>> AFRP.hold Unoccupied
|
|
|
|
dinnerLightEvents :: HASS (Event Value) (Event Lights)
|
|
dinnerLightEvents =
|
|
((,) <$> dinnerLightLevel <*> dinnerPresence)
|
|
>>> arr lightWanted
|
|
>>> (sleepEvent &&& offEvent &&& onEvent)
|
|
>>> arr (\(s, (o, n)) -> s `AFRP.lMerge` o `AFRP.lMerge` n)
|
|
where
|
|
lightWanted (lightLevel, occ) = occ == Occupied && lightLevel < 13
|
|
|
|
onEvent =
|
|
AFRP.edge
|
|
>>> arr (fmap (const LightsOn))
|
|
|
|
sleepEvent =
|
|
arr not
|
|
>>> AFRP.edge
|
|
>>> arr (fmap (const LightsSleep))
|
|
|
|
offEvent =
|
|
arr not
|
|
>>> AFRP.waitFor 300
|
|
>>> arr (fmap (const LightsOff))
|
|
|
|
dinnerTableController :: HASS (Event Value) ()
|
|
dinnerTableController = proc x -> do
|
|
ev <- dinnerLightEvents -< x
|
|
case ev of
|
|
Event LightsOn -> do
|
|
sleep -< False
|
|
callServiceDyn (light [EntityId "light.kitchen_dining_large"]) -< On Nothing
|
|
Event LightsOff -> do
|
|
sleep -< False
|
|
callServiceDyn (light [EntityId "light.kitchen_dining_large"]) -< Off
|
|
Event LightsSleep -> do
|
|
sleep -< True
|
|
_ -> returnA -< ()
|
|
where
|
|
sleep = callServiceDyn (switch [EntityId "switch.adaptive_lighting_ruokapoydan_valot_sleep_mode"])
|
|
|
|
kitchenMotionController :: HASS (Event Value) ()
|
|
kitchenMotionController = kitchenCeilingController <> dinnerTableController
|