Sleep mode in the bedroom

src/HomeAssistant/Controller/Bedroom.hs

@@ -27,37 +27,68 @@ createBedroomScene = Service
   , serviceTarget= []
   }
 
-
+data PresenceLights
+  = LightsOn -- Restore lights
+  | LightsOff -- Timer expired, darkness
+  | LightsSleep -- No presence detected, sleep mode
+  deriving Show
 
 -- Bedroom presence
 bedroomPresence :: HASS (Event Value) (Event Presence)
 bedroomPresence = presence "binary_sensor.presence_sensor_bedroom_occupancy"
 
+presenceLightEvents :: HASS (Event Value) (Event PresenceLights)
+presenceLightEvents =
+  bedroomPresence >>> AFRP.hold Unoccupied
+  >>> arr lightWanted
+  >>> (sleepEvent &&& offEvent &&& onEvent)
+  >>> arr (\(s,(o,n)) -> s `AFRP.lMerge` o `AFRP.lMerge` n)
+  where
+    lightWanted o = o == Occupied
+    sleepEvent = arr not >>> AFRP.edge >>> arr (AFRP.tag LightsSleep)
+    onEvent = AFRP.edge >>> arr (AFRP.tag LightsOn)
+    offEvent = arr not >>> AFRP.waitFor 300 >>> arr (AFRP.tag LightsOff)
+
 bedroomPresenceController :: HASS (Event Value) ()
 bedroomPresenceController = proc x -> do
-  p <- bedroomPresence >>> traceEvent -< x
+  p <- presenceLightEvents >>> traceEvent -< x
   case p of
-       Event Unoccupied -> callService createBedroomScene >>> callService (light bedroomLights Off) -< ()
-       Event Occupied -> callService (activateScene "scene.makuuhuone_lights_snapshot") -< ()
+       Event LightsOff -> do
+         callService (light bedroomLights Off) -< ()
+       Event LightsOn -> do
+         sleepMode -< False
+         callService (activateScene "scene.makuuhuone_lights_snapshot") -< ()
+       Event LightsSleep -> do
+         callService createBedroomScene -< ()
+         sleepMode -< True
        _ -> returnA -< ()
 
+  where
+    sleepMode = callServiceDyn (switch [EntityId "switch.adaptive_lighting_makuuhuoneen_valot_sleep_mode"] )
 
 
 data BedroomControls
   = Masse (IkeaButton IkeaGesture)
   | Enishen (IkeaButton IkeaGesture)
+  | Central IkeaController
   deriving Show
 
 
 bedroomButton :: HASS (Event Value) (Event BedroomControls)
-bedroomButton = (masseButton &&& enishenButton) >>> arr (uncurry lMerge)
+bedroomButton = (masseButton &&& enishenButton &&& centralButton)
+  >>> arr (\(a,(b,c)) -> a `lMerge` b `lMerge` c)
   where
     masseButton = fmap Masse <$> ikeaQuickButton "event.bedroom_quick_remote_masse_action"
     enishenButton = fmap Enishen <$> ikeaQuickButton "event.bedroom_quick_jemina_action"
+    centralButton = fmap Central <$> ikeaBoxRemote "event.bedroom_remote_action"
 
 bedroomButtonController :: HASS (Event Value) ()
 bedroomButtonController = proc x -> do
   ev <- bedroomButton >>> traceEvent -< x
+  -- Any event will cause the sleep mode to be turned off
+  case ev of
+       Event _ -> sleepMode -< False
+       _ -> returnA -< ()
   case ev of
        Event (Masse (OnButton ShortRelease)) -> callService (activateScene "scene.makuuhuone_masse") -< ()
        Event (Masse (OnButton DoubleClick)) -> callService (activateScene "scene.makuuhuone_keski") -< ()
@@ -68,6 +99,8 @@ bedroomButtonController = proc x -> do
        Event (Enishen (OnButton LongClick)) -> callService (activateScene "scene.makuuhuone_kirkas") -< ()
        Event (Enishen (OffButton _)) -> callService (light [AreaId "makuuhuone"] Off) -< ()
        _ -> returnA -< ()
+  where
+    sleepMode = callServiceDyn (switch [EntityId "switch.adaptive_lighting_makuuhuoneen_valot_sleep_mode"] )