summaryrefslogtreecommitdiff
path: root/Omni/Agent/Log.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Agent/Log.hs')
-rw-r--r--Omni/Agent/Log.hs92
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