Drop build-time controller flag, run all controllers, consolidate paths

src/HomeAssistant/Runtime.hs

@@ -51,27 +51,27 @@ step path name trace st a = do
   let req = Request now tz trace name
   stepAutoSerializing path st req a
 
-data Controller = forall b. Controller Bool T.Text (HASS (Event Value) b)
+data Controller = forall b. Controller T.Text (HASS (Event Value) b)
 
 controllers :: [Controller]
 controllers =
-  [ Controller True "bedroom-presence" bedroomPresenceController
-  , Controller True "bedroom-button" bedroomButtonController
-  , Controller True "bedroom-drawer" bedroomDrawerController
-  , Controller True "bedroom-humidifier" humidifierController
-  , Controller True "school-light-controller" schoolLightController
-  , Controller True "kitchen-motion-controller" kitchenMotionController
-  , Controller True "livingroom-presence" livingroomPresenceController
-  , Controller True "hallway-motion-controller" hallwayLightsController
-  , Controller True "children-button" childrenBedroomButtonController
-  , Controller True "livingroom-plants" livingroomPlantLights
+  [ Controller "bedroom-presence" bedroomPresenceController
+  , Controller "bedroom-button" bedroomButtonController
+  , Controller "bedroom-drawer" bedroomDrawerController
+  , Controller "bedroom-humidifier" humidifierController
+  , Controller "school-light-controller" schoolLightController
+  , Controller "kitchen-motion-controller" kitchenMotionController
+  , Controller "livingroom-presence" livingroomPresenceController
+  , Controller "hallway-motion-controller" hallwayLightsController
+  , Controller "children-button" childrenBedroomButtonController
+  , Controller "livingroom-plants" livingroomPlantLights
   ]
 
 -- | 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 :: MonadIO m => FilePath -> Bus -> Controller -> m Void
-runController rootDir bus (Controller _enabled name machine ) = liftIO $ do
+runController rootDir bus (Controller name machine ) = liftIO $ do
   inbound <- atomically (dupTChan (busInbound bus))
   let ns = Namespace [name]
   let workerDefinition = runMealy machine (runKatipContextT (busLogEnv bus) () ns . channelHassEval bus)
@@ -104,23 +104,22 @@ defaultMain = withSocketsDo $ do
   appMetrics <- HomeAssistant.Runtime.Metrics.registerAppMetrics store
   rateLimitMetrics <- registerRateLimitMetrics store
   rootPath <- fromMaybe "/tmp/" <$> lookupEnv "HA_LIB_DIR"
-  let allNames = [n | Controller _ n _ <- controllers]
+  let allNames = map (\(Controller n _) -> n) controllers
   flags <- loadFlags rootPath allNames
   withBus severity appMetrics flags $ \bus -> do
     token <- getEnv "HA_TOKEN"
     host <- getEnv "HA_HOST"
-    rrdPath <- fromMaybe "hass-controller.rrd" <$> lookupEnv "HA_RRD_PATH"
+    let rrdPath = rootPath </> "hass-controller.rrd"
     rrdtool <- fromMaybe "rrdtool" <$> lookupEnv "HA_RRDTOOL"
     metricsPort <- lookupPort
     writerLimiter <- slidingWindowLimiter rateLimitMetrics 10 20
-    let active = [c | c@(Controller True _ _) <- controllers]
-        ents = foldMap (\(Controller _ _ m) -> entities m) active
+    let ents = foldMap (\(Controller _ m) -> entities m) controllers
         workers =
           [ ("reader", readerAction host 8123 token ents bus)
           , ("writer", writerAction writerLimiter bus)
           , ("metrics", HomeAssistant.Runtime.Metrics.metricsAction store rrdPath rrdtool)
           , ("metrics-http", HttpServer.runHttpServer (busLogEnv bus) rrdPath rrdtool (busFlags bus) metricsPort)
-          ] ++ [ (name, runController rootPath bus c) | c@(Controller True name _) <- active ]
+          ] ++ [ (name, runController rootPath bus c) | c@(Controller name _) <- controllers ]
     runKatipContextT (busLogEnv bus) () mempty $
       mapConcurrently_ (uncurry supervised) workers