blob: 4e99c5f0b97073f97549e344244697cd172528c3 (
plain)
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
|
module Main (main) where
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import System.IO
import System.Process
import Config
import Job
fitToLength :: Int -> Text -> Text
fitToLength maxlen str | len <= maxlen = str <> T.replicate (maxlen - len) " "
| otherwise = T.take (maxlen - 1) str <> "…"
where len = T.length str
showStatus :: Bool -> JobStatus a -> Text
showStatus blink = \case
JobQueued -> "\ESC[94m…\ESC[0m "
JobWaiting uses -> "\ESC[94m~" <> fitToLength 6 (T.intercalate "," (map textJobName uses)) <> "\ESC[0m"
JobSkipped -> "\ESC[0m-\ESC[0m "
JobRunning -> "\ESC[96m" <> (if blink then "*" else "⋅") <> "\ESC[0m "
JobError _ -> "\ESC[91m!!\ESC[0m "
JobFailed -> "\ESC[91m✗\ESC[0m "
JobDone _ -> "\ESC[92m✓\ESC[0m "
displayStatusLine :: Text -> Text -> [TVar (JobStatus JobOutput)] -> IO ()
displayStatusLine prefix1 prefix2 statuses = do
blinkVar <- newTVarIO False
t <- forkIO $ forever $ do
threadDelay 500000
atomically $ writeTVar blinkVar . not =<< readTVar blinkVar
go blinkVar ""
killThread t
where
go blinkVar prev = do
(ss, cur) <- atomically $ do
ss <- mapM readTVar statuses
blink <- readTVar blinkVar
let cur = T.concat $ map ((" " <>) . showStatus blink) ss
when (cur == prev) retry
return (ss, cur)
when (not $ T.null prev) $ putStr "\r"
let prefix1' = if any jobStatusFailed ss then "\ESC[91m" <> prefix1 <> "\ESC[0m"
else prefix1
T.putStr $ prefix1' <> prefix2 <> cur
hFlush stdout
if all jobStatusFinished ss
then T.putStrLn ""
else go blinkVar cur
main :: IO ()
main = do
Just configPath <- findConfig
config <- parseConfig configPath
commits <- map (fmap (drop 1) . (span (/=' '))) . lines <$>
readProcess "git" ["log", "--pretty=oneline", "--first-parent", "--reverse", "origin/master..HEAD"] ""
putStr $ replicate (8 + 50) ' '
forM_ (configJobs config) $ \job -> do
T.putStr $ (" "<>) $ fitToLength 7 $ textJobName $ jobName job
putStrLn ""
forM_ commits $ \(cid, desc) -> do
let shortCid = T.pack $ take 7 cid
outs <- runJobs "./.minici" cid $ configJobs config
displayStatusLine shortCid (" " <> fitToLength 50 (T.pack desc)) outs
|