Sleep mode in the bedroom

src/HomeAssistant/Controller.hs

@@ -32,6 +32,8 @@ module HomeAssistant.Controller
   , IkeaButton(..)
   , IkeaGesture(..)
   , activateScene
+  , ikeaBoxRemote
+  , IkeaController(..)
   ) where
 
 import AFRP (Mealy (..), eff, Event(..), events, filterA, (>>|), toEvent, Request, hold, lMerge, waitFor, tag, edge)
@@ -228,6 +230,34 @@ ikeaQuickButton entityId =
   where
     eventType v = v ^? key "event" . key "variables" . key "trigger" . key "to_state" . key "attributes" . key "event_type" . _String . to toIkeaQuickButton . traversed
 
+data IkeaController
+  = ControllerOn -- Short press on
+  | ControllerOff -- Short press off
+  | ControllerBrighnessUp -- Turn brightness up
+  | ControllerBrighnessDown -- Turn brighness down
+  | ControllerArrowRight -- Turn brighness down
+  | ControllerArrowLeft -- Turn brighness down
+  | ControllerBrighnessStop
+  deriving Show
+
+toIkeaController :: T.Text -> Maybe IkeaController
+toIkeaController = \case
+  "on" -> Just ControllerOn
+  "off" -> Just ControllerOff
+  "brightness_move_up" -> Just ControllerBrighnessUp
+  "brightness_move_down" -> Just ControllerBrighnessDown
+  "brightness_stop" -> Just ControllerBrighnessStop
+  "arrow_right_click" -> Just ControllerArrowRight
+  "arrow_left_click" -> Just ControllerArrowLeft
+  _ -> Nothing
+
+ikeaBoxRemote :: T.Text -> HASS (Event Value) (Event IkeaController)
+ikeaBoxRemote entityId = entityChangeEvent' entityId
+  >>| arr (maybe (Left ()) Right . eventType)
+  >>> toEvent
+  where
+    eventType v = v ^? key "event" . key "variables" . key "trigger" . key "to_state" . key "attributes" . key "event_type" . _String . to toIkeaController . traversed
+
 activateScene :: T.Text -> Service
 activateScene sceneId = Service
   { serviceDomain="scene"

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"] )