summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Omni/Agent/Log.hs92
-rw-r--r--Omni/Agent/LogTest.hs78
-rw-r--r--Omni/Agent/Worker.hs75
3 files changed, 126 insertions, 119 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
diff --git a/Omni/Agent/LogTest.hs b/Omni/Agent/LogTest.hs
index 518147e..97b558d 100644
--- a/Omni/Agent/LogTest.hs
+++ b/Omni/Agent/LogTest.hs
@@ -5,7 +5,6 @@
module Omni.Agent.LogTest where
import Alpha
-import qualified Data.Set as Set
import Omni.Agent.Log
import qualified Omni.Test as Test
@@ -17,9 +16,7 @@ tests =
Test.group
"Omni.Agent.Log"
[ Test.unit "Parse LogEntry" testParse,
- Test.unit "Format LogEntry" testFormat,
- Test.unit "Update Status" testUpdateStatus,
- Test.unit "Render Status" testRenderStatus
+ Test.unit "Format LogEntry" testFormat
]
testParse :: IO ()
@@ -27,13 +24,12 @@ testParse = do
let json = "{\"message\": \"executing 1 tools in 1 batch(es)\", \"batches\": [[\"grep\"]]}"
let expected =
LogEntry
- { leMessage = "executing 1 tools in 1 batch(es)",
+ { leMessage = Just "executing 1 tools in 1 batch(es)",
leLevel = Nothing,
leToolName = Nothing,
leBatches = Just [["grep"]],
leMethod = Nothing,
- lePath = Nothing,
- leTimestamp = Nothing
+ lePath = Nothing
}
parseLine json @?= Just expected
@@ -41,84 +37,38 @@ testFormat :: IO ()
testFormat = do
let entry =
LogEntry
- { leMessage = "executing 1 tools in 1 batch(es)",
+ { leMessage = Just "executing 1 tools in 1 batch(es)",
leLevel = Nothing,
leToolName = Nothing,
leBatches = Just [["grep"]],
leMethod = Nothing,
- lePath = Nothing,
- leTimestamp = Nothing
+ lePath = Nothing
}
- format entry @?= Just "🤖 THOUGHT: Planning tool execution (grep)"
+ -- Expect NO emoji
+ formatLogEntry entry @?= Just "THOUGHT: Planning tool execution (grep)"
let entry2 =
LogEntry
- { leMessage = "some random log",
+ { leMessage = Just "some random log",
leLevel = Nothing,
leToolName = Nothing,
leBatches = Nothing,
leMethod = Nothing,
- lePath = Nothing,
- leTimestamp = Nothing
+ lePath = Nothing
}
- format entry2 @?= Nothing
+ formatLogEntry entry2 @?= Nothing
let entry3 =
LogEntry
- { leMessage = "some error",
+ { leMessage = Just "some error",
leLevel = Just "error",
leToolName = Nothing,
leBatches = Nothing,
leMethod = Nothing,
- lePath = Nothing,
- leTimestamp = Nothing
+ lePath = Nothing
}
- format entry3 @?= Just "❌ ERROR: some error"
-
-testUpdateStatus :: IO ()
-testUpdateStatus = do
- let s0 = initialStatus "worker-1"
- let e1 =
- LogEntry
- { leMessage = "executing 1 tools in 1 batch(es)",
- leLevel = Nothing,
- leToolName = Nothing,
- leBatches = Just [["grep"]],
- leMethod = Nothing,
- lePath = Nothing,
- leTimestamp = Just "12:00:00"
- }
- let s1 = updateStatus e1 s0
- sLastActivity s1 @?= "🤖 THOUGHT: Planning tool execution (grep)"
- sStartTime s1 @?= Just "12:00:00"
-
- let e2 =
- LogEntry
- { leMessage = "ide-fs",
- leLevel = Nothing,
- leToolName = Nothing,
- leBatches = Nothing,
- leMethod = Just "readFile",
- lePath = Just "/path/to/file",
- leTimestamp = Just "12:00:01"
- }
- let s2 = updateStatus e2 s1
- sLastActivity s2 @?= "📂 READ: /path/to/file"
- Set.member "/path/to/file" (sFiles s2) @?= True
- sStartTime s2 @?= Just "12:00:00" -- Should preserve start time
-
-testRenderStatus :: IO ()
-testRenderStatus = do
- let s =
- Status
- { sWorkerName = "worker-1",
- sTaskId = Just "t-123",
- sFiles = Set.fromList ["file1", "file2"],
- sStartTime = Just "12:00",
- sLastActivity = "Running..."
- }
- let output = renderStatus s
- output @?= "[Worker: worker-1] Task: t-123 | Files: 2\nRunning..."
+ -- Expect NO emoji
+ formatLogEntry entry3 @?= Just "ERROR: some error"
(@?=) :: (Eq a, Show a) => a -> a -> IO ()
(@?=) = (Test.@?=)
diff --git a/Omni/Agent/Worker.hs b/Omni/Agent/Worker.hs
index 94a4e35..c01a853 100644
--- a/Omni/Agent/Worker.hs
+++ b/Omni/Agent/Worker.hs
@@ -5,11 +5,14 @@
module Omni.Agent.Worker where
import Alpha
+import Control.Concurrent (forkIO, killThread, threadDelay)
+import Control.Monad (forever)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString.Lazy as BL
import qualified Data.Scientific as Scientific
import qualified Data.Text as Text
+import qualified Data.Text.IO as TIO
import qualified Data.Time as Time
import qualified Omni.Agent.Core as Core
import qualified Omni.Agent.Git as Git
@@ -152,7 +155,10 @@ runAmp repo task = do
<> "'.\n"
Directory.createDirectoryIfMissing True (repo </> "_/llm")
- let logFile = repo </> "_/llm/amp.log"
+ let logPath = repo </> "_/llm/amp.log"
+
+ -- Ensure log file is empty/exists
+ IO.writeFile logPath ""
-- Read AGENTS.md
agentsMd <-
@@ -167,13 +173,8 @@ runAmp repo task = do
<> "\n\nREPOSITORY GUIDELINES (AGENTS.md):\n"
<> agentsMd
- -- Clean up previous log
- exists <- Directory.doesFileExist logFile
- when exists (Directory.removeFile logFile)
-
- -- Start background monitors
- tidTime <- forkIO timeTicker
- tidLog <- forkIO (monitorLog logFile)
+ -- Monitor log file
+ tidLog <- forkIO (monitorLog logPath)
-- Assume amp is in PATH
let args = ["--log-level", "debug", "--log-file", "_/llm/amp.log", "--dangerously-allow-all", "-x", Text.unpack fullPrompt]
@@ -182,7 +183,6 @@ runAmp repo task = do
(exitCode, out, _err) <- Process.readCreateProcessWithExitCode cp ""
-- Cleanup
- killThread tidTime
killThread tidLog
pure (exitCode, Text.pack out)
@@ -239,56 +239,21 @@ findBaseBranch repo task = do
[] -> pure "live"
monitorLog :: FilePath -> IO ()
-monitorLog logPath = do
- waitForFile logPath
- IO.withFile logPath IO.ReadMode <| \h -> do
- -- Start from beginning of file (don't seek to end)
+monitorLog path = do
+ -- Wait for file to exist
+ waitForFile path
+
+ IO.withFile path IO.ReadMode <| \h -> do
+ IO.hSetBuffering h IO.LineBuffering
forever <| do
eof <- IO.hIsEOF h
if eof
then threadDelay 100000 -- 0.1s
else do
- line <- IO.hGetLine h
- parseAndUpdate (Text.pack line)
+ line <- TIO.hGetLine h
+ AgentLog.processLogLine line
waitForFile :: FilePath -> IO ()
-waitForFile path = do
- exists <- Directory.doesFileExist path
- if exists
- then pure ()
- else do
- threadDelay 100000
- waitForFile path
-
-parseAndUpdate :: Text -> IO ()
-parseAndUpdate line = do
- let maybeObj = Aeson.decode (BL.fromStrict (encodeUtf8 line)) :: Maybe Aeson.Object
- case maybeObj of
- Nothing -> pure ()
- Just obj -> do
- -- Extract message (was msg)
- case KM.lookup "message" obj of
- Just (Aeson.String m) -> unless (Text.null m) (AgentLog.updateActivity m)
- _ -> pure ()
-
- -- Extract threadId
- case KM.lookup "threadId" obj of
- Just (Aeson.String tid) -> AgentLog.update (\s -> s {AgentLog.statusThreadId = Just tid})
- _ -> pure ()
-
- -- Extract cost from usage-ledger:event
- -- Pattern: {"totalCredits": 154.0, "message": "usage-ledger:event", ...}
- -- The credits are in cents, so we divide by 100 to get dollars.
- case KM.lookup "totalCredits" obj of
- Just (Aeson.Number n) ->
- let total = Scientific.toRealFloat n / 100.0
- in AgentLog.update (\s -> s {AgentLog.statusCredits = total})
- _ -> pure ()
-
-timeTicker :: IO ()
-timeTicker =
- forever <| do
- time <- Time.getCurrentTime
- let timeStr = Time.formatTime Time.defaultTimeLocale "%H:%M" time
- AgentLog.update (\s -> s {AgentLog.statusTime = Text.pack timeStr})
- threadDelay 1000000 -- 1s
+waitForFile p = do
+ e <- Directory.doesFileExist p
+ if e then pure () else threadDelay 100000 >> waitForFile p