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
|
{-# 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)
|
