diff options
Diffstat (limited to 'Omni/Agent/Log.hs')
| -rw-r--r-- | Omni/Agent/Log.hs | 157 |
1 files changed, 132 insertions, 25 deletions
diff --git a/Omni/Agent/Log.hs b/Omni/Agent/Log.hs index afaf1da..dd66abc 100644 --- a/Omni/Agent/Log.hs +++ b/Omni/Agent/Log.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -6,16 +7,34 @@ module Omni.Agent.Log where import Alpha +import Data.Aeson (Value (..), decode) +import qualified Data.Aeson.KeyMap as KM +import qualified Data.ByteString.Lazy as BL import Data.IORef (IORef, modifyIORef', newIORef, readIORef, writeIORef) +import qualified Data.Text.Encoding as TextEnc import qualified Data.Text.IO as TIO +import qualified Data.Vector as V import qualified System.Console.ANSI as ANSI import qualified System.IO as IO import System.IO.Unsafe (unsafePerformIO) +import Text.Printf (printf) + +-- | Parsed log entry +data LogEntry = LogEntry + { leMessage :: Maybe Text, + leLevel :: Maybe Text, + leToolName :: Maybe Text, + leBatches :: Maybe [[Text]], + leMethod :: Maybe Text, + lePath :: Maybe Text + } + deriving (Show, Eq) -- | Status of the agent for the UI data Status = Status { statusWorker :: Text, statusTask :: Maybe Text, + statusThreadId :: Maybe Text, statusFiles :: Int, statusCredits :: Double, statusTime :: Text, -- formatted time string @@ -28,6 +47,7 @@ emptyStatus workerName = Status { statusWorker = workerName, statusTask = Nothing, + statusThreadId = Nothing, statusFiles = 0, statusCredits = 0.0, statusTime = "00:00", @@ -44,10 +64,9 @@ init :: Text -> IO () init workerName = do IO.hSetBuffering IO.stderr IO.LineBuffering writeIORef currentStatus (emptyStatus workerName) - -- Reserve 2 lines at bottom - IO.hPutStrLn IO.stderr "" - IO.hPutStrLn IO.stderr "" - ANSI.hCursorUp IO.stderr 2 + -- Reserve 5 lines at bottom + replicateM_ 5 (IO.hPutStrLn IO.stderr "") + ANSI.hCursorUp IO.stderr 5 -- | Update the status update :: (Status -> Status) -> IO () @@ -59,14 +78,96 @@ update f = do updateActivity :: Text -> IO () updateActivity msg = update (\s -> s {statusActivity = msg}) +-- | Process a log line from the agent and update status if relevant +processLogLine :: Text -> IO () +processLogLine line = do + let entry = parseLine line + for_ (entry +> formatLogEntry) updateActivity + +-- | Parse a JSON log line into a LogEntry +parseLine :: Text -> Maybe LogEntry +parseLine line = do + let lbs = BL.fromStrict (TextEnc.encodeUtf8 line) + obj <- decode lbs + case obj of + Object o -> + Just + LogEntry + { leMessage = getString "message" o, + leLevel = getString "level" o, + leToolName = getString "toolName" o, + leBatches = getBatches o, + leMethod = getString "method" o, + lePath = getString "path" o + } + _ -> Nothing + where + getString k o = + case KM.lookup k o of + Just (String s) -> Just s + _ -> Nothing + + getBatches o = + case KM.lookup "batches" o of + Just (Array b) -> + Just + <| mapMaybe + ( \case + Array b0 -> + Just + <| mapMaybe + ( \case + String s -> Just s + _ -> Nothing + ) + (V.toList b0) + _ -> Nothing + ) + (V.toList b) + _ -> Nothing + +-- | Format a log entry into a user-friendly status message (NO EMOJIS) +formatLogEntry :: LogEntry -> Maybe Text +formatLogEntry LogEntry {..} = + case leMessage of + Just "executing 1 tools in 1 batch(es)" -> do + let tools = fromMaybe [] leBatches + let firstTool = case tools of + ((t : _) : _) -> t + _ -> "unknown" + Just ("THOUGHT: Planning tool execution (" <> firstTool <> ")") + Just "Tool Bash permitted - action: allow" -> + Just "TOOL: Bash command executed" + Just "Processing tool completion for ledger" + | isJust leToolName -> + Just ("TOOL: " <> fromMaybe "unknown" leToolName <> " completed") + Just "ide-fs" | leMethod == Just "readFile" -> + case lePath of + Just p -> Just ("READ: " <> p) + _ -> Nothing + Just "System prompt build complete (no changes)" -> + Just "THINKING..." + Just "System prompt build complete (first build)" -> + Just "STARTING new task context" + Just msg + | leLevel == Just "error" -> + Just ("ERROR: " <> msg) + _ -> Nothing + -- | Log a scrolling message (appears above status bars) log :: Text -> IO () log msg = do - -- Clear status bars + -- Clear status bars (5 lines) ANSI.hClearLine IO.stderr ANSI.hCursorDown IO.stderr 1 ANSI.hClearLine IO.stderr - ANSI.hCursorUp IO.stderr 1 + ANSI.hCursorDown IO.stderr 1 + ANSI.hClearLine IO.stderr + ANSI.hCursorDown IO.stderr 1 + ANSI.hClearLine IO.stderr + ANSI.hCursorDown IO.stderr 1 + ANSI.hClearLine IO.stderr + ANSI.hCursorUp IO.stderr 4 -- Print message (scrolls screen) TIO.hPutStrLn IO.stderr msg @@ -75,37 +176,43 @@ log msg = do -- (Since we scrolled, we are now on the line above where the first status line should be) render --- | Render the two status lines +-- | Render the 5 status lines (Vertical Layout) render :: IO () render = do Status {..} <- readIORef currentStatus - -- Line 1: Meta - -- [Worker: name] Task: t-123 | Files: 3 | Credits: $0.45 | Time: 05:23 let taskStr = maybe "None" identity statusTask - meta = - "[Worker: " - <> statusWorker - <> "] Task: " - <> taskStr - <> " | Files: " - <> tshow statusFiles - <> " | Credits: $" - <> tshow statusCredits - <> " | Time: " - <> statusTime + threadStr = maybe "None" identity statusThreadId + -- Line 1: Worker + Time + ANSI.hSetCursorColumn IO.stderr 0 + ANSI.hClearLine IO.stderr + TIO.hPutStr IO.stderr <| "Worker: " <> statusWorker <> " | Time: " <> statusTime + + -- Line 2: Task + ANSI.hCursorDown IO.stderr 1 + ANSI.hSetCursorColumn IO.stderr 0 + ANSI.hClearLine IO.stderr + TIO.hPutStr IO.stderr <| "Task: " <> taskStr + + -- Line 3: Thread + ANSI.hCursorDown IO.stderr 1 + ANSI.hSetCursorColumn IO.stderr 0 + ANSI.hClearLine IO.stderr + TIO.hPutStr IO.stderr <| "Thread: " <> threadStr + + -- Line 4: Credits + ANSI.hCursorDown IO.stderr 1 ANSI.hSetCursorColumn IO.stderr 0 ANSI.hClearLine IO.stderr - TIO.hPutStr IO.stderr meta + TIO.hPutStr IO.stderr <| "Credits: $" <> str (printf "%.2f" statusCredits :: String) - -- Line 2: Activity - -- [14:05:22] > Thinking... + -- Line 5: Activity ANSI.hCursorDown IO.stderr 1 ANSI.hSetCursorColumn IO.stderr 0 ANSI.hClearLine IO.stderr TIO.hPutStr IO.stderr ("> " <> statusActivity) - -- Return cursor to line 1 - ANSI.hCursorUp IO.stderr 1 + -- Return cursor to Line 1 + ANSI.hCursorUp IO.stderr 4 IO.hFlush IO.stderr |