diff --git a/src/HomeAssistant/Controller/Kitchen.hs b/src/HomeAssistant/Controller/Kitchen.hs index 948f832..3882823 100644 --- a/src/HomeAssistant/Controller/Kitchen.hs +++ b/src/HomeAssistant/Controller/Kitchen.hs @@ -6,14 +6,13 @@ import AFRP (Event (..)) import qualified AFRP import Data.Aeson (Value) import Control.Arrow ((>>>), Arrow (..), returnA) -import Data.Bool (bool) 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 +data Lights = LightsOn | LightsOff | LightsSleep deriving (Show) kitchenPresence :: HASS (Event Value) Presence @@ -46,21 +45,43 @@ dinnerPresence :: HASS (Event Value) Presence dinnerPresence = presence "binary_sensor.sijainti_keittio_occupancy" >>> AFRP.hold Unoccupied dinnerLightEvents :: HASS (Event Value) (Event Lights) -dinnerLightEvents = ((,) <$> dinnerLightLevel <*> dinnerPresence) +dinnerLightEvents = + ((,) <$> dinnerLightLevel <*> dinnerPresence) >>> arr lightWanted - >>> AFRP.changes - >>> arr (fmap (bool LightsOff LightsOn)) + >>> (sleepEvent &&& offEvent &&& onEvent) + >>> arr (\(s, (o, n)) -> s `AFRP.lMerge` o `AFRP.lMerge` n) where - -- This means that both light level and occupancy can change the light state 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 -> callServiceDyn (light [EntityId "light.kitchen_dining_large"]) -< On Nothing - Event LightsOff -> callServiceDyn (light [EntityId "light.kitchen_dining_large"]) -< Off + 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