src/Main.hs


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

module Main (main) where

import Control.Concurrent.STM

import Control.Monad

import System.IO
import System.Process

import Config
import Job

fitToLength :: Int -> String -> String
fitToLength maxlen str | len <= maxlen = str <> replicate (maxlen - len) ' '
                       | otherwise     = take (maxlen - 1) str <> "…"
    where len = length str

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
        putStr $ (' ':) $ fitToLength 7 $ stringJobName $ jobName job
    putStrLn ""

    forM_ commits $ \(cid, desc) -> do
        let shortCid = take 7 cid
        putStr $ shortCid <> " " <> fitToLength 50 desc
        hFlush stdout
        outs <- runJobs "./.minici" cid $ configJobs config
        results <- forM outs $ \outVar -> do
            putStr " "
            hFlush stdout
            out <- atomically $ maybe retry return =<< readTVar outVar
            if | outStatus out -> do
                    putStr "\ESC[92m✓\ESC[0m      "
               | otherwise -> do
                    putStr "\ESC[91m✗\ESC[0m      "
            hFlush stdout
            return $ outStatus out

        when (not $ and results) $ do
            putStr $ "\r\ESC[91m" <> shortCid <> "\ESC[0m"
        putStrLn ""