MasseR/home-assistant-controller
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Clean tests

Browse Source
This commit is contained in:
MasseR
2026-08-21 16:01:15 +03:00
parent 96d4fb4c8d
commit 50c82393ed
1 changed files with 34 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files
test/RuntimeSpec.hs
+34 -37
View File
@@ -1,43 +1,40 @@
{-# LANGUAGE OverloadedStrings #-}
module RuntimeSpec (spec) where 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 import Test.Hspec
import Katip (Severity(..))
spec :: Spec spec :: Spec
spec = describe "runController" $ do spec = pure ()
it "feeds inbound events through the machine and forwards service calls" $ withBus InfoS $ \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"
Right (_, svc1) <- boundedRead (busOutbound bus)
Right (_, svc2) <- boundedRead (busOutbound bus)
putStrLn "After the reads"
svc1 `shouldBe` light [EntityId "light.bedroom_masse"] True
svc2 `shouldBe` light [EntityId "light.bedroom_masse"] False
atomically (isEmptyTChan (busOutbound bus)) `shouldReturn` True
where
boundedRead channel = race (threadDelay 10000) (atomically (readTChan channel))
doorEvent :: Text -> Value -- I'm commenting out the test as that specific controller
doorEvent state = object -- was just a dummy for seeing how the data flows (dead code)
[ "event" .= object -- But leaving it commented as it retains some code sample on how and what to test
[ "data" .= object --
[ "entity_id" .= ("binary_sensor.makuuhuone_ovi_contact" :: Text) -- spec :: Spec
, "new_state" .= object ["state" .= state] -- spec = describe "runController" $ do
] -- it "feeds inbound events through the machine and forwards service calls" $ withBus InfoS $ \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"
-- Right (_, svc1) <- boundedRead (busOutbound bus)
-- Right (_, svc2) <- boundedRead (busOutbound bus)
-- putStrLn "After the reads"
-- svc1 `shouldBe` light [EntityId "light.bedroom_masse"] True
-- svc2 `shouldBe` 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]
-- ]
-- ]
-- ]