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"