    {-|

    Check and show the status of the hledger installation.

    -}
    {-
    Old design notes:

    ## Goals
    - Make getting started with hledger and PTA easier and quicker, to
      (a) make this practical for more people (non techies, busy techies..)
      (b) free up more time and energy for learning and doing PTA and finance

    Subgoals:
    - Reduce the special knowledge and docs needed after install, to get a standard setup working (especially on windows)
    - Help with discovery and setup of advanced quality of life terminal features
    - Assist with setting up a first or new journal file
    - Deliver relevant install/setup/config expertise more efficiently, freeing up dev and support time

    ## Design
    Why a built in command and not a shell script, haskell script, or docs ?
    So it is available and runs reliably anywhere a hledger executable runs, and so it can detect more context-specific advice.
    (Optionally use shell or haskell scripts for prototyping, if that's helpful)

    ## Setup checks
    Somewhat ordered.
    These deal with the complexities of terminals, the shell, GHC, hledger, and the user's machine, locale, and data.
    Initially just informational hints.
    Later, add automated or interactive diagnosis and repair attempts,
    and semi-persistent state (invalidated at suitable times).
    These checks are a necessary evil/stopgap; long term, automate/replace/remove them whenever possible.

    -}

    -- {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE OverloadedStrings #-}
    -- {-# LANGUAGE NamedFieldPuns #-}
    -- {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TemplateHaskell #-}

    {-# 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 (
      setupmode
     ,setup
    )
    where

    import Control.Concurrent (rtsSupportsBoundThreads)
    import Control.Exception
    import Control.Monad
    -- import Data.ByteString qualified as B
    import Data.Char
    import Data.Default (def)
    import Data.List
    import Data.Map qualified as M
    import Data.Maybe
    import Data.Text qualified as T
    import Data.Text.Encoding qualified as T
    import Data.Version qualified (showVersion)
    import Network.HTTP.Client
    import Network.HTTP.Types (statusCode, hLocation)
    import Network.HTTP.Req as R
    import Safe
    import System.Directory
    import System.Environment (getEnvironment, lookupEnv)
    import System.Exit
    import System.FilePath
    import System.Info
    import System.Process
    import Text.Printf (printf)

    import Hledger
    import Hledger.Cli.CliOptions
    import Hledger.Cli.Conf
    import Hledger.Cli.Version
    import System.IO (localeEncoding, stdout, hFlush)

    setupmode :: Mode RawOpts
    setupmode = String
    -> [Flag RawOpts]
    -> [(String, [Flag RawOpts])]
    -> [Flag RawOpts]
    -> ([Arg RawOpts], Maybe (Arg RawOpts))
    -> Mode RawOpts
    hledgerCommandMode
      $(embedFileRelative "Hledger/Cli/Commands/Setup.txt")
      []
      [(String, [Flag RawOpts])
    generalflagsgroup3]
      []
      ([], Maybe (Arg RawOpts)
    forall a. Maybe a
    Nothing)

    {- | Test and print the status of various aspects of the hledger installation.
    May also show extra info and hints on how to fix problems.
    The goal is to detect and show as much useful information as possible,
    and to complete this task reliably regardless of what we find,
    without premature termination or misformatting.

    The tests are grouped into setup* routines, so named because they might do more
    than just test in future.

    This is the second version of setup. If it finds that the currently
    running hledger is not the one installed in PATH (by comparing --version output),
    it refuses to proceed further until that has been done.
    This means it can rely on all the latest features and use the hledger API
    within this process, simplifying things greatly.
    -}
    setup :: CliOpts -> Journal -> IO ()
    setup :: CliOpts -> Journal -> IO ()
    setup _opts :: CliOpts
    _opts@CliOpts{rawopts_ :: CliOpts -> RawOpts
    rawopts_=RawOpts
    _rawopts, reportspec_ :: CliOpts -> ReportSpec
    reportspec_=ReportSpec
    _rspec} Journal
    _ignoredj = do
      -- This command is not given a journal and should not use _ignoredj;
      -- instead read it ourselves when we are ready.
      String -> IO ()
    putStrLn String
    "Checking your hledger setup.."
      color <- IO Bool
    useColorOnStdout
      when color $
        putStrLn $ "Legend: " <> intercalate ", " [
           good    "good"
          ,neutral "neutral"
          ,warning "unknown"
          ,bad     "warning"
          ]
      meconf <- setupHledger
      setupTerminal meconf
      setupJournal meconf
      putStr "\n"

    ------------------------------------------------------------------------------

    -- Returns Nothing if no config file was found,
    -- or Just the read error or config if it was found.
    setupHledger :: IO (Maybe (Either String Conf))
    setupHledger :: IO (Maybe (Either String Conf))
    setupHledger = do
      String -> IO ()
    pgroup String
    "hledger"

      let
        os' :: String
    os'
          | String
    osString -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    ==String
    "darwin" = String
    "macos"
          | String
    osString -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    ==String
    "mingw32" = String
    "windows"
          | Bool
    otherwise = String
    os
      mosversion <- IO (Maybe String)
    getOSVersion
      let osdesc = String
    os' String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String -> (String -> String) -> Maybe String -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "" (String
    " "String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <>) Maybe String
    mosversion
      pdesc "is running on"
      putStrLn $ "      " <> osdesc <> " on " <> arch

      pdesc "is built with a supported compiler/RTS"
      p (if rtsSupportsBoundThreads then Y else N) $
        compilerName <> " " <> Data.Version.showVersion fullCompilerVersion
          <> if rtsSupportsBoundThreads then ", using threaded RTS" else ", RTS does not have threads enabled"

      pdesc "is a native binary for this machine ?"
      case hbinArch binaryinfo of
        Maybe String
    Nothing -> YNU -> String -> IO ()
    p YNU
    U (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "couldn't detect this binary's architecture"
        Just String
    a | String
    a String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    arch -> YNU -> String -> IO ()
    p YNU
    N (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "binary is for " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    a String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ", system is " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    arch String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ", may run slowly"
        Just String
    a -> YNU -> String -> IO ()
    p YNU
    Y String
    a

      pdesc "is a released version ?"
      if isReleaseVersion $ hbinPackageVersion binaryinfo
      then p Y prognameandversion
      else i N prognameandversion

      pdesc "is up to date ? checking latest..." >> hFlush stdout
      elatestversionnumstr <- getLatestHledgerVersion
      case elatestversionnumstr of
        Left String
    e -> YNU -> String -> IO ()
    p YNU
    U (String
    "couldn't read " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    latestHledgerVersionUrlStr String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    e)
        Right String
    latestversionnumstr ->
          case String -> Maybe Version
    toVersion String
    latestversionnumstr of
            Maybe Version
    Nothing -> YNU -> String -> IO ()
    p YNU
    U String
    "couldn't parse latest version number"
            Just Version
    latestversion -> YNU -> String -> IO ()
    p
              (if HledgerBinaryInfo -> Version
    hbinPackageVersion HledgerBinaryInfo
    binaryinfo Version -> Version -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Version
    latestversion then YNU
    Y else YNU
    N)
              (String
    "latest is " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    latestversionnumstr String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ", " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Version -> String
    showVersion (HledgerBinaryInfo -> Version
    hbinPackageVersion HledgerBinaryInfo
    binaryinfo) String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " is installed")

      pdesc "is installed in PATH (this version) ?"
      pathexes  <- findExecutables progname
      let
        (failaction, failmsg) =
          -- (exitFailure , "Please install this hledger in PATH then run setup again.")
          (return ()   , " Some of this info may not apply to that hledger version. Continuing anyway..")
      case pathexes of
        [] -> YNU -> String -> IO ()
    p YNU
    N String
    failmsg IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    failaction
        String
    exe:[String]
    _ -> do
          eerrout <- [[String]] -> IO (Either String String)
    tryHledgerArgs [[String
    "--version", String
    "--no-conf"], [String
    "--version"]]
          case eerrout of
            Left  String
    err -> YNU -> String -> IO ()
    p YNU
    U (String
    progname String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " --version failed: " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    err) IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    failaction
            Right String
    out -> do
              case String -> Either String HledgerBinaryInfo
    parseHledgerVersion String
    out of
                Left  String
    _ -> YNU -> String -> IO ()
    p YNU
    U (String
    "couldn't parse " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    progname String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " --version: " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String -> String
    rstrip String
    out) IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    forall a. IO a
    exitFailure
                Right HledgerBinaryInfo
    pathbin -> do
                  let pathversion :: String
    pathversion = HledgerBinaryInfo -> String
    hbinVersionOutput HledgerBinaryInfo
    pathbin
                  if String
    pathversion String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    prognameandversion
                  then YNU -> String -> IO ()
    p YNU
    N (String -> String
    chomp (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines [
                     String
    ""
                    ,String
    " A different hledger version was found in PATH: " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    pathversion
                    ,String
    " at: " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    exe
                    ,String
    failmsg
                    ]) IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    failaction
                  else YNU -> String -> IO ()
    p YNU
    Y String
    exe

      pdesc "has a system text encoding configured ?"
      let encoding = TextEncoding
    localeEncoding  -- the initial system encoding
      if map toLower (show encoding) == "ascii"
      then p N (show encoding <> ", please configure an encoding for non-ascii data")
      else p Y (show encoding <> ", data files must use this encoding")

      -- pdesc "can handle UTF-8 text ?"
      -- let
      --   eAcuteUtf8   = B.pack [0xC3, 0xA9]
      --   eAcuteLatin1 = B.pack [0xE9]
      -- case T.decodeUtf8' eAcuteUtf8 of
      --   Left _  -> p N "hledger's docs and examples use UTF-8"
      --   Right t -> p Y (T.unpack t)

      -- pdesc "can report text decoding failures ?"
      -- i U (T.unpack $ T.decodeUtf8 eAcuteLatin1)

      pdesc "has a user config file ?"
      muf <- activeUserConfFile
      mlf <- activeLocalConfFile
      let
        (ok, msg) = case muf of
          Just String
    f  -> (YNU
    Y, String
    f String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> if Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe String
    mlf then String
    " (overridden)" else String
    "")
          Maybe String
    Nothing -> (YNU
    N, String
    "")
      i ok msg

      pdesc "has a local config file ?"
      let
        (ok, msg) = case mlf of
          Just String
    f  -> (YNU
    Y, String
    f)
          Maybe String
    Nothing -> (YNU
    N, String
    "")
      i ok msg

      if (isJust muf || isJust mlf) then do
        pdesc "the config file is readable ?"
        econf <- getConf def
        case econf of
          Left String
    e -> YNU -> String -> IO ()
    p YNU
    N String
    e IO ()
    -> IO (Maybe (Either String Conf))
    -> IO (Maybe (Either String Conf))
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe (Either String Conf) -> IO (Maybe (Either String Conf))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String Conf -> Maybe (Either String Conf)
    forall a. a -> Maybe a
    Just (Either String Conf -> Maybe (Either String Conf))
    -> Either String Conf -> Maybe (Either String Conf)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String Conf
    forall a b. a -> Either a b
    Left String
    e)
          Right (Conf
    conf, Maybe String
    _) -> do
            YNU -> String -> IO ()
    p YNU
    Y String
    ""

            -- pdesc "common general options are configured ?"
            -- --infer-costs"
            -- print --explicit --infer-costs"

            Maybe (Either String Conf) -> IO (Maybe (Either String Conf))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Either String Conf) -> IO (Maybe (Either String Conf)))
    -> Maybe (Either String Conf) -> IO (Maybe (Either String Conf))
    forall a b. (a -> b) -> a -> b
    $ Either String Conf -> Maybe (Either String Conf)
    forall a. a -> Maybe a
    Just (Either String Conf -> Maybe (Either String Conf))
    -> Either String Conf -> Maybe (Either String Conf)
    forall a b. (a -> b) -> a -> b
    $ Conf -> Either String Conf
    forall a b. b -> Either a b
    Right Conf
    conf
      else
        return Nothing

    ------------------------------------------------------------------------------

    setupTerminal :: Maybe (Either a Conf) -> IO ()
    setupTerminal Maybe (Either a Conf)
    meconf = do
      String -> IO ()
    pgroup String
    "terminal"
      let
        -- Find the last opt/arg matched by a predicate in the general config, if there is one.
        conflookup :: (String -> Bool) -> Maybe String
    conflookup String -> Bool
    predicate = case Maybe (Either a Conf)
    meconf of
          Just (Right Conf
    conf) -> (String -> Bool) -> [String] -> Maybe String
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find String -> Bool
    predicate ([String] -> Maybe String) -> [String] -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String]
    forall a. [a] -> [a]
    reverse ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ String -> Conf -> [String]
    confLookup String
    "general" Conf
    conf
          Maybe (Either a Conf)
    _ -> Maybe String
    forall a. Maybe a
    Nothing

      String -> IO ()
    pdesc String
    "the NO_COLOR variable is defined ?"
      mnocolor <- String -> IO (Maybe String)
    lookupEnv String
    "NO_COLOR"
      case mnocolor of
        Maybe String
    Nothing -> YNU -> String -> IO ()
    i YNU
    N String
    ""
        Just String
    _  -> YNU -> String -> IO ()
    i YNU
    Y String
    ""

      meconfigcolor <- do
        pdesc "--color is configured by config file ?"
        let mcolorarg = (String -> Bool) -> Maybe String
    conflookup (\String
    a -> (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    a) [String
    "--color", String
    "--colour"])
        case mcolorarg of
          Maybe String
    Nothing -> YNU -> String -> IO ()
    i YNU
    N String
    "" IO ()
    -> IO (Maybe (Either String YNA)) -> IO (Maybe (Either String YNA))
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe (Either String YNA) -> IO (Maybe (Either String YNA))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Either String YNA)
    forall a. Maybe a
    Nothing
          Just String
    a  -> do
            YNU -> String -> IO ()
    i YNU
    Y String
    a
            let
              arg :: String
    arg = String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Char
    '=',Char
    ' ']) (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. [a] -> [a]
    reverse String
    a
            Maybe (Either String YNA) -> IO (Maybe (Either String YNA))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Either String YNA) -> IO (Maybe (Either String YNA)))
    -> Maybe (Either String YNA) -> IO (Maybe (Either String YNA))
    forall a b. (a -> b) -> a -> b
    $ Either String YNA -> Maybe (Either String YNA)
    forall a. a -> Maybe a
    Just (Either String YNA -> Maybe (Either String YNA))
    -> Either String YNA -> Maybe (Either String YNA)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String YNA
    parseYNA String
    arg

      pdesc "hledger will use color by default ?"
      case (meconfigcolor, isJust mnocolor) of
        (Just (Right YNA
    Yes), Bool
    _)     -> YNU -> String -> IO ()
    p YNU
    Y String
    ""
        (Just (Right YNA
    No),  Bool
    _)     -> YNU -> String -> IO ()
    i YNU
    N String
    ""
        (Maybe (Either String YNA)
    _,                Bool
    True)  -> YNU -> String -> IO ()
    i YNU
    N String
    ""
        (Maybe (Either String YNA)
    _,                Bool
    False) -> YNU -> String -> IO ()
    p YNU
    Y String
    ""

      pdesc "the PAGER variable is defined ?"
      mv <- lookupEnv "PAGER"
      case mv of
        Maybe String
    Nothing -> YNU -> String -> IO ()
    i YNU
    N String
    ""
        Just String
    v  -> YNU -> String -> IO ()
    i YNU
    Y String
    v

      pdesc "--pager is configured by config file ?"
      let mpagerarg = (String -> Bool) -> Maybe String
    conflookup (String
    "--pager" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`)
      meconfpager <- case mpagerarg of
        Maybe String
    Nothing -> YNU -> String -> IO ()
    i YNU
    N String
    "" IO ()
    -> IO (Maybe (Either String YNA)) -> IO (Maybe (Either String YNA))
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe (Either String YNA) -> IO (Maybe (Either String YNA))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Either String YNA)
    forall a. Maybe a
    Nothing
        Just String
    a  -> do
          YNU -> String -> IO ()
    i YNU
    Y String
    a
          let arg :: String
    arg = String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Char
    '=',Char
    ' ']) (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. [a] -> [a]
    reverse String
    a
          Maybe (Either String YNA) -> IO (Maybe (Either String YNA))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Either String YNA) -> IO (Maybe (Either String YNA)))
    -> Maybe (Either String YNA) -> IO (Maybe (Either String YNA))
    forall a b. (a -> b) -> a -> b
    $ Either String YNA -> Maybe (Either String YNA)
    forall a. a -> Maybe a
    Just (Either String YNA -> Maybe (Either String YNA))
    -> Either String YNA -> Maybe (Either String YNA)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String YNA
    parseYNA String
    arg

      pdesc "hledger will use a pager when needed ?"
      mpager <- findPager
      case mpager of
        Maybe String
    Nothing    -> YNU -> String -> IO ()
    i YNU
    N String
    "no pager was found"
        Just String
    pager ->
          case Maybe (Either String YNA)
    meconfpager of
            Just (Right YNA
    No) -> YNU -> String -> IO ()
    i YNU
    N String
    "disabled in config file"
            Maybe (Either String YNA)
    _ -> do
              YNU -> String -> IO ()
    p YNU
    Y String
    pager

              Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (String -> String
    takeBaseName String
    pager) String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "more") (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                String -> IO ()
    pdesc String
    "the MORE variable is defined ?"
                mv <- String -> IO (Maybe String)
    lookupEnv String
    "MORE"
                case mv of
                  Maybe String
    Nothing -> YNU -> String -> IO ()
    i YNU
    N String
    ""
                  Just String
    v  -> YNU -> String -> IO ()
    i YNU
    Y String
    v

              Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (String -> String
    takeBaseName String
    pager) String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "less") (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                mHLEDGER_LESS <- String -> IO (Maybe String)
    lookupEnv String
    "HLEDGER_LESS"
                mLESS <- lookupEnv "LESS"

                pdesc "the LESS variable is defined ?"
                case mLESS of
                  Maybe String
    Nothing -> YNU -> String -> IO ()
    i YNU
    N String
    ""
                  Just String
    v  -> YNU -> String -> IO ()
    i YNU
    Y (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    v String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> if Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe String
    mHLEDGER_LESS then String
    " (overridden)" else String
    ""

                pdesc "the HLEDGER_LESS variable is defined ?"
                case mHLEDGER_LESS of
                  Maybe String
    Nothing -> YNU -> String -> IO ()
    i YNU
    N String
    ""
                  Just String
    v  -> YNU -> String -> IO ()
    i YNU
    Y String
    v

                when (isNothing mHLEDGER_LESS) $ do
                  pdesc "adjusting LESS var for consistent UX ?"
                  usecolor <- useColorOnStdout
                  i Y $ lessVarValue mHLEDGER_LESS mLESS usecolor

                pdesc "less is working with these options ?"
                usecolor <- useColorOnStdout
                let newlessvar = Maybe String -> Maybe String -> Bool -> String
    lessVarValue Maybe String
    mHLEDGER_LESS Maybe String
    mLESS Bool
    usecolor
                env <- getEnvironment
                let customEnv = (String
    "LESS", String
    newlessvar) (String, String) -> [(String, String)] -> [(String, String)]
    forall a. a -> [a] -> [a]
    : ((String, String) -> Bool)
    -> [(String, String)] -> [(String, String)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    "LESS") (String -> Bool)
    -> ((String, String) -> String) -> (String, String) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, String) -> String
    forall a b. (a, b) -> a
    fst) [(String, String)]
    env
                lessHasError <- lessIsWorking (Just customEnv)
                if lessHasError
                  then p N "less --version shows a problem, check LESS/HLEDGER_LESS settings"
                  else p Y ""

      pdesc "box-drawing chars are used by default ?"
      if isJust $ conflookup ("--pretty"==)
      then p Y ""
      else i N "you can use --pretty to enable them"

      -- pdesc "bash shell completions are installed ?" >> p U ""
      -- pdesc "zsh shell completions are installed ?" >> p U ""

    ------------------------------------------------------------------------------

    setupJournal :: Maybe (Either a Conf) -> IO ()
    setupJournal Maybe (Either a Conf)
    meconf = do
      String -> IO ()
    pgroup String
    "journal"
      let
        -- Find the last opt/arg matched by a predicate in the general config, if there is one.
        conflookup :: (String -> Bool) -> Maybe String
    conflookup String -> Bool
    predicate = case Maybe (Either a Conf)
    meconf of
          Just (Right Conf
    conf) -> (String -> Bool) -> [String] -> Maybe String
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find String -> Bool
    predicate ([String] -> Maybe String) -> [String] -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String]
    forall a. [a] -> [a]
    reverse ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ String -> Conf -> [String]
    confLookup String
    "general" Conf
    conf
          Maybe (Either a Conf)
    _ -> Maybe String
    forall a. Maybe a
    Nothing

      -- pdesc "a home directory journal file exists ?"
      -- mh <- getHomeSafe
      -- (ok,msg) <- case mh of
      --   Just h -> do
      --     let f = h </> journalDefaultFilename
      --     e <- doesFileExist f
      --     return (if e then Y else N, if e then f else "")
      --   Nothing -> return (N, "")
      -- i ok msg

      String -> IO ()
    pdesc String
    "the LEDGER_FILE variable is defined ?"
      mf <- String -> IO (Maybe String)
    lookupEnv String
    journalEnvVar
      let
        (ok, msg) = case mf of
          Just String
    f  -> (YNU
    Y, String
    f)
          Maybe String
    Nothing -> (YNU
    N, String
    "")
      i ok msg

      -- case mf of
      --   Nothing -> return ()
      --   Just f -> do
      --     pdesc "$LEDGER_FILE journal exists ?"
      --     e <- doesFileExist f
      --     i e "" ""

      -- when (isJust mh && isJust mf) $ do
      --   pdesc "$LEDGER_FILE is masking home journal ?"
      --   i Y ""

      pdesc "a default journal file is readable ?"
      ef <- defaultJournalPathSafely
      -- let
      --   args = concat [
      --     ["print"],
      --     ["--ignore-assertions" | supportsIgnoreAssertions version],
      --     ["--no-conf" | supportsConfigFiles version]
      --     ]
      -- (exit, _, err) <- readProcessWithExitCode progname args ""
      -- XXX can this ignore assertions and config files, like the above ?
      ej <- defaultJournalSafely
      let trim String
    s = (String -> String)
    -> (String -> String) -> Either String String -> String
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (String -> String -> String
    forall a b. a -> b -> a
    const String
    s) String -> String
    forall a. a -> a
    id (Either String String -> String) -> Either String String -> String
    forall a b. (a -> b) -> a -> b
    $ Regexp -> String -> String -> Either String String
    regexReplace (Text -> Regexp
    toRegex' Text
    "^Error: ") String
    "" String
    s
      case (ef, ej) of
        (Left String
    err, Either String Journal
    _) -> YNU -> String -> IO ()
    p YNU
    N (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> String
    trim String
    err
        (Right String
    f, Left String
    err) -> YNU -> String -> IO ()
    p YNU
    N (String
    f String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ":\n" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String -> String
    trim String
    err)
        (Right String
    f, Right j :: Journal
    j@Journal{[(String, String)]
    [(String, Text)]
    [(Text, AccountDeclarationInfo)]
    [(Text, TagDeclarationInfo)]
    [(Text, PayeeDeclarationInfo)]
    [Text]
    [MarketPrice]
    [PriceDirective]
    [TimeclockEntry]
    [PeriodicTransaction]
    [TransactionModifier]
    [Transaction]
    [AccountAlias]
    Maybe Char
    Maybe Year
    Maybe (Text, AmountStyle)
    Text
    Map Text [Tag]
    Map Text Commodity
    Map Text AmountStyle
    Map Text AccountType
    Map AccountType [Text]
    POSIXTime
    jparsedefaultyear :: Maybe Year
    jparsedefaultcommodity :: Maybe (Text, AmountStyle)
    jparsedecimalmark :: Maybe Char
    jparseparentaccounts :: [Text]
    jparsealiases :: [AccountAlias]
    jparsetimeclockentries :: [TimeclockEntry]
    jincludefilestack :: [(String, String)]
    jdeclaredpayees :: [(Text, PayeeDeclarationInfo)]
    jdeclaredtags :: [(Text, TagDeclarationInfo)]
    jdeclaredaccounts :: [(Text, AccountDeclarationInfo)]
    jdeclaredaccounttags :: Map Text [Tag]
    jdeclaredaccounttypes :: Map AccountType [Text]
    jaccounttypes :: Map Text AccountType
    jdeclaredcommodities :: Map Text Commodity
    jdeclaredcommoditytags :: Map Text [Tag]
    jinferredcommoditystyles :: Map Text AmountStyle
    jglobalcommoditystyles :: Map Text AmountStyle
    jpricedirectives :: [PriceDirective]
    jinferredmarketprices :: [MarketPrice]
    jtxnmodifiers :: [TransactionModifier]
    jperiodictxns :: [PeriodicTransaction]
    jtxns :: [Transaction]
    jfinalcommentlines :: Text
    jfiles :: [(String, Text)]
    jlastreadtime :: POSIXTime
    jlastreadtime :: Journal -> POSIXTime
    jfiles :: Journal -> [(String, Text)]
    jfinalcommentlines :: Journal -> Text
    jtxns :: Journal -> [Transaction]
    jperiodictxns :: Journal -> [PeriodicTransaction]
    jtxnmodifiers :: Journal -> [TransactionModifier]
    jinferredmarketprices :: Journal -> [MarketPrice]
    jpricedirectives :: Journal -> [PriceDirective]
    jglobalcommoditystyles :: Journal -> Map Text AmountStyle
    jinferredcommoditystyles :: Journal -> Map Text AmountStyle
    jdeclaredcommoditytags :: Journal -> Map Text [Tag]
    jdeclaredcommodities :: Journal -> Map Text Commodity
    jaccounttypes :: Journal -> Map Text AccountType
    jdeclaredaccounttypes :: Journal -> Map AccountType [Text]
    jdeclaredaccounttags :: Journal -> Map Text [Tag]
    jdeclaredaccounts :: Journal -> [(Text, AccountDeclarationInfo)]
    jdeclaredtags :: Journal -> [(Text, TagDeclarationInfo)]
    jdeclaredpayees :: Journal -> [(Text, PayeeDeclarationInfo)]
    jincludefilestack :: Journal -> [(String, String)]
    jparsetimeclockentries :: Journal -> [TimeclockEntry]
    jparsealiases :: Journal -> [AccountAlias]
    jparseparentaccounts :: Journal -> [Text]
    jparsedecimalmark :: Journal -> Maybe Char
    jparsedefaultcommodity :: Journal -> Maybe (Text, AmountStyle)
    jparsedefaultyear :: Journal -> Maybe Year
    ..}) -> do
          YNU -> String -> IO ()
    p YNU
    Y String
    f

          String -> IO ()
    pdesc String
    "it includes additional files ?"
          let numfiles :: Int
    numfiles = [(String, Text)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(String, Text)]
    jfiles
          if Int
    numfiles Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1
          then YNU -> String -> IO ()
    i YNU
    Y (Int -> String
    forall a. Show a => a -> String
    show (Int
    numfiles Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " files")
          else YNU -> String -> IO ()
    i YNU
    N String
    ""

          String -> IO ()
    pdesc String
    "all commodities are declared ?"
          let
            numcommodities :: Int
    numcommodities = Set Text -> Int
    forall a. Set a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Set Text -> Int) -> Set Text -> Int
    forall a b. (a -> b) -> a -> b
    $ Journal -> Set Text
    journalCommodities Journal
    j
            undeclaredcommodities :: [Text]
    undeclaredcommodities = Journal -> [Text]
    journalCommoditiesUsed Journal
    j [Text] -> [Text] -> [Text]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ Journal -> [Text]
    journalCommoditiesDeclared Journal
    j
          if [Text] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Text]
    undeclaredcommodities
          then YNU -> String -> IO ()
    p YNU
    Y (Int -> String
    forall a. Show a => a -> String
    show Int
    numcommodities String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " commodities")
          else YNU -> String -> IO ()
    p YNU
    N (Int -> String
    forall a. Show a => a -> String
    show ([Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    undeclaredcommodities) String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " undeclared commodities")

          let
            accttypes :: [AccountType]
    accttypes = [AccountType
    Asset, AccountType
    Liability, AccountType
    Equity, AccountType
    Revenue, AccountType
    Expense, AccountType
    Cash, AccountType
    Conversion]
            typesdeclaredorinferred :: [AccountType]
    typesdeclaredorinferred = [AccountType] -> [AccountType]
    forall a. Eq a => [a] -> [a]
    nub ([AccountType] -> [AccountType]) -> [AccountType] -> [AccountType]
    forall a b. (a -> b) -> a -> b
    $ Map Text AccountType -> [AccountType]
    forall k a. Map k a -> [a]
    M.elems Map Text AccountType
    jaccounttypes
            typesnotfound :: [AccountType]
    typesnotfound = (AccountType -> Bool) -> [AccountType] -> [AccountType]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not(Bool -> Bool) -> (AccountType -> Bool) -> AccountType -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(AccountType -> [AccountType] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [AccountType]
    typesdeclaredorinferred)) [AccountType]
    accttypes
            acctswithdeclaredorinferredtype :: [Text]
    acctswithdeclaredorinferredtype = [Text] -> [Text]
    forall a. Eq a => [a] -> [a]
    nub (Map Text AccountType -> [Text]
    forall k a. Map k a -> [k]
    M.keys Map Text AccountType
    jaccounttypes)
            numaccts :: Int
    numaccts = [Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Text] -> Int) -> [Text] -> Int
    forall a b. (a -> b) -> a -> b
    $ Journal -> [Text]
    journalAccountNames Journal
    j
            untypedaccts :: [Text]
    untypedaccts = Journal -> [Text]
    journalAccountNames Journal
    j [Text] -> [Text] -> [Text]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ [Text]
    acctswithdeclaredorinferredtype
            undeclaredaccts :: [Text]
    undeclaredaccts = Journal -> [Text]
    journalAccountNamesUsed Journal
    j [Text] -> [Text] -> [Text]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ Journal -> [Text]
    journalAccountNamesDeclared Journal
    j
            -- hasdeclaredaccts t = case M.lookup t jdeclaredaccounttypes of
            --   Just (_ : _) -> True
            --   _ -> False

          -- pdesc "Asset accounts declared ?"
          -- if hasdeclaredaccts Asset then i Y "" else i N ""

          -- pdesc "Liability accounts declared ?"
          -- if hasdeclaredaccts Liability then i Y "" else i N ""

          -- pdesc "Equity accounts declared ?"
          -- if hasdeclaredaccts Equity then i Y "" else i N ""

          -- pdesc "Revenue accounts declared ?"
          -- if hasdeclaredaccts Revenue then i Y "" else i N ""

          -- pdesc "Expense accounts declared ?"
          -- if hasdeclaredaccts Expense then i Y "" else i N ""

          -- pdesc "Cash accounts declared ?"
          -- if hasdeclaredaccts Cash then i Y "" else i N ""

          -- pdesc "Conversion accounts declared ?"
          -- if hasdeclaredaccts Conversion then i Y "" else i N ""  -- ("--infer-equity will use a default conversion account name")

          -- XXX hard to detect accounts where type was inferred from name
          -- unless arealltypesdeclared $ do
          -- let
          --   acctswithdeclaredtype           = concat (M.elems jdeclaredaccounttypes)
          --   acctswithinferredtype           = acctswithdeclaredorinferredtype \\ acctswithdeclaredtype
          --   arealltypesdeclared = all hasdeclaredaccts accttypes
          --   typesinferredfromnames =
          --     if arealltypesdeclared then []
          --     else sort $ nub $ catMaybes $ map (flip M.lookup jaccounttypes) acctswithinferredtype
          -- pdesc "types detected from account names ?"
          -- if null typesinferredfromnames then i N "" else i Y (concatMap show typesinferredfromnames)

          String -> IO ()
    pdesc String
    "all accounts are declared ?"
          if [Text] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Text]
    undeclaredaccts then YNU -> String -> IO ()
    p YNU
    Y (Int -> String
    forall a. Show a => a -> String
    show Int
    numaccts String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " accounts") else YNU -> String -> IO ()
    i YNU
    N (Int -> String
    forall a. Show a => a -> String
    show ([Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    undeclaredaccts) String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " undeclared accounts")

          String -> IO ()
    pdesc String
    "all accounts have types ?"
          if [Text] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Text]
    untypedaccts then YNU -> String -> IO ()
    p YNU
    Y String
    "" else YNU -> String -> IO ()
    i YNU
    N (Int -> String
    forall a. Show a => a -> String
    show ([Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    untypedaccts) String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " accounts without types")

          String -> IO ()
    pdesc String
    "accounts of all types exist ?"
          if [AccountType] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [AccountType]
    typesnotfound
          then YNU -> String -> IO ()
    p YNU
    Y ((AccountType -> String) -> [AccountType] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap AccountType -> String
    forall a. Show a => a -> String
    show [AccountType]
    accttypes String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " accounts detected")
          else YNU -> String -> IO ()
    p YNU
    N ((AccountType -> String) -> [AccountType] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap AccountType -> String
    forall a. Show a => a -> String
    show [AccountType]
    typesnotfound String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " accounts not found; some reports may not work")

          String -> IO ()
    pdesc String
    "commodities/accounts are being checked ?"
          let strict :: Bool
    strict = Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe String -> Bool) -> Maybe String -> Bool
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> Maybe String
    conflookup (\String
    a -> (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    ==String
    a) [String
    "-s", String
    "--strict"])
          if Bool
    strict
          then YNU -> String -> IO ()
    i YNU
    Y String
    "commodities and accounts must be declared"
          else YNU -> String -> IO ()
    i YNU
    N String
    "you can use -s to check them"

          String -> IO ()
    pdesc String
    "balance assertions are being checked ?"
          let ignoreassertions :: Bool
    ignoreassertions = Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe String -> Bool) -> Maybe String -> Bool
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> Maybe String
    conflookup (\String
    a -> (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    ==String
    a) [String
    "-I", String
    "--ignore-assertions"])
          if
            | Bool
    ignoreassertions Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    strict -> YNU -> String -> IO ()
    i YNU
    N String
    "you can use -s to check them"
            | Bool -> Bool
    not Bool
    strict -> YNU -> String -> IO ()
    i YNU
    Y String
    "you can use -I to ignore them"
            | Bool
    otherwise -> YNU -> String -> IO ()
    i YNU
    Y String
    "can't ignore assertions (-s in config file)"

    ------------------------------------------------------------------------------

    -- Test a hledger version for support of various features.
    Version
    ver >=! :: Version -> String -> Bool
    >=! String
    str = Version
    ver Version -> Version -> Bool
    forall a. Ord a => a -> a -> Bool
    >= (Maybe Version -> Version
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe Version -> Version) -> Maybe Version -> Version
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe Version
    toVersion String
    str)
    supportsIgnoreAssertions :: Version -> Bool
    supportsIgnoreAssertions = (Version -> String -> Bool
    >=! String
    "0.24") -- --ignore-assertions (2014)
    supportsCommodityDirective :: Version -> Bool
    supportsCommodityDirective = (Version -> String -> Bool
    >=! String
    "1.0") -- commodity directive (2016)
    supportsPretty :: Version -> Bool
    supportsPretty = (Version -> String -> Bool
    >=! String
    "1.2") -- --pretty, to use box-drawing characters (2017)
    supportsAccountDirective :: Version -> Bool
    supportsAccountDirective = (Version -> String -> Bool
    >=! String
    "1.9") -- account directive (2018)
    supportsAccountTypes :: Version -> Bool
    supportsAccountTypes = (Version -> String -> Bool
    >=! String
    "1.13") -- ALERX account types, type: tag (2019)
    supportsCashAccountType :: Version -> Bool
    supportsCashAccountType = (Version -> String -> Bool
    >=! String
    "1.19") -- C/Cash account type (2020)
    supportsBasicColor :: Version -> Bool
    supportsBasicColor = (Version -> String -> Bool
    >=! String
    "1.19") -- basic color detection/control (2020)
    supportsConversionAccountType :: Version -> Bool
    supportsConversionAccountType = (Version -> String -> Bool
    >=! String
    "1.25") -- V/Conversion account type, accounts --types (2022)
    supportsConfigFiles :: Version -> Bool
    supportsConfigFiles = (Version -> String -> Bool
    >=! String
    "1.40") -- config files (2024)
    supportsColor :: Version -> Bool
    supportsColor = (Version -> String -> Bool
    >=! String
    "1.41") -- robust color detection/control (2024)
    supportsPager :: Version -> Bool
    supportsPager = (Version -> String -> Bool
    >=! String
    "1.41") -- use a pager for all output (2024)
    supportsBashCompletions :: Version -> Bool
    supportsBashCompletions = (Version -> String -> Bool
    >=! String
    "1.41") -- up to date bash shell completions (2024)

    -- yes, no, unknown
    data YNU = Y | N | U deriving (YNU -> YNU -> Bool
    (YNU -> YNU -> Bool) -> (YNU -> YNU -> Bool) -> Eq YNU
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: YNU -> YNU -> Bool
    == :: YNU -> YNU -> Bool
    $c/= :: YNU -> YNU -> Bool
    /= :: YNU -> YNU -> Bool
    Eq)

    -- ANSI styles
    good :: String -> String
    good    = String -> String
    bold' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    brightGreen'
    neutral :: String -> String
    neutral = String -> String
    bold' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    brightBlue'
    warning :: String -> String
    warning = String -> String
    bold' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    brightYellow'
    bad :: String -> String
    bad     = String -> String
    bold' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    brightRed'

    -- Show status, in red/green/yellow if supported.
    instance Show YNU where
      show :: YNU -> String
    show YNU
    Y = String -> String
    good    String
    "yes"    -- ✅ apple emojis - won't work everywhere
      show YNU
    N = String -> String
    bad     String
    " no"    -- ❌
      show YNU
    U = String -> String
    warning String
    "  ?"

    -- Show status, in blue/yellow if supported.
    showInfo :: YNU -> String
    showInfo YNU
    Y = String -> String
    neutral String
    "yes"  -- ℹ️
    showInfo YNU
    N = String -> String
    neutral String
    " no"  -- ℹ️
    showInfo YNU
    U = String -> String
    warning String
    "  ?"

    -- | Print a test's pass or fail status, as "yes" or "no" or "",
    -- in green/red if supported, and the (possibly empty) provided message.
    p :: YNU -> String -> IO ()
    p :: YNU -> String -> IO ()
    p YNU
    ok String
    msg = String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unwords [String
    "", YNU -> String
    forall a. Show a => a -> String
    show YNU
    ok, String
    "", String
    msg]

    -- | Like p, but display the status as info, in neutral blue.
    i :: YNU -> String -> IO ()
    i :: YNU -> String -> IO ()
    i YNU
    ok String
    msg = String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unwords [String
    "", YNU -> String
    showInfo YNU
    ok, String
    "", String
    msg]

    -- | Print a setup test groups heading.
    pgroup :: String -> IO ()
    pgroup :: String -> IO ()
    pgroup String
    s = String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "\n" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String -> String
    bold' String
    s

    -- | Print a setup test's description, formatting and padding it to a fixed width.
    pdesc :: String -> IO ()
    pdesc :: String -> IO ()
    pdesc String
    s = String -> String -> IO ()
    forall r. PrintfType r => String -> r
    printf String
    "* %-40s" String
    s

    (IO (Either String String)
    getLatestHledgerVersion, String
    latestHledgerVersionUrlStr) =
      -- (getLatestHledgerVersionFromHackage, "https://hackage.haskell.org/package/hledger/docs")
      (IO (Either String String)
    getLatestHledgerVersionFromHledgerOrg, String
    "https://hledger.org/install.html")

    httptimeout :: Int
    httptimeout = Int
    10000000  -- 10s

    -- | Get the current hledger release version from the internet.
    -- Currently requests the latest doc page from Hackage and inspects the redirect path.
    -- Should catch all normal errors, and time out after 10 seconds.
    getLatestHledgerVersionFromHackage :: IO (Either String String)
    getLatestHledgerVersionFromHackage :: IO (Either String String)
    getLatestHledgerVersionFromHackage = do
      let url :: Url 'Https
    url = Text -> Url 'Https
    https Text
    "hackage.haskell.org" Url 'Https -> Text -> Url 'Https
    forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
    /: Text
    "package" Url 'Https -> Text -> Url 'Https
    forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
    /: Text
    "hledger" Url 'Https -> Text -> Url 'Https
    forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
    /: Text
    "docs" Url 'Https -> Text -> Url 'Https
    forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
    /: Text
    ""
      result <- IO BsResponse -> IO (Either HttpException BsResponse)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO BsResponse -> IO (Either HttpException BsResponse))
    -> IO BsResponse -> IO (Either HttpException BsResponse)
    forall a b. (a -> b) -> a -> b
    $ HttpConfig -> Req BsResponse -> IO BsResponse
    forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
    runReq HttpConfig
    defaultHttpConfig{httpConfigRedirectCount=0} (Req BsResponse -> IO BsResponse)
    -> Req BsResponse -> IO BsResponse
    forall a b. (a -> b) -> a -> b
    $
        HEAD
    -> Url 'Https
    -> NoReqBody
    -> Proxy BsResponse
    -> Option 'Https
    -> Req BsResponse
    forall (m :: * -> *) method body response (scheme :: Scheme).
    (MonadHttp m, HttpMethod method, HttpBody body,
     HttpResponse response,
     HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
    method
    -> Url scheme
    -> body
    -> Proxy response
    -> Option scheme
    -> m response
    req HEAD
    HEAD Url 'Https
    url NoReqBody
    NoReqBody Proxy BsResponse
    bsResponse (Int -> Option 'Https
    forall (scheme :: Scheme). Int -> Option scheme
    R.responseTimeout Int
    httptimeout)
      case result of
        Right BsResponse
    _ -> Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String String -> IO (Either String String))
    -> Either String String -> IO (Either String String)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String String
    forall a b. a -> Either a b
    Left String
    "expected a redirect"
        Left (VanillaHttpException (HttpExceptionRequest Request
    _ (StatusCodeException Response ()
    rsp ByteString
    _))) -> do
          let status :: Int
    status = Status -> Int
    statusCode (Status -> Int) -> Status -> Int
    forall a b. (a -> b) -> a -> b
    $ Response () -> Status
    forall body. Response body -> Status
    responseStatus Response ()
    rsp
          if Int
    status Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    300 Bool -> Bool -> Bool
    && Int
    status Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    400
            then do
              let locationHeader :: Maybe ByteString
    locationHeader = HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    hLocation (Response () -> [(HeaderName, ByteString)]
    forall body. Response body -> [(HeaderName, ByteString)]
    responseHeaders Response ()
    rsp)
              case (ByteString -> Text) -> Maybe ByteString -> Maybe Text
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ByteString -> Text
    T.decodeUtf8 Maybe ByteString
    locationHeader of
                Maybe Text
    Nothing       -> Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String String -> IO (Either String String))
    -> Either String String -> IO (Either String String)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String String
    forall a b. a -> Either a b
    Left String
    "no Location header"
                Just Text
    location -> do
                  let packagename :: [Text]
    packagename = Int -> [Text] -> [Text]
    forall a. Int -> [a] -> [a]
    take Int
    1 ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Text] -> [Text]
    forall a. Int -> [a] -> [a]
    drop Int
    1 ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ [Text] -> [Text]
    forall a. [a] -> [a]
    reverse ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    T.splitOn Text
    "/" Text
    location
                  case [Text]
    packagename of
                    [Text
    n] -> Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String String -> IO (Either String String))
    -> Either String String -> IO (Either String String)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String String
    forall a b. b -> Either a b
    Right (String -> Either String String) -> String -> Either String String
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Char
    '0'..Char
    '9']) (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack Text
    n
                    [Text]
    _   -> Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String String -> IO (Either String String))
    -> Either String String -> IO (Either String String)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String String
    forall a b. a -> Either a b
    Left String
    "couldn't parse Location"
            else Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String String -> IO (Either String String))
    -> Either String String -> IO (Either String String)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String String
    forall a b. a -> Either a b
    Left (String -> Either String String) -> String -> Either String String
    forall a b. (a -> b) -> a -> b
    $ String
    "HTTP status " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    status
        Left HttpException
    err -> Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String String -> IO (Either String String))
    -> Either String String -> IO (Either String String)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String String
    forall a b. a -> Either a b
    Left (String -> Either String String) -> String -> Either String String
    forall a b. (a -> b) -> a -> b
    $ String
    "other exception: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ HttpException -> String
    forall a. Show a => a -> String
    show HttpException
    err

    -- | Like the above, but get the version from the first number on the hledger.org Install page.
    getLatestHledgerVersionFromHledgerOrg :: IO (Either String String)
    getLatestHledgerVersionFromHledgerOrg :: IO (Either String String)
    getLatestHledgerVersionFromHledgerOrg = do
      let url :: Url 'Https
    url = Text -> Url 'Https
    https Text
    "hledger.org" Url 'Https -> Text -> Url 'Https
    forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
    /: Text
    "install.html"
      do
        result <- IO BsResponse -> IO (Either HttpException BsResponse)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO BsResponse -> IO (Either HttpException BsResponse))
    -> IO BsResponse -> IO (Either HttpException BsResponse)
    forall a b. (a -> b) -> a -> b
    $ HttpConfig -> Req BsResponse -> IO BsResponse
    forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
    runReq HttpConfig
    defaultHttpConfig (Req BsResponse -> IO BsResponse)
    -> Req BsResponse -> IO BsResponse
    forall a b. (a -> b) -> a -> b
    $ GET
    -> Url 'Https
    -> NoReqBody
    -> Proxy BsResponse
    -> Option 'Https
    -> Req BsResponse
    forall (m :: * -> *) method body response (scheme :: Scheme).
    (MonadHttp m, HttpMethod method, HttpBody body,
     HttpResponse response,
     HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
    method
    -> Url scheme
    -> body
    -> Proxy response
    -> Option scheme
    -> m response
    req GET
    GET Url 'Https
    url NoReqBody
    NoReqBody Proxy BsResponse
    bsResponse (Int -> Option 'Https
    forall (scheme :: Scheme). Int -> Option scheme
    R.responseTimeout Int
    httptimeout)
        case result of
          Left (HttpException
    _ :: R.HttpException) -> Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String String -> IO (Either String String))
    -> Either String String -> IO (Either String String)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String String
    forall a b. a -> Either a b
    Left String
    "(HTTP failure)"
          Right BsResponse
    rsp -> case ByteString -> Either UnicodeException Text
    T.decodeUtf8' (ByteString -> Either UnicodeException Text)
    -> ByteString -> Either UnicodeException Text
    forall a b. (a -> b) -> a -> b
    $ BsResponse -> HttpResponseBody BsResponse
    forall response.
    HttpResponse response =>
    response -> HttpResponseBody response
    R.responseBody BsResponse
    rsp of
            Left UnicodeException
    e  -> Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String String -> IO (Either String String))
    -> Either String String -> IO (Either String String)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String String
    forall a b. a -> Either a b
    Left (String -> Either String String) -> String -> Either String String
    forall a b. (a -> b) -> a -> b
    $ UnicodeException -> String
    forall a. Show a => a -> String
    show UnicodeException
    e
            Right Text
    t -> Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String String -> IO (Either String String))
    -> Either String String -> IO (Either String String)
    forall a b. (a -> b) -> a -> b
    $
              if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    version then String -> Either String String
    forall a b. a -> Either a b
    Left String
    "couldn't parse version" else String -> Either String String
    forall a b. b -> Either a b
    Right String
    version
              where
                -- keep synced
                versionline :: [String]
    versionline = Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    take Int
    1 ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    "current hledger release" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf`)) ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    lines (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack Text
    t
                version :: String
    version = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (String
    "0123456789."::[Char])) (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isDigit) (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> String
    forall a. a -> [a] -> a
    headDef String
    "" ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [String]
    versionline
      -- work around potential failure on mac (& possible security issue, reported upstream)
      IO (Either String String)
    -> (IOError -> IO (Either String String))
    -> IO (Either String String)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` (\(IOError
    _ :: IOError) -> Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String String -> IO (Either String String))
    -> Either String String -> IO (Either String String)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String String
    forall a b. a -> Either a b
    Left (String -> Either String String) -> String -> Either String String
    forall a b. (a -> b) -> a -> b
    $ String
    "(IO error" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> if String
    osString -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    ==String
    "darwin" then String
    " - mac PATH issue ?)" else String
    ")")

    -- | Try to run the hledger in PATH with one or more sets of command line arguments.
    -- Returns the output from the first set of arguments that runs successfully,
    -- or the error output from the last set.
    tryHledgerArgs :: [[String]] -> IO (Either String String)
    tryHledgerArgs :: [[String]] -> IO (Either String String)
    tryHledgerArgs [] = Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either String String -> IO (Either String String))
    -> Either String String -> IO (Either String String)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String String
    forall a b. a -> Either a b
    Left String
    "tryHledgerArgs: no arguments provided"
    tryHledgerArgs ([String]
    args:[[String]]
    rest) = do
      eresult <- [String] -> IO (Either String String)
    runHledger [String]
    args
      case eresult of
        Right String
    out -> Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either String String -> IO (Either String String))
    -> Either String String -> IO (Either String String)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String String
    forall a b. b -> Either a b
    Right String
    out
        Left String
    err -> if [[String]] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[String]]
    rest then Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either String String -> IO (Either String String))
    -> Either String String -> IO (Either String String)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String String
    forall a b. a -> Either a b
    Left String
    err else [[String]] -> IO (Either String String)
    tryHledgerArgs [[String]]
    rest

    -- | Run the hledger in PATH with the given command line arguments,
    -- returning the output on success or the error output on failure.
    runHledger :: [String] -> IO (Either String String)
    runHledger :: [String] -> IO (Either String String)
    runHledger [String]
    args = do
      (exit, out, err) <- String -> [String] -> String -> IO (ExitCode, String, String)
    readProcessWithExitCode String
    "hledger" [String]
    args String
    ""
      pure $ case exit of
        ExitCode
    ExitSuccess -> String -> Either String String
    forall a b. b -> Either a b
    Right String
    out
        ExitFailure Int
    _ -> String -> Either String String
    forall a b. a -> Either a b
    Left String
    err

    -- | Get the operating system version string, if possible.
    -- Uses platform-specific commands to detect the OS version.
    getOSVersion :: IO (Maybe String)
    getOSVersion :: IO (Maybe String)
    getOSVersion = case String
    os of
      String
    "darwin"  -> String -> [String] -> IO (Maybe String)
    tryCommand String
    "sw_vers" [String
    "-productVersion"]
      String
    "mingw32" -> String -> [String] -> IO (Maybe String)
    tryCommand String
    "cmd" [String
    "/c", String
    "ver"]
      String
    "linux"   -> String -> [String] -> IO (Maybe String)
    tryCommand String
    "uname" [String
    "-r"]
      String
    _         -> Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe String
    forall a. Maybe a
    Nothing
      where
        tryCommand :: String -> [String] -> IO (Maybe String)
    tryCommand String
    cmd [String]
    args =
          (String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String)
    -> (String -> String) -> String -> Maybe String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    strip (String -> Maybe String) -> IO String -> IO (Maybe String)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> [String] -> String -> IO String
    readProcess String
    cmd [String]
    args String
    "")
          IO (Maybe String)
    -> (SomeException -> IO (Maybe String)) -> IO (Maybe String)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` (\(SomeException
    _ :: SomeException) -> Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe String
    forall a. Maybe a
    Nothing)