diff --git a/src/HomeAssistant/Controller.hs b/src/HomeAssistant/Controller.hs index 6bbdc4c..7c65cd4 100644 --- a/src/HomeAssistant/Controller.hs +++ b/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" diff --git a/src/HomeAssistant/Controller/Bedroom.hs b/src/HomeAssistant/Controller/Bedroom.hs index 0a78f17..9725afe 100644 --- a/src/HomeAssistant/Controller/Bedroom.hs +++ b/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"] )