From df1cc5d142e8d0e332341b82eb581e77c328f687 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Wed, 1 Mar 2023 21:51:24 +0100
Subject: Version information from git

---
 erebos-tester.cabal |  4 ++++
 src/Main.hs         |  6 ++----
 src/Version.hs      | 19 +++++++++++++++++++
 src/Version/Git.hs  | 32 ++++++++++++++++++++++++++++++++
 4 files changed, 57 insertions(+), 4 deletions(-)
 create mode 100644 src/Version.hs
 create mode 100644 src/Version/Git.hs

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)
-- 
cgit v1.2.3