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
---
 erebos.cabal        |  7 +++++++
 main/Main.hs        | 11 ++++++++++-
 main/Version.hs     | 19 +++++++++++++++++++
 main/Version/Git.hs | 31 +++++++++++++++++++++++++++++++
 4 files changed, 67 insertions(+), 1 deletion(-)
 create mode 100644 main/Version.hs
 create mode 100644 main/Version/Git.hs

diff --git a/erebos.cabal b/erebos.cabal
index e25c79d..3734f1f 100644
--- a/erebos.cabal
+++ b/erebos.cabal
@@ -64,6 +64,7 @@ common common
         ForeignFunctionInterface
         OverloadedStrings
         RecursiveDo
+        TemplateHaskell
         UndecidableInstances
 
 library
@@ -144,15 +145,21 @@ executable erebos
 
     main-is:             Main.hs
     other-modules:
+        Paths_erebos
         Test
+        Version
+        Version.Git
 
     build-depends:
         bytestring,
         cryptonite,
+        directory,
         erebos,
         haskeline >=0.7 && <0.9,
         mtl,
         network,
+        process >=1.6 && <1.7,
+        template-haskell >=2.18 && <2.22,
         text,
         time,
         transformers >= 0.5 && <0.7,
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