summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--erebos.cabal7
-rw-r--r--main/Main.hs11
-rw-r--r--main/Version.hs19
-rw-r--r--main/Version/Git.hs31
4 files changed, 67 insertions, 1 deletions
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)