Toggle controllers

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

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"