Control the kitchen lights

src/HomeAssistant/Runtime.hs

@@ -13,7 +13,7 @@ module HomeAssistant.Runtime
   , runController
   ) where
 
-import AFRP (Event (..), Mealy (..), Request (..), Auto, stepAutoSerializing)
+import AFRP (Event (..), Mealy (..), Request (..), Auto, stepAutoSerializing, load, DecodedAuto (..))
 import Control.Concurrent.Async (async, waitAny)
 import Control.Concurrent.STM (atomically, dupTChan, readTChan)
 import Data.Aeson (Value)
@@ -37,6 +37,7 @@ import Data.Maybe (fromMaybe)
 import qualified System.Metrics
 import qualified HomeAssistant.Runtime.Metrics
 import System.FilePath ((</>))
+import HomeAssistant.Controller.Kitchen (kitchenMotionController)
 
 step :: (MonadIO m) => FilePath -> UUID -> Auto m a b -> a -> m (b, Auto m a b)
 step path trace st a = do
@@ -52,9 +53,10 @@ controllers =
   [ Controller "bedroom-presence" bedroomPresenceController False
   , Controller "bedroom-button" bedroomButtonController False -- This works but leaving for vacation
   , Controller "bedroom-drawer" bedroomDrawerController True
-  , Controller "bedroom-humidifier" humidifierController False
+  , Controller "bedroom-humidifier" humidifierController True
   , Controller "ruuvi-controller" ruuviController False
   , Controller "school-light-controller" schoolLightController True
+  , Controller "kitchen-motion-controller" kitchenMotionController True
   ]
 
 -- | Steps the machine for every inbound message; service calls go to the
@@ -64,8 +66,11 @@ runController :: FilePath -> Bus -> Controller -> IO Void
 runController rootDir bus (Controller name machine _enabled) = do
   inbound <- atomically (dupTChan (busInbound bus))
   let ns = Namespace [name]
-  let worker = runMealy machine (runKatipContextT (busLogEnv bus) () ns . channelHassEval bus)
+  let workerDefinition = runMealy machine (runKatipContextT (busLogEnv bus) () ns . channelHassEval bus)
   let path  = rootDir </> T.unpack name
+  worker <- load path workerDefinition >>= \case
+    Decoded a -> pure a
+    FailDecode err a -> a <$ putStrLn ("Failed to load (" <> T.unpack name <> "): " <> err)
   go path inbound worker
   where
     go path inbound f = do