Command-line option to report version

4 files changed, 87 insertions, 0 deletions

diff --git a/minici.cabal b/minici.cabal
index aeb713f..2f85134 100644
--- a/minici.cabal
+++ b/minici.cabal
@@ -26,8 +26,12 @@ executable minici
     -- Modules included in this executable, other than Main.
     other-modules:      Config
                         Job
+                        Paths_minici
+                        Version
+                        Version.Git
 
     -- LANGUAGE extensions used by modules in this package.
+    other-extensions:    TemplateHaskell
     default-extensions:  ExistentialQuantification
                          FlexibleContexts
                          FlexibleInstances
@@ -53,6 +57,8 @@ executable minici
                     , parser-combinators >=1.3 && <1.4
                     , process >=1.6 && <1.7
                     , stm >=2.5 && <2.6
+                    , template-haskell  >=2.17 && <2.19
                     , text >=1.2 && <2.1
+                    , th-compat         >=0.1 && <0.2
     hs-source-dirs:   src
     default-language: Haskell2010
diff --git a/src/Main.hs b/src/Main.hs
index 4e99c5f..dc30d32 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -9,11 +9,31 @@ import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
 
+import System.Console.GetOpt
+import System.Environment
+import System.Exit
 import System.IO
 import System.Process
 
 import Config
 import Job
+import Version
+
+data CmdlineOptions = CmdlineOptions
+    { optShowVersion :: Bool
+    }
+
+defaultCmdlineOptions :: CmdlineOptions
+defaultCmdlineOptions = CmdlineOptions
+    { optShowVersion = False
+    }
+
+options :: [OptDescr (CmdlineOptions -> CmdlineOptions)]
+options =
+    [ Option ['V'] ["version"]
+        (NoArg $ \opts -> opts { optShowVersion = True })
+        "show version and exit"
+    ]
 
 fitToLength :: Int -> Text -> Text
 fitToLength maxlen str | len <= maxlen = str <> T.replicate (maxlen - len) " "
@@ -58,6 +78,16 @@ displayStatusLine prefix1 prefix2 statuses = do
 
 main :: IO ()
 main = do
+    args <- getArgs
+    opts <- case getOpt Permute options args of
+        (o, _, []) -> return (foldl (flip id) defaultCmdlineOptions o)
+        (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
+            where header = "Usage: minici [OPTION...]"
+
+    when (optShowVersion opts) $ do
+        putStrLn versionLine
+        exitSuccess
+
     Just configPath <- findConfig
     config <- parseConfig configPath
 
diff --git a/src/Version.hs b/src/Version.hs
new file mode 100644
index 0000000..d476912
--- /dev/null
+++ b/src/Version.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Version (
+    versionLine,
+) where
+
+import Paths_minici (version)
+import Data.Version (showVersion)
+import Version.Git
+
+{-# NOINLINE versionLine #-}
+versionLine :: String
+versionLine = do
+    let ver = case $$tGitVersion of
+            Just gver
+                | 'v':v <- gver, not $ all (`elem` ('.': ['0'..'9'])) v
+                -> "git " <> gver
+            _   -> "version " <> showVersion version
+     in "MiniCI " <> ver
diff --git a/src/Version/Git.hs b/src/Version/Git.hs
new file mode 100644
index 0000000..fcd54a0
--- /dev/null
+++ b/src/Version/Git.hs
@@ -0,0 +1,32 @@
+module Version.Git (
+    tGitVersion,
+) where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.Syntax.Compat
+
+import System.Directory
+import System.Exit
+import System.Process
+
+tGitVersion :: SpliceQ (Maybe String)
+tGitVersion = unsafeSpliceCoerce $ do
+    let git args = do
+            (ExitSuccess, out, _) <- readCreateProcessWithExitCode
+                (proc "git" $ [ "--git-dir=./.git", "--work-tree=." ] ++ args) ""
+            return $ lines out
+
+    mbver <- runIO $ do
+        doesPathExist "./.git" >>= \case
+            False -> return Nothing
+            True -> do
+                desc:_ <- git [ "describe", "--always", "--dirty= (dirty)" ]
+                files <- git [ "ls-files" ]
+                return $ Just (desc, files)
+
+    case mbver of
+        Just (_, files) -> mapM_ addDependentFile files
+        Nothing -> return ()
+
+    lift (fst <$> mbver :: Maybe String)