Commit: 20a2dd4d
commit 20a2dd4d40342f274ed7d48cfc7caf4ab6ace2db
Author: Coder Agent <coder@agents.omni>
Date: Thu Apr 16 04:22:03 2026
refactor(agentd): split view and log/session helpers
Move persistent watch/activity rendering into Omni.Agentd.PersistentView.
Move session JSON parsing and log filtering into SessionJson and LogFilter.
Wire Daemon/CLI to the new modules with behavior unchanged.
Task-Id: t-805
diff --git a/Omni/Agentd.hs b/Omni/Agentd.hs
index df5d10e1..607b43a4 100755
--- a/Omni/Agentd.hs
+++ b/Omni/Agentd.hs
@@ -44,7 +44,6 @@ import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.Encoding as TE
-import qualified Data.Text.Encoding.Error as TextEncodingError
import qualified Data.Text.IO as TextIO
import qualified Data.Time as Time
import qualified Data.Vector as Vector
@@ -58,6 +57,7 @@ import qualified Omni.Agent.Trace as Trace
-- import qualified Omni.Agent.Op.Runner as OpRunner
import qualified Omni.Agent.Watch as Watch
import qualified Omni.Agentd.Daemon as Daemon
+import Omni.Agentd.PersistentView
import qualified Omni.Agentd.SessionLog as SessionLog
import qualified Omni.Agents.Summarize as AgentSummary
import qualified Omni.Test as Test
@@ -1387,201 +1387,6 @@ followPersistentWatchSession sessionPath timezone details runId = loop
Concurrent.threadDelay persistentWatchPollMicros
loop nextOffset
-formatPersistentWatchLine :: Time.TimeZone -> Bool -> Text -> Text -> Maybe Text
-formatPersistentWatchLine timezone details runId line =
- let trimmed = Text.strip line
- in if Text.null trimmed
- then Nothing
- else case decodeJsonObject line of
- Nothing -> Just <| watchPrefix timezone runId Nothing <> "raw " <> clipWatchText 120 trimmed
- Just obj ->
- let timestamp = topLookupTextField "timestamp" obj
- in case topLookupTextField "type" obj of
- Nothing ->
- if details
- then Just <| watchPrefix timezone runId timestamp <> "event " <> clipWatchText 120 trimmed
- else Nothing
- Just _ ->
- let body = renderPersistentWatchEvent details obj
- in Just <| watchPrefix timezone runId timestamp <> body
-
-watchPrefix :: Time.TimeZone -> Text -> Maybe Text -> Text
-watchPrefix timezone runId mTimestamp =
- formatWatchTimestamp timezone mTimestamp <> " [" <> runId <> "] "
-
-formatWatchTimestamp :: Time.TimeZone -> Maybe Text -> Text
-formatWatchTimestamp timezone mTimestamp =
- case mTimestamp of
- Nothing -> "--:--:--"
- Just ts ->
- case parseWatchTimestamp ts of
- Nothing -> "--:--:--"
- Just utc ->
- Text.pack
- <| Time.formatTime
- Time.defaultTimeLocale
- "%H:%M:%S"
- (Time.utcToLocalTime timezone utc)
-
-parseWatchTimestamp :: Text -> Maybe Time.UTCTime
-parseWatchTimestamp ts =
- let input = Text.unpack (Text.strip ts)
- in Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" input
- <|> Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q%z" input
- <|> Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%d %H:%M:%S%Q UTC" input
-
-renderPersistentWatchEvent :: Bool -> Aeson.Object -> Text
-renderPersistentWatchEvent details obj =
- case topLookupTextField "type" obj of
- Just "session" ->
- "session cwd=" <> fromMaybe "?" (topLookupTextField "cwd" obj)
- Just "model_change" ->
- let provider = fromMaybe "?" (topLookupTextField "provider" obj)
- modelId = fromMaybe "?" (topLookupTextField "modelId" obj)
- in "model " <> provider <> "/" <> modelId
- Just "thinking_level_change" ->
- "thinking " <> fromMaybe "?" (topLookupTextField "thinkingLevel" obj)
- Just "message" ->
- fromMaybe "message" (renderPersistentWatchMessage details obj)
- Just "infer_start" ->
- let iter = maybe "" (\i -> " i=" <> tshow i) (topLookupIntField "iteration" obj)
- model = maybe "" (" model=" <>) (topLookupTextField "model" obj)
- in "infer_start" <> iter <> model
- Just "tool_call" ->
- let toolName = fromMaybe "tool" (topLookupTextField "tool_name" obj)
- argPreview =
- case topLookupObjectField "tool_args" obj of
- Nothing -> ""
- Just argsObj ->
- if details
- then " " <> renderJsonObjectPreview 180 argsObj
- else case topLookupTextField "command" argsObj of
- Nothing -> ""
- Just cmd -> " cmd=" <> clipWatchText 90 cmd
- in "tool_call " <> toolName <> argPreview
- Just "tool_result" ->
- let toolName = fromMaybe "tool" (topLookupTextField "tool_name" obj)
- ok = fromMaybe True (topLookupBoolField "success" obj)
- icon = if ok then "✓" else "✗"
- duration = maybe "" (\ms -> " (" <> tshow ms <> "ms)") (topLookupIntField "duration_ms" obj)
- outputPreview =
- case topLookupTextField "output" obj of
- Nothing -> ""
- Just out ->
- let limit = if details then 220 else 120
- in ": " <> clipWatchText limit out
- in "tool_result " <> icon <> " " <> toolName <> duration <> outputPreview
- Just "infer_end" ->
- let iter = maybe "" (\i -> " i=" <> tshow i) (topLookupIntField "iteration" obj)
- tokens = maybe "" (\n -> " tok=" <> tshow n) (topLookupIntField "tokens" obj)
- duration = maybe "" (\ms -> " dur=" <> tshow ms <> "ms") (topLookupIntField "duration_ms" obj)
- cost = maybe "" (\c -> " cost=" <> formatCost c) (topLookupNumberField "cost_cents" obj)
- responsePreview =
- if details
- then case topLookupTextField "response_preview" obj of
- Nothing -> ""
- Just resp -> " | " <> clipWatchText 180 resp
- else ""
- in "infer_end" <> iter <> tokens <> duration <> cost <> responsePreview
- Just "checkpoint" ->
- "checkpoint " <> fromMaybe "?" (topLookupTextField "name" obj)
- Just "result" ->
- let ok = fromMaybe True (topLookupBoolField "success" obj)
- prefix = if ok then "result ✓" else "result ✗"
- message =
- topLookupTextField "response" obj
- <|> topLookupTextField "error" obj
- <|> topLookupTextField "message" obj
- in case message of
- Nothing -> prefix
- Just txt -> prefix <> ": " <> clipWatchText (if details then 220 else 120) txt
- Just "custom" ->
- renderPersistentWatchCustom details obj
- Just other ->
- "event " <> other
- Nothing ->
- "event"
-
-renderPersistentWatchMessage :: Bool -> Aeson.Object -> Maybe Text
-renderPersistentWatchMessage details obj = do
- msgObj <- topLookupObjectField "message" obj
- role <- topLookupTextField "role" msgObj
- case role of
- "user" ->
- let snippet = fromMaybe "(message)" (messageTextSnippet msgObj)
- limit = if details then 220 else 120
- in Just <| "user: " <> clipWatchText limit snippet
- "assistant" ->
- case messageToolCalls msgObj of
- tool : rest ->
- let preview =
- if null rest
- then tool
- else tool <> " +" <> tshow (length rest)
- in Just <| "assistant→tool " <> preview
- [] ->
- let snippet =
- fromMaybe "(assistant response)"
- <| messageTextSnippet msgObj
- <|> messageThinkingSnippet msgObj
- limit = if details then 220 else 120
- in Just <| "assistant: " <> clipWatchText limit snippet
- "toolResult" ->
- let toolName = fromMaybe "tool" (topLookupTextField "toolName" msgObj)
- isError = fromMaybe False (topLookupBoolField "isError" msgObj)
- icon = if isError then "✗" else "✓"
- suffix =
- case messageTextSnippet msgObj of
- Nothing -> ""
- Just snippet ->
- let limit = if details then 220 else 120
- in ": " <> clipWatchText limit snippet
- in Just <| "tool_result " <> icon <> " " <> toolName <> suffix
- _ ->
- Just <| "message " <> role
-
-renderPersistentWatchCustom :: Bool -> Aeson.Object -> Text
-renderPersistentWatchCustom details obj =
- let customType = fromMaybe "custom" (topLookupTextField "custom_type" obj)
- message =
- case topLookupObjectField "data" obj of
- Nothing -> Nothing
- Just dataObj ->
- topLookupTextField "message" dataObj
- <|> topLookupTextField "response" dataObj
- <|> topLookupTextField "error" dataObj
- <|> topLookupTextField "content" dataObj
- suffix =
- case message of
- Nothing -> ""
- Just msg ->
- let limit = if details then 220 else 120
- in ": " <> clipWatchText limit msg
- in customType <> suffix
-
-messageThinkingSnippet :: Aeson.Object -> Maybe Text
-messageThinkingSnippet msgObj =
- case topLookupArrayField "content" msgObj of
- Nothing -> Nothing
- Just parts -> listToMaybe (mapMaybe extractThinking parts)
- where
- extractThinking (Aeson.Object partObj) = do
- partType <- topLookupTextField "type" partObj
- guard (partType == "thinking")
- topLookupTextField "thinking" partObj
- extractThinking _ = Nothing
-
-renderJsonObjectPreview :: Int -> Aeson.Object -> Text
-renderJsonObjectPreview limit obj =
- clipWatchText limit <| TE.decodeUtf8With TextEncodingError.lenientDecode (BL.toStrict (Aeson.encode (Aeson.Object obj)))
-
-clipWatchText :: Int -> Text -> Text
-clipWatchText limit txt =
- let cleaned = Text.strip <| Text.replace "\n" " " txt
- in if Text.length cleaned > limit
- then Text.take limit cleaned <> "…"
- else cleaned
-
-- | Active persistent session names suitable for default watch mode.
activePersistentWatchIds :: IO [Text]
activePersistentWatchIds = do
@@ -3123,12 +2928,6 @@ completeJsonLines content =
takeLast :: Int -> [a] -> [a]
takeLast n xs = List.drop (max 0 (length xs - n)) xs
-formatCost :: Double -> Text
-formatCost c = Text.pack <| Printf.printf "%.2f¢" c
-
-clipActivity :: Text -> Text
-clipActivity = Text.take 120 <. Text.replace "\n" " " <. Text.strip
-
buildActivityFingerprint :: Text -> [Text] -> [Text] -> Text
buildActivityFingerprint status thinking tools =
clipActivity <| Text.intercalate "|" (status : takeLast 4 thinking <> takeLast 4 tools)
@@ -3215,134 +3014,6 @@ eventPayloadObject (Aeson.Object obj) =
_ -> Just obj
eventPayloadObject _ = Nothing
-persistentLineLabel :: Text -> Maybe Text
-persistentLineLabel line = do
- obj <- decodeJsonObject line
- eventType <- topLookupTextField "type" obj
- case eventType of
- "session" -> Just "session started"
- "model_change" -> Just "model changed"
- "thinking_level_change" -> Just "thinking level changed"
- "message" -> do
- msgObj <- topLookupObjectField "message" obj
- role <- topLookupTextField "role" msgObj
- case role of
- "user" ->
- let snippet = fromMaybe "user message" (messageTextSnippet msgObj)
- in Just <| "user: " <> clipActivity snippet
- "assistant" ->
- case messageToolCalls msgObj of
- tool : _ -> Just <| "running tool " <> tool
- [] ->
- let snippet = fromMaybe "assistant message" (messageTextSnippet msgObj)
- in Just <| "assistant: " <> clipActivity snippet
- "toolResult" ->
- let toolName = fromMaybe "tool" (topLookupTextField "toolName" msgObj)
- in Just <| "tool result: " <> toolName
- _ -> Just <| "message: " <> role
- "result" ->
- let ok = fromMaybe True (topLookupBoolField "success" obj)
- prefix = if ok then "result" else "result error"
- detail =
- topLookupTextField "response" obj
- <|> topLookupTextField "error" obj
- <|> topLookupTextField "message" obj
- in Just <| case detail of
- Nothing -> prefix
- Just txt -> prefix <> ": " <> clipActivity txt
- _ -> Just eventType
-
-persistentToolLabel :: Text -> Maybe Text
-persistentToolLabel line = do
- obj <- decodeJsonObject line
- eventType <- topLookupTextField "type" obj
- guard (eventType == "message")
- msgObj <- topLookupObjectField "message" obj
- role <- topLookupTextField "role" msgObj
- case role of
- "assistant" ->
- case messageToolCalls msgObj of
- tool : _ -> Just <| "tool " <> tool
- [] -> Nothing
- "toolResult" -> ("tool " <>) </ topLookupTextField "toolName" msgObj
- _ -> Nothing
-
-messageToolCalls :: Aeson.Object -> [Text]
-messageToolCalls msgObj =
- case topLookupArrayField "content" msgObj of
- Nothing -> []
- Just parts -> mapMaybe toolCallName parts
- where
- toolCallName (Aeson.Object partObj) = do
- typ <- topLookupTextField "type" partObj
- guard (typ == "toolCall")
- topLookupTextField "name" partObj
- toolCallName _ = Nothing
-
-messageTextSnippet :: Aeson.Object -> Maybe Text
-messageTextSnippet msgObj =
- case topLookupArrayField "content" msgObj of
- Nothing -> Nothing
- Just parts -> listToMaybe (mapMaybe textPart parts)
- where
- textPart (Aeson.Object partObj) = do
- typ <- topLookupTextField "type" partObj
- guard (typ == "text")
- topLookupTextField "text" partObj
- textPart _ = Nothing
-
-normalizePersistentSessionObject :: Aeson.Object -> Aeson.Object
-normalizePersistentSessionObject obj =
- case topLookupTextField "type" obj of
- Just _ -> obj
- Nothing ->
- case topLookupBoolField "success" obj of
- Just _ -> KeyMap.insert "type" (Aeson.String "result") obj
- Nothing -> obj
-
-decodeJsonObject :: Text -> Maybe Aeson.Object
-decodeJsonObject line = do
- value <- Aeson.decodeStrict' (TE.encodeUtf8 line)
- case value of
- Aeson.Object obj -> Just (normalizePersistentSessionObject obj)
- _ -> Nothing
-
-topLookupTextField :: Text -> Aeson.Object -> Maybe Text
-topLookupTextField key obj =
- case KeyMap.lookup (Key.fromText key) obj of
- Just (Aeson.String val) -> Just val
- _ -> Nothing
-
-topLookupIntField :: Text -> Aeson.Object -> Maybe Int
-topLookupIntField key obj =
- case KeyMap.lookup (Key.fromText key) obj of
- Just (Aeson.Number val) -> Just (round val)
- _ -> Nothing
-
-topLookupNumberField :: Text -> Aeson.Object -> Maybe Double
-topLookupNumberField key obj =
- case KeyMap.lookup (Key.fromText key) obj of
- Just (Aeson.Number val) -> Just (realToFrac val)
- _ -> Nothing
-
-topLookupBoolField :: Text -> Aeson.Object -> Maybe Bool
-topLookupBoolField key obj =
- case KeyMap.lookup (Key.fromText key) obj of
- Just (Aeson.Bool val) -> Just val
- _ -> Nothing
-
-topLookupObjectField :: Text -> Aeson.Object -> Maybe Aeson.Object
-topLookupObjectField key obj =
- case KeyMap.lookup (Key.fromText key) obj of
- Just (Aeson.Object val) -> Just val
- _ -> Nothing
-
-topLookupArrayField :: Text -> Aeson.Object -> Maybe [Aeson.Value]
-topLookupArrayField key obj =
- case KeyMap.lookup (Key.fromText key) obj of
- Just (Aeson.Array vals) -> Just (Vector.toList vals)
- _ -> Nothing
-
daemonStatusLabel :: Daemon.AgentStatus -> Text
daemonStatusLabel = \case
Daemon.StatusPending -> "Pending"
diff --git a/Omni/Agentd/Daemon.hs b/Omni/Agentd/Daemon.hs
index 6c979766..54535706 100644
--- a/Omni/Agentd/Daemon.hs
+++ b/Omni/Agentd/Daemon.hs
@@ -66,7 +66,6 @@ import qualified Control.Concurrent.STM as STM
import qualified Control.Exception as Exception
import Data.Aeson (FromJSON, ToJSON, (.:), (.:?), (.=))
import qualified Data.Aeson as Aeson
-import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
@@ -85,6 +84,15 @@ import qualified Database.SQLite.Simple as SQL
import qualified Network.HTTP.Simple as HTTP
import qualified Omni.Agent.Models as Models
import qualified Omni.Agent.Trace as Trace
+import Omni.Agentd.LogFilter (LogFilterOptions (..), defaultLogFilterOptions)
+import qualified Omni.Agentd.LogFilter as LogFilter
+import Omni.Agentd.SessionJson
+ ( lineObjectFromJsonl,
+ lookupObjectKey,
+ lookupTextKey,
+ parseLogTimestamp,
+ sessionObjectFromJsonlBytes,
+ )
import qualified Omni.Agentd.SessionLog as SessionLog
import qualified Omni.Agents.Summarize as Summarize
import qualified Omni.Test as Test
@@ -1598,158 +1606,6 @@ purgePersistentAgent mDbPath runId = do
Left err -> pure (Left ("Failed to purge agent: " <> tshow err))
Right () -> pure (Right ())
-data LogFilterOptions = LogFilterOptions
- { lfoLast :: Maybe Int,
- lfoSince :: Maybe Text,
- lfoType :: Maybe Text,
- lfoRole :: Maybe Text,
- lfoContains :: Maybe Text
- }
- deriving (Show, Eq)
-
-defaultLogFilterOptions :: LogFilterOptions
-defaultLogFilterOptions =
- LogFilterOptions
- { lfoLast = Nothing,
- lfoSince = Nothing,
- lfoType = Nothing,
- lfoRole = Nothing,
- lfoContains = Nothing
- }
-
-data ParsedLogFilterOptions = ParsedLogFilterOptions
- { plfoLast :: Maybe Int,
- plfoSince :: Maybe Time.UTCTime,
- plfoType :: Maybe Text,
- plfoRole :: Maybe Text,
- plfoContains :: Maybe Text
- }
- deriving (Show, Eq)
-
-compileLogFilterOptions :: LogFilterOptions -> Either Text ParsedLogFilterOptions
-compileLogFilterOptions opts = do
- forM_ (lfoLast opts) <| \n ->
- when (n <= 0) <| Left "--last must be greater than 0"
- parsedSince <- case lfoSince opts of
- Nothing -> Right Nothing
- Just raw ->
- case parseLogTimestamp raw of
- Nothing ->
- Left
- <| "Invalid --since timestamp: "
- <> raw
- <> " (expected RFC3339, e.g. 2026-04-11T13:59:40Z)"
- Just ts -> Right (Just ts)
- pure
- ParsedLogFilterOptions
- { plfoLast = lfoLast opts,
- plfoSince = parsedSince,
- plfoType = lfoType opts,
- plfoRole = lfoRole opts,
- plfoContains = lfoContains opts
- }
-
-parseLogTimestamp :: Text -> Maybe Time.UTCTime
-parseLogTimestamp ts =
- let input = Text.unpack (Text.strip ts)
- in Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" input
- <|> Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q%z" input
- <|> Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%d %H:%M:%S%Q UTC" input
-
-normalizeSessionObject :: Aeson.Object -> Aeson.Object
-normalizeSessionObject obj =
- case lookupTextKey "type" obj of
- Just _ -> obj
- Nothing ->
- case lookupBoolKey "success" obj of
- Just _ -> KeyMap.insert "type" (Aeson.String "result") obj
- Nothing -> obj
-
-sessionObjectFromJsonlBytes :: BS.ByteString -> Maybe Aeson.Object
-sessionObjectFromJsonlBytes bytes = do
- value <- Aeson.decodeStrict' bytes
- case value of
- Aeson.Object obj -> Just (normalizeSessionObject obj)
- _ -> Nothing
-
-lineObjectFromJsonl :: Text -> Maybe Aeson.Object
-lineObjectFromJsonl line = sessionObjectFromJsonlBytes (TextEncoding.encodeUtf8 line)
-
-lineMatchesLogFilter :: ParsedLogFilterOptions -> Text -> Bool
-lineMatchesLogFilter filterOpts line =
- let obj = lineObjectFromJsonl line
- normalize = Text.toLower <. Text.strip
- containsMatches =
- case plfoContains filterOpts of
- Nothing -> True
- Just needle -> needle `Text.isInfixOf` line
- typeMatches =
- case plfoType filterOpts of
- Nothing -> True
- Just expected ->
- case obj of
- Nothing -> False
- Just o ->
- case lookupTextKey "type" o of
- Just actual -> normalize actual == normalize expected
- Nothing -> False
- roleMatches =
- case plfoRole filterOpts of
- Nothing -> True
- Just expected ->
- case obj of
- Nothing -> False
- Just o ->
- case lookupObjectKey "message" o of
- Nothing -> False
- Just messageObj ->
- case lookupTextKey "role" messageObj of
- Just actual -> normalize actual == normalize expected
- Nothing -> False
- sinceMatches =
- case plfoSince filterOpts of
- Nothing -> True
- Just sinceTs ->
- case obj of
- Nothing -> False
- Just o ->
- case lookupTextKey "timestamp" o of
- Nothing -> False
- Just ts ->
- case parseLogTimestamp ts of
- Just eventTs -> eventTs >= sinceTs
- Nothing -> False
- in containsMatches && typeMatches && roleMatches && sinceMatches
-
-selectLogLines :: ParsedLogFilterOptions -> [Text] -> [Text]
-selectLogLines filterOpts lines' =
- let nonBlankLines = filter (not <. Text.null <. Text.strip) lines'
- matching = filter (lineMatchesLogFilter filterOpts) nonBlankLines
- in case plfoLast filterOpts of
- Nothing -> matching
- Just n -> List.drop (max 0 (length matching - n)) matching
-
-decodeLogLine :: BS.ByteString -> Text
-decodeLogLine = SessionLog.decodeJsonlLine
-
-followSessionLogFile :: FilePath -> ParsedLogFilterOptions -> Integer -> IO Exit.ExitCode
-followSessionLogFile sessionPath filterOpts = loop
- where
- loop offset = do
- exists <- Dir.doesFileExist sessionPath
- if not exists
- then do
- TextIO.hPutStrLn IO.stderr <| "Session log disappeared while following: " <> Text.pack sessionPath
- pure (Exit.ExitFailure 1)
- else do
- (lineBytes, nextOffset) <- SessionLog.readJsonlFromOffset sessionPath offset
- let linesText = map decodeLogLine lineBytes
- forM_ linesText <| \line ->
- when (lineMatchesLogFilter filterOpts line) <| TextIO.putStrLn line
- unless (null linesText) <| IO.hFlush IO.stdout
- threadDelay 250000
- loop nextOffset
-
streamAgentLogs :: Text -> Bool -> LogFilterOptions -> IO Exit.ExitCode
streamAgentLogs runId follow filterOptions = do
sessionPath <- agentSessionLogPath runId
@@ -1758,25 +1614,7 @@ streamAgentLogs runId follow filterOptions = do
then do
TextIO.hPutStrLn IO.stderr <| "No session log found for " <> runId <> ": " <> Text.pack sessionPath
pure (Exit.ExitFailure 1)
- else case compileLogFilterOptions filterOptions of
- Left err -> do
- TextIO.hPutStrLn IO.stderr err
- pure (Exit.ExitFailure 1)
- Right parsedFilter -> do
- initialChunk <- IO.withFile sessionPath IO.ReadMode BS.hGetContents
- let (initialLineBytes, initialOffset) = SessionLog.splitCompleteJsonlLines initialChunk
- initialLines = map decodeLogLine initialLineBytes
- selected = selectLogLines parsedFilter initialLines
- if follow
- then do
- forM_ selected TextIO.putStrLn
- unless (null selected) <| IO.hFlush IO.stdout
- followSessionLogFile sessionPath parsedFilter initialOffset
- else do
- if null selected
- then TextIO.putStrLn "-- No entries --"
- else forM_ selected TextIO.putStrLn
- pure Exit.ExitSuccess
+ else LogFilter.streamSessionLogFile sessionPath follow filterOptions
-- * Notification bridge (events.jsonl -> maildir)
@@ -1946,24 +1784,6 @@ parseNotifyEventLine line = do
}
_ -> Nothing
-lookupTextKey :: Text -> Aeson.Object -> Maybe Text
-lookupTextKey key obj =
- case KeyMap.lookup (Key.fromText key) obj of
- Just (Aeson.String val) -> Just val
- _ -> Nothing
-
-lookupBoolKey :: Text -> Aeson.Object -> Maybe Bool
-lookupBoolKey key obj =
- case KeyMap.lookup (Key.fromText key) obj of
- Just (Aeson.Bool val) -> Just val
- _ -> Nothing
-
-lookupObjectKey :: Text -> Aeson.Object -> Maybe Aeson.Object
-lookupObjectKey key obj =
- case KeyMap.lookup (Key.fromText key) obj of
- Just (Aeson.Object val) -> Just val
- _ -> Nothing
-
deliverNotifyEvent :: FilePath -> Text -> NotifyState -> NotifyEvent -> IO NotifyState
deliverNotifyEvent maildir runId state event = do
let eventKey = runId <> "|" <> neType event <> "|" <> neTimestamp event
@@ -2895,18 +2715,18 @@ test =
"{\"type\":\"message\",\"timestamp\":\"2026-04-11T15:01:15.946Z\",\"message\":{\"role\":\"user\"}}",
"{\"type\":\"message\",\"timestamp\":\"2026-04-11T15:01:19.802Z\",\"message\":{\"role\":\"assistant\"}}"
]
- case compileLogFilterOptions defaultLogFilterOptions {lfoLast = Just 1} of
+ case LogFilter.compileLogFilterOptions defaultLogFilterOptions {lfoLast = Just 1} of
Left err -> Test.assertFailure (Text.unpack err)
- Right parsed -> selectLogLines parsed lines' Test.@=? [List.last lines'],
+ Right parsed -> LogFilter.selectLogLines parsed lines' Test.@=? [List.last lines'],
Test.unit "log filter supports --since" <| do
let lines' =
[ "{\"type\":\"session\",\"timestamp\":\"2026-04-11T13:59:40.563Z\"}",
"{\"type\":\"message\",\"timestamp\":\"2026-04-11T15:01:15.946Z\",\"message\":{\"role\":\"user\"}}",
"{\"type\":\"message\",\"timestamp\":\"2026-04-11T15:01:19.802Z\",\"message\":{\"role\":\"assistant\"}}"
]
- case compileLogFilterOptions defaultLogFilterOptions {lfoSince = Just "2026-04-11T15:01:16Z"} of
+ case LogFilter.compileLogFilterOptions defaultLogFilterOptions {lfoSince = Just "2026-04-11T15:01:16Z"} of
Left err -> Test.assertFailure (Text.unpack err)
- Right parsed -> selectLogLines parsed lines' Test.@=? [List.last lines'],
+ Right parsed -> LogFilter.selectLogLines parsed lines' Test.@=? [List.last lines'],
Test.unit "log filter supports --type and --role" <| do
let lines' =
[ "{\"type\":\"session\",\"timestamp\":\"2026-04-11T13:59:40.563Z\"}",
@@ -2918,17 +2738,17 @@ test =
{ lfoType = Just "message",
lfoRole = Just "assistant"
}
- case compileLogFilterOptions opts of
+ case LogFilter.compileLogFilterOptions opts of
Left err -> Test.assertFailure (Text.unpack err)
- Right parsed -> selectLogLines parsed lines' Test.@=? [List.last lines'],
+ Right parsed -> LogFilter.selectLogLines parsed lines' Test.@=? [List.last lines'],
Test.unit "log filter supports legacy untyped result lines" <| do
let lines' =
[ "{\"type\":\"session\",\"timestamp\":\"2026-04-11T13:59:40.563Z\"}",
"{\"success\":true,\"response\":\"done\"}"
]
- case compileLogFilterOptions defaultLogFilterOptions {lfoType = Just "result"} of
+ case LogFilter.compileLogFilterOptions defaultLogFilterOptions {lfoType = Just "result"} of
Left err -> Test.assertFailure (Text.unpack err)
- Right parsed -> selectLogLines parsed lines' Test.@=? [List.last lines'],
+ Right parsed -> LogFilter.selectLogLines parsed lines' Test.@=? [List.last lines'],
Test.unit "session log splitter drops trailing partial line" <| do
let chunk = TextEncoding.encodeUtf8 "{\"type\":\"a\"}\n{\"type\":\"b\"}\n{\"type\":\"partial\""
expectedConsumed = fromIntegral (BS.length (TextEncoding.encodeUtf8 "{\"type\":\"a\"}\n{\"type\":\"b\"}\n"))
@@ -2941,7 +2761,7 @@ test =
(lines', _nextOffset) <- SessionLog.readTailJsonlLines path 7
map SessionLog.decodeJsonlLine lines' Test.@=? ["xyz"],
Test.unit "log filter rejects invalid --since timestamps" <| do
- case compileLogFilterOptions defaultLogFilterOptions {lfoSince = Just "not-a-time"} of
+ case LogFilter.compileLogFilterOptions defaultLogFilterOptions {lfoSince = Just "not-a-time"} of
Left _ -> pure ()
Right _ -> Test.assertFailure "Expected invalid --since to fail",
Test.unit "persistent unit template avoids ~/.local/bin" <| do
diff --git a/Omni/Agentd/LogFilter.hs b/Omni/Agentd/LogFilter.hs
new file mode 100644
index 00000000..d0e200f8
--- /dev/null
+++ b/Omni/Agentd/LogFilter.hs
@@ -0,0 +1,179 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Omni.Agentd.LogFilter
+ ( LogFilterOptions (..),
+ defaultLogFilterOptions,
+ ParsedLogFilterOptions,
+ compileLogFilterOptions,
+ lineMatchesLogFilter,
+ selectLogLines,
+ streamSessionLogFile,
+ )
+where
+
+import Alpha
+import qualified Control.Concurrent as Concurrent
+import qualified Data.ByteString as BS
+import qualified Data.List as List
+import qualified Data.Text as Text
+import qualified Data.Text.IO as TextIO
+import qualified Data.Time as Time
+import qualified Omni.Agentd.SessionJson as SessionJson
+import qualified Omni.Agentd.SessionLog as SessionLog
+import qualified System.Directory as Dir
+import qualified System.Exit as Exit
+import qualified System.IO as IO
+
+data LogFilterOptions = LogFilterOptions
+ { lfoLast :: Maybe Int,
+ lfoSince :: Maybe Text,
+ lfoType :: Maybe Text,
+ lfoRole :: Maybe Text,
+ lfoContains :: Maybe Text
+ }
+ deriving (Show, Eq)
+
+defaultLogFilterOptions :: LogFilterOptions
+defaultLogFilterOptions =
+ LogFilterOptions
+ { lfoLast = Nothing,
+ lfoSince = Nothing,
+ lfoType = Nothing,
+ lfoRole = Nothing,
+ lfoContains = Nothing
+ }
+
+data ParsedLogFilterOptions = ParsedLogFilterOptions
+ { plfoLast :: Maybe Int,
+ plfoSince :: Maybe Time.UTCTime,
+ plfoType :: Maybe Text,
+ plfoRole :: Maybe Text,
+ plfoContains :: Maybe Text
+ }
+ deriving (Show, Eq)
+
+compileLogFilterOptions :: LogFilterOptions -> Either Text ParsedLogFilterOptions
+compileLogFilterOptions opts = do
+ forM_ (lfoLast opts) <| \n ->
+ when (n <= 0) <| Left "--last must be greater than 0"
+ parsedSince <- case lfoSince opts of
+ Nothing -> Right Nothing
+ Just raw ->
+ case SessionJson.parseLogTimestamp raw of
+ Nothing ->
+ Left
+ <| "Invalid --since timestamp: "
+ <> raw
+ <> " (expected RFC3339, e.g. 2026-04-11T13:59:40Z)"
+ Just ts -> Right (Just ts)
+ pure
+ ParsedLogFilterOptions
+ { plfoLast = lfoLast opts,
+ plfoSince = parsedSince,
+ plfoType = lfoType opts,
+ plfoRole = lfoRole opts,
+ plfoContains = lfoContains opts
+ }
+
+lineMatchesLogFilter :: ParsedLogFilterOptions -> Text -> Bool
+lineMatchesLogFilter filterOpts line =
+ let obj = SessionJson.lineObjectFromJsonl line
+ normalize = Text.toLower <. Text.strip
+ containsMatches =
+ case plfoContains filterOpts of
+ Nothing -> True
+ Just needle -> needle `Text.isInfixOf` line
+ typeMatches =
+ case plfoType filterOpts of
+ Nothing -> True
+ Just expected ->
+ case obj of
+ Nothing -> False
+ Just o ->
+ case SessionJson.lookupTextKey "type" o of
+ Just actual -> normalize actual == normalize expected
+ Nothing -> False
+ roleMatches =
+ case plfoRole filterOpts of
+ Nothing -> True
+ Just expected ->
+ case obj of
+ Nothing -> False
+ Just o ->
+ case SessionJson.lookupObjectKey "message" o of
+ Nothing -> False
+ Just messageObj ->
+ case SessionJson.lookupTextKey "role" messageObj of
+ Just actual -> normalize actual == normalize expected
+ Nothing -> False
+ sinceMatches =
+ case plfoSince filterOpts of
+ Nothing -> True
+ Just sinceTs ->
+ case obj of
+ Nothing -> False
+ Just o ->
+ case SessionJson.lookupTextKey "timestamp" o of
+ Nothing -> False
+ Just ts ->
+ case SessionJson.parseLogTimestamp ts of
+ Just eventTs -> eventTs >= sinceTs
+ Nothing -> False
+ in containsMatches && typeMatches && roleMatches && sinceMatches
+
+selectLogLines :: ParsedLogFilterOptions -> [Text] -> [Text]
+selectLogLines filterOpts lines' =
+ let nonBlankLines = filter (not <. Text.null <. Text.strip) lines'
+ matching = filter (lineMatchesLogFilter filterOpts) nonBlankLines
+ in case plfoLast filterOpts of
+ Nothing -> matching
+ Just n -> List.drop (max 0 (length matching - n)) matching
+
+decodeLogLine :: BS.ByteString -> Text
+decodeLogLine = SessionLog.decodeJsonlLine
+
+followSessionLogFile :: FilePath -> ParsedLogFilterOptions -> Integer -> IO Exit.ExitCode
+followSessionLogFile sessionPath filterOpts = loop
+ where
+ loop offset = do
+ exists <- Dir.doesFileExist sessionPath
+ if not exists
+ then do
+ TextIO.hPutStrLn IO.stderr <| "Session log disappeared while following: " <> Text.pack sessionPath
+ pure (Exit.ExitFailure 1)
+ else do
+ (lineBytes, nextOffset) <- SessionLog.readJsonlFromOffset sessionPath offset
+ let linesText = map decodeLogLine lineBytes
+ forM_ linesText <| \line ->
+ when (lineMatchesLogFilter filterOpts line) <| TextIO.putStrLn line
+ unless (null linesText) <| IO.hFlush IO.stdout
+ Concurrent.threadDelay 250000
+ loop nextOffset
+
+streamSessionLogFile :: FilePath -> Bool -> LogFilterOptions -> IO Exit.ExitCode
+streamSessionLogFile sessionPath follow filterOptions = do
+ exists <- Dir.doesFileExist sessionPath
+ if not exists
+ then do
+ TextIO.hPutStrLn IO.stderr <| "No session log found: " <> Text.pack sessionPath
+ pure (Exit.ExitFailure 1)
+ else case compileLogFilterOptions filterOptions of
+ Left err -> do
+ TextIO.hPutStrLn IO.stderr err
+ pure (Exit.ExitFailure 1)
+ Right parsedFilter -> do
+ initialChunk <- IO.withFile sessionPath IO.ReadMode BS.hGetContents
+ let (initialLineBytes, initialOffset) = SessionLog.splitCompleteJsonlLines initialChunk
+ initialLines = map decodeLogLine initialLineBytes
+ selected = selectLogLines parsedFilter initialLines
+ if follow
+ then do
+ forM_ selected TextIO.putStrLn
+ unless (null selected) <| IO.hFlush IO.stdout
+ followSessionLogFile sessionPath parsedFilter initialOffset
+ else do
+ if null selected
+ then TextIO.putStrLn "-- No entries --"
+ else forM_ selected TextIO.putStrLn
+ pure Exit.ExitSuccess
diff --git a/Omni/Agentd/PersistentView.hs b/Omni/Agentd/PersistentView.hs
new file mode 100644
index 00000000..06b3f243
--- /dev/null
+++ b/Omni/Agentd/PersistentView.hs
@@ -0,0 +1,360 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Rendering and parsing helpers for persistent session JSONL streams.
+module Omni.Agentd.PersistentView
+ ( formatPersistentWatchLine,
+ persistentLineLabel,
+ persistentToolLabel,
+ decodeJsonObject,
+ topLookupTextField,
+ topLookupIntField,
+ topLookupNumberField,
+ topLookupBoolField,
+ topLookupObjectField,
+ topLookupArrayField,
+ formatCost,
+ clipActivity,
+ )
+where
+
+import Alpha
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Key as Key
+import qualified Data.Aeson.KeyMap as KeyMap
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as TE
+import qualified Data.Text.Encoding.Error as TextEncodingError
+import qualified Data.Time as Time
+import qualified Data.Vector as Vector
+import qualified Text.Printf as Printf
+
+formatPersistentWatchLine :: Time.TimeZone -> Bool -> Text -> Text -> Maybe Text
+formatPersistentWatchLine timezone details runId line =
+ let trimmed = Text.strip line
+ in if Text.null trimmed
+ then Nothing
+ else case decodeJsonObject line of
+ Nothing -> Just <| watchPrefix timezone runId Nothing <> "raw " <> clipWatchText 120 trimmed
+ Just obj ->
+ let timestamp = topLookupTextField "timestamp" obj
+ in case topLookupTextField "type" obj of
+ Nothing ->
+ if details
+ then Just <| watchPrefix timezone runId timestamp <> "event " <> clipWatchText 120 trimmed
+ else Nothing
+ Just _ ->
+ let body = renderPersistentWatchEvent details obj
+ in Just <| watchPrefix timezone runId timestamp <> body
+
+watchPrefix :: Time.TimeZone -> Text -> Maybe Text -> Text
+watchPrefix timezone runId mTimestamp =
+ formatWatchTimestamp timezone mTimestamp <> " [" <> runId <> "] "
+
+formatWatchTimestamp :: Time.TimeZone -> Maybe Text -> Text
+formatWatchTimestamp timezone mTimestamp =
+ case mTimestamp of
+ Nothing -> "--:--:--"
+ Just ts ->
+ case parseWatchTimestamp ts of
+ Nothing -> "--:--:--"
+ Just utc ->
+ Text.pack
+ <| Time.formatTime
+ Time.defaultTimeLocale
+ "%H:%M:%S"
+ (Time.utcToLocalTime timezone utc)
+
+parseWatchTimestamp :: Text -> Maybe Time.UTCTime
+parseWatchTimestamp ts =
+ let input = Text.unpack (Text.strip ts)
+ in Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" input
+ <|> Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q%z" input
+ <|> Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%d %H:%M:%S%Q UTC" input
+
+renderPersistentWatchEvent :: Bool -> Aeson.Object -> Text
+renderPersistentWatchEvent details obj =
+ case topLookupTextField "type" obj of
+ Just "session" ->
+ "session cwd=" <> fromMaybe "?" (topLookupTextField "cwd" obj)
+ Just "model_change" ->
+ let provider = fromMaybe "?" (topLookupTextField "provider" obj)
+ modelId = fromMaybe "?" (topLookupTextField "modelId" obj)
+ in "model " <> provider <> "/" <> modelId
+ Just "thinking_level_change" ->
+ "thinking " <> fromMaybe "?" (topLookupTextField "thinkingLevel" obj)
+ Just "message" ->
+ fromMaybe "message" (renderPersistentWatchMessage details obj)
+ Just "infer_start" ->
+ let iter = maybe "" (\i -> " i=" <> tshow i) (topLookupIntField "iteration" obj)
+ model = maybe "" (" model=" <>) (topLookupTextField "model" obj)
+ in "infer_start" <> iter <> model
+ Just "tool_call" ->
+ let toolName = fromMaybe "tool" (topLookupTextField "tool_name" obj)
+ argPreview =
+ case topLookupObjectField "tool_args" obj of
+ Nothing -> ""
+ Just argsObj ->
+ if details
+ then " " <> renderJsonObjectPreview 180 argsObj
+ else case topLookupTextField "command" argsObj of
+ Nothing -> ""
+ Just cmd -> " cmd=" <> clipWatchText 90 cmd
+ in "tool_call " <> toolName <> argPreview
+ Just "tool_result" ->
+ let toolName = fromMaybe "tool" (topLookupTextField "tool_name" obj)
+ ok = fromMaybe True (topLookupBoolField "success" obj)
+ icon = if ok then "✓" else "✗"
+ duration = maybe "" (\ms -> " (" <> tshow ms <> "ms)") (topLookupIntField "duration_ms" obj)
+ outputPreview =
+ case topLookupTextField "output" obj of
+ Nothing -> ""
+ Just out ->
+ let limit = if details then 220 else 120
+ in ": " <> clipWatchText limit out
+ in "tool_result " <> icon <> " " <> toolName <> duration <> outputPreview
+ Just "infer_end" ->
+ let iter = maybe "" (\i -> " i=" <> tshow i) (topLookupIntField "iteration" obj)
+ tokens = maybe "" (\n -> " tok=" <> tshow n) (topLookupIntField "tokens" obj)
+ duration = maybe "" (\ms -> " dur=" <> tshow ms <> "ms") (topLookupIntField "duration_ms" obj)
+ cost = maybe "" (\c -> " cost=" <> formatCost c) (topLookupNumberField "cost_cents" obj)
+ responsePreview =
+ if details
+ then case topLookupTextField "response_preview" obj of
+ Nothing -> ""
+ Just resp -> " | " <> clipWatchText 180 resp
+ else ""
+ in "infer_end" <> iter <> tokens <> duration <> cost <> responsePreview
+ Just "checkpoint" ->
+ "checkpoint " <> fromMaybe "?" (topLookupTextField "name" obj)
+ Just "result" ->
+ let ok = fromMaybe True (topLookupBoolField "success" obj)
+ prefix = if ok then "result ✓" else "result ✗"
+ message =
+ topLookupTextField "response" obj
+ <|> topLookupTextField "error" obj
+ <|> topLookupTextField "message" obj
+ in case message of
+ Nothing -> prefix
+ Just txt -> prefix <> ": " <> clipWatchText (if details then 220 else 120) txt
+ Just "custom" ->
+ renderPersistentWatchCustom details obj
+ Just other ->
+ "event " <> other
+ Nothing ->
+ "event"
+
+renderPersistentWatchMessage :: Bool -> Aeson.Object -> Maybe Text
+renderPersistentWatchMessage details obj = do
+ msgObj <- topLookupObjectField "message" obj
+ role <- topLookupTextField "role" msgObj
+ case role of
+ "user" ->
+ let snippet = fromMaybe "(message)" (messageTextSnippet msgObj)
+ limit = if details then 220 else 120
+ in Just <| "user: " <> clipWatchText limit snippet
+ "assistant" ->
+ case messageToolCalls msgObj of
+ tool : rest ->
+ let preview =
+ if null rest
+ then tool
+ else tool <> " +" <> tshow (length rest)
+ in Just <| "assistant→tool " <> preview
+ [] ->
+ let snippet =
+ fromMaybe "(assistant response)"
+ <| messageTextSnippet msgObj
+ <|> messageThinkingSnippet msgObj
+ limit = if details then 220 else 120
+ in Just <| "assistant: " <> clipWatchText limit snippet
+ "toolResult" ->
+ let toolName = fromMaybe "tool" (topLookupTextField "toolName" msgObj)
+ isError = fromMaybe False (topLookupBoolField "isError" msgObj)
+ icon = if isError then "✗" else "✓"
+ suffix =
+ case messageTextSnippet msgObj of
+ Nothing -> ""
+ Just snippet ->
+ let limit = if details then 220 else 120
+ in ": " <> clipWatchText limit snippet
+ in Just <| "tool_result " <> icon <> " " <> toolName <> suffix
+ _ ->
+ Just <| "message " <> role
+
+renderPersistentWatchCustom :: Bool -> Aeson.Object -> Text
+renderPersistentWatchCustom details obj =
+ let customType = fromMaybe "custom" (topLookupTextField "custom_type" obj)
+ message =
+ case topLookupObjectField "data" obj of
+ Nothing -> Nothing
+ Just dataObj ->
+ topLookupTextField "message" dataObj
+ <|> topLookupTextField "response" dataObj
+ <|> topLookupTextField "error" dataObj
+ <|> topLookupTextField "content" dataObj
+ suffix =
+ case message of
+ Nothing -> ""
+ Just msg ->
+ let limit = if details then 220 else 120
+ in ": " <> clipWatchText limit msg
+ in customType <> suffix
+
+messageThinkingSnippet :: Aeson.Object -> Maybe Text
+messageThinkingSnippet msgObj =
+ case topLookupArrayField "content" msgObj of
+ Nothing -> Nothing
+ Just parts -> listToMaybe (mapMaybe extractThinking parts)
+ where
+ extractThinking (Aeson.Object partObj) = do
+ partType <- topLookupTextField "type" partObj
+ guard (partType == "thinking")
+ topLookupTextField "thinking" partObj
+ extractThinking _ = Nothing
+
+renderJsonObjectPreview :: Int -> Aeson.Object -> Text
+renderJsonObjectPreview limit obj =
+ clipWatchText limit <| TE.decodeUtf8With TextEncodingError.lenientDecode (BL.toStrict (Aeson.encode (Aeson.Object obj)))
+
+clipWatchText :: Int -> Text -> Text
+clipWatchText limit txt =
+ let cleaned = Text.strip <| Text.replace "\n" " " txt
+ in if Text.length cleaned > limit
+ then Text.take limit cleaned <> "…"
+ else cleaned
+
+persistentLineLabel :: Text -> Maybe Text
+persistentLineLabel line = do
+ obj <- decodeJsonObject line
+ eventType <- topLookupTextField "type" obj
+ case eventType of
+ "session" -> Just "session started"
+ "model_change" -> Just "model changed"
+ "thinking_level_change" -> Just "thinking level changed"
+ "message" -> do
+ msgObj <- topLookupObjectField "message" obj
+ role <- topLookupTextField "role" msgObj
+ case role of
+ "user" ->
+ let snippet = fromMaybe "user message" (messageTextSnippet msgObj)
+ in Just <| "user: " <> clipActivity snippet
+ "assistant" ->
+ case messageToolCalls msgObj of
+ tool : _ -> Just <| "running tool " <> tool
+ [] ->
+ let snippet = fromMaybe "assistant message" (messageTextSnippet msgObj)
+ in Just <| "assistant: " <> clipActivity snippet
+ "toolResult" ->
+ let toolName = fromMaybe "tool" (topLookupTextField "toolName" msgObj)
+ in Just <| "tool result: " <> toolName
+ _ -> Just <| "message: " <> role
+ "result" ->
+ let ok = fromMaybe True (topLookupBoolField "success" obj)
+ prefix = if ok then "result" else "result error"
+ detail =
+ topLookupTextField "response" obj
+ <|> topLookupTextField "error" obj
+ <|> topLookupTextField "message" obj
+ in Just <| case detail of
+ Nothing -> prefix
+ Just txt -> prefix <> ": " <> clipActivity txt
+ _ -> Just eventType
+
+persistentToolLabel :: Text -> Maybe Text
+persistentToolLabel line = do
+ obj <- decodeJsonObject line
+ eventType <- topLookupTextField "type" obj
+ guard (eventType == "message")
+ msgObj <- topLookupObjectField "message" obj
+ role <- topLookupTextField "role" msgObj
+ case role of
+ "assistant" ->
+ case messageToolCalls msgObj of
+ tool : _ -> Just <| "tool " <> tool
+ [] -> Nothing
+ "toolResult" -> ("tool " <>) </ topLookupTextField "toolName" msgObj
+ _ -> Nothing
+
+messageToolCalls :: Aeson.Object -> [Text]
+messageToolCalls msgObj =
+ case topLookupArrayField "content" msgObj of
+ Nothing -> []
+ Just parts -> mapMaybe toolCallName parts
+ where
+ toolCallName (Aeson.Object partObj) = do
+ typ <- topLookupTextField "type" partObj
+ guard (typ == "toolCall")
+ topLookupTextField "name" partObj
+ toolCallName _ = Nothing
+
+messageTextSnippet :: Aeson.Object -> Maybe Text
+messageTextSnippet msgObj =
+ case topLookupArrayField "content" msgObj of
+ Nothing -> Nothing
+ Just parts -> listToMaybe (mapMaybe textPart parts)
+ where
+ textPart (Aeson.Object partObj) = do
+ typ <- topLookupTextField "type" partObj
+ guard (typ == "text")
+ topLookupTextField "text" partObj
+ textPart _ = Nothing
+
+normalizePersistentSessionObject :: Aeson.Object -> Aeson.Object
+normalizePersistentSessionObject obj =
+ case topLookupTextField "type" obj of
+ Just _ -> obj
+ Nothing ->
+ case topLookupBoolField "success" obj of
+ Just _ -> KeyMap.insert "type" (Aeson.String "result") obj
+ Nothing -> obj
+
+decodeJsonObject :: Text -> Maybe Aeson.Object
+decodeJsonObject line = do
+ value <- Aeson.decodeStrict' (TE.encodeUtf8 line)
+ case value of
+ Aeson.Object obj -> Just (normalizePersistentSessionObject obj)
+ _ -> Nothing
+
+topLookupTextField :: Text -> Aeson.Object -> Maybe Text
+topLookupTextField key obj =
+ case KeyMap.lookup (Key.fromText key) obj of
+ Just (Aeson.String val) -> Just val
+ _ -> Nothing
+
+topLookupIntField :: Text -> Aeson.Object -> Maybe Int
+topLookupIntField key obj =
+ case KeyMap.lookup (Key.fromText key) obj of
+ Just (Aeson.Number val) -> Just (round val)
+ _ -> Nothing
+
+topLookupNumberField :: Text -> Aeson.Object -> Maybe Double
+topLookupNumberField key obj =
+ case KeyMap.lookup (Key.fromText key) obj of
+ Just (Aeson.Number val) -> Just (realToFrac val)
+ _ -> Nothing
+
+topLookupBoolField :: Text -> Aeson.Object -> Maybe Bool
+topLookupBoolField key obj =
+ case KeyMap.lookup (Key.fromText key) obj of
+ Just (Aeson.Bool val) -> Just val
+ _ -> Nothing
+
+topLookupObjectField :: Text -> Aeson.Object -> Maybe Aeson.Object
+topLookupObjectField key obj =
+ case KeyMap.lookup (Key.fromText key) obj of
+ Just (Aeson.Object val) -> Just val
+ _ -> Nothing
+
+topLookupArrayField :: Text -> Aeson.Object -> Maybe [Aeson.Value]
+topLookupArrayField key obj =
+ case KeyMap.lookup (Key.fromText key) obj of
+ Just (Aeson.Array vals) -> Just (Vector.toList vals)
+ _ -> Nothing
+
+formatCost :: Double -> Text
+formatCost c = Text.pack <| Printf.printf "%.2f¢" c
+
+clipActivity :: Text -> Text
+clipActivity = Text.take 120 <. Text.replace "\n" " " <. Text.strip
diff --git a/Omni/Agentd/SessionJson.hs b/Omni/Agentd/SessionJson.hs
new file mode 100644
index 00000000..bf66c077
--- /dev/null
+++ b/Omni/Agentd/SessionJson.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Omni.Agentd.SessionJson
+ ( parseLogTimestamp,
+ sessionObjectFromJsonlBytes,
+ lineObjectFromJsonl,
+ lookupTextKey,
+ lookupBoolKey,
+ lookupObjectKey,
+ )
+where
+
+import Alpha
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Key as Key
+import qualified Data.Aeson.KeyMap as KeyMap
+import qualified Data.ByteString as BS
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as TextEncoding
+import qualified Data.Time as Time
+
+parseLogTimestamp :: Text -> Maybe Time.UTCTime
+parseLogTimestamp ts =
+ let input = Text.unpack (Text.strip ts)
+ in Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" input
+ <|> Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q%z" input
+ <|> Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%d %H:%M:%S%Q UTC" input
+
+normalizeSessionObject :: Aeson.Object -> Aeson.Object
+normalizeSessionObject obj =
+ case lookupTextKey "type" obj of
+ Just _ -> obj
+ Nothing ->
+ case lookupBoolKey "success" obj of
+ Just _ -> KeyMap.insert "type" (Aeson.String "result") obj
+ Nothing -> obj
+
+sessionObjectFromJsonlBytes :: BS.ByteString -> Maybe Aeson.Object
+sessionObjectFromJsonlBytes bytes = do
+ value <- Aeson.decodeStrict' bytes
+ case value of
+ Aeson.Object obj -> Just (normalizeSessionObject obj)
+ _ -> Nothing
+
+lineObjectFromJsonl :: Text -> Maybe Aeson.Object
+lineObjectFromJsonl line = sessionObjectFromJsonlBytes (TextEncoding.encodeUtf8 line)
+
+lookupTextKey :: Text -> Aeson.Object -> Maybe Text
+lookupTextKey key obj =
+ case KeyMap.lookup (Key.fromText key) obj of
+ Just (Aeson.String val) -> Just val
+ _ -> Nothing
+
+lookupBoolKey :: Text -> Aeson.Object -> Maybe Bool
+lookupBoolKey key obj =
+ case KeyMap.lookup (Key.fromText key) obj of
+ Just (Aeson.Bool val) -> Just val
+ _ -> Nothing
+
+lookupObjectKey :: Text -> Aeson.Object -> Maybe Aeson.Object
+lookupObjectKey key obj =
+ case KeyMap.lookup (Key.fromText key) obj of
+ Just (Aeson.Object val) -> Just val
+ _ -> Nothing