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.hs96
1 files changed, 95 insertions, 1 deletions
diff --git a/Omni/Agent/Log.hs b/Omni/Agent/Log.hs
index 2e26272..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,11 +7,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)
+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
@@ -60,6 +78,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
+ 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
@@ -111,7 +205,7 @@ render = do
ANSI.hCursorDown IO.stderr 1
ANSI.hSetCursorColumn IO.stderr 0
ANSI.hClearLine IO.stderr
- TIO.hPutStr IO.stderr <| "Credits: $" <> tshow statusCredits
+ TIO.hPutStr IO.stderr <| "Credits: $" <> str (printf "%.2f" statusCredits :: String)
-- Line 5: Activity
ANSI.hCursorDown IO.stderr 1