lib: and setup: robust parsing of hledger --version output
This commit is contained in:
Simon Michael
parent
a13b7d2a82
commit
f39b34184e
@ -14,6 +14,7 @@ Check and show the status of the hledger installation.
|
||||
{-# OPTIONS_GHC -Wno-name-shadowing #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
-- {-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
|
||||
module Hledger.Cli.Commands.Setup (
|
||||
@ -46,7 +47,7 @@ import Text.Printf (printf)
|
||||
import Hledger
|
||||
import Hledger.Cli.CliOptions
|
||||
import Hledger.Cli.Conf
|
||||
import Hledger.Cli.Version (Version, toVersion)
|
||||
import Hledger.Cli.Version
|
||||
|
||||
|
||||
setupmode = hledgerCommandMode
|
||||
@ -88,10 +89,18 @@ setup _opts@CliOpts{rawopts_=_rawopts, reportspec_=_rspec} _ignoredj = do
|
||||
-- This command is not given a journal and should not use _ignoredj;
|
||||
-- instead detect it ourselves when we are ready.
|
||||
putStrLn "Checking your hledger setup.."
|
||||
color <- useColorOnStdout
|
||||
when color $
|
||||
putStrLn $ "Legend: " <> intercalate ", " [
|
||||
good "good"
|
||||
,neutral "neutral"
|
||||
,warning "warning"
|
||||
,bad "bad"
|
||||
]
|
||||
mversion <- setupHledger
|
||||
case mversion of
|
||||
Nothing -> return ()
|
||||
Just (_, version) -> do
|
||||
Just HledgerBinaryVersion{hbinPackageVersion=version} -> do
|
||||
setupConfig version
|
||||
setupFile version
|
||||
-- setupAccounts version
|
||||
@ -113,7 +122,7 @@ supportsConfigFiles = (>= 1 :| [40]) -- config files, 2024
|
||||
-- if found, tests it in various ways;
|
||||
-- and if it ran successfully, returns the full --version output
|
||||
-- and the numeric Version parsed from that.
|
||||
setupHledger :: IO (Maybe (String, Version))
|
||||
setupHledger :: IO (Maybe HledgerBinaryVersion)
|
||||
setupHledger = do
|
||||
pgroup "hledger"
|
||||
|
||||
@ -146,52 +155,45 @@ setupHledger = do
|
||||
(pathexe:_, _) -> do
|
||||
p Y (quoteIfNeeded pathexe)
|
||||
|
||||
-- If hledger was found in PATH, do more checks
|
||||
-- hledger was found in PATH, continue
|
||||
|
||||
pdesc "runs ?"
|
||||
pdesc "runs, --version looks like hledger ?"
|
||||
eerrout <- tryHledgerArgs [["--version", "--no-conf"], ["--version"]]
|
||||
case eerrout of
|
||||
Left err -> p N ("'" <> progname <> " --version' failed: \n" <> err) >> return Nothing
|
||||
Right out -> do
|
||||
p Y ""
|
||||
Left err ->
|
||||
p N (progname <> " --version failed: " <> err) >> return Nothing
|
||||
Right out | versionoutput <- rstrip out -> do
|
||||
case parseHledgerVersion versionoutput of
|
||||
Left _ -> p N (progname <> " --version shows: " <> rstrip out) >> return Nothing
|
||||
Right bininfo@HledgerBinaryVersion{..} -> do
|
||||
p Y versionoutput
|
||||
|
||||
-- If it runs, do more checks
|
||||
let
|
||||
versionoutput = rstrip out
|
||||
versionwords = words versionoutput
|
||||
-- It runs and --version output looks ok, continue
|
||||
|
||||
pdesc "is a native binary ?"
|
||||
let
|
||||
sysarch = os' <> "-" <> arch
|
||||
where
|
||||
os' -- keep synced: Version.hs
|
||||
| os == "darwin" = "mac"
|
||||
| os == "mingw32" = "windows"
|
||||
| otherwise = os
|
||||
case drop 2 versionwords of
|
||||
exearch:_ -> if exearch == sysarch
|
||||
then p Y versionoutput
|
||||
else p N $ "installed binary is for " <> exearch <> ", system is " <> sysarch
|
||||
_ -> p U $ "couldn't detect arch in --version output"
|
||||
pdesc "is a native binary ?"
|
||||
case hbinArch of
|
||||
Nothing -> p U $ "couldn't detect arch in --version output"
|
||||
Just binarch | binarch /= arch -> p N $ "installed binary is for " <> binarch <> ", system is " <> arch
|
||||
Just binarch -> p Y binarch
|
||||
|
||||
pdesc "is up to date ?"
|
||||
case drop 1 versionwords of
|
||||
[] -> p U "couldn't parse --version output" >> return Nothing
|
||||
detailedversionstr:_ -> do
|
||||
let
|
||||
versionnumstr = takeWhile (`elem` ("0123456789." :: String)) detailedversionstr
|
||||
mversion = toVersion versionnumstr
|
||||
case mversion of
|
||||
Nothing -> p U "couldn't parse --version's version number" >> return Nothing
|
||||
Just version -> do
|
||||
elatestversionnumstr <- getLatestHledgerVersion
|
||||
case elatestversionnumstr of
|
||||
Left e -> p U ("couldn't read " <> latestHledgerVersionUrlStr <> " , " <> e)
|
||||
Right latestversionnumstr ->
|
||||
case toVersion latestversionnumstr of
|
||||
Nothing -> p U "couldn't parse latest version number"
|
||||
Just latest -> p (if version >= latest then Y else N) (versionnumstr <> " installed, latest is " <> latestversionnumstr)
|
||||
return $ Just (versionoutput, version)
|
||||
pdesc "is up to date ?"
|
||||
let binversion = hbinPackageVersion
|
||||
elatestversionnumstr <- getLatestHledgerVersion
|
||||
case elatestversionnumstr of
|
||||
Left e -> p U ("couldn't read " <> latestHledgerVersionUrlStr <> " , " <> e)
|
||||
Right latestversionnumstr ->
|
||||
case toVersion latestversionnumstr of
|
||||
Nothing -> p U "couldn't parse latest version number"
|
||||
Just latestversion -> p
|
||||
(if binversion >= latestversion then Y else N)
|
||||
(showVersion hbinPackageVersion <> " installed, latest is " <> latestversionnumstr)
|
||||
|
||||
pdesc "is the hledger running setup the same ?"
|
||||
if prognameandversion == hbinVersionOutput
|
||||
then i Y ""
|
||||
else i N prognameandversion
|
||||
|
||||
return $ Just bininfo
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
@ -342,16 +344,22 @@ setupTags = do
|
||||
-- yes, no, unknown
|
||||
data YNU = Y | N | U deriving (Eq)
|
||||
|
||||
-- ANSI styles
|
||||
good = bold' . brightGreen'
|
||||
neutral = bold' . brightBlue'
|
||||
warning = bold' . brightYellow'
|
||||
bad = bold' . brightRed'
|
||||
|
||||
-- Show status, in red/green/yellow if supported.
|
||||
instance Show YNU where
|
||||
show Y = bold' (brightGreen' "yes") -- ✅ apple emojis - won't work everywhere
|
||||
show N = bold' (brightRed' " no") -- ❌
|
||||
show U = bold' (brightYellow' " ? ")
|
||||
show Y = good "yes" -- ✅ apple emojis - won't work everywhere
|
||||
show N = bad " no" -- ❌
|
||||
show U = warning " ? "
|
||||
|
||||
-- Show status, in blue/yellow if supported.
|
||||
showInfo Y = bold' (brightBlue' "yes") -- ℹ️
|
||||
showInfo N = bold' (brightBlue' " no") -- ℹ️
|
||||
showInfo U = bold' (brightYellow' " ? ")
|
||||
showInfo Y = neutral "yes" -- ℹ️
|
||||
showInfo N = neutral " no" -- ℹ️
|
||||
showInfo U = warning " ? "
|
||||
|
||||
-- | Print a test's pass or fail status, as "yes" or "no" or "",
|
||||
-- in green/red if supported, and the (possibly empty) provided message.
|
||||
|
||||
@ -4,11 +4,16 @@ Version number-related utilities. See also the Makefile.
|
||||
-}
|
||||
|
||||
module Hledger.Cli.Version (
|
||||
ProgramName,
|
||||
PackageVersionString,
|
||||
Version,
|
||||
DetailedVersionString,
|
||||
toVersion,
|
||||
showVersion,
|
||||
HledgerVersionString,
|
||||
HledgerBinaryVersion(..),
|
||||
ProgramName,
|
||||
GitHash,
|
||||
ArchName,
|
||||
parseHledgerVersion,
|
||||
packageversion,
|
||||
packagemajorversion,
|
||||
versionStringWith,
|
||||
@ -18,18 +23,29 @@ where
|
||||
import GitHash (GitInfo, giHash, giCommitDate) -- giDirty
|
||||
import System.Info (os, arch)
|
||||
import Data.List (intercalate)
|
||||
import Data.List.NonEmpty (NonEmpty, nonEmpty)
|
||||
import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty, toList)
|
||||
import Data.List.Split (splitOn)
|
||||
import Data.Maybe
|
||||
import Text.Read (readMaybe)
|
||||
|
||||
import Hledger.Utils (ghcDebugSupportedInLib, splitAtElement)
|
||||
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
|
||||
|
||||
type ProgramName = String
|
||||
|
||||
type PackageVersionString = String -- ^ A Cabal/Hackage-compatible package version string: one or more dot-separated integers.
|
||||
type Version = NonEmpty Int -- ^ The number parts parsed from a PackageVersionString.
|
||||
type DetailedVersionString = String -- ^ A hledger version string, including a package version and other info like a git hash.
|
||||
-- | 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
|
||||
|
||||
showVersion :: Version -> String
|
||||
showVersion = intercalate "." . map show . toList
|
||||
|
||||
-- | Parse a valid Cabal/Hackage-compatible package version.
|
||||
toVersion :: PackageVersionString -> Maybe Version
|
||||
@ -40,6 +56,110 @@ toVersion s =
|
||||
then Nothing
|
||||
else nonEmpty $ catMaybes parts
|
||||
|
||||
-- | 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 HledgerBinaryVersion = HledgerBinaryVersion {
|
||||
hbinVersionOutput :: String
|
||||
, hbinProgramName :: ProgramName
|
||||
, hbinPackageVersion :: Version
|
||||
, hbinGitHash :: Maybe GitHash
|
||||
, hbinReleaseDate :: Maybe Day
|
||||
, hbinOs :: Maybe OsName
|
||||
, hbinArch :: Maybe ArchName
|
||||
} deriving (Show, Eq)
|
||||
|
||||
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 HledgerBinaryVersion
|
||||
parseHledgerVersion s =
|
||||
case parse hledgerversionp "" s of
|
||||
Left err -> Left $ errorBundlePretty err
|
||||
Right v -> Right 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 HledgerBinaryVersion
|
||||
hledgerversionp = do
|
||||
progName <- (<>) <$> string "hledger" <*> many (letterChar <|> char '-')
|
||||
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
|
||||
-- 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.
|
||||
mosarch <- optional $ do
|
||||
string ","
|
||||
some (char ' ')
|
||||
some (letterChar <|> digitChar <|> char '-' <|> char '_')
|
||||
let
|
||||
(march, mos) = case mosarch of
|
||||
Nothing -> (Nothing, Nothing)
|
||||
Just osarch -> bimap (Just . reverse) (Just . reverse) $ second (drop 1) $ break (== '-') $ reverse osarch
|
||||
many spaceChar
|
||||
eof
|
||||
return $ HledgerBinaryVersion
|
||||
{ hbinVersionOutput = ""
|
||||
, hbinProgramName = progName
|
||||
, hbinPackageVersion = pkgversion
|
||||
, hbinGitHash = mgithash
|
||||
, hbinReleaseDate = mreldate
|
||||
, hbinOs = mos
|
||||
, hbinArch = march
|
||||
}
|
||||
|
||||
-- | Parser for Cabal package version numbers, one or more dot-separated integers. Eg "1.42.1".
|
||||
packageversionp :: Parser Version
|
||||
packageversionp = do
|
||||
firstNum <- L.decimal
|
||||
rest <- many (char '.' *> L.decimal)
|
||||
return $ firstNum :| 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
|
||||
@ -86,7 +206,7 @@ packagemajorversion = intercalate "." $ take 2 $ splitAtElement '.' packageversi
|
||||
-- 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 -> DetailedVersionString
|
||||
versionStringWith :: Either String GitInfo -> Bool -> ProgramName -> PackageVersionString -> HledgerVersionString
|
||||
versionStringWith egitinfo ghcDebugSupportedInThisPackage progname packagever =
|
||||
concat $
|
||||
[ progname , " " , version , ", " , os' , "-" , arch ]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user