{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-} -- | Status of the agent for the UI module Omni.Agent.Log where import Alpha import Data.IORef (IORef, modifyIORef', newIORef, readIORef, writeIORef) import qualified Data.Text as Text import qualified Data.Text.IO as TIO import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime) import Data.Time.Format (defaultTimeLocale, parseTimeOrError) import qualified System.Console.ANSI as ANSI import qualified System.IO as IO import System.IO.Unsafe (unsafePerformIO) import Text.Printf (printf) -- | Status of the agent for the UI data Status = Status { statusWorker :: Text, statusTask :: Maybe Text, statusThread :: Maybe Text, statusFiles :: Int, statusCredits :: Double, statusStartTime :: UTCTime, statusActivity :: Text } deriving (Show, Eq) emptyStatus :: Text -> UTCTime -> Status emptyStatus workerName startTime = Status { statusWorker = workerName, statusTask = Nothing, statusThread = Nothing, statusFiles = 0, statusCredits = 0.0, statusStartTime = startTime, statusActivity = "Idle" } -- | Global state for the status bar {-# NOINLINE currentStatus #-} currentStatus :: IORef Status currentStatus = unsafePerformIO (newIORef (emptyStatus "Unknown" defaultStartTime)) defaultStartTime :: UTCTime defaultStartTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%d %H:%M:%S %Z" "2000-01-01 00:00:00 UTC" -- | Initialize the status bar system init :: Text -> IO () init workerName = do IO.hSetBuffering IO.stderr IO.LineBuffering startTime <- getCurrentTime writeIORef currentStatus (emptyStatus workerName startTime) -- 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 -- | Get the current status getStatus :: IO Status getStatus = readIORef currentStatus -- | 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 now <- getCurrentTime let taskStr = maybe "None" identity statusTask threadStr = maybe "None" identity statusThread elapsed = diffUTCTime now statusStartTime elapsedStr = formatElapsed elapsed -- 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 let creditsStr = Text.pack (printf "%.2f" statusCredits) TIO.hPutStr IO.stderr ("Files: " <> tshow statusFiles <> " | Credits: $" <> creditsStr) -- Line 4: Time (elapsed duration) ANSI.hCursorDown IO.stderr 1 ANSI.hSetCursorColumn IO.stderr 0 ANSI.hClearLine IO.stderr TIO.hPutStr IO.stderr ("Time: " <> elapsedStr) -- 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 -- | Format elapsed time as MM:SS or HH:MM:SS formatElapsed :: NominalDiffTime -> Text formatElapsed elapsed = let totalSecs = floor elapsed :: Int hours = totalSecs `div` 3600 mins = (totalSecs `mod` 3600) `div` 60 secs = totalSecs `mod` 60 in if hours > 0 then Text.pack (printf "%02d:%02d:%02d" hours mins secs) else Text.pack (printf "%02d:%02d" mins secs)