Support for areas

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
 

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"

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