diff options
| -rw-r--r-- | erebos.cabal | 7 | ||||
| -rw-r--r-- | main/Main.hs | 11 | ||||
| -rw-r--r-- | main/Version.hs | 19 | ||||
| -rw-r--r-- | main/Version/Git.hs | 31 |
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) |