From d31a6d893e037f1fe1d0ed44a3cb9de2d82ca324 Mon Sep 17 00:00:00 2001 From: Mats Rauhala Date: Fri, 21 Aug 2026 09:32:31 +0300 Subject: [PATCH] Support for areas --- src/HomeAssistant/Controller.hs | 22 +++++++++++++--------- src/HomeAssistant/Controller/Bedroom.hs | 12 +++++++----- src/HomeAssistant/Runtime/Connection.hs | 5 +++-- 3 files changed, 23 insertions(+), 16 deletions(-) diff --git a/src/HomeAssistant/Controller.hs b/src/HomeAssistant/Controller.hs index 2b9cc9b..522f817 100644 --- a/src/HomeAssistant/Controller.hs +++ b/src/HomeAssistant/Controller.hs @@ -27,6 +27,7 @@ module HomeAssistant.Controller , debug , traceEvent , switch + , Target(..) ) where import AFRP (Mealy (..), eff, Event(..), hold, events, changes, filterA, (>>|), toEvent, Request) @@ -39,11 +40,14 @@ import Data.Aeson.Lens (key, _String) import qualified Data.Text.Lens as TL import Data.Bool (bool) +data Target = EntityId !T.Text | AreaId !T.Text + deriving (Show,Eq) + data Service = Service { serviceDomain :: T.Text , serviceName :: T.Text , serviceData :: Maybe Value - , serviceTarget :: [T.Text] + , serviceTarget :: [Target] } deriving (Show, Eq) @@ -98,29 +102,29 @@ door = entityBool "binary_sensor.makuuhuone_ovi_contact" >>> changes -- Turn off lights when door is closed -light :: [T.Text] -> Bool -> Service -light entityIds b = Service +light :: [Target] -> Bool -> Service +light targets b = Service { serviceDomain="light" , serviceName= bool "turn_off" "turn_on" b , serviceData=Nothing - , serviceTarget=entityIds + , serviceTarget=targets } -- Name conflict with AFRP -switch :: [T.Text] -> Bool -> Service -switch entityIds b = Service +switch :: [Target] -> Bool -> Service +switch targets b = Service { serviceDomain="switch" , serviceName= bool "turn_off" "turn_on" b , serviceData=Nothing - , serviceTarget=entityIds + , serviceTarget=targets } lightController :: HASS (Event Value) (Event DoorState) lightController = proc ev -> do doorState <- door -< ev case doorState of - Event Open -> callService (light ["light.bedroom_masse"] False) -< () - Event Closed -> callService (light ["light.bedroom_masse"] True) -< () + Event Open -> callService (light [EntityId "light.bedroom_masse"] False) -< () + Event Closed -> callService (light [EntityId "light.bedroom_masse"] True) -< () _ -> returnA -< () returnA -< doorState diff --git a/src/HomeAssistant/Controller/Bedroom.hs b/src/HomeAssistant/Controller/Bedroom.hs index 2295312..b8e3a27 100644 --- a/src/HomeAssistant/Controller/Bedroom.hs +++ b/src/HomeAssistant/Controller/Bedroom.hs @@ -13,8 +13,8 @@ import Data.Bool (bool) -bedroomLights :: [T.Text] -bedroomLights = ["light.bedroom_masse","light.bedroom_jemina","light.bedroom_ceiling","light.bedroom_led_switch"] +bedroomLights :: [Target] +bedroomLights = map EntityId ["light.bedroom_masse","light.bedroom_jemina","light.bedroom_ceiling","light.bedroom_led_switch"] createBedroomScene :: Service createBedroomScene = Service @@ -22,7 +22,7 @@ createBedroomScene = Service , serviceName= "create" , serviceData= Just $ object [ "scene_id" .= ("makuuhuone_lights_snapshot" :: T.Text) - , "snapshot_entities" .= bedroomLights + , "snapshot_entities" .= [l | EntityId l <- bedroomLights] ] , serviceTarget= [] } @@ -32,7 +32,7 @@ activateScene :: T.Text -> Service activateScene sceneId = Service { serviceDomain="scene" , serviceName= "turn_on" - , serviceTarget= [sceneId] + , serviceTarget= [EntityId sceneId] , serviceData = Nothing } @@ -99,9 +99,11 @@ bedroomButtonController = proc x -> do Event (Masse (OnButton ShortRelease)) -> callService (activateScene "scene.makuuhuone_masse") -< () -- this should be on release Event (Masse (OnButton DoubleClick)) -> callService (activateScene "scene.makuuhuone_keski") -< () Event (Masse (OnButton LongClick)) -> callService (activateScene "scene.makuuhuone_kirkas") -< () + Event (Masse (OffButton _)) -> callService (light [AreaId "makuuhuone"] False) -< () Event (Enishen (OnButton ShortRelease)) -> callService (activateScene "scene.makuuhuone_jemina") -< () Event (Enishen (OnButton DoubleClick)) -> callService (activateScene "scene.makuuhuone_keski") -< () Event (Enishen (OnButton LongClick)) -> callService (activateScene "scene.makuuhuone_kirkas") -< () + Event (Enishen (OffButton _)) -> callService (light [AreaId "makuuhuone"] False) -< () _ -> returnA -< () @@ -118,4 +120,4 @@ bedroomDrawerController = proc x -> do Event Closed -> callService (switch [entity] False) -< () _ -> returnA -< () where - entity = "bedroom_drawer_light_masse" + entity = EntityId "bedroom_drawer_light_masse" diff --git a/src/HomeAssistant/Runtime/Connection.hs b/src/HomeAssistant/Runtime/Connection.hs index b33483c..f194d94 100644 --- a/src/HomeAssistant/Runtime/Connection.hs +++ b/src/HomeAssistant/Runtime/Connection.hs @@ -24,7 +24,7 @@ import Data.Aeson.Lens (key, _String) import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import Data.Void (Void) -import HomeAssistant.Controller (Service (..)) +import HomeAssistant.Controller (Service (..), Target (..)) import HomeAssistant.Runtime.Bus import HomeAssistant.Runtime.Supervisor (Fatal (..)) import qualified Network.WebSockets as WS @@ -97,5 +97,6 @@ encodeService callId Service{..} = object $ , "type" .= ("call_service" :: T.Text) , "domain" .= serviceDomain , "service" .= serviceName - , "target" .= object ["entity_id" .= serviceTarget] + , "target" .= object [ "entity_id" .= [e | EntityId e <- serviceTarget] + , "area_id" .= [a | AreaId a <- serviceTarget]] ] <> maybe [] (\d -> ["data" .= d]) serviceData