From 55cead7b8d31f5e5fe09df0588abf736a465c0eb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Wed, 30 Nov 2022 21:30:26 +0100
Subject: First build test using cabal

---
 minici.cabal | 17 ++++++++++++
 src/Main.hs  | 90 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 105 insertions(+), 2 deletions(-)

diff --git a/minici.cabal b/minici.cabal
index 55bad96..1dce029 100644
--- a/minici.cabal
+++ b/minici.cabal
@@ -21,12 +21,29 @@ maintainer:         roman.smrz@seznam.cz
 
 executable minici
     main-is:          Main.hs
+    ghc-options:      -Wall
 
     -- Modules included in this executable, other than Main.
     -- other-modules:
 
     -- LANGUAGE extensions used by modules in this package.
+    default-extensions:  ExistentialQuantification
+                         FlexibleContexts
+                         FlexibleInstances
+                         GADTs
+                         GeneralizedNewtypeDeriving
+                         ImportQualifiedPost
+                         LambdaCase
+                         MultiParamTypeClasses
+                         OverloadedStrings
+                         ScopedTypeVariables
+                         TupleSections
+                         TypeApplications
     -- other-extensions:
     build-depends:    base ^>=4.15.1.0
+                    , directory >=1.3 && <1.4
+                    , mtl >=2.2 && <2.3
+                    , process >=1.6 && <1.7
+                    , text >=1.2 && <1.3
     hs-source-dirs:   src
     default-language: Haskell2010
diff --git a/src/Main.hs b/src/Main.hs
index 65ae4a0..32c0288 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,4 +1,90 @@
-module Main where
+module Main (main) where
+
+import Control.Monad
+import Control.Monad.Except
+
+import Data.Text (Text)
+import Data.Text qualified as T
+
+import System.Directory
+import System.Exit
+import System.IO
+import System.Process
+
+data Job = Job
+    { jobName :: JobName
+    , jobRecipe :: [CreateProcess]
+    , jobArtifacts :: [(ArtifactName, CreateProcess)]
+    }
+
+data JobOutput = JobOutput
+    { outName :: JobName
+    , outStatus :: Bool
+    , outArtifacts :: [(ArtifactName, FilePath)]
+    }
+    deriving (Show)
+
+data JobName = JobName Text
+    deriving (Eq, Ord, Show)
+
+data ArtifactName = ArtifactName Text
+    deriving (Eq, Ord, Show)
+
+
+runJob :: String -> Job -> IO JobOutput
+runJob cid job = do
+    [path] <- lines <$> readProcess "mktemp" ["-d", "-t", "minici.XXXXXXXXXX"] ""
+
+    "" <- readProcess "git" ["--work-tree=" <> path, "restore", "--source=" <> cid, "--", "."] ""
+
+    res <- runExceptT $ do
+        forM_ (jobRecipe job) $ \p -> do
+            (Just hin, Just hout, Just herr, hp) <- liftIO $ createProcess p
+                { cwd = Just path
+                , std_in = CreatePipe
+                , std_out = CreatePipe
+                , std_err = CreatePipe
+                }
+            liftIO $ hClose hin
+            exit <- liftIO $ waitForProcess hp
+            liftIO $ hClose hout
+            liftIO $ hClose herr
+
+            when (exit /= ExitSuccess) $
+                throwError ()
+
+    removeDirectoryRecursive $ path
+
+    return JobOutput
+        { outName = jobName job
+        , outStatus = res == Right ()
+        , outArtifacts = []
+        }
+
+
+cabalJob :: JobName -> [ArtifactName] -> Job
+cabalJob name artifacts = Job
+    { jobName = name
+    , jobRecipe = [ proc "cabal" ["build", "--ghc-option=-Werror"] ]
+    , jobArtifacts = map (\(ArtifactName aname) -> (ArtifactName "bin", proc "cabal" ["list-bin", T.unpack aname])) artifacts
+    }
 
 main :: IO ()
-main = putStrLn "Hello, Haskell!"
+main = do
+    commits <- map (fmap (drop 1) . (span (/=' '))) . lines <$>
+        readProcess "git" ["log", "--pretty=oneline", "--first-parent", "--reverse", "origin/master..HEAD"] ""
+    forM_ commits $ \(cid, desc) -> do
+        let descLen = length desc
+            desc' = if descLen <= 50 then desc <> replicate (50 - descLen) ' '
+                                     else take 49 desc <> "…"
+            shortCid = take 7 cid
+
+        putStr $ shortCid <> " " <> desc' <> " "
+        hFlush stdout
+        runJob cid (cabalJob (JobName "build") $ map (ArtifactName . T.pack) []) >>= \case
+            out | outStatus out -> do
+                putStr "\ESC[92m✓\ESC[0m"
+            _ -> do
+                putStr "\ESC[91m✗\ESC[0m"
+                putStr $ "\r\ESC[91m" <> shortCid <> "\ESC[0m"
+        putStrLn ""
-- 
cgit v1.2.3