Run controllers on their own threads over the bus
This commit is contained in:
@@ -0,0 +1,36 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module RuntimeSpec (spec) where
|
||||
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Concurrent.Async (async)
|
||||
import Control.Concurrent.STM (atomically, readTChan, writeTChan)
|
||||
import Data.Aeson (Value, object, (.=))
|
||||
import Data.Text (Text)
|
||||
import HomeAssistant.Controller (light, lightController)
|
||||
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" $ do
|
||||
bus <- newBus 0
|
||||
_ <- async (runController bus (Controller "test" lightController))
|
||||
threadDelay 100000 -- let the controller dup its inbound channel
|
||||
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
|
||||
|
||||
doorEvent :: Text -> Value
|
||||
doorEvent state = object
|
||||
[ "event" .= object
|
||||
[ "data" .= object
|
||||
[ "entity_id" .= ("binary_sensor.makuuhuone_ovi_contact" :: Text)
|
||||
, "new_state" .= object ["state" .= state]
|
||||
]
|
||||
]
|
||||
]
|
||||
Reference in New Issue
Block a user