Severity level

src/HomeAssistant/Runtime.hs

@@ -25,7 +25,7 @@ import HomeAssistant.Runtime.Bus
 import HomeAssistant.Runtime.Connection (readerAction, writerAction)
 import HomeAssistant.Runtime.Supervisor (defaultBackoff, supervised)
 import Network.Socket (withSocketsDo)
-import System.Environment (getEnv)
+import System.Environment (getEnv, lookupEnv)
 import HomeAssistant.Controller.Bedroom (bedroomPresenceController, bedroomButtonController, bedroomDrawerController)
 import Data.UUID (UUID, toText)
 import qualified Data.UUID.V4 as UUID.V4
@@ -63,16 +63,18 @@ runController bus (Controller name machine _enabled) = do
       go inbound f'
 
 defaultMain :: IO ()
-defaultMain = withSocketsDo $ withBus $ \bus -> do
-  token <- getEnv "HA_TOKEN"
-  host <- getEnv "HA_HOST"
-  let workers =
-        [ ("reader", readerAction host 8123 token bus)
-        , ("writer", writerAction bus)
-        ] ++ [ (name, runController bus c) | c@(Controller name _ True) <- controllers ]
-  as <- mapM (\(name, act) -> async (supervised name defaultBackoff act)) workers
-  (_, v) <- waitAny as
-  absurd v
+defaultMain = withSocketsDo $ do
+  severity <- maybe DebugS (const InfoS) <$> lookupEnv "HA_DEBUG"
+  withBus severity $ \bus -> do
+    token <- getEnv "HA_TOKEN"
+    host <- getEnv "HA_HOST"
+    let workers =
+          [ ("reader", readerAction host 8123 token bus)
+          , ("writer", writerAction bus)
+          ] ++ [ (name, runController bus c) | c@(Controller name _ True) <- controllers ]
+    as <- mapM (\(name, act) -> async (supervised name defaultBackoff act)) workers
+    (_, v) <- waitAny as
+    absurd v
 
 dryRunHassEval :: Namespace -> Bus -> HASSEff a -> IO a
 dryRunHassEval ns bus = \case