diff --git a/home-assistant-controller.cabal b/home-assistant-controller.cabal index 302d8e4..d96fdc1 100644 --- a/home-assistant-controller.cabal +++ b/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. diff --git a/src/HomeAssistant/Runtime.hs b/src/HomeAssistant/Runtime.hs index 6895c4c..55a77bc 100644 --- a/src/HomeAssistant/Runtime.hs +++ b/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