defaultMain: wire metricsAction worker and enable -with-rtsopts=-T

home-assistant-controller.cabal

@@ -126,7 +126,7 @@ executable home-assistant-controller
 
     -- Base language which the package is written in.
     default-language: GHC2024
-    ghc-options: -threaded
+    ghc-options: -threaded -with-rtsopts=-T
 
 test-suite home-assistant-controller-test
     -- Import common warning flags.

src/HomeAssistant/Runtime.hs

@@ -34,6 +34,9 @@ import Control.Monad.IO.Class (liftIO, MonadIO)
 import Control.Monad.Fix (MonadFix)
 import HomeAssistant.Controller.Ruuvi (ruuviController)
 import HomeAssistant.Controller.Children (schoolLightController)
+import Data.Maybe (fromMaybe)
+import qualified System.Metrics
+import qualified HomeAssistant.Runtime.Metrics
 
 step :: (MonadFix m, MonadIO m) => (forall x. eff x -> m x) -> UUID -> Mealy eff a b -> a -> m (b, Mealy eff a b)
 step nt trace (Mealy _ f) a = do
@@ -74,12 +77,17 @@ defaultMain = withSocketsDo $ do
   withBus severity $ \bus -> do
     token <- getEnv "HA_TOKEN"
     host <- getEnv "HA_HOST"
+    store <- System.Metrics.newStore
+    System.Metrics.registerGcMetrics store
+    rrdPath <- fromMaybe "hass-controller.rrd" <$> lookupEnv "HA_RRD_PATH"
+    rrdtool <- fromMaybe "rrdtool" <$> lookupEnv "HA_RRDTOOL"
     let active = [c | c@(Controller _ _ True) <- controllers]
         ents = foldMap (\(Controller _ m _) -> entities m) active
         workers =
           [ ("reader", readerAction host 8123 token ents bus)
           , ("writer", writerAction bus)
           ] ++ [ (name, runController bus c) | c@(Controller name _ True) <- controllers ]
+            ++ [("metrics", HomeAssistant.Runtime.Metrics.metricsAction store rrdPath rrdtool)]
     as <- mapM (\(name, act) -> async (supervised name defaultBackoff act)) workers
     (_, v) <- waitAny as
     absurd v