Merge task t-rWclFp3vN: Improve Worker status bar activity formatting

1 files changed, 92 insertions, 0 deletions

diff --git a/Omni/Agent/Log.hs b/Omni/Agent/Log.hs
index 2e26272..59efb38 100644
--- a/Omni/Agent/Log.hs
+++ b/Omni/Agent/Log.hs
@@ -6,12 +6,28 @@
 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)
 
+-- | 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,
@@ -60,6 +76,82 @@ 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
+  Data.Foldable.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