43 lines
1.8 KiB
Haskell
43 lines
1.8 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
module RuntimeSpec (spec) where
|
|
|
|
import Control.Concurrent (threadDelay)
|
|
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, Target (..))
|
|
import HomeAssistant.Runtime (Controller (..), runController)
|
|
import HomeAssistant.Runtime.Bus
|
|
import Test.Hspec
|
|
|
|
spec :: Spec
|
|
spec = describe "runController" $ do
|
|
it "feeds inbound events through the machine and forwards service calls" $ withBus $ \bus -> do
|
|
_ <- async (runController bus (Controller "test" lightController True))
|
|
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
|
|
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
|
|
[ "event" .= object
|
|
[ "data" .= object
|
|
[ "entity_id" .= ("binary_sensor.makuuhuone_ovi_contact" :: Text)
|
|
, "new_state" .= object ["state" .= state]
|
|
]
|
|
]
|
|
]
|