Logging and really not working light restoration

src/HomeAssistant/Runtime/Bus.hs

@@ -10,6 +10,7 @@ module HomeAssistant.Runtime.Bus
   , recordInbound
   , recordOutbound
   , channelHassEval
+  , withLogEnv
   ) where
 
 import Control.Concurrent.STM
@@ -51,33 +52,36 @@ data Bus = Bus
   , busFlags    :: Flags
   }
 
-withBus :: Severity -> AppMetrics -> Flags -> (Bus -> IO a) -> IO a
-withBus severity metrics flags callback = do
+withLogEnv :: Severity -> (LogEnv -> IO a) -> IO a
+withLogEnv severity f = do
   let makeLogEnv = registerJournalScribe =<< registerHandleScribe =<< initLogEnv "hass-controller" "production"
   -- closeScribes will stop accepting new logs, flush existing ones and clean up resources
-  bracket makeLogEnv closeScribes $ \le -> do
-    bus <- Bus
-          <$> newBroadcastTChanIO
-          <*> newTChanIO
-          <*> newTVarIO Nothing
-          <*> mkCallIdGen 0
-          <*> pure le
-          <*> pure metrics
-          <*> pure flags
-    callback bus
+  bracket makeLogEnv closeScribes $ \le -> f le
   where
     registerJournalScribe :: LogEnv -> IO LogEnv
     registerJournalScribe le = do
       journalScribe <- mkJournalScribe (permitItem severity) V2
       registerScribe "journalctl" journalScribe defaultScribeSettings le
     registerHandleScribe le = do
-      systemdUnit <- isJust <$> lookupEnv "INVOCATION_ID"
+      systemdUnit <- isJust <$> lookupEnv "HA_CONTROLLER_SYSTEMD"
       if systemdUnit
          then pure le -- ignore stdout when running in systemd
          else do
            handleScribe <- mkHandleScribe ColorIfTerminal stdout (permitItem severity) V2
            registerScribe "stdout" handleScribe defaultScribeSettings le
 
+withBus :: MonadIO m => LogEnv -> AppMetrics -> Flags -> (Bus -> m a) -> m a
+withBus le metrics flags callback = do
+  bus <- Bus
+        <$> liftIO newBroadcastTChanIO
+        <*> liftIO newTChanIO
+        <*> liftIO (newTVarIO Nothing)
+        <*> liftIO (mkCallIdGen 0)
+        <*> pure le
+        <*> pure metrics
+        <*> pure flags
+  callback bus
+
 recordInbound :: Bus -> IO ()
 recordInbound bus = inc (amTriggersIn (busMetrics bus))