From 0ed3f76533cde17322cf04018713d70c2f78d490 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Wed, 14 Feb 2024 21:44:45 +0100
Subject: Version information from git
Changelog: Added -V switch to show version
---
main/Main.hs | 11 ++++++++++-
main/Version.hs | 19 +++++++++++++++++++
main/Version/Git.hs | 31 +++++++++++++++++++++++++++++++
3 files changed, 60 insertions(+), 1 deletion(-)
create mode 100644 main/Version.hs
create mode 100644 main/Version/Git.hs
(limited to 'main')
diff --git a/main/Main.hs b/main/Main.hs
index 72af295..3359598 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -46,14 +46,17 @@ import Erebos.Storage.Merge
import Erebos.Sync
import Test
+import Version
data Options = Options
{ optServer :: ServerOptions
+ , optShowVersion :: Bool
}
defaultOptions :: Options
defaultOptions = Options
{ optServer = defaultServerOptions
+ , optShowVersion = False
}
options :: [OptDescr (Options -> Options)]
@@ -64,6 +67,9 @@ options =
, Option ['s'] ["silent"]
(NoArg (so $ \opts -> opts { serverLocalDiscovery = False }))
"do not send announce packets for local discovery"
+ , Option ['V'] ["version"]
+ (NoArg $ \opts -> opts { optShowVersion = True })
+ "show version and exit"
]
where so f opts = opts { optServer = f $ optServer opts }
@@ -125,7 +131,10 @@ main = do
(o, [], []) -> return (foldl (flip id) defaultOptions o)
(_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
where header = "Usage: erebos [OPTION...]"
- interactiveLoop st opts
+
+ if optShowVersion opts
+ then putStrLn versionLine
+ else interactiveLoop st opts
interactiveLoop :: Storage -> Options -> IO ()
diff --git a/main/Version.hs b/main/Version.hs
new file mode 100644
index 0000000..d7583bf
--- /dev/null
+++ b/main/Version.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Version (
+ versionLine,
+) where
+
+import Paths_erebos (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 CLI " <> ver
diff --git a/main/Version/Git.hs b/main/Version/Git.hs
new file mode 100644
index 0000000..2aae6e3
--- /dev/null
+++ b/main/Version/Git.hs
@@ -0,0 +1,31 @@
+module Version.Git (
+ tGitVersion,
+) where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+
+import System.Directory
+import System.Exit
+import System.Process
+
+tGitVersion :: Code Q (Maybe String)
+tGitVersion = unsafeCodeCoerce $ 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