diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2023-03-01 21:51:24 +0100 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2023-03-01 21:51:24 +0100 |
commit | df1cc5d142e8d0e332341b82eb581e77c328f687 (patch) | |
tree | 218aad7a946574b794a4658c36dbef59019e1c29 | |
parent | 8f4bb4eddb4dabf20a9256d406a1b9823a54879b (diff) |
Version information from git
-rw-r--r-- | erebos-tester.cabal | 4 | ||||
-rw-r--r-- | src/Main.hs | 6 | ||||
-rw-r--r-- | src/Version.hs | 19 | ||||
-rw-r--r-- | src/Version/Git.hs | 32 |
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) |