From d1bdd2eb67e5a0ef2b74012093b18297e804a603 Mon Sep 17 00:00:00 2001 From: Mats Rauhala Date: Tue, 15 Sep 2026 10:49:12 +0300 Subject: [PATCH] Dinner presence --- src/HomeAssistant/Controller/Kitchen.hs | 31 +++++++++++++++++++++++-- 1 file changed, 29 insertions(+), 2 deletions(-) diff --git a/src/HomeAssistant/Controller/Kitchen.hs b/src/HomeAssistant/Controller/Kitchen.hs index dcd49c3..8b78189 100644 --- a/src/HomeAssistant/Controller/Kitchen.hs +++ b/src/HomeAssistant/Controller/Kitchen.hs @@ -45,8 +45,8 @@ eventLights = AFRP.changes >>> arr (fmap presenceLights) presenceLights Occupied = LightsOn presenceLights Unoccupied = LightsOff -kitchenMotionController :: HASS (Event Value) () -kitchenMotionController = proc x -> do +kitchenCeilingController :: HASS (Event Value) () +kitchenCeilingController = proc x -> do now <- AFRP.currentTime -< () p <- kitchenMotion >>> kitchenPresence -< x ev <- eventLights -< p @@ -57,3 +57,30 @@ kitchenMotionController = proc x -> do _ -> 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 + >>> AFRP.changes + >>> arr (fmap (bool LightsOff LightsOn)) + where + -- This means that both light level and occupancy can change the light state + lightWanted (lightLevel, occ) = occ == Occupied && lightLevel < 13 + +dinnerTableController :: HASS (Event Value) () +dinnerTableController = proc x -> do + ev <- dinnerLightEvents -< x + case ev of + Event LightsOn -> callServiceDyn (light [EntityId "light.kitchen_dining_large"]) -< On Nothing + Event LightsOff -> callServiceDyn (light [EntityId "light.kitchen_dining_large"]) -< Off + _ -> returnA -< () + +kitchenMotionController :: HASS (Event Value) () +kitchenMotionController = kitchenCeilingController <> dinnerTableController