80 lines
2.7 KiB
Haskell
80 lines
2.7 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 (..))
|
|
import Data.Default (def)
|
|
|
|
|
|
-- Kitchen has two "presence" sensors. One IKEA motion sensor and one SwitchBot presence sensor
|
|
|
|
kitchenPresence :: HASS (Event Value) Presence
|
|
kitchenPresence = motion "binary_sensor.kitchen_movement_occupancy" >>> motionToPresence 500
|
|
|
|
kitchenCeilingController :: HASS (Event Value) ()
|
|
kitchenCeilingController = proc x -> do
|
|
now <- AFRP.currentTime -< ()
|
|
p <- kitchenPresence -< x
|
|
ev <- lightingModeEvents -< p
|
|
traceEvent -< ev
|
|
case ev of
|
|
Event LightingOn | lightsAllowed now -> callServiceDyn (light [EntityId "light.kitchen_ceiling"]) -< On def
|
|
Event LightingOff -> 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 LightingMode)
|
|
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 LightingOn))
|
|
|
|
sleepEvent =
|
|
arr not
|
|
>>> AFRP.edge
|
|
>>> arr (fmap (const LightingSleep))
|
|
|
|
offEvent =
|
|
arr not
|
|
>>> AFRP.waitFor 300
|
|
>>> arr (fmap (const LightingOff))
|
|
|
|
dinnerTableController :: HASS (Event Value) ()
|
|
dinnerTableController = proc x -> do
|
|
ev <- dinnerLightEvents -< x
|
|
case ev of
|
|
Event LightingOn -> do
|
|
sleep -< False
|
|
callServiceDyn (light [EntityId "light.kitchen_dining_large"]) -< On def
|
|
Event LightingOff -> do
|
|
sleep -< False
|
|
callServiceDyn (light [EntityId "light.kitchen_dining_large"]) -< Off
|
|
Event LightingSleep -> do
|
|
sleep -< True
|
|
_ -> returnA -< ()
|
|
where
|
|
sleep = callServiceDyn (switchService [EntityId "switch.adaptive_lighting_ruokapoydan_valot_sleep_mode"])
|
|
|
|
kitchenMotionController :: HASS (Event Value) ()
|
|
kitchenMotionController = kitchenCeilingController <> dinnerTableController
|