{-# LANGUAGE CPP             #-}
{-
Version number-related utilities. See also the Makefile.
-}

module Hledger.Cli.Version (
  ProgramName,
  PackageVersion,
  VersionString,
  packageversion,
  progname,
  versionStringWith,
)
where

import GitHash (GitInfo, giHash, giCommitDate)  -- giDirty
import System.Info (os, arch)
import Data.List (intercalate)
import Data.Maybe (fromMaybe)

type ProgramName    = String
type PackageVersion = String
type VersionString  = String

-- | The VERSION string defined with -D in this package's package.yaml/.cabal file 
-- (by Shake setversion), if any. Normally a dotted number string with 1-3 components.
packageversion :: PackageVersion
packageversion :: PackageVersion
packageversion =
#ifdef VERSION
  VERSION
#else
  ""
#endif

-- | The name of this package's main executable.
progname :: ProgramName
progname :: PackageVersion
progname = PackageVersion
"hledger"

-- | Given possible git state info from the build directory (or an error message, which is ignored),
-- the name of a program (executable) in the currently building package,
-- and the package's version, make a complete version string. Here is the logic:
-- 
-- * Program name, OS and architecture are always shown.
-- * The package version is always shown.
-- * If there is git info at build time, the latest commit hash and commit date are shown,
--   and (TODO, requires githash to use -uno for giDirty):
--   if the working copy has uncommitted changes a + sign is appended.
-- * (TODO, requires adding --match support to githash:
--   If there are tags matching THISPKG-[0-9]*, the latest one is used to calculate patch level
--   (number of commits since tag), and if non-zero, it and the branch name are shown.)
--
-- Some example outputs:
--
-- * A homebrew binary, not built in git repo:             hledger-ui 1.24, mac-aarch64
-- * A CI release build, built in git repo at release tag: hledger-ui 1.24.1-g455b35293-20211210, mac-x86_64
-- * (TODO) A dev build, built in git repo:                hledger-ui 1.24.1+1-g4abd8ef10-20211210 (1.24-branch), mac-x86_64
--
-- This function requires git log to show the default (rfc2822-style) date format,
-- so that must not be overridden by a log.date git config variable.
--
versionStringWith :: Either String GitInfo -> ProgramName -> PackageVersion -> VersionString
versionStringWith :: Either PackageVersion GitInfo
-> PackageVersion -> PackageVersion -> PackageVersion
versionStringWith Either PackageVersion GitInfo
egitinfo PackageVersion
prognam PackageVersion
packagever =
  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ PackageVersion
prognam , PackageVersion
" " , PackageVersion
version , PackageVersion
", " , PackageVersion
os' , PackageVersion
"-" , PackageVersion
arch ]
  where
    os' :: PackageVersion
os' | PackageVersion
os forall a. Eq a => a -> a -> Bool
== PackageVersion
"darwin"  = PackageVersion
"mac"
        | PackageVersion
os forall a. Eq a => a -> a -> Bool
== PackageVersion
"mingw32" = PackageVersion
"windows"
        | Bool
otherwise       = PackageVersion
os
    version :: PackageVersion
version = case Either PackageVersion GitInfo
egitinfo of
      Left PackageVersion
_err     -> PackageVersion
packagever
      Right GitInfo
gitinfo -> 
        case PackageVersion -> [PackageVersion]
words forall a b. (a -> b) -> a -> b
$ GitInfo -> PackageVersion
giCommitDate GitInfo
gitinfo of
          -- git log's date format is normally --date=default ("similar to --date=rfc2822")
          PackageVersion
_weekday:PackageVersion
mon:PackageVersion
day:PackageVersion
_localtime:PackageVersion
year:PackageVersion
_offset:[PackageVersion]
_ ->
            forall a. [a] -> [[a]] -> [a]
intercalate PackageVersion
"-" forall a b. (a -> b) -> a -> b
$ [PackageVersion
packagever, PackageVersion
hash, PackageVersion
date]
              -- ++ ["+" | giDirty gitinfo]
              --   XXX giDirty is wrong when repo shows untracked files by default, skip it for now
              where
                hash :: PackageVersion
hash = Char
'g' forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
take Int
9 (GitInfo -> PackageVersion
giHash GitInfo
gitinfo)  -- like git describe
                date :: PackageVersion
date = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [PackageVersion
year,PackageVersion
mm,PackageVersion
dd]
                  where 
                    mm :: PackageVersion
mm = forall a. a -> Maybe a -> a
fromMaybe PackageVersion
mon forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup PackageVersion
mon forall a b. (a -> b) -> a -> b
$ [
                      (PackageVersion
"Jan",PackageVersion
"01")
                      ,(PackageVersion
"Feb",PackageVersion
"02")
                      ,(PackageVersion
"Mar",PackageVersion
"03")
                      ,(PackageVersion
"Apr",PackageVersion
"04")
                      ,(PackageVersion
"May",PackageVersion
"05")
                      ,(PackageVersion
"Jun",PackageVersion
"06")
                      ,(PackageVersion
"Jul",PackageVersion
"07")
                      ,(PackageVersion
"Aug",PackageVersion
"08")
                      ,(PackageVersion
"Sep",PackageVersion
"09")
                      ,(PackageVersion
"Oct",PackageVersion
"10")
                      ,(PackageVersion
"Nov",PackageVersion
"11")
                      ,(PackageVersion
"Dec",PackageVersion
"12")
                      ]
                    dd :: PackageVersion
dd = (if forall (t :: * -> *) a. Foldable t => t a -> Int
length PackageVersion
day forall a. Ord a => a -> a -> Bool
< Int
2 then (Char
'0'forall a. a -> [a] -> [a]
:) else forall a. a -> a
id) PackageVersion
day
          -- but could be overridden by a log.date config variable in repo or user git config
          [PackageVersion]
_ -> PackageVersion
packageversion

-- -- | Given a program name, return a precise platform-specific executable
-- -- name suitable for naming downloadable binaries.  Can raise an error if
-- -- the version and patch level was not defined correctly at build time.
-- binaryfilename :: String -> String
-- binaryfilename progname = concat
--     [progname, "-", buildversion, "-", os', "-", arch, suffix]
--   where
--     (os',suffix) | os == "darwin"  = ("mac","" :: String)
--                  | os == "mingw32" = ("windows",".exe")
--                  | otherwise       = (os,"")