{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- Provides the package version and git revision which this was compiled from.
--
-- It is assumed that all cardano-wallet packages have the same version, that of
-- the core package.
--
-- Stack builds will have the `git` command available to run during
-- compilation.
--
-- Nix builds will inject the git revision into the executables after
-- compiling. If the git revision has changed but the sources have
-- not, then no haskell packages will be rebuilt, but the embedded git
-- revision will be updated.

module Cardano.Wallet.Version
    ( -- * Values computed at compile-time
      version
    , gitRevision
    , GitRevision
    , Version

      -- * Displaying Versions
    , showVersionAsDate
    , showFullVersion
    ) where

import Prelude

import Cardano.Wallet.Version.TH
    ( gitRevFromGit )
import Data.FileEmbed
    ( dummySpaceWith )
import Data.String
    ( fromString )
import Data.Text
    ( Text )
import Data.Text.Encoding
    ( decodeLatin1 )
import Data.Version
    ( Version (..), showVersion )
import Fmt
    ( build, fmt, padLeftF )
import Paths_cardano_wallet_core
    ( version )

import qualified Data.Text as T

newtype GitRevision = GitRevision Text deriving (Int -> GitRevision -> ShowS
[GitRevision] -> ShowS
GitRevision -> String
(Int -> GitRevision -> ShowS)
-> (GitRevision -> String)
-> ([GitRevision] -> ShowS)
-> Show GitRevision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitRevision] -> ShowS
$cshowList :: [GitRevision] -> ShowS
show :: GitRevision -> String
$cshow :: GitRevision -> String
showsPrec :: Int -> GitRevision -> ShowS
$cshowsPrec :: Int -> GitRevision -> ShowS
Show, GitRevision -> GitRevision -> Bool
(GitRevision -> GitRevision -> Bool)
-> (GitRevision -> GitRevision -> Bool) -> Eq GitRevision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitRevision -> GitRevision -> Bool
$c/= :: GitRevision -> GitRevision -> Bool
== :: GitRevision -> GitRevision -> Bool
$c== :: GitRevision -> GitRevision -> Bool
Eq)

-- | Like 'showVersionAsDate', but also show the git revision.
showFullVersion :: Version -> GitRevision -> String
showFullVersion :: Version -> GitRevision -> String
showFullVersion Version
v (GitRevision Text
r) =
    Version -> String
showVersionAsDate Version
v String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (git revision: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
r String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"

-- | Format the Cabal version in the vYYYY-MM-DD style that we use for git tags.
showVersionAsDate :: Version -> String
showVersionAsDate :: Version -> String
showVersionAsDate (Version (Int
y:Int
m:Int
d:[Int]
vs) [String]
tags) = Builder -> String
forall b. FromBuilder b => Builder -> b
fmt (Builder -> String)
-> ([Builder] -> Builder) -> [Builder] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> String) -> [Builder] -> String
forall a b. (a -> b) -> a -> b
$
    [Builder
"v", Int -> Int -> Builder
forall a. Buildable a => Int -> a -> Builder
digits Int
4 Int
y, Builder
"-", Int -> Int -> Builder
forall a. Buildable a => Int -> a -> Builder
digits Int
2 Int
m, Builder
"-", Int -> Int -> Builder
forall a. Buildable a => Int -> a -> Builder
digits Int
2 Int
d ] [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++
    (Int -> Builder) -> [Int] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map ((Builder
"." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder) -> (Int -> Builder) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
forall p. Buildable p => p -> Builder
build) [Int]
vs [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++ ((String -> Builder) -> [String] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map ((Builder
"-" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder) -> (String -> Builder) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
forall p. Buildable p => p -> Builder
build) [String]
tags)
  where
    digits :: Int -> a -> Builder
digits Int
n a
i = Int -> Char -> a -> Builder
forall a. Buildable a => Int -> Char -> a -> Builder
padLeftF Int
n Char
'0' a
i
showVersionAsDate (Version [Int]
vs [String]
tags) = Version -> String
showVersion ([Int] -> [String] -> Version
Version [Int]
vs [String]
tags)

-- | The Git revision ID (40 character hex string) of this build.
--
-- This requires @git@ to be available when building. Alternatively, the git
-- revision of the @cardano-wallet@ binary can be updated post-build using
-- "Data.FileEmbed.injectWith".
gitRevision :: GitRevision
gitRevision :: GitRevision
gitRevision
    | Text
gitRevEmbed Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
zeroRev = Text -> GitRevision
GitRevision Text
gitRevEmbed
    | Text -> Bool
T.null Text
fromGit         = Text -> GitRevision
GitRevision Text
zeroRev
    | Bool
otherwise              = Text -> GitRevision
GitRevision Text
fromGit
  where
    -- Git revision embedded after compilation using
    -- Data.FileEmbed.injectWith. If nothing has been injected,
    -- this will be filled with 0 characters.
    gitRevEmbed :: Text
    gitRevEmbed :: Text
gitRevEmbed = ByteString -> Text
decodeLatin1 $(dummySpaceWith "gitrev" 40)

    -- Git revision found during compilation by running git. If
    -- git could not be run, then this will be empty.
    fromGit :: Text
fromGit = Text -> Text
T.strip (String -> Text
forall a. IsString a => String -> a
fromString $(String
gitRevFromGit))

    zeroRev :: Text
    zeroRev :: Text
zeroRev = Text
"0000000000000000000000000000000000000000"