Quick buttons

src/HomeAssistant/Controller/Children.hs

@@ -1,13 +1,14 @@
 {-# LANGUAGE Arrows #-}
 {-# LANGUAGE OverloadedStrings #-}
 module HomeAssistant.Controller.Children where
-import HomeAssistant.Controller (HASS, callService, Target (AreaId), light, Light(..))
-import AFRP (Event)
+import HomeAssistant.Controller (HASS, callService, Target (AreaId), light, Light(..), ikeaQuickButton, IkeaGesture (..), IkeaButton (..), traceEvent, activateScene)
+import AFRP (Event (..))
 import qualified AFRP
-import Control.Arrow (Arrow(..), (>>>))
+import Control.Arrow (Arrow(..), (>>>), returnA)
 import Data.Time (Day, TimeOfDay (..), localDay, LocalTime (..))
 import Data.Time.Calendar.OrdinalDate (WeekOfYear, mondayStartWeek)
 import Data.Functor.Contravariant (Predicate (..), (>$<))
+import Data.Aeson (Value)
 
 -- Let's see building some reasonable interface for utctime
 dow :: Day -> (WeekOfYear, Int)
@@ -80,3 +81,17 @@ lightsOn = foldMap atTime timersOn
 lightsOff :: HASS a ()
 lightsOff = foldMap atTime timersOff
   >>> AFRP.onEvent (callService (light [AreaId "lasten_makuuhuone"] Off))
+
+
+bedroomButton :: HASS   (Event Value) (Event (IkeaButton IkeaGesture))
+bedroomButton = ikeaQuickButton "event.children_quick_remote_action"
+
+childrenBedroomButtonController :: HASS (Event Value) ()
+childrenBedroomButtonController = proc x -> do
+  ev <- bedroomButton >>> traceEvent -< x
+  case ev of
+       Event (OnButton ShortRelease) -> callService (activateScene "scene.lasten_nukkuvalmistelu") -< ()
+       Event (OnButton DoubleClick) -> callService (activateScene "scene.lasten_luku") -< ()
+       Event (OnButton LongClick) -> callService (activateScene "scene.lasten_kirkas") -< ()
+       Event (OffButton _) -> callService (light [AreaId "lasten_makuuhuone"] Off) -< ()
+       _ -> returnA -< ()