Merge Ava deployment changes

1 files changed, 35 insertions, 9 deletions

diff --git a/Omni/Log.hs b/Omni/Log.hs
index 91fcb55..c42d5e8 100644
--- a/Omni/Log.hs
+++ b/Omni/Log.hs
@@ -15,6 +15,12 @@
 --    * often use `br` after `warn`, unless its really unimportant
 --
 --    * labels should be roughly hierarchical from general->specific
+--
+-- Future improvements to consider:
+--    * Add timestamps (set via LOG_TIMESTAMPS=1 env var)
+--    * Add log level filtering (set via LOG_LEVEL=warn to suppress info)
+--    * Add structured JSON output (set via LOG_FORMAT=json for machine parsing)
+--    * Add a `debug` level below `info` for verbose debugging
 module Omni.Log
   ( Lvl (..),
     good,
@@ -22,6 +28,7 @@ module Omni.Log
     info,
     warn,
     fail,
+    debug,
     wipe,
 
     -- * Debugging
@@ -50,7 +57,8 @@ import qualified System.Environment as Env
 import qualified System.IO as IO
 import System.IO.Unsafe (unsafePerformIO)
 
-data Lvl = Good | Pass | Info | Warn | Fail | Mark
+data Lvl = Debug | Good | Pass | Info | Warn | Fail | Mark
+  deriving (Eq, Ord)
 
 -- | Get the environment. This should probably return 'Omni.App.Area' instead of
 -- 'String', but I don't want to depend on everything in 'Omni.App', so some kind
@@ -60,19 +68,36 @@ area =
   Env.lookupEnv "AREA"
     /> maybe "Test" identity
 
+-- | Get the minimum log level from LOG_LEVEL env var (default: Info)
+-- Set LOG_LEVEL=debug to see debug messages, LOG_LEVEL=warn to suppress info
+minLogLevel :: Lvl
+minLogLevel =
+  unsafePerformIO <| do
+    Env.lookupEnv "LOG_LEVEL" /> \case
+      Just "debug" -> Debug
+      Just "info" -> Info
+      Just "warn" -> Warn
+      Just "fail" -> Fail
+      _ -> Info
+{-# NOINLINE minLogLevel #-}
+
 msg :: Lvl -> [Text] -> IO ()
-msg lvl labels =
-  area +> \case
-    "Live" -> putDumb
-    _ ->
-      Env.getEnv "TERM" +> \case
-        "dumb" -> putDumb
-        _ -> Rainbow.hPutChunks IO.stderr [fore color <| clear <> chunk txt <> "\r"]
+msg lvl labels
+  | lvl < minLogLevel = pure () -- Skip messages below minimum level
+  | otherwise =
+      area +> \case
+        "Live" -> putDumb
+        _ ->
+          Env.lookupEnv "TERM" +> \case
+            Just "dumb" -> putDumb
+            Nothing -> putDumb
+            _ -> Rainbow.hPutChunks IO.stderr [fore color <| clear <> chunk txt <> "\r"]
   where
     -- For systemd-journal, emacs *compilation* buffers, etc.
     putDumb = putStr <| txt <> "\n"
     txt = fmt (label : labels)
     (color, label) = case lvl of
+      Debug -> (white, "debg")
       Good -> (green, "good")
       Pass -> (green, "pass")
       Info -> (white, "info")
@@ -94,12 +119,13 @@ br = Rainbow.hPutChunks stderr ["\n"] >> IO.hFlush stderr
 wipe :: IO ()
 wipe = hPutStr stderr ("\r" :: Text) >> IO.hFlush stderr
 
-good, pass, info, warn, fail :: [Text] -> IO ()
+good, pass, info, warn, fail, debug :: [Text] -> IO ()
 good = msg Good
 pass = msg Pass
 info = msg Info
 warn = msg Warn
 fail = msg Fail
+debug = msg Debug
 
 -- | Like 'Debug.trace' but follows the patterns in this module
 mark :: (Show a) => Text -> a -> a