From b18bd4eee969681ee532c4898ddaaa0851e6b846 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Tue, 16 Dec 2025 13:24:54 -0500 Subject: Batch web_reader tool, much faster Added retry with backoff, parallel proccessing, editing pages down to main content, summarization with haiku. It's so much faster and more reliable now. Plus improved the logging system and distangled the status UI bar from the logging module. --- Omni/Log.hs | 45 +++++++++++++++++++++++++++++++++++---------- 1 file changed, 35 insertions(+), 10 deletions(-) (limited to 'Omni/Log.hs') diff --git a/Omni/Log.hs b/Omni/Log.hs index ecfe973..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,20 +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.lookupEnv "TERM" +> \case - Just "dumb" -> putDumb - Nothing -> 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") @@ -95,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 -- cgit v1.2.3