Update tests
This commit is contained in:
+2
-2
@@ -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
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
+12
-6
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user