summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2023-03-01 21:51:24 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2023-03-01 21:51:24 +0100
commitdf1cc5d142e8d0e332341b82eb581e77c328f687 (patch)
tree218aad7a946574b794a4658c36dbef59019e1c29
parent8f4bb4eddb4dabf20a9256d406a1b9823a54879b (diff)
Version information from git
-rw-r--r--erebos-tester.cabal4
-rw-r--r--src/Main.hs6
-rw-r--r--src/Version.hs19
-rw-r--r--src/Version/Git.hs32
4 files changed, 57 insertions, 4 deletions
diff --git a/erebos-tester.cabal b/erebos-tester.cabal
index ee062b2..a6bd7c5 100644
--- a/erebos-tester.cabal
+++ b/erebos-tester.cabal
@@ -44,6 +44,8 @@ executable erebos-tester-core
Run.Monad
Test
Util
+ Version
+ Version.Git
other-extensions: TemplateHaskell
default-extensions: ExistentialQuantification
FlexibleContexts
@@ -77,7 +79,9 @@ executable erebos-tester-core
regex-tdfa ^>=1.3.1.0,
scientific >=0.3 && < 0.4,
stm ^>=2.5.0.1,
+ template-haskell >=2.17 && <2.18,
text >=1.2 && <2.1,
+ th-compat >=0.1 && <0.2,
unix ^>=2.7.2.2,
hs-source-dirs: src
default-language: Haskell2010
diff --git a/src/Main.hs b/src/Main.hs
index 404ecec..adb738e 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -26,9 +26,6 @@ import System.Posix.Process
import System.Posix.Signals
import System.Process
-import Paths_erebos_tester (version)
-import Data.Version (showVersion)
-
import Config
import GDB
import Network
@@ -38,6 +35,7 @@ import Process
import Run.Monad
import Test
import Util
+import Version
withVar :: ExprType e => VarName -> e -> TestRun a -> TestRun a
withVar name value = local (fmap $ \s -> s { tsVars = (name, SomeVarValue value) : tsVars s })
@@ -356,7 +354,7 @@ main = do
where header = "Usage: erebos-tester [OPTION...]"
when (optShowVersion opts) $ do
- putStrLn $ "Erebos Tester version " <> showVersion version
+ putStrLn versionLine
exitSuccess
getPermissions (head $ words $ optDefaultTool $ optTest opts) >>= \perms -> do
diff --git a/src/Version.hs b/src/Version.hs
new file mode 100644
index 0000000..ace016b
--- /dev/null
+++ b/src/Version.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Version (
+ versionLine,
+) where
+
+import Paths_erebos_tester (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 "Erebos Tester " <> 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)