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

module Hledger.Cli.Version (
  PackageVersionString,
  Version,
  nullversion,
  toVersion,
  showVersion,
  isReleaseVersion,
  HledgerVersionString,
  HledgerBinaryInfo(..),
  nullbinaryinfo,
  ProgramName,
  GitHash,
  ArchName,
  parseHledgerVersion,
  packageversion,
  packagemajorversion,
  versionStringWith,
)
where

import GitHash (GitInfo, giHash, giCommitDate)  -- giDirty
import System.Info (os, arch)
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty, toList)
import Data.List.Split (splitOn)
import Data.Maybe
import Text.Read (readMaybe)

import Hledger.Utils (ghcDebugSupportedInLib, splitAtElement, rstrip)
import Data.Time (Day)
import Text.Megaparsec
import Data.Void (Void)
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
import Hledger.Data.Dates (parsedate)
import Data.Bifunctor
import qualified Data.List.NonEmpty as NE


-- | A Cabal/Hackage-compatible package version string: one or more dot-separated integers.
type PackageVersionString = String

-- | The number parts parsed from a PackageVersionString.
type Version = NonEmpty Int

nullversion :: NonEmpty Int
nullversion = [Int] -> NonEmpty Int
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Int
0]

showVersion :: Version -> String
showVersion :: NonEmpty Int -> String
showVersion = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String)
-> (NonEmpty Int -> [String]) -> NonEmpty Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show ([Int] -> [String])
-> (NonEmpty Int -> [Int]) -> NonEmpty Int -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Int -> [Int]
forall a. NonEmpty a -> [a]
toList

-- | Parse a valid Cabal/Hackage-compatible package version.
toVersion :: PackageVersionString -> Maybe Version
toVersion :: String -> Maybe (NonEmpty Int)
toVersion String
s =
  let parts :: [Maybe Int]
parts = (String -> Maybe Int) -> [String] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([String] -> [Maybe Int]) -> [String] -> [Maybe Int]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." String
s :: [Maybe Int]
  in
    if [Maybe Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe Int]
parts Bool -> Bool -> Bool
|| (Maybe Int -> Bool) -> [Maybe Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing [Maybe Int]
parts
    then Maybe (NonEmpty Int)
forall a. Maybe a
Nothing
    else [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int)) -> [Int] -> Maybe (NonEmpty Int)
forall a b. (a -> b) -> a -> b
$ [Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Int]
parts

isReleaseVersion :: Version -> Bool
isReleaseVersion :: NonEmpty Int -> Bool
isReleaseVersion NonEmpty Int
v = NonEmpty Int -> Int
forall a. NonEmpty a -> a
NE.last NonEmpty Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
98   -- .99 and possibly .98 are dev

-- | A hledger version string, as shown by hledger --version.
-- This can vary; some examples:
--
-- * dev builds:     hledger 1.42.99-g2288f5193-20250422, mac-aarch64
--
-- * release builds: hledger 1.42.1, mac-aarch64
--
-- * older versions: hledger 1.21
type HledgerVersionString = String

-- | The program name from a hledger version string: hledger, hledger-ui, hledger-web..
type ProgramName = String

-- | The operating system name from a hledger version string.
-- This the value of @System.Info.os@ modified for readability:
-- mac, windows, linux, linux-android, freebsd, netbsd, openbsd..
type OsName = String

-- | The machine architecture from a hledger version string.
-- This is the value of @System.Info.arch@, eg:
-- aarch64, alpha, arm, hppa, hppa1_1, i386, ia64, loongarch32, loongarch64, m68k,
-- mips, mipseb, mipsel, nios2, powerpc, powerpc64, powerpc64le, riscv32, riscv64,
-- rs6000, s390, s390x, sh4, sparc, sparc64, vax, x86_64..
type ArchName = String

-- | The git hash from a hledger version string, excluding the g prefix.
type GitHash = String

-- | The name and package version of a hledger binary,
-- and the build's git hash, the release date, and the binary's 
-- intended operating machine and machine architecture, if we can detect these.
-- Also, a copy of the --version output from which it was parsed.
data HledgerBinaryInfo = HledgerBinaryInfo {
    HledgerBinaryInfo -> String
hbinVersionOutput     :: String
  , HledgerBinaryInfo -> String
hbinProgramName       :: ProgramName
  , HledgerBinaryInfo -> NonEmpty Int
hbinPackageVersion    :: Version 
  , HledgerBinaryInfo -> String
hbinPackageVersionStr :: String
  , HledgerBinaryInfo -> Maybe String
hbinGitHash           :: Maybe GitHash
  , HledgerBinaryInfo -> Maybe Day
hbinReleaseDate       :: Maybe Day
  , HledgerBinaryInfo -> Maybe String
hbinOs                :: Maybe OsName
  , HledgerBinaryInfo -> Maybe String
hbinArch              :: Maybe ArchName
} deriving (Int -> HledgerBinaryInfo -> ShowS
[HledgerBinaryInfo] -> ShowS
HledgerBinaryInfo -> String
(Int -> HledgerBinaryInfo -> ShowS)
-> (HledgerBinaryInfo -> String)
-> ([HledgerBinaryInfo] -> ShowS)
-> Show HledgerBinaryInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HledgerBinaryInfo -> ShowS
showsPrec :: Int -> HledgerBinaryInfo -> ShowS
$cshow :: HledgerBinaryInfo -> String
show :: HledgerBinaryInfo -> String
$cshowList :: [HledgerBinaryInfo] -> ShowS
showList :: [HledgerBinaryInfo] -> ShowS
Show, HledgerBinaryInfo -> HledgerBinaryInfo -> Bool
(HledgerBinaryInfo -> HledgerBinaryInfo -> Bool)
-> (HledgerBinaryInfo -> HledgerBinaryInfo -> Bool)
-> Eq HledgerBinaryInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HledgerBinaryInfo -> HledgerBinaryInfo -> Bool
== :: HledgerBinaryInfo -> HledgerBinaryInfo -> Bool
$c/= :: HledgerBinaryInfo -> HledgerBinaryInfo -> Bool
/= :: HledgerBinaryInfo -> HledgerBinaryInfo -> Bool
Eq)

nullbinaryinfo :: HledgerBinaryInfo
nullbinaryinfo = HledgerBinaryInfo {
    hbinVersionOutput :: String
hbinVersionOutput     = String
""
  , hbinProgramName :: String
hbinProgramName       = String
""
  , hbinPackageVersion :: NonEmpty Int
hbinPackageVersion    = NonEmpty Int
nullversion
  , hbinPackageVersionStr :: String
hbinPackageVersionStr = String
""
  , hbinGitHash :: Maybe String
hbinGitHash           = Maybe String
forall a. Maybe a
Nothing
  , hbinReleaseDate :: Maybe Day
hbinReleaseDate       = Maybe Day
forall a. Maybe a
Nothing
  , hbinOs :: Maybe String
hbinOs                = Maybe String
forall a. Maybe a
Nothing
  , hbinArch :: Maybe String
hbinArch              = Maybe String
forall a. Maybe a
Nothing
}

type Parser = Parsec Void String

-- | Parse hledger's --version output.
--
-- >>> isRight $ parseHledgerVersion "hledger 1.21"
-- True
-- >>> isRight $ parseHledgerVersion "hledger 1.42.1, mac-aarch64"
-- True
-- >>> isRight $ parseHledgerVersion "hledger 1.42.99-g2288f5193-20250422, mac-aarch64"
-- True
--
parseHledgerVersion :: HledgerVersionString -> Either String HledgerBinaryInfo
parseHledgerVersion :: String -> Either String HledgerBinaryInfo
parseHledgerVersion String
s = 
  case Parsec Void String HledgerBinaryInfo
-> String
-> String
-> Either (ParseErrorBundle String Void) HledgerBinaryInfo
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void String HledgerBinaryInfo
hledgerversionp String
"" String
s of
  Left ParseErrorBundle String Void
err -> String -> Either String HledgerBinaryInfo
forall a b. a -> Either a b
Left (String -> Either String HledgerBinaryInfo)
-> String -> Either String HledgerBinaryInfo
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle String Void
err
  Right HledgerBinaryInfo
v  -> HledgerBinaryInfo -> Either String HledgerBinaryInfo
forall a b. b -> Either a b
Right HledgerBinaryInfo
v{hbinVersionOutput=rstrip s}

-- Parser for hledger --version output: a program name beginning with "hledger" and a package version;
-- possibly followed by a git hash and release date;
-- possibly followed by the binary's intended operating system and architecture
-- (see HledgerVersionString and versionStringWith).
-- The hbinVersionOutput field is left blank here; parseHledgerVersion sets it.
hledgerversionp :: Parser HledgerBinaryInfo
hledgerversionp :: Parsec Void String HledgerBinaryInfo
hledgerversionp = do
  String
progName <- String -> ShowS
forall a. Semigroup a => a -> a -> a
(<>) (String -> ShowS)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"hledger" ParsecT Void String Identity ShowS
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void String Identity Char
ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'-')
  ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void String Identity Char
 -> ParsecT Void String Identity String)
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
' '
  NonEmpty Int
pkgversion <- Parser (NonEmpty Int)
packageversionp
  Maybe String
mgithash <- ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void String Identity String
 -> ParsecT Void String Identity (Maybe String))
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String)
forall a b. (a -> b) -> a -> b
$ ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void String Identity String
 -> ParsecT Void String Identity String)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"-g" ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void String Identity Char
ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar
  Maybe Day
mreldate <- ParsecT Void String Identity Day
-> ParsecT Void String Identity (Maybe Day)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void String Identity Day
 -> ParsecT Void String Identity (Maybe Day))
-> ParsecT Void String Identity Day
-> ParsecT Void String Identity (Maybe Day)
forall a b. (a -> b) -> a -> b
$ do
    Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"-"
    String
datestr <- (:) (Char -> ShowS)
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity Char
ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar ParsecT Void String Identity ShowS
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void String Identity Char
ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'-')
    ParsecT Void String Identity Day
-> (Day -> ParsecT Void String Identity Day)
-> Maybe Day
-> ParsecT Void String Identity Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ParsecT Void String Identity Day
forall a. String -> ParsecT Void String Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid date") Day -> ParsecT Void String Identity Day
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Day -> ParsecT Void String Identity Day)
-> Maybe Day -> ParsecT Void String Identity Day
forall a b. (a -> b) -> a -> b
$ String -> Maybe Day
parsedate (String -> Maybe Day) -> String -> Maybe Day
forall a b. (a -> b) -> a -> b
$ String
datestr
  -- Oh oh. hledger --version prints OS-ARCH, but it turns out OS can contain hyphens (eg linux-android).
  -- Based on the "common values" in System.Info docs, it seems ARCH typically does not contain hyphens;
  -- we'll assume that here, and split at the rightmost hyphen.
  Maybe String
mosarch <- ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void String Identity String
 -> ParsecT Void String Identity (Maybe String))
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
    Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
","
    ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
' ')
    ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void String Identity Char
ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity Char
ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'-' ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'_')
  let
    (Maybe String
march, Maybe String
mos) = case Maybe String
mosarch of
      Maybe String
Nothing -> (Maybe String
forall a. Maybe a
Nothing, Maybe String
forall a. Maybe a
Nothing)
      Just String
osarch -> (String -> Maybe String)
-> (String -> Maybe String)
-> (String, String)
-> (Maybe String, Maybe String)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> ShowS -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> ShowS -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse) ((String, String) -> (Maybe String, Maybe String))
-> (String, String) -> (Maybe String, Maybe String)
forall a b. (a -> b) -> a -> b
$ ShowS -> (String, String) -> (String, String)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1) ((String, String) -> (String, String))
-> (String, String) -> (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
osarch
  ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void String Identity Char
ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar
  ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  HledgerBinaryInfo -> Parsec Void String HledgerBinaryInfo
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (HledgerBinaryInfo -> Parsec Void String HledgerBinaryInfo)
-> HledgerBinaryInfo -> Parsec Void String HledgerBinaryInfo
forall a b. (a -> b) -> a -> b
$ HledgerBinaryInfo
    { hbinVersionOutput :: String
hbinVersionOutput = String
""
    , hbinProgramName :: String
hbinProgramName = String
progName
    , hbinPackageVersion :: NonEmpty Int
hbinPackageVersion = NonEmpty Int
pkgversion
    , hbinPackageVersionStr :: String
hbinPackageVersionStr = NonEmpty Int -> String
showVersion NonEmpty Int
pkgversion
    , hbinGitHash :: Maybe String
hbinGitHash = Maybe String
mgithash
    , hbinReleaseDate :: Maybe Day
hbinReleaseDate = Maybe Day
mreldate
    , hbinOs :: Maybe String
hbinOs = Maybe String
mos
    , hbinArch :: Maybe String
hbinArch = Maybe String
march
    }

-- | Parser for Cabal package version numbers, one or more dot-separated integers. Eg "1.42.1".
packageversionp :: Parser Version
packageversionp :: Parser (NonEmpty Int)
packageversionp = do
  Int
firstNum <- ParsecT Void String Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal
  [Int]
rest <- ParsecT Void String Identity Int
-> ParsecT Void String Identity [Int]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'.' ParsecT Void String Identity Char
-> ParsecT Void String Identity Int
-> ParsecT Void String Identity Int
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal)
  NonEmpty Int -> Parser (NonEmpty Int)
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty Int -> Parser (NonEmpty Int))
-> NonEmpty Int -> Parser (NonEmpty Int)
forall a b. (a -> b) -> a -> b
$ Int
firstNum Int -> [Int] -> NonEmpty Int
forall a. a -> [a] -> NonEmpty a
:| [Int]
rest

-- | 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 :: PackageVersionString
packageversion :: String
packageversion =
#ifdef VERSION
  VERSION
#else
  ""
#endif

-- | Just the first 1-2 components of packageversion.
packagemajorversion :: PackageVersionString
packagemajorversion :: String
packagemajorversion = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
2 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
splitAtElement Char
'.' String
packageversion

-- | Given possible git state info from the build directory (or a git error, which is ignored),
-- and the debug build flag, executable name and package version for the package being built,
-- make the best version string we can. 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.)
-- * If the debug build flag was enabled for the package being built, and for hledger-lib (both are needed),
--   "ghc-debug support" is 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.
--
-- The GitInfo if any, fetched by template haskell, is passed down from
-- a top-level module, reducing wasteful recompilation.
-- The status of the debug build flag is also passed down, since it is
-- specific to each hledger package.
--
-- This is used indirectly by at least hledger, hledger-ui, and hledger-web,
-- so output should be suitable for all of those.
--
versionStringWith :: Either String GitInfo -> Bool -> ProgramName -> PackageVersionString -> HledgerVersionString
versionStringWith :: Either String GitInfo -> Bool -> String -> ShowS
versionStringWith Either String GitInfo
egitinfo Bool
ghcDebugSupportedInThisPackage String
progname String
packagever =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    [ String
progname , String
" " , String
version , String
", " , String
os' , String
"-" , String
arch ]
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
" with ghc-debug support" | Bool
ghcDebugSupportedInThisPackage Bool -> Bool -> Bool
&& Bool
ghcDebugSupportedInLib ]
  where
    os' :: String
os' | String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"darwin"  = String
"mac"
        | String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw32" = String
"windows"
        | Bool
otherwise       = String
os
    version :: String
version = case Either String GitInfo
egitinfo of
      Left String
_err     -> String
packagever
      Right GitInfo
gitinfo -> 
        case String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ GitInfo -> String
giCommitDate GitInfo
gitinfo of
          -- git log's date format is normally --date=default ("similar to --date=rfc2822")
          String
_weekday:String
mon:String
day:String
_localtime:String
year:String
_offset:[String]
_ ->
            String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"-" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String
packagever, String
hash, String
date]
              -- ++ ["+" | giDirty gitinfo]
              --   XXX giDirty is wrong when repo shows untracked files by default, skip it for now
              where
                hash :: String
hash = Char
'g' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
9 (GitInfo -> String
giHash GitInfo
gitinfo)  -- like git describe
                date :: String
date = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
year,String
mm,String
dd]
                  where 
                    mm :: String
mm = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
mon (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
mon ([(String, String)] -> Maybe String)
-> [(String, String)] -> Maybe String
forall a b. (a -> b) -> a -> b
$ [
                      (String
"Jan",String
"01")
                      ,(String
"Feb",String
"02")
                      ,(String
"Mar",String
"03")
                      ,(String
"Apr",String
"04")
                      ,(String
"May",String
"05")
                      ,(String
"Jun",String
"06")
                      ,(String
"Jul",String
"07")
                      ,(String
"Aug",String
"08")
                      ,(String
"Sep",String
"09")
                      ,(String
"Oct",String
"10")
                      ,(String
"Nov",String
"11")
                      ,(String
"Dec",String
"12")
                      ]
                    dd :: String
dd = (if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
day Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 then (Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:) else ShowS
forall a. a -> a
id) String
day
          -- but could be overridden by a log.date config variable in repo or user git config
          [String]
_ -> String
packageversion