Update tests

src/HomeAssistant/Runtime.hs

@@ -55,8 +55,7 @@ runController bus (Controller _name machine) = do
     go inbound f = do
       msg <- atomically (readTChan inbound)
       uuid <- UUID.V4.nextRandom
-      -- (_, f') <- step (channelHassEval bus) f (Event msg)
-      (_, f') <- step (dryRunHassEval (busGen bus)) uuid f (Event msg)
+      (_, f') <- step (channelHassEval bus) uuid f (Event msg)
       go inbound f'
 
 defaultMain :: IO ()

src/HomeAssistant/Runtime/Connection.hs

@@ -97,6 +97,16 @@ encodeService callId Service{..} = object $
   , "type"    .= ("call_service" :: T.Text)
   , "domain"  .= serviceDomain
   , "service" .= serviceName
-  , "target"  .= object [ "entity_id" .= [e | EntityId e <- serviceTarget]
-                        , "area_id" .= [a | AreaId a <- serviceTarget]]
-  ] <> maybe [] (\d -> ["data" .= d]) serviceData
+  , "target"  .= targetObject serviceTarget
+  ] <> maybe [] (\d -> ["service_data" .= d]) serviceData
+
+-- | A single target encodes as a scalar; multiple encode as a list. Empty
+-- lists are omitted so Home Assistant receives only populated keys.
+targetObject :: [Target] -> Value
+targetObject targets = object $ entityPart <> areaPart
+  where
+    entityPart = emit "entity_id" [e | EntityId e <- targets]
+    areaPart   = emit "area_id" [a | AreaId a <- targets]
+    emit _ []     = []
+    emit k [x]    = [k .= x]
+    emit k many   = [k .= many]

test/BusSpec.hs

@@ -9,7 +9,7 @@ import Control.Concurrent.STM
   , writeTChan
   )
 import Data.Aeson (Value (..))
-import HomeAssistant.Controller (HASSEff (..), Service (..))
+import HomeAssistant.Controller (HASSEff (..), Service (..), Target(..))
 import HomeAssistant.Runtime.Bus
 import Test.Hspec
 
@@ -28,7 +28,7 @@ spec = describe "Bus" $ do
 
   it "channelHassEval writes CallService to the outbound channel" $ do
     bus <- newBus 0
-    let svc = Service "light" "turn_on" Nothing "light.bedroom_masse"
+    let svc = Service "light" "turn_on" Nothing [EntityId "light.bedroom_masse"]
     channelHassEval bus (CallService svc)
     atomically (readTChan (busOutbound bus)) `shouldReturn` svc
 

test/ConnectionSpec.hs

@@ -4,14 +4,14 @@ module ConnectionSpec (spec) where
 
 import Data.Aeson (object, (.=))
 import Data.Text (Text)
-import HomeAssistant.Controller (Service (..))
+import HomeAssistant.Controller (Service (..), Target(..))
 import HomeAssistant.Runtime.Connection (encodeService)
 import Test.Hspec
 
 spec :: Spec
 spec = describe "encodeService" $ do
   it "encodes a call_service message" $
-    encodeService 7 (Service "light" "turn_on" Nothing "light.bedroom_masse")
+    encodeService 7 (Service "light" "turn_on" Nothing [EntityId "light.bedroom_masse"])
       `shouldBe` object
         [ "id" .= (7 :: Int)
         , "type" .= ("call_service" :: Text)
@@ -21,7 +21,7 @@ spec = describe "encodeService" $ do
         ]
 
   it "includes service_data when present" $
-    encodeService 8 (Service "light" "turn_on" (Just (object ["brightness" .= (200 :: Int)])) "light.bedroom_masse")
+    encodeService 8 (Service "light" "turn_on" (Just (object ["brightness" .= (200 :: Int)])) [EntityId "light.bedroom_masse"])
       `shouldBe` object
         [ "id" .= (8 :: Int)
         , "type" .= ("call_service" :: Text)

test/RuntimeSpec.hs

@@ -2,11 +2,11 @@
 module RuntimeSpec (spec) where
 
 import Control.Concurrent (threadDelay)
-import Control.Concurrent.Async (async)
+import Control.Concurrent.Async (async, race)
 import Control.Concurrent.STM (atomically, isEmptyTChan, readTChan, writeTChan)
 import Data.Aeson (Value, object, (.=))
 import Data.Text (Text)
-import HomeAssistant.Controller (light, lightController)
+import HomeAssistant.Controller (light, lightController, Target (..))
 import HomeAssistant.Runtime (Controller (..), runController)
 import HomeAssistant.Runtime.Bus
 import Test.Hspec
@@ -16,15 +16,21 @@ spec = describe "runController" $ do
   it "feeds inbound events through the machine and forwards service calls" $ do
     bus <- newBus 0
     _ <- async (runController bus (Controller "test" lightController))
+    putStrLn "Before the delay"
     threadDelay 100000 -- let the controller dup its inbound channel
+    putStrLn "After the delay"
     atomically $ writeTChan (busInbound bus) (doorEvent "on")  -- initial value: no change event
     atomically $ writeTChan (busInbound bus) (doorEvent "off") -- door closes: lights on
     atomically $ writeTChan (busInbound bus) (doorEvent "on")  -- door opens: lights off
-    svc1 <- atomically (readTChan (busOutbound bus))
-    svc2 <- atomically (readTChan (busOutbound bus))
-    svc1 `shouldBe` light True
-    svc2 `shouldBe` light False
+    putStrLn "After the writes"
+    svc1 <- boundedRead (busOutbound bus)
+    svc2 <- boundedRead (busOutbound bus)
+    putStrLn "After the reads"
+    svc1 `shouldBe` Right (light [EntityId "light.bedroom_masse"] True)
+    svc2 `shouldBe` Right (light [EntityId "light.bedroom_masse"] False)
     atomically (isEmptyTChan (busOutbound bus)) `shouldReturn` True
+  where
+    boundedRead channel = race (threadDelay 10000) (atomically (readTChan channel))
 
 doorEvent :: Text -> Value
 doorEvent state = object