diff options
Diffstat (limited to 'main')
| -rw-r--r-- | main/Main.hs | 11 | ||||
| -rw-r--r-- | main/Version.hs | 19 | ||||
| -rw-r--r-- | main/Version/Git.hs | 31 | 
3 files changed, 60 insertions, 1 deletions
| 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) |