lib: and setup: robust parsing of hledger --version output

hledger/Hledger/Cli/Commands/Setup.hs

@@ -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
+        Left  err ->
-        Right out -> do
+          p N (progname <> " --version failed: " <> err) >> return Nothing
-          p Y ""
+        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
+              -- It runs and --version output looks ok, continue
-          let
-            versionoutput = rstrip out
-            versionwords = words versionoutput
 
-          pdesc "is a native binary ?"
+              pdesc "is a native binary ?"
-          let
+              case hbinArch of
-            sysarch = os' <> "-" <> arch
+                Nothing -> p U $ "couldn't detect arch in --version output"
-              where
+                Just binarch | binarch /= arch -> p N $ "installed binary is for " <> binarch <> ", system is " <> arch
-                os' -- keep synced: Version.hs
+                Just binarch -> p Y binarch
-                  | 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 up to date ?"
+              pdesc "is up to date ?"
-          case drop 1 versionwords of
+              let binversion = hbinPackageVersion
-            [] -> p U "couldn't parse --version output" >> return Nothing
+              elatestversionnumstr <- getLatestHledgerVersion
-            detailedversionstr:_ -> do
+              case elatestversionnumstr of
-              let
+                Left e -> p U ("couldn't read " <> latestHledgerVersionUrlStr <> " , " <> e)
-                versionnumstr = takeWhile (`elem` ("0123456789." :: String)) detailedversionstr
+                Right latestversionnumstr ->
-                mversion      = toVersion versionnumstr
+                  case toVersion latestversionnumstr of
-              case mversion of
+                    Nothing -> p U "couldn't parse latest version number"
-                Nothing -> p U "couldn't parse --version's version number" >> return Nothing
+                    Just latestversion -> p
-                Just version -> do
+                      (if binversion >= latestversion then Y else N)
-                  elatestversionnumstr <- getLatestHledgerVersion
+                      (showVersion hbinPackageVersion <> " installed, latest is " <> latestversionnumstr)
-                  case elatestversionnumstr of
+
-                    Left e -> p U ("couldn't read " <> latestHledgerVersionUrlStr <> " , " <> e)
+              pdesc "is the hledger running setup the same ?"
-                    Right latestversionnumstr ->
+              if prognameandversion == hbinVersionOutput
-                      case toVersion latestversionnumstr of
+              then i Y ""
-                        Nothing -> p U "couldn't parse latest version number"
+              else i N prognameandversion
-                        Just latest -> p (if version >= latest then Y else N) (versionnumstr <> " installed, latest is " <> latestversionnumstr)
+
-                  return $ Just (versionoutput, version) 
+              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 Y = good    "yes"    -- ✅ apple emojis - won't work everywhere
-  show N = bold' (brightRed'    " no")    -- ❌
+  show N = bad     " no"    -- ❌
-  show U = bold' (brightYellow' " ? ")
+  show U = warning " ? "
 
 -- Show status, in blue/yellow if supported.
-showInfo Y = bold' (brightBlue'   "yes")  -- ℹ️
+showInfo Y = neutral "yes"  -- ℹ️
-showInfo N = bold' (brightBlue'   " no")  -- ℹ️
+showInfo N = neutral " no"  -- ℹ️
-showInfo U = bold' (brightYellow' " ? ")
+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.

hledger/Hledger/Cli/Version.hs

@@ -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.
+-- | 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 PackageVersionString = String
-type DetailedVersionString = String         -- ^ A hledger version string, including a package version and other info like a git hash.
+
+-- | 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 ]