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
|
{-# 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)
-- | Status of the agent for the UI
data Status = Status
{ statusWorker :: Text,
statusTask :: Maybe Text,
statusThreadId :: 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,
statusThreadId = 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 4 lines at bottom
replicateM_ 4 (IO.hPutStrLn IO.stderr "")
ANSI.hCursorUp IO.stderr 4
-- | 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 (4 lines)
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 3
-- 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 4 status lines (Vertical Layout)
render :: IO ()
render = do
Status {..} <- readIORef currentStatus
let taskStr = maybe "None" identity statusTask
threadStr = maybe "None" identity statusThreadId
-- Line 1: Worker + Time
ANSI.hSetCursorColumn IO.stderr 0
ANSI.hClearLine IO.stderr
TIO.hPutStr IO.stderr <| "Worker: " <> statusWorker <> " | Time: " <> statusTime
-- 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: Thread + Credits
ANSI.hCursorDown IO.stderr 1
ANSI.hSetCursorColumn IO.stderr 0
ANSI.hClearLine IO.stderr
TIO.hPutStr IO.stderr <| "Thread: " <> threadStr <> " | Credits: $" <> tshow statusCredits
-- Line 4: 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 3
IO.hFlush IO.stderr
|
