Fix ikea buttons
This commit is contained in:
@@ -48,28 +48,30 @@ bedroomPresenceController = proc x -> do
|
|||||||
Event Occupied -> callService (activateScene "makuuhuone_lights_snapshot") -< ()
|
Event Occupied -> callService (activateScene "makuuhuone_lights_snapshot") -< ()
|
||||||
_ -> returnA -< ()
|
_ -> returnA -< ()
|
||||||
|
|
||||||
-- Ikea quick buttons are identified by different event types
|
data IkeaGesture
|
||||||
data IkeaQuickButton
|
= ShortClick
|
||||||
= ShortClickOn
|
| ShortRelease
|
||||||
| DoubleClickOn
|
| DoubleClick
|
||||||
| LongClickOn
|
| LongClick
|
||||||
| ShortClickOff
|
deriving Show
|
||||||
| DoubleClickOff
|
data IkeaButton a = OnButton !a | OffButton !a
|
||||||
| LongClickOff
|
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
|
|
||||||
toIkeaQuickButton :: T.Text -> Maybe IkeaQuickButton
|
toIkeaQuickButton :: T.Text -> Maybe (IkeaButton IkeaGesture)
|
||||||
toIkeaQuickButton = \case
|
toIkeaQuickButton = \case
|
||||||
"1_initial_press" -> Just ShortClickOn
|
-- 1 is on, 2 is off side of the button
|
||||||
"1_double_press" -> Just DoubleClickOn
|
"1_initial_press" -> Just $ OnButton ShortClick
|
||||||
"1_long_press" -> Just LongClickOn
|
"1_short_release" -> Just $ OnButton ShortRelease
|
||||||
"2_initial_press" -> Just ShortClickOff
|
"1_double_press" -> Just $ OnButton DoubleClick
|
||||||
"2_double_press" -> Just DoubleClickOff
|
"1_long_press" -> Just $ OnButton LongClick
|
||||||
"2_long_press" -> Just LongClickOff
|
"2_initial_press" -> Just $ OffButton ShortClick
|
||||||
|
"2_short_release" -> Just $ OffButton ShortRelease
|
||||||
|
"2_double_press" -> Just $ OffButton DoubleClick
|
||||||
|
"2_long_press" -> Just $ OffButton LongClick
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
ikeaQuickButton :: T.Text -> HASS (Event Value) (Event IkeaQuickButton)
|
ikeaQuickButton :: T.Text -> HASS (Event Value) (Event (IkeaButton IkeaGesture))
|
||||||
ikeaQuickButton entityId =
|
ikeaQuickButton entityId =
|
||||||
entityChangeEvent' entityId
|
entityChangeEvent' entityId
|
||||||
>>| arr (maybe (Left ()) Right . eventType)
|
>>| arr (maybe (Left ()) Right . eventType)
|
||||||
@@ -79,8 +81,8 @@ ikeaQuickButton entityId =
|
|||||||
|
|
||||||
|
|
||||||
data BedroomControls
|
data BedroomControls
|
||||||
= Masse IkeaQuickButton
|
= Masse (IkeaButton IkeaGesture)
|
||||||
| Enishen IkeaQuickButton
|
| Enishen (IkeaButton IkeaGesture)
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
|
|
||||||
@@ -94,12 +96,12 @@ bedroomButtonController :: HASS (Event Value) ()
|
|||||||
bedroomButtonController = proc x -> do
|
bedroomButtonController = proc x -> do
|
||||||
ev <- bedroomButton >>> traceEvent -< x
|
ev <- bedroomButton >>> traceEvent -< x
|
||||||
case ev of
|
case ev of
|
||||||
Event (Masse ShortClickOn) -> callService (activateScene "scene.makuuhuone_masse") -< () -- this should be on release
|
Event (Masse (OnButton ShortRelease)) -> callService (activateScene "scene.makuuhuone_masse") -< () -- this should be on release
|
||||||
Event (Masse DoubleClickOn) -> callService (activateScene "scene.makuuhuone_keski") -< ()
|
Event (Masse (OnButton DoubleClick)) -> callService (activateScene "scene.makuuhuone_keski") -< ()
|
||||||
Event (Masse LongClickOn) -> callService (activateScene "scene.makuuhuone_kirkas") -< ()
|
Event (Masse (OnButton LongClick)) -> callService (activateScene "scene.makuuhuone_kirkas") -< ()
|
||||||
Event (Enishen ShortClickOn) -> callService (activateScene "scene.makuuhuone_jemina") -< ()
|
Event (Enishen (OnButton ShortRelease)) -> callService (activateScene "scene.makuuhuone_jemina") -< ()
|
||||||
Event (Enishen DoubleClickOn) -> callService (activateScene "scene.makuuhuone_keski") -< ()
|
Event (Enishen (OnButton DoubleClick)) -> callService (activateScene "scene.makuuhuone_keski") -< ()
|
||||||
Event (Enishen LongClickOn) -> callService (activateScene "scene.makuuhuone_kirkas") -< ()
|
Event (Enishen (OnButton LongClick)) -> callService (activateScene "scene.makuuhuone_kirkas") -< ()
|
||||||
_ -> returnA -< ()
|
_ -> returnA -< ()
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user