Untested three-state for dinner table

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