feat: implement t-rWclFp3vN

1 files changed, 88 insertions, 64 deletions

diff --git a/Omni/Agent/Log.hs b/Omni/Agent/Log.hs
index 28b39ec..99b40ae 100644
--- a/Omni/Agent/Log.hs
+++ b/Omni/Agent/Log.hs
@@ -17,6 +17,17 @@ import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text.Encoding as TextEnc
 import qualified Data.Vector as V
 
+-- | 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,
@@ -67,72 +78,85 @@ 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
+  case entry >>= formatLogEntry of
+    Just msg -> updateActivity msg
+    Nothing -> pure ()
+
+-- | Parse a JSON log line into a LogEntry
+parseLine :: Text -> Maybe LogEntry
+parseLine line = do
   let lbs = BL.fromStrict (TextEnc.encodeUtf8 line)
-  case decode lbs of
-    Just (Object obj) -> do
-      let message =
-            case KM.lookup "message" obj of
-              Just (String m) -> Just m
-              _ -> Nothing
-
-      let toolName =
-            case KM.lookup "toolName" obj of
-              Just (String t) -> Just t
-              _ -> Nothing
-
-      let level =
-            case KM.lookup "level" obj of
-              Just (String l) -> Just l
-              _ -> Nothing
-
-      case message of
-        Just "executing 1 tools in 1 batch(es)" -> do
-          let batchTool =
-                case KM.lookup "batches" obj of
-                  Just (Array b) ->
-                    case V.toList b of
-                      (Array b0 : _) ->
-                        case V.toList b0 of
-                          (String t : _) -> Just t
-                          _ -> Nothing
-                      _ -> Nothing
-                  _ -> Nothing
-          updateActivity ("THOUGHT: Planning tool execution (" <> fromMaybe "unknown" batchTool <> ")")
-
-        Just "Tool Bash permitted - action: allow" ->
-          updateActivity "TOOL: Bash command executed"
-
-        Just msg | toolName /= Nothing && msg == "Processing tool completion for ledger" ->
-          updateActivity ("TOOL: " <> fromMaybe "unknown" toolName <> " completed")
-
-        Just "ide-fs" -> do
-          let method =
-                case KM.lookup "method" obj of
-                  Just (String m) -> Just m
+  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
-          case method of
-            Just "readFile" -> do
-              let path =
-                    case KM.lookup "path" obj of
-                      Just (String p) -> Just p
-                      _ -> Nothing
-              case path of
-                Just p -> updateActivity ("READ: " <> p)
-                Nothing -> pure ()
-            _ -> pure ()
-
-        Just "System prompt build complete (no changes)" ->
-          updateActivity "THINKING..."
-
-        Just "System prompt build complete (first build)" ->
-          updateActivity "STARTING new task context"
-
-        Just msg | level == Just "error" ->
-          updateActivity ("ERROR: " <> msg)
-
-        _ -> pure ()
-
-    _ -> pure ()
+              )
+              (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 ()