imp: setup v2, simpler implementation and shorter output
This one tests only with the currently running hledger, and requires being installed in PATH to show full info.
This commit is contained in:
Simon Michael
parent
78baaee6c5
commit
4a5b0d46b5
@ -23,11 +23,11 @@ module Hledger.Cli.Commands.Setup (
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Control.Exception
|
||||
import Control.Monad
|
||||
import qualified Data.ByteString as B
|
||||
-- import qualified Data.ByteString as B
|
||||
import Data.Char
|
||||
import Data.Default (def)
|
||||
import Data.List
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
@ -49,7 +49,7 @@ import Hledger hiding (setupPager)
|
||||
import Hledger.Cli.CliOptions
|
||||
import Hledger.Cli.Conf
|
||||
import Hledger.Cli.Version
|
||||
import Data.Default (def)
|
||||
import System.IO (localeEncoding)
|
||||
|
||||
|
||||
setupmode = hledgerCommandMode
|
||||
@ -69,27 +69,16 @@ without premature termination or misformatting.
|
||||
The tests are grouped into setup* routines, so named because they might do more
|
||||
than just test in future.
|
||||
|
||||
The first group of tests checks the hledger executable found in PATH.
|
||||
Note, later tests which require running hledger should use this executable,
|
||||
rather than the API of the hledger currently running (in case they're different).
|
||||
|
||||
This hledger executable could be old; we can't assume it has modern flags/commands.
|
||||
Eg its --version output may be less than usual, or it may not have the check command.
|
||||
|
||||
Or it may not accept -n/--no-conf, which we may need to avoid disruption from config files.
|
||||
Eg there's an inconvenient bug in hledger 1.40-1.42ish: without -n, a bad config file
|
||||
breaks pretty much everything, including --version, --help, and test.
|
||||
|
||||
So we first try hledger --version -n; if this fails, we try hledger --version.
|
||||
(For absolute precision we should perhaps check the failure output for "Unknown flag: -n"..)
|
||||
If we are able to detect the version, we use that to decide how and whether to run
|
||||
later tests. Eg, for hledger <1.40, we won't run config tests, and won't use -n.
|
||||
|
||||
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 _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.
|
||||
-- instead read it ourselves when we are ready.
|
||||
putStrLn "Checking your hledger setup.."
|
||||
color <- useColorOnStdout
|
||||
when color $
|
||||
@ -99,100 +88,27 @@ setup _opts@CliOpts{rawopts_=_rawopts, reportspec_=_rspec} _ignoredj = do
|
||||
,warning "unknown"
|
||||
,bad "warning"
|
||||
]
|
||||
mversion <- setupHledger
|
||||
case mversion of
|
||||
Nothing -> return ()
|
||||
Just HledgerBinaryVersion{hbinPackageVersion=version} -> do
|
||||
setupLocale
|
||||
conf <- fromMaybe nullconf <$> setupConfig version
|
||||
setupColor version conf
|
||||
setupPager version conf
|
||||
setupPretty version conf
|
||||
setupCompletions version
|
||||
ej <- setupJournal version
|
||||
let mj = either (const Nothing) Just ej
|
||||
setupAccounts version mj
|
||||
setupCommodities version mj
|
||||
return ()
|
||||
conf <- fromMaybe nullconf <$> setupHledger
|
||||
setupTerminal conf
|
||||
setupJournal
|
||||
-- setupStrictness conf
|
||||
putStr "\n"
|
||||
|
||||
-- Test a hledger version for support of various features.
|
||||
ver >=! str = ver >= (fromJust $ toVersion str)
|
||||
supportsIgnoreAssertions = (>=! "0.24") -- --ignore-assertions (2014)
|
||||
supportsCommodityDirective = (>=! "1.0") -- commodity directive (2016)
|
||||
supportsPretty = (>=! "1.2") -- --pretty, to use box-drawing characters (2017)
|
||||
supportsAccountDirective = (>=! "1.9") -- account directive (2018)
|
||||
supportsAccountTypes = (>=! "1.13") -- ALERX account types, type: tag (2019)
|
||||
supportsCashAccountType = (>=! "1.19") -- C/Cash account type (2020)
|
||||
supportsBasicColor = (>=! "1.19") -- basic color detection/control (2020)
|
||||
supportsConversionAccountType = (>=! "1.25") -- V/Conversion account type, accounts --types (2022)
|
||||
supportsConfigFiles = (>=! "1.40") -- config files (2024)
|
||||
supportsColor = (>=! "1.41") -- robust color detection/control (2024)
|
||||
supportsPager = (>=! "1.41") -- use a pager for all output (2024)
|
||||
supportsBashCompletions = (>=! "1.41") -- up to date bash shell completions (2024)
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- | This first test group looks for a "hledger" executable in PATH;
|
||||
-- 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 HledgerBinaryVersion)
|
||||
setupHledger :: IO (Maybe Conf)
|
||||
setupHledger = do
|
||||
pgroup "hledger"
|
||||
|
||||
pdesc "is in PATH ?"
|
||||
pathexes <- findExecutables progname
|
||||
home <- getHomeDirectory
|
||||
appdata <- getXdgDirectory XdgData ""
|
||||
otherexes <- flip findExecutablesInDirectories progname $
|
||||
[home </> ".local/bin"
|
||||
,home </> ".cabal/bin"
|
||||
,home </> ".nix-profile/bin"
|
||||
,"/opt/homebrew/bin"
|
||||
,"/usr/local/bin"
|
||||
,"/usr/bin"
|
||||
]
|
||||
++ [appdata </> "local/bin" | os == "mingw32"]
|
||||
++ [appdata </> "cabal/bin" | os == "mingw32"]
|
||||
case (pathexes, otherexes) of
|
||||
([], []) -> do
|
||||
p N $ "Move the " <> progname <> " binary to a directory in your shell's PATH"
|
||||
return Nothing
|
||||
([], otherexe:_) -> do
|
||||
let otherdir = takeDirectory otherexe
|
||||
p N $ unlines
|
||||
["Add " <> otherdir <> " to PATH in your shell config."
|
||||
," Eg on unix: echo 'export PATH=" <> otherdir <> ":$PATH' >> ~/.profile"
|
||||
," and start a new shell session."
|
||||
]
|
||||
return Nothing
|
||||
(pathexe:_, _) -> do
|
||||
p Y (quoteIfNeeded pathexe)
|
||||
|
||||
-- hledger was found in PATH, continue
|
||||
|
||||
pdesc "runs and --version looks like hledger ?"
|
||||
eerrout <- tryHledgerArgs [["--version", "--no-conf"], ["--version"]]
|
||||
case eerrout of
|
||||
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
|
||||
|
||||
-- It runs and --version output looks ok, continue
|
||||
|
||||
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 a released version ?"
|
||||
let isreleased = if isReleaseVersion $ hbinPackageVersion binaryinfo then Y else N
|
||||
i isreleased prognameandversion
|
||||
|
||||
pdesc "is up to date ?"
|
||||
let binversion = hbinPackageVersion
|
||||
elatestversionnumstr <- getLatestHledgerVersion
|
||||
case elatestversionnumstr of
|
||||
Left e -> p U ("couldn't read " <> latestHledgerVersionUrlStr <> " , " <> e)
|
||||
@ -200,30 +116,56 @@ setupHledger = do
|
||||
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)
|
||||
(if hbinPackageVersion binaryinfo >= latestversion then Y else N)
|
||||
(showVersion (hbinPackageVersion binaryinfo) <> " installed, latest is " <> latestversionnumstr)
|
||||
|
||||
pdesc "is same as the hledger running setup ?"
|
||||
if prognameandversion == hbinVersionOutput
|
||||
then i Y ""
|
||||
else i N prognameandversion
|
||||
pdesc "is a native binary for this machine ?"
|
||||
case hbinArch binaryinfo of
|
||||
Nothing -> p U $ "couldn't detect this binary's architecture"
|
||||
Just a | a /= arch -> p N $ "binary is for " <> a <> ", system is " <> arch <> ", may run slowly"
|
||||
Just a -> p Y a
|
||||
|
||||
return $ Just bininfo
|
||||
pdesc "is installed in PATH ?"
|
||||
pathexes <- findExecutables progname
|
||||
let msg = "please install this hledger in PATH and run setup again"
|
||||
case pathexes of
|
||||
[] -> p N msg >> exitFailure
|
||||
exe:_ -> do
|
||||
eerrout <- tryHledgerArgs [["--version", "--no-conf"], ["--version"]]
|
||||
case eerrout of
|
||||
Left err -> p U (progname <> " --version failed: " <> err) >> exitFailure
|
||||
Right out -> do
|
||||
case parseHledgerVersion out of
|
||||
Left _ -> p U ("couldn't parse " <> progname <> " --version: " <> rstrip out) >> exitFailure
|
||||
Right pathbin -> do
|
||||
let pathversion = hbinVersionOutput pathbin
|
||||
if pathversion /= prognameandversion
|
||||
then p N (unlines [
|
||||
""
|
||||
,"PATH hledger is " <> pathversion <> " (" <> exe <> ")"
|
||||
,"this hledger is " <> prognameandversion
|
||||
,msg
|
||||
]) >> exitFailure
|
||||
else p Y exe
|
||||
|
||||
pdesc "has a system text encoding configured ?"
|
||||
let encoding = localeEncoding -- the initial system encoding
|
||||
if map toLower (show encoding) == "ascii"
|
||||
then p N (show encoding <> " - please configure an encoding to handle non-ascii text")
|
||||
else p Y (show 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)
|
||||
|
||||
setupConfig :: Version -> IO (Maybe Conf)
|
||||
setupConfig version = do
|
||||
pgroup "config"
|
||||
-- pdesc "can report text decoding failures ?"
|
||||
-- i U (T.unpack $ T.decodeUtf8 eAcuteLatin1)
|
||||
|
||||
pdesc "hledger supports config files ?"
|
||||
if (not $ supportsConfigFiles version)
|
||||
then p N "hledger 1.40+ needed" >> return Nothing
|
||||
else do
|
||||
p Y ""
|
||||
|
||||
pdesc "a user config file exists ? (optional)"
|
||||
pdesc "has a user config file ? (optional)"
|
||||
muf <- activeUserConfFile
|
||||
let
|
||||
(ok, msg) = case muf of
|
||||
@ -231,7 +173,7 @@ setupConfig version = do
|
||||
Nothing -> (N, "")
|
||||
i ok msg
|
||||
|
||||
pdesc "a local config file exists ?"
|
||||
pdesc "current directory has a local config ?"
|
||||
mlf <- activeLocalConfFile
|
||||
let
|
||||
(ok, msg) = case mlf of
|
||||
@ -243,53 +185,26 @@ setupConfig version = do
|
||||
pdesc "local config is masking user config ?"
|
||||
i Y ""
|
||||
|
||||
let mf = mlf <|> muf
|
||||
case mf of
|
||||
Nothing -> return Nothing
|
||||
Just _ -> do
|
||||
pdesc "hledger can read the config file ?"
|
||||
-- Test config file readability, without requiring journal file readability, forward compatibly.
|
||||
(exit, _, err) <- readProcessWithExitCode progname ["print", "-f-"] ""
|
||||
case exit of
|
||||
ExitFailure _ -> p N ("\n"<>err) >> return Nothing
|
||||
ExitSuccess -> do
|
||||
p Y ""
|
||||
|
||||
-- Read config file ourselves for closer inspection
|
||||
-- econfsections <- readFile f <&> parseConf f . T.pack
|
||||
econf <- getConf def -- safer; should agree with file detection above
|
||||
if (isJust muf || isJust mlf) then do
|
||||
pdesc "the config file is readable ?"
|
||||
econf <- getConf def
|
||||
case econf of
|
||||
Left _ -> return Nothing
|
||||
Right (conf, _) -> do
|
||||
Left e -> p N (show e) >> return Nothing
|
||||
Right (conf, f) -> do
|
||||
p Y (fromMaybe "" f)
|
||||
|
||||
-- pdesc "common general options configured ?"
|
||||
-- --pretty --ignore-assertions --infer-costs"
|
||||
-- pdesc "common general options are configured ?"
|
||||
-- --infer-costs"
|
||||
-- print --explicit --show-costs"
|
||||
|
||||
return $ Just conf
|
||||
else
|
||||
return Nothing
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
setupLocale = do
|
||||
pgroup "locale"
|
||||
|
||||
-- pdesc "a locale is set to allow UTF-8 text ?"
|
||||
-- pdesc "the locale allows decoding UTF-8 text ?"
|
||||
pdesc "the locale allows handling UTF-8 text ?"
|
||||
case T.decodeUtf8' $ B.pack [0xC3, 0xA9] of -- é
|
||||
Left _ -> p N "hint: set a UTF-8 locale / enable UTF-8 text"
|
||||
Right t -> p Y (T.unpack t)
|
||||
--- XXX also recognise non-utf8 locales I guess, as long as some text encoding is supported
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
setupColor version conf = do
|
||||
pgroup "color"
|
||||
|
||||
pdesc "hledger supports robust color output ?"
|
||||
if not $ supportsColor version then p N "hledger 1.41+ needed"
|
||||
else do
|
||||
p Y ""
|
||||
setupTerminal conf = do
|
||||
pgroup "terminal"
|
||||
|
||||
pdesc "the NO_COLOR variable is defined ?"
|
||||
mnocolor <- lookupEnv "NO_COLOR"
|
||||
@ -310,22 +225,12 @@ setupColor version conf = do
|
||||
arg = reverse $ takeWhile (`notElem` ['=',' ']) $ reverse a
|
||||
return $ Just $ parseYNA arg
|
||||
|
||||
pdesc "hledger will use color when possible ?"
|
||||
pdesc "hledger will use color by default ?"
|
||||
case (meconfigcolor, isJust mnocolor) of
|
||||
(Just (Right Yes), _) -> i Y ""
|
||||
(Just (Right Yes), _) -> p Y ""
|
||||
(Just (Right No), _) -> i N ""
|
||||
(_, True) -> i N ""
|
||||
(_, False) -> i Y ""
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
setupPager version conf = do
|
||||
pgroup "pager"
|
||||
|
||||
pdesc "hledger supports paged output ?"
|
||||
if not $ supportsPager version then p N "hledger 1.41+ needed"
|
||||
else do
|
||||
p Y ""
|
||||
(_, False) -> p Y ""
|
||||
|
||||
pdesc "the PAGER variable is defined ?"
|
||||
mv <- lookupEnv "PAGER"
|
||||
@ -350,7 +255,7 @@ setupPager version conf = do
|
||||
Nothing -> p N "no pager was found"
|
||||
Just pager ->
|
||||
case meconfpager of
|
||||
Just (Right No) -> p N ""
|
||||
Just (Right No) -> p N "disabled in config file"
|
||||
_ -> do
|
||||
p Y pager
|
||||
|
||||
@ -379,51 +284,32 @@ setupPager version conf = do
|
||||
usecolor <- useColorOnStdout
|
||||
i (if usecolor then Y else N) ""
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
setupPretty version conf = do
|
||||
pgroup "pretty"
|
||||
|
||||
pdesc "hledger supports pretty table borders ?"
|
||||
if not $ supportsPretty version then p N "hledger 1.2+ needed"
|
||||
else do
|
||||
p Y ""
|
||||
|
||||
pdesc "--pretty is enabled in the config file ?"
|
||||
let
|
||||
confgenargs = confLookup "general" conf
|
||||
confpretty = isJust $ find ("--pretty" ==) confgenargs
|
||||
i (if confpretty then Y else N) ""
|
||||
if confpretty
|
||||
then i Y "tables will use box-drawing characters"
|
||||
else i N "tables will use ASCII characters"
|
||||
|
||||
pdesc "bash shell completions are installed ?" >> p U ""
|
||||
pdesc "zsh shell completions are installed ?" >> p U ""
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
setupCompletions version = do
|
||||
pgroup "completions"
|
||||
|
||||
pdesc "up to date bash completions available ?"
|
||||
if not $ supportsBashCompletions version then p N "hledger 1.41+ needed"
|
||||
else do
|
||||
p Y ""
|
||||
|
||||
pdesc "bash shell completions are installed ?"
|
||||
p U ""
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
setupJournal :: Version -> IO (Either String Journal)
|
||||
setupJournal version = do
|
||||
setupJournal :: IO (Either String Journal)
|
||||
setupJournal = do
|
||||
pgroup "journal"
|
||||
|
||||
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
|
||||
-- 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
|
||||
|
||||
pdesc "the LEDGER_FILE variable is defined ?"
|
||||
mf <- lookupEnv journalEnvVar
|
||||
@ -444,97 +330,71 @@ setupJournal version = do
|
||||
-- pdesc "$LEDGER_FILE is masking home journal ?"
|
||||
-- i Y ""
|
||||
|
||||
pdesc "a default journal file exists ?"
|
||||
pdesc "a default journal file is readable ?"
|
||||
jfile <- defaultJournalPath
|
||||
exists <- doesFileExist jfile
|
||||
let (ok, msg) = (if exists then Y else N, if exists then jfile else "")
|
||||
p ok msg
|
||||
|
||||
when exists $ do
|
||||
-- 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
|
||||
case ej of
|
||||
Left e -> do
|
||||
p N (jfile <> ":\n" <> show e)
|
||||
return $ Left e
|
||||
Right j@Journal{..} -> do
|
||||
p Y jfile
|
||||
|
||||
when (os == "mingw32") $ do
|
||||
pdesc "default journal file path is safe for Windows ?"
|
||||
pdesc "it includes additional files ?"
|
||||
let numfiles = length jfiles
|
||||
if numfiles > 1
|
||||
then i Y (show $ numfiles - 1)
|
||||
else i N ""
|
||||
|
||||
pdesc "all commodities are declared ?"
|
||||
let
|
||||
(ok, msg) =
|
||||
-- like ensureJournalFileExists:
|
||||
if isWindowsUnsafeDotPath jfile
|
||||
then (N, "the file name ends with a dot, this is unsafe on Windows")
|
||||
else (Y, "")
|
||||
p ok msg
|
||||
|
||||
pdesc "hledger can read the default journal ?"
|
||||
-- Basic readability check: ignoring config files if it's hledger >=1.40,
|
||||
-- and balance assertions if possible (can't if it's hledger <=0.23),
|
||||
-- try read the file (ie do the parseable and autobalanced checks pass).
|
||||
let
|
||||
args = concat [
|
||||
["print"],
|
||||
["--ignore-assertions" | supportsIgnoreAssertions version],
|
||||
["--no-conf" | supportsConfigFiles version]
|
||||
]
|
||||
(exit, _, err) <- readProcessWithExitCode progname args ""
|
||||
case exit of
|
||||
ExitSuccess -> p Y ""
|
||||
ExitFailure _ -> p N ("\n"<>err)
|
||||
|
||||
-- Try to read the journal ourselves for closer inspection later.
|
||||
-- There's the possibility this could read the journal differently from the hledger in PATH,
|
||||
-- if that's a different version.
|
||||
-- Also we assume defaultJournalPath will detect the same file as the logic above.
|
||||
defaultJournalSafely
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
setupAccounts version mj = do
|
||||
pgroup "accounts"
|
||||
|
||||
pdesc "hledger supports account directives ?"
|
||||
if not $ supportsAccountDirective version
|
||||
then p N "hledger 1.9+ needed"
|
||||
else do
|
||||
p Y ""
|
||||
|
||||
pdesc "hledger supports all account types ?" -- (ALERXCV)
|
||||
if not $ supportsConversionAccountType version
|
||||
then p N "hledger 1.25+ needed"
|
||||
else do
|
||||
p Y ""
|
||||
|
||||
case mj of
|
||||
Nothing -> return ()
|
||||
Just j@Journal{..} -> do
|
||||
numcommodities = length $ journalCommodities j
|
||||
undeclaredcommodities = journalCommoditiesUsed j \\ journalCommoditiesDeclared j
|
||||
if null undeclaredcommodities
|
||||
then p Y (show numcommodities)
|
||||
else p N (show (length undeclaredcommodities) <> "; declaring helps set their precision")
|
||||
|
||||
let
|
||||
accttypes = [Asset, Liability, Equity, Revenue, Expense, Cash, Conversion]
|
||||
typesdeclaredorinferred = nub $ M.elems jaccounttypes
|
||||
typesnotfound = filter (not.(`elem` typesdeclaredorinferred)) accttypes
|
||||
acctswithdeclaredorinferredtype = nub (M.keys jaccounttypes)
|
||||
numaccts = length $ journalAccountNames j
|
||||
untypedaccts = journalAccountNames j \\ acctswithdeclaredorinferredtype
|
||||
undeclaredaccts = journalAccountNamesUsed j \\ journalAccountNamesDeclared j
|
||||
hasdeclaredaccts t = case M.lookup t jdeclaredaccounttypes of
|
||||
Just (_ : _) -> True
|
||||
_ -> False
|
||||
-- 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 "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 "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 "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 "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 "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 "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")
|
||||
-- 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
|
||||
@ -548,35 +408,26 @@ setupAccounts version mj = do
|
||||
-- pdesc "types detected from account names ?"
|
||||
-- if null typesinferredfromnames then i N "" else i Y (concatMap show typesinferredfromnames)
|
||||
|
||||
pdesc "an account of each type was detected ?"
|
||||
if all (`elem` typesdeclaredorinferred) accttypes
|
||||
then p Y ""
|
||||
else p N "reports like bs, cf, is may be empty"
|
||||
pdesc "all accounts are declared ?"
|
||||
if null undeclaredaccts then i Y (show numaccts) else i N (show (length undeclaredaccts) <> " undeclared")
|
||||
|
||||
pdesc "all accounts have types ?"
|
||||
if null untypedaccts then i Y "" else i N ""
|
||||
if null untypedaccts then i Y "" else i N (show (length untypedaccts) <> " untyped")
|
||||
|
||||
pdesc "all accounts are declared ?"
|
||||
if null undeclaredaccts then i Y "" else i N ""
|
||||
pdesc "accounts of each type were detected ?"
|
||||
if null typesnotfound
|
||||
then p Y (concatMap show accttypes)
|
||||
else p N (concatMap show typesnotfound <> "not found; type: queries, bs/cf/is reports may not work")
|
||||
|
||||
return $ Right j
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
setupCommodities version mj = do
|
||||
pgroup "commodities"
|
||||
|
||||
pdesc "hledger supports commodity directives ?"
|
||||
if not $ supportsCommodityDirective version
|
||||
then p N "hledger 1.0+ needed"
|
||||
else do
|
||||
p Y ""
|
||||
|
||||
case mj of
|
||||
Nothing -> return ()
|
||||
Just j -> do
|
||||
|
||||
pdesc "all commodities are declared ?"
|
||||
let undeclaredcommodities = journalCommoditiesUsed j \\ journalCommoditiesDeclared j
|
||||
if null undeclaredcommodities then p Y "" else p N "declaring helps set their precision"
|
||||
setupStrictness = do
|
||||
pgroup "strictness"
|
||||
pdesc "balance assertions are checked by default ?"
|
||||
-- ignore-assertions
|
||||
pdesc "commodities/conversions/accounts are checked by default ?"
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
@ -586,6 +437,21 @@ setupCommodities version mj = do
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- Test a hledger version for support of various features.
|
||||
ver >=! str = ver >= (fromJust $ toVersion str)
|
||||
supportsIgnoreAssertions = (>=! "0.24") -- --ignore-assertions (2014)
|
||||
supportsCommodityDirective = (>=! "1.0") -- commodity directive (2016)
|
||||
supportsPretty = (>=! "1.2") -- --pretty, to use box-drawing characters (2017)
|
||||
supportsAccountDirective = (>=! "1.9") -- account directive (2018)
|
||||
supportsAccountTypes = (>=! "1.13") -- ALERX account types, type: tag (2019)
|
||||
supportsCashAccountType = (>=! "1.19") -- C/Cash account type (2020)
|
||||
supportsBasicColor = (>=! "1.19") -- basic color detection/control (2020)
|
||||
supportsConversionAccountType = (>=! "1.25") -- V/Conversion account type, accounts --types (2022)
|
||||
supportsConfigFiles = (>=! "1.40") -- config files (2024)
|
||||
supportsColor = (>=! "1.41") -- robust color detection/control (2024)
|
||||
supportsPager = (>=! "1.41") -- use a pager for all output (2024)
|
||||
supportsBashCompletions = (>=! "1.41") -- up to date bash shell completions (2024)
|
||||
|
||||
-- yes, no, unknown
|
||||
data YNU = Y | N | U deriving (Eq)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user