{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-} -- | Status of the agent for the UI module Omni.Agent.Log where import Alpha import Data.Aeson ((.:), (.:?)) import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy as BL import Data.IORef (IORef, modifyIORef', newIORef, readIORef, writeIORef) import qualified Data.Text as Text import qualified Data.Text.Encoding as TE 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) -- | Status of the agent for the UI data Status = Status { statusWorker :: Text, statusTask :: Maybe Text, statusThread :: 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, statusThread = 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 5 lines at bottom IO.hPutStrLn IO.stderr "" IO.hPutStrLn IO.stderr "" IO.hPutStrLn IO.stderr "" IO.hPutStrLn IO.stderr "" IO.hPutStrLn IO.stderr "" ANSI.hCursorUp IO.stderr 5 -- | 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}) -- | 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.hCursorDown IO.stderr 1 ANSI.hClearLine IO.stderr ANSI.hCursorDown IO.stderr 1 ANSI.hClearLine IO.stderr ANSI.hCursorDown IO.stderr 1 ANSI.hClearLine IO.stderr ANSI.hCursorUp IO.stderr 4 -- 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 five status lines render :: IO () render = do Status {..} <- readIORef currentStatus let taskStr = maybe "None" identity statusTask threadStr = maybe "None" identity statusThread -- Line 1: Worker | Thread ANSI.hSetCursorColumn IO.stderr 0 ANSI.hClearLine IO.stderr TIO.hPutStr IO.stderr ("[Worker: " <> statusWorker <> "] Thread: " <> threadStr) -- Line 2: Task ANSI.hCursorDown IO.stderr 1 ANSI.hSetCursorColumn IO.stderr 0 ANSI.hClearLine IO.stderr TIO.hPutStr IO.stderr ("Task: " <> taskStr) -- Line 3: Files | Credits ANSI.hCursorDown IO.stderr 1 ANSI.hSetCursorColumn IO.stderr 0 ANSI.hClearLine IO.stderr TIO.hPutStr IO.stderr ("Files: " <> tshow statusFiles <> " | Credits: $" <> tshow statusCredits) -- Line 4: Time ANSI.hCursorDown IO.stderr 1 ANSI.hSetCursorColumn IO.stderr 0 ANSI.hClearLine IO.stderr TIO.hPutStr IO.stderr ("Time: " <> statusTime) -- Line 5: Activity 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 4 IO.hFlush IO.stderr -- | Log Entry from JSON data LogEntry = LogEntry { leMessage :: Text, leThreadId :: Maybe Text, leCredits :: Maybe Double, leTotalCredits :: Maybe Double, leTimestamp :: Maybe Text } deriving (Show, Eq) instance Aeson.FromJSON LogEntry where parseJSON = Aeson.withObject "LogEntry" <| \v -> (LogEntry v .:? "threadId" <*> v .:? "credits" <*> v .:? "totalCredits" <*> v .:? "timestamp" -- | Parse a log line and update status processLogLine :: Text -> IO () processLogLine line = do let bs = BL.fromStrict <| TE.encodeUtf8 line case Aeson.decode bs of Just entry -> update (updateFromEntry entry) Nothing -> pure () -- Ignore invalid JSON updateFromEntry :: LogEntry -> Status -> Status updateFromEntry LogEntry {..} s = s { statusThread = leThreadId <|> statusThread s, statusCredits = maybe (statusCredits s) (/ 100.0) (leTotalCredits <|> leCredits), statusTime = maybe (statusTime s) formatTime leTimestamp } formatTime :: Text -> Text formatTime ts = -- "2025-11-22T21:24:02.512Z" -> "21:24" case Text.splitOn "T" ts of [_, time] -> case Text.splitOn ":" time of (h : m : _) -> h <> ":" <> m _ -> ts _ -> ts