version command

commit 9df07ae34a6d1c7f53cee3abe2304ff81eb0a26c
Author: Sergey Ivanov <ivanovs-4@yandex.ru>
Date:   Tue Oct 24 22:25:34 2023 +0400

    `version` command for hbs2, hbs2-peer, git-hbs2

flake.nix

@@ -26,7 +26,18 @@ inputs = {
 };
 
 outputs = { self, nixpkgs, haskell-flake-utils, ... }@inputs:
-
+  let
+    packageNames = [
+     "hbs2"
+     "hbs2-peer"
+     "hbs2-core"
+     "hbs2-storage-simple"
+     "hbs2-git"
+     "hbs2-qblf"
+     "hbs2-keyman"
+     "hbs2-share"
+    ];
+  in
  haskell-flake-utils.lib.simpleCabalProject2flake {
    inherit self nixpkgs;
    systems = [ "x86_64-linux" "aarch64-linux" "x86_64-darwin" "aarch64-darwin" ];
@@ -37,16 +48,7 @@ outputs = { self, nixpkgs, haskell-flake-utils, ... }@inputs:
      db-pipe
    ];
 
-   packageNames = [
+   inherit packageNames;
-     "hbs2"
-     "hbs2-peer"
-     "hbs2-core"
-     "hbs2-storage-simple"
-     "hbs2-git"
-     "hbs2-qblf"
-     "hbs2-keyman"
-     "hbs2-share"
-   ];
 
    packageDirs = {
      "hbs2" = "./hbs2";
@@ -75,16 +77,38 @@ outputs = { self, nixpkgs, haskell-flake-utils, ... }@inputs:
     justStaticExecutables
 
     dontCheck
+
+    (compose.overrideCabal (drv: {
+        preBuild = ''
+          export GIT_HASH="${self.rev or self.dirtyRev or "dirty"}"
+        '';
+      }))
+
    ];
 
-   shellExtBuildInputs = {pkgs}: with pkgs;  [
+   shell = {pkgs, ...}:
-     haskellPackages.haskell-language-server
+      pkgs.haskellPackages.shellFor {
-     haskellPackages.htags
+        packages = _: pkgs.lib.attrsets.attrVals packageNames pkgs.haskellPackages;
-     haskellPackages.hoogle
+        # withHoogle = true;
-     pkg-config
+        buildInputs = (
-     inputs.hspup.packages.${pkgs.system}.default
+          with pkgs.haskellPackages; ([
-     inputs.fixme.packages.${pkgs.system}.default
+            ghcid
-   ];
+            cabal-install
+            haskell-language-server
+            htags
+          ])
+          ++
+          [ pkgs.pkg-config
+            inputs.hspup.packages.${pkgs.system}.default
+            inputs.fixme.packages.${pkgs.system}.default
+          ]
+        );
+
+        shellHook = ''
+          export GIT_HASH="${self.rev or self.dirtyRev or "dirty"}"
+        '';
+
+      };
 
  };
 

hbs2-core/hbs2-core.cabal

@@ -147,6 +147,7 @@ library
                     , HBS2.Net.Dialog.Client
                     , HBS2.Net.Dialog.Helpers.List
                     , HBS2.Net.Dialog.Helpers.Streaming
+                    , HBS2.Version
 
 
     -- other-modules:
@@ -205,6 +206,7 @@ library
                     , streaming
                     , string-conversions
                     , suckless-conf
+                    , template-haskell
                     , temporary
                     , text
                     , time

hbs2-core/lib/HBS2/Version.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE StrictData #-}
+
+module HBS2.Version (inlineBuildVersion, BuildVersion(..)) where
+
+import Data.Aeson
+import Data.Data
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Version (Version, showVersion)
+import GHC.Generics
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax (Lift (..), dataToExpQ)
+import System.Environment (getEnvironment)
+
+data BuildVersion = BuildVersion
+    { buildVersion_git :: Maybe Text
+    , buildVersion_pkg :: Text
+    }
+    deriving (Generic, Eq, Show, Data)
+
+instance ToJSON BuildVersion
+
+-- | Lift text as expression in TH.
+-- https://stackoverflow.com/questions/38143464/cant-find-inerface-file-declaration-for-variable
+liftText :: Text -> Q Exp
+liftText txt = AppE (VarE 'T.pack) <$> lift (T.unpack txt)
+
+liftDataWithText :: (Data a) => a -> Q Exp
+liftDataWithText = dataToExpQ (fmap liftText . cast)
+
+lookupEnv :: String -> Q (Maybe Text)
+lookupEnv key = fmap (T.strip . T.pack) . lookup key <$> runIO getEnvironment
+
+inlineBuildVersion :: Version -> Q Exp
+inlineBuildVersion version =
+    flip sigE [t|BuildVersion|] . liftDataWithText =<< do
+        buildVersion_git <- lookupEnv "GIT_HASH"
+        let buildVersion_pkg = (T.pack . showVersion) version
+        pure BuildVersion {..}

hbs2-git/git-hbs2/Main.hs

@@ -8,11 +8,16 @@ import HBS2Git.Export
 import HBS2Git.Tools
 import HBS2Git.KeysCommand
 import HBS2.Net.Proto.Definition()
+import HBS2.Version
 
 import RunShow
 
 import Options.Applicative as O
 import Control.Monad
+import Data.Aeson qualified as Aeson
+import Data.ByteString.Lazy qualified as LBS
+
+import Paths_hbs2_git qualified as Pkg
 
 main :: IO ()
 main = join . customExecParser (prefs showHelpOnError) $
@@ -28,8 +33,12 @@ main = join . customExecParser (prefs showHelpOnError) $
                         <> command "show"      (info pShow (progDesc "show various types of objects"))
                         <> command "tools"     (info pTools (progDesc "misc tools"))
                         <> command "key"       (info pKeys (progDesc "manage keys"))
+                        <> command "version"   (info pVersion (progDesc "show program version"))
                         )
 
+    pVersion = pure do
+        LBS.putStr $ Aeson.encode $(inlineBuildVersion Pkg.version)
+
     pExport = do
       keyfile   <- strArgument (metavar "KEIRING-FILE")
       pure $ runApp WithLog do

hbs2-git/hbs2-git.cabal

@@ -53,6 +53,7 @@ common shared-properties
                      , TypeApplications
                      , TypeOperators
                      , TypeFamilies
+                     , TemplateHaskell
 
 
   build-depends: hbs2-core, hbs2-peer
@@ -148,12 +149,14 @@ executable git-hbs2
 
     other-modules:
       RunShow
+      Paths_hbs2_git
 
     -- other-extensions:
     build-depends:
         base, hbs2-git
       , optparse-applicative
       , http-types
+      , template-haskell
 
     hs-source-dirs:   git-hbs2
     default-language: Haskell2010

hbs2-peer/app/PeerMain.hs

@@ -39,6 +39,8 @@ import HBS2.Storage.Operations.Missed
 import HBS2.Data.Detect
 
 import HBS2.System.Logger.Simple hiding (info)
+import HBS2.Version
+import Paths_hbs2_peer qualified as Pkg
 
 import Brains
 import BrainyPeerLocator
@@ -84,6 +86,7 @@ import Control.Monad.Reader
 import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.Writer.CPS qualified as W
 import Crypto.Saltine (sodiumInit)
+import Data.Aeson qualified as Aeson
 import Data.ByteString.Lazy qualified as LBS
 import Data.ByteString qualified as BS
 import Data.Cache qualified as Cache
@@ -240,6 +243,7 @@ runCLI = do
                 <> command "poll"      (info pPoll  (progDesc "polling management"))
                 <> command "log"       (info pLog   (progDesc "set logging level"))
                 <> command "bypass"    (info pByPass (progDesc "bypass"))
+                <> command "version"   (info pVersion (progDesc "show program version"))
                 -- FIXME: bring-back-dialogue-over-separate-socket
                 -- <> command "dial"      (info pDialog (progDesc "dialog commands"))
                 )
@@ -272,6 +276,9 @@ runCLI = do
 
       m
 
+    pVersion = pure do
+        LBS.putStr $ Aeson.encode $(inlineBuildVersion Pkg.version)
+
     pRun = do
       runPeer <$> common
 

hbs2-peer/hbs2-peer.cabal

@@ -75,6 +75,7 @@ common common-deps
         , heaps
         , psqueues
         , string-conversions
+        , template-haskell
 
 common shared-properties
   ghc-options:
@@ -119,6 +120,7 @@ common shared-properties
                      , RecursiveDo
                      , ScopedTypeVariables
                      , StandaloneDeriving
+                     , TemplateHaskell
                      , TupleSections
                      , TypeApplications
                      , TypeFamilies
@@ -197,6 +199,8 @@ executable hbs2-peer
                     , CLI.Common
                     , CLI.RefChan
 
+                    , Paths_hbs2_peer
+
     -- other-extensions:
     build-depends:    base, hbs2-peer, hbs2-keyman, vty
 

hbs2/Main.hs

@@ -24,6 +24,8 @@ import HBS2.Storage.Simple
 import HBS2.Storage.Simple.Extra
 import HBS2.Data.Bundle
 import HBS2.OrDie
+import HBS2.Version
+import Paths_hbs2 qualified as Pkg
 
 
 import HBS2.System.Logger.Simple hiding (info)
@@ -38,6 +40,7 @@ import Control.Monad.Except
 import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.Resource
 import Crypto.Saltine.Core.Box qualified as Encrypt
+import Data.Aeson qualified as Aeson
 import Data.ByteString.Char8 qualified as BS8
 import Data.ByteString.Lazy (ByteString)
 import Data.ByteString.Lazy qualified as LBS
@@ -548,12 +551,15 @@ main = join . customExecParser (prefs showHelpOnError) $
                         <> command "reflog"          (info pReflog (progDesc "reflog commands"))
                         <> command "bundle"          (info pBundle (progDesc "bundle commands"))
                         <> command "anyref"          (info pAnyRef (progDesc "anyref commands"))
+                        <> command "version"         (info pVersion (progDesc "show program version"))
                         )
-
     common = do
       pref <- optional $ strOption ( short 'p' <> long "prefix" <> help "storage prefix" )
       pure $ CommonOpts pref
 
+    pVersion = pure do
+        LBS.putStr $ Aeson.encode $(inlineBuildVersion Pkg.version)
+
     pStore = do
       o <- common
       file <- optional $ strArgument ( metavar "FILE" )

hbs2/hbs2.cabal

@@ -52,6 +52,7 @@ common shared-properties
                      , RecordWildCards
                      , ScopedTypeVariables
                      , StandaloneDeriving
+                     , TemplateHaskell
                      , TupleSections
                      , TypeApplications
                      , TypeFamilies
@@ -60,7 +61,8 @@ common shared-properties
 executable hbs2
     import:           shared-properties
     main-is:          Main.hs
-    -- other-modules:
+    other-modules:
+      Paths_hbs2
     -- other-extensions:
     build-depends:    base, hbs2-core, hbs2-storage-simple
                     , aeson