{-# LANGUAGE CPP #-}
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)
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
type PackageVersionString = String
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
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
type HledgerVersionString = String
type ProgramName = String
type OsName = String
type ArchName = String
type GitHash = String
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
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}
hledgerversionp :: Parser HledgerBinaryInfo
hledgerversionp :: Parsec Void String HledgerBinaryInfo
hledgerversionp = do
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
'-')
some $ char ' '
pkgversion <- packageversionp
mgithash <- optional $ try $ string "-g" *> some hexDigitChar
mreldate <- optional $ do
string "-"
datestr <- (:) <$> digitChar <*> some (digitChar <|> char '-')
maybe (fail "invalid date") pure $ parsedate $ datestr
mosarch <- optional $ do
string ","
some (char ' ')
some (letterChar <|> digitChar <|> char '-' <|> char '_')
let
(march, mos) = case 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
many spaceChar
eof
return $ HledgerBinaryInfo
{ hbinVersionOutput = ""
, hbinProgramName = progName
, hbinPackageVersion = pkgversion
, hbinPackageVersionStr = showVersion pkgversion
, hbinGitHash = mgithash
, hbinReleaseDate = mreldate
, hbinOs = mos
, hbinArch = march
}
packageversionp :: Parser Version
packageversionp :: Parser (NonEmpty Int)
packageversionp = do
firstNum <- ParsecT Void String Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal
rest <- many (char '.' *> L.decimal)
return $ firstNum :| rest
packageversion :: PackageVersionString
packageversion :: String
packageversion =
#ifdef VERSION
VERSION
#else
""
#endif
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
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
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]
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)
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
[String]
_ -> String
packageversion