diff --git a/src/HomeAssistant/Runtime.hs b/src/HomeAssistant/Runtime.hs index 33054ad..a8b2b04 100644 --- a/src/HomeAssistant/Runtime.hs +++ b/src/HomeAssistant/Runtime.hs @@ -35,20 +35,20 @@ step nt trace (Mealy f) a = do now <- getCurrentTime f nt (Request now trace) a -data Controller = forall b. Controller T.Text (HASS (Event Value) b) +data Controller = forall b. Controller T.Text (HASS (Event Value) b) Bool controllers :: [Controller] controllers = - [ Controller "bedroom-presence" bedroomPresenceController - , Controller "bedroom-button" bedroomButtonController - , Controller "bedroom-drawer" bedroomDrawerController + [ Controller "bedroom-presence" bedroomPresenceController False + , Controller "bedroom-button" bedroomButtonController False + , Controller "bedroom-drawer" bedroomDrawerController True ] -- | Steps the machine for every inbound message; service calls go to the -- bus. A restart re-dups the inbound channel and starts from the machine's -- initial state; messages broadcast during the restart window are lost. runController :: Bus -> Controller -> IO Void -runController bus (Controller _name machine) = do +runController bus (Controller _name machine _enabled) = do inbound <- atomically (dupTChan (busInbound bus)) go inbound machine where @@ -65,7 +65,7 @@ defaultMain = withSocketsDo $ do let workers = [ ("reader", readerAction "last-resort-redux" 8123 token bus) , ("writer", writerAction bus) - ] ++ [ (name, runController bus c) | c@(Controller name _) <- controllers ] + ] ++ [ (name, runController bus c) | c@(Controller name _ True) <- controllers ] as <- mapM (\(name, act) -> async (supervised name defaultBackoff act)) workers (_, v) <- waitAny as absurd v diff --git a/test/RuntimeSpec.hs b/test/RuntimeSpec.hs index b6df20b..35b907b 100644 --- a/test/RuntimeSpec.hs +++ b/test/RuntimeSpec.hs @@ -15,7 +15,7 @@ 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)) + _ <- async (runController bus (Controller "test" lightController True)) putStrLn "Before the delay" threadDelay 100000 -- let the controller dup its inbound channel putStrLn "After the delay"