1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- : out omni-agent-log
module Omni.Agent.Log where
import Alpha
import Data.IORef (IORef, modifyIORef', newIORef, readIORef, writeIORef)
import qualified Data.Text.IO as TIO
import qualified System.Console.ANSI as ANSI
import qualified System.IO as IO
import System.IO.Unsafe (unsafePerformIO)
import Data.Aeson (Value(..), decode)
import qualified Data.Aeson.KeyMap as KM
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,
statusTask :: Maybe Text,
statusFiles :: Int,
statusCredits :: Double,
statusTime :: Text, -- formatted time string
statusActivity :: Text
}
deriving (Show, Eq)
emptyStatus :: Text -> Status
emptyStatus workerName =
Status
{ statusWorker = workerName,
statusTask = Nothing,
statusFiles = 0,
statusCredits = 0.0,
statusTime = "00:00",
statusActivity = "Idle"
}
-- | Global state for the status bar
{-# NOINLINE currentStatus #-}
currentStatus :: IORef Status
currentStatus = unsafePerformIO (newIORef (emptyStatus "Unknown"))
-- | Initialize the status bar system
init :: Text -> IO ()
init workerName = do
IO.hSetBuffering IO.stderr IO.LineBuffering
writeIORef currentStatus (emptyStatus workerName)
-- Reserve 2 lines at bottom
IO.hPutStrLn IO.stderr ""
IO.hPutStrLn IO.stderr ""
ANSI.hCursorUp IO.stderr 2
-- | Update the status
update :: (Status -> Status) -> IO ()
update f = do
modifyIORef' currentStatus f
render
-- | Set the activity message
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
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)
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
-- Clear status bars
ANSI.hClearLine IO.stderr
ANSI.hCursorDown IO.stderr 1
ANSI.hClearLine IO.stderr
ANSI.hCursorUp IO.stderr 1
-- Print message (scrolls screen)
TIO.hPutStrLn IO.stderr msg
-- Re-render status bars at bottom
-- (Since we scrolled, we are now on the line above where the first status line should be)
render
-- | Render the two status lines
render :: IO ()
render = do
Status {..} <- readIORef currentStatus
-- Line 1: Meta
-- [Worker: name] Task: t-123 | Files: 3 | Credits: $0.45 | Time: 05:23
let taskStr = maybe "None" identity statusTask
meta =
"[Worker: "
<> statusWorker
<> "] Task: "
<> taskStr
<> " | Files: "
<> tshow statusFiles
<> " | Credits: $"
<> tshow statusCredits
<> " | Time: "
<> statusTime
ANSI.hSetCursorColumn IO.stderr 0
ANSI.hClearLine IO.stderr
TIO.hPutStr IO.stderr meta
-- Line 2: Activity
-- [14:05:22] > Thinking...
ANSI.hCursorDown IO.stderr 1
ANSI.hSetCursorColumn IO.stderr 0
ANSI.hClearLine IO.stderr
TIO.hPutStr IO.stderr ("> " <> statusActivity)
-- Return cursor to line 1
ANSI.hCursorUp IO.stderr 1
IO.hFlush IO.stderr
|
