IKEA buttons

src/HomeAssistant/Controller/Bedroom.hs

@@ -4,9 +4,12 @@ module HomeAssistant.Controller.Bedroom where
 
 import HomeAssistant.Controller
 import qualified Data.Text as T
-import AFRP (Event (..))
+import AFRP (Event (..), (>>|), toEvent, lMerge)
 import Data.Aeson (Value, object, (.=))
-import Control.Arrow ((>>>), returnA)
+import Control.Arrow ((>>>), returnA, arr, ArrowChoice (..), Arrow (..))
+import Control.Lens ((^?), to, traversed)
+import Data.Aeson.Lens (key, _String)
+import qualified Data.Text.Lens as TL
 
 
 
@@ -45,3 +48,54 @@ bedroomPresenceController = proc x -> do
        Event Occupied -> callService (activateScene "makuuhuone_lights_snapshot") -< ()
        _ -> returnA -< ()
 
+-- Ikea quick buttons are identified by different event types
+data IkeaQuickButton
+  = ShortClickOn
+  | DoubleClickOn
+  | LongClickOn
+  | ShortClickOff
+  | DoubleClickOff
+  | LongClickOff
+
+
+toIkeaQuickButton :: T.Text -> Maybe IkeaQuickButton
+toIkeaQuickButton = \case
+  "1_initial_press" -> Just ShortClickOn
+  "1_double_press" -> Just DoubleClickOn
+  "1_long_press" -> Just LongClickOn
+  "2_initial_press" -> Just ShortClickOff
+  "2_double_press" -> Just DoubleClickOff
+  "2_long_press" -> Just LongClickOff
+  _ -> Nothing
+
+ikeaQuickButton :: T.Text -> HASS (Event Value) (Event IkeaQuickButton)
+ikeaQuickButton entityId =
+  entityChangeEvent' entityId
+  >>| arr (maybe (Left ()) Right . eventType)
+  >>> toEvent
+  where
+    eventType v = v ^? key "event" . key "data" . key "new_state" . key "state" . _String . to toIkeaQuickButton . traversed
+
+
+data BedroomControls
+  = Masse IkeaQuickButton
+  | Enishen IkeaQuickButton
+
+
+bedroomButton :: HASS (Event Value) (Event BedroomControls)
+bedroomButton = (masseButton &&& enishenButton) >>> arr (uncurry lMerge)
+  where
+    masseButton = fmap Masse <$> ikeaQuickButton "event.bedroom_quick_remote_masse_action"
+    enishenButton = fmap Enishen <$> ikeaQuickButton "event.bedroom_quick_remote_jemina_action"
+
+bedroomButtonController :: HASS (Event Value) ()
+bedroomButtonController = proc x -> do
+  ev <- bedroomButton -< x
+  case ev of
+       Event (Masse ShortClickOn) -> callService (activateScene "scene.makuuhuone_masse") -< ()
+       Event (Masse DoubleClickOn) -> callService (activateScene "scene.makuuhuone_keski") -< ()
+       Event (Masse LongClickOn) -> callService (activateScene "scene.makuuhuone_kirkas") -< ()
+       Event (Enishen ShortClickOn) -> callService (activateScene "scene.makuuhuone_jemina") -< ()
+       Event (Enishen DoubleClickOn) -> callService (activateScene "scene.makuuhuone_keski") -< ()
+       Event (Enishen LongClickOn) -> callService (activateScene "scene.makuuhuone_kirkas") -< ()
+       _ -> returnA -< ()