summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2023-04-25 22:17:58 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2023-04-25 22:17:58 +0200
commit780fc8894379f28af0f03bc27c3a41aca8c95b5a (patch)
treee5bdc1db78df4a58c27a73b8fea675eb5c9328a4 /src
parent649ba09db13caea5de5d179c538b8a2945a9a69d (diff)
Command-line option to report version
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs30
-rw-r--r--src/Version.hs19
-rw-r--r--src/Version/Git.hs32
3 files changed, 81 insertions, 0 deletions
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)