hledger/hledger/Hledger/Cli.hs

563 lines
25 KiB
Haskell

{-|
This is the root module of the @hledger@ package,
providing hledger's command-line interface.
The main function,
commands,
command-line options,
and utilities useful to other hledger command-line programs
are exported.
It also re-exports hledger-lib:Hledger
and cmdargs:System.Concole.CmdArgs.Explicit
See also:
- hledger-lib:Hledger
- [The README files](https://github.com/search?q=repo%3Asimonmichael%2Fhledger+path%3A**%2FREADME*&type=code&ref=advsearch)
- [The high-level developer docs](https://hledger.org/dev.html)
== About
hledger - a fast, reliable, user-friendly plain text accounting tool.
Copyright (c) 2007-2023 Simon Michael <simon@joyful.com> and contributors
Released under GPL version 3 or later.
hledger is a Haskell rewrite of John Wiegley's "ledger".
It generates financial reports from a plain text general journal.
You can use the command line:
> $ hledger
or ghci:
> $ make ghci
> ghci> Right j <- runExceptT $ readJournalFile definputopts "examples/sample.journal" -- or: j <- defaultJournal
> ghci> :t j
> j :: Journal
> ghci> stats defcliopts j
> Main file : examples/sample.journal
> Included files :
> Transactions span : 2008-01-01 to 2009-01-01 (366 days)
> Last transaction : 2008-12-31 (733772 days from now)
> Transactions : 5 (0.0 per day)
> Transactions last 30 days: 0 (0.0 per day)
> Transactions last 7 days : 0 (0.0 per day)
> Payees/descriptions : 5
> Accounts : 8 (depth 3)
> Commodities : 1 ($)
> Market prices : 0 ()
>
> Run time (throughput) : 1695276900.00s (0 txns/s)
> ghci> balance defcliopts j
> $1 assets:bank:saving
> $-2 assets:cash
> $1 expenses:food
> $1 expenses:supplies
> $-1 income:gifts
> $-1 income:salary
> $1 liabilities:debts
> --------------------
> 0
> ghci>
etc.
-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Unused LANGUAGE pragma" #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.Cli (
main,
mainmode,
argsToCliOpts,
-- * Re-exports
module Hledger.Cli.CliOptions,
module Hledger.Cli.Conf,
module Hledger.Cli.Commands,
module Hledger.Cli.DocFiles,
module Hledger.Cli.Utils,
module Hledger.Cli.Version,
module Hledger,
-- ** System.Console.CmdArgs.Explicit
module System.Console.CmdArgs.Explicit,
)
where
import Control.Monad (when, unless)
import Data.List
import qualified Data.List.NonEmpty as NE
import Data.Time.Clock.POSIX (getPOSIXTime)
import Safe
import System.Console.CmdArgs.Explicit hiding (Name)
import qualified System.Console.CmdArgs.Explicit as CmdArgs
import System.Environment
import System.Exit
import System.FilePath
import System.Process
import Text.Printf
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Conf
import Hledger.Cli.Commands
import Hledger.Cli.DocFiles
import Hledger.Cli.Utils
import Hledger.Cli.Version
import Data.Bifunctor (second)
import Data.Function ((&))
import Data.Functor ((<&>))
import Data.List.Extra (nubSort)
import Data.Maybe (isJust)
verboseDebugLevel = 8
-- | The overall cmdargs mode describing hledger's command-line options and subcommands.
-- The names of known addons are provided so they too can be recognised as commands.
mainmode addons = defMode {
modeNames = [progname ++ " [COMMAND]"]
,modeArgs = ([], Just $ argsFlag "[ARGS]")
,modeHelp = unlines ["hledger's main command line interface. Run with no ARGS to list commands."]
,modeGroupModes = Group {
-- subcommands in the unnamed group, shown first:
groupUnnamed = [
]
-- subcommands in named groups:
,groupNamed = [
]
-- subcommands handled but not shown in the help:
,groupHidden = map fst builtinCommands ++ map addonCommandMode addons
}
,modeGroupFlags = Group {
-- flags in named groups: (keep synced with Hledger.Cli.CliOptions.highlightHelp)
groupNamed = cligeneralflagsgroups1
-- flags in the unnamed group, shown last:
,groupUnnamed = confflags -- keep synced with dropUnsupportedOpts
-- flags handled but not shown in the help:
,groupHidden = detailedversionflag : hiddenflags
}
,modeHelpSuffix = []
-- "Examples:" :
-- map (progname ++) [
-- " list commands"
-- ," CMD [--] [OPTS] [ARGS] run a command (use -- with addon commands)"
-- ,"-CMD [OPTS] [ARGS] or run addon commands directly"
-- ," -h show general usage"
-- ," CMD -h show command usage"
-- ," help [MANUAL] show any of the hledger manuals in various formats"
-- ]
}
-- A dummy mode just for parsing --conf/--no-conf flags.
confflagsmode = defMode{
modeGroupFlags=Group [] confflags []
,modeArgs = ([], Just $ argsFlag "")
}
------------------------------------------------------------------------------
-- | hledger CLI's main procedure.
--
-- Here we will parse the command line, read any config file,
-- and search for hledger-* addon executables in the user's PATH,
-- then choose the appropriate builtin operation or addon operation to run,
-- then run it in the right way, usually reading input data (eg a journal) first.
--
-- When making a CLI usable and robust with main command, builtin subcommands,
-- various kinds of addon commands, and config files that add general and
-- command-specific options, while balancing circular dependencies, environment,
-- idioms, legacy, and libraries with their own requirements and limitations:
-- things get crazy, and there is a tradeoff against complexity and bug risk.
-- We try to provide the most intuitive, expressive and robust CLI that's feasible
-- while keeping the CLI processing below sufficiently comprehensible, troubleshootable,
-- and tested. It's an ongoing quest.
-- See also: Hledger.Cli.CliOptions, cli.test, addons.test, --debug and --debug=8.
--
-- Probably the biggest source of complexity here is that cmdargs can't parse
-- a command line containing undeclared flags, but this arises often with our
-- addon commands and builtin/custom commands which haven't implemented all options,
-- so we have to work hard to work around this.
-- https://github.com/ndmitchell/cmdargs/issues/36 is the wishlist issue;
-- implementing that would simplify hledger's CLI processing a lot.
--
main :: IO ()
main = withGhcDebug' $ do
-- let's go!
let
dbgIO, dbgIO1, dbgIO2 :: Show a => String -> a -> IO () -- this signature is needed
dbgIO = ptraceAtIO verboseDebugLevel
dbgIO1 = ptraceAtIO 1
dbgIO2 = ptraceAtIO 2
dbgIO "running" prognameandversion
starttime <- getPOSIXTime
-- give ghc-debug a chance to take control
when (ghcDebugMode == GDPauseAtStart) $ ghcDebugPause'
-- try to encourage user's $PAGER to display ANSI when supported
when useColorOnStdout setupPager
-- Search PATH for addon commands. Exclude any that match builtin command names.
addons <- hledgerAddons <&> filter (not . (`elem` builtinCommandNames) . dropExtension)
---------------------------------------------------------------
-- Preliminary command line parsing.
-- Do some argument preprocessing to help cmdargs
cliargs <- getArgs
>>= expandArgsAt -- interpolate @ARGFILEs
<&> replaceNumericFlags -- convert -NUM to --depth=NUM
let
(clicmdarg, cliargswithoutcmd, cliargswithcmdfirst) = moveFlagsAfterCommand cliargs
cliargswithcmdfirstwithoutclispecific = dropCliSpecificOpts cliargswithcmdfirst
(cliargsbeforecmd, cliargsaftercmd) = second (drop 1) $ break (==clicmdarg) cliargs
dbgIO "cli args" cliargs
dbgIO "cli args with command first, if any" cliargswithcmdfirst
dbgIO "command argument found" clicmdarg
dbgIO "cli args before command" cliargsbeforecmd
dbgIO "cli args after command" cliargsaftercmd
-- Now try to identify the full subcommand name, so we can look for
-- command-specific options in config files (clicmdarg may be only an abbreviation).
-- For this do a preliminary cmdargs parse of the arguments with cli-specific options removed.
-- If no command was provided, or if the command line contains a bad flag
-- or a wrongly present/missing flag argument, cmd will be "".
let
rawopts0 = cmdargsParse
"to get command name"
(mainmode addons)
cliargswithcmdfirstwithoutclispecific
cmd = stringopt "command" rawopts0
-- XXX better error message when cmdargs fails (eg spaced/quoted/malformed flag values) ?
nocmdprovided = null clicmdarg
badcmdprovided = null cmd && not nocmdprovided
isaddoncmd = not (null cmd) && cmd `elem` addons
-- isbuiltincmd = cmd `elem` builtinCommandNames
mcmdmodeaction = findBuiltinCommand cmd
effectivemode = maybe (mainmode []) fst mcmdmodeaction
dbgIO "cli args with command first and no cli-specific opts" cliargswithcmdfirstwithoutclispecific
dbgIO1 "command found" cmd
dbgIO "no command provided" nocmdprovided
dbgIO "bad command provided" badcmdprovided
dbgIO "is addon command" isaddoncmd
---------------------------------------------------------------
-- Read extra options from a config file.
-- Identify any --conf/--no-conf options.
-- For this parse with cmdargs again, this time with just the args that look conf-related.
let cliconfargs = dropUnsupportedOpts confflagsmode cliargswithoutcmd
dbgIO "cli args without command" cliargswithoutcmd
-- dbgIO "cli conf args" cliconfargs
let rawopts1 = cmdargsParse "to get conf file" confflagsmode cliconfargs
-- Read extra general and command-specific args/opts from the config file if found.
-- Ignore any general opts or cli-specific opts not known to be supported by the command.
(conf, mconffile) <- getConf rawopts1
let
genargsfromconf = confLookup "general" conf
addoncmdssupportinggenopts = ["ui", "web"] -- addons known to support hledger general options
supportedgenargsfromconf
| cmd `elem` addoncmdssupportinggenopts =
[a | a <- genargsfromconf, not $ any (`isPrefixOf` a) addoncmdssupportinggenopts]
| isaddoncmd = []
| otherwise = dropUnsupportedOpts effectivemode genargsfromconf
excludedgenargsfromconf = genargsfromconf \\ supportedgenargsfromconf
cmdargsfromconf
| null cmd = []
| otherwise = confLookup cmd conf & if isaddoncmd then ("--":) else id
when (isJust mconffile) $ do
dbgIO1 "using extra general args from config file" genargsfromconf
unless (null excludedgenargsfromconf) $
dbgIO1 "excluded general args from config file, not supported by this command" excludedgenargsfromconf
dbgIO1 "using extra command args from config file" cmdargsfromconf
---------------------------------------------------------------
-- Combine cli and config file args and parse with cmdargs.
-- A bad flag or flag argument will cause the program to exit with an error here.
let
finalargs = -- (avoid breaking vs code haskell highlighting..)
(if null clicmdarg then [] else [clicmdarg]) <> supportedgenargsfromconf <> cmdargsfromconf <> cliargswithoutcmd
& replaceNumericFlags -- convert any -NUM opts from the config file
-- finalargs' <- expandArgsAt finalargs -- expand @ARGFILEs in the config file ? don't bother
let rawopts = cmdargsParse "to get options" (mainmode addons) finalargs
---------------------------------------------------------------
-- Finally, select an action and run it.
-- We check for the help/doc/version flags first, since they are a high priority.
-- (A perfectionist might think they should be so high priority that adding -h
-- to an invalid command line would show help. But cmdargs tends to fail first,
-- preventing this, and trying to detect them without cmdargs, and always do the
-- right thing with builtin commands and addon commands, gets much too complicated.)
let
helpFlag = boolopt "help" rawopts
tldrFlag = boolopt "tldr" rawopts
infoFlag = boolopt "info" rawopts
manFlag = boolopt "man" rawopts
versionFlag = boolopt "version" rawopts
if
-- no command and a help/doc flag found - show general help/docs
| nocmdprovided && helpFlag -> pager $ showModeUsage (mainmode []) ++ "\n"
| nocmdprovided && tldrFlag -> runTldrForPage "hledger"
| nocmdprovided && infoFlag -> runInfoForTopic "hledger" Nothing
| nocmdprovided && manFlag -> runManForTopic "hledger" Nothing
-- --version flag found and none of these other conditions - show version
| versionFlag && not (isaddoncmd || helpFlag || tldrFlag || infoFlag || manFlag) -> putStrLn prognameandversion
-- there's a command argument, but it's bad - show error
| badcmdprovided -> error' $ "command "++clicmdarg++" is not recognized, run with no command to see a list"
-- no command found, nothing else to do - show the commands list
| nocmdprovided -> dbgIO "" "no command, showing commands list" >> printCommandsList prognameandversion addons
-- builtin command found
| Just (cmdmode, cmdaction) <- mcmdmodeaction -> do
-- validate opts/args more and convert to CliOpts
opts <- rawOptsToCliOpts rawopts >>= \opts0 -> return opts0{progstarttime_=starttime}
dbgIO2 "processed opts" opts
dbgIO "period from opts" (period_ . _rsReportOpts $ reportspec_ opts)
dbgIO "interval from opts" (interval_ . _rsReportOpts $ reportspec_ opts)
dbgIO "query from opts & args" (_rsQuery $ reportspec_ opts)
let
mcmdname = headMay $ modeNames cmdmode
tldrpagename = maybe "hledger" (("hledger-"<>)) mcmdname
-- run the builtin command according to its type
if
-- help/doc flag - show command help/docs
| helpFlag -> pager $ showModeUsage cmdmode ++ "\n"
| tldrFlag -> runTldrForPage tldrpagename
| infoFlag -> runInfoForTopic "hledger" mcmdname
| manFlag -> runManForTopic "hledger" mcmdname
-- builtin command which should not require or read the journal - run it
| cmd `elem` ["demo","help","test"] ->
cmdaction opts $ error' $ cmd++" tried to read the journal but is not supposed to"
-- builtin command which should create the journal if missing - do that and run it
| cmd `elem` ["add","import"] -> do
ensureJournalFileExists . NE.head =<< journalFilePathFromOpts opts
withJournalDo opts (cmdaction opts)
-- all other builtin commands - read the journal and if successful run the command with it
| otherwise -> withJournalDo opts $ cmdaction opts
-- external addon command found - run it,
-- passing any cli arguments written after the command name
-- and any command-specific opts from the config file.
-- Any "--" arguments, which sometimes must be used in the command line
-- to hide addon-specific opts from hledger's cmdargs parsing,
-- (and are also accepted in the config file, though not required there),
-- will be removed.
-- (hledger does not preserve -- arguments)
-- Arguments written before the command name, and general opts from the config file,
-- are not passed since we can't be sure they're supported.
| isaddoncmd -> do
let
addonargs0 = filter (/="--") $ supportedgenargsfromconf <> cmdargsfromconf <> cliargswithoutcmd
addonargs = dropCliSpecificOpts addonargs0
shellcmd = printf "%s-%s %s" progname cmd (unwords' addonargs) :: String
dbgIO "addon command selected" cmd
dbgIO "addon command arguments after removing cli-specific opts" (map quoteIfNeeded addonargs)
dbgIO1 "running addon" shellcmd
system shellcmd >>= exitWith
-- deprecated command found
-- cmd == "convert" = error' (modeHelp oldconvertmode) >> exitFailure
-- something else (shouldn't happen) - show an error
| otherwise -> usageError $
"could not understand the arguments "++show finalargs
<> if null genargsfromconf then "" else "\ngeneral arguments added from config file: "++show genargsfromconf
<> if null cmdargsfromconf then "" else "\ncommand arguments added from config file: "++show cmdargsfromconf
-- And we're done.
-- Give ghc-debug a final chance to take control.
when (ghcDebugMode == GDPauseAtEnd) $ ghcDebugPause'
------------------------------------------------------------------------------
-- | A helper for addons/scripts: this parses hledger CliOpts from these
-- command line arguments and add-on command names, roughly how hledger main does.
-- If option parsing/validating fails, it exits the program with usageError.
-- Unlike main, this does not read extra args from a config file
-- or search for addons; to do those things, mimic the code in main for now.
argsToCliOpts :: [String] -> [String] -> IO CliOpts
argsToCliOpts args addons = do
let
(_, _, args0) = moveFlagsAfterCommand args
args1 = replaceNumericFlags args0
rawopts = cmdargsParse "to get options" (mainmode addons) args1
rawOptsToCliOpts rawopts
-- | Parse the given command line arguments/options with the given cmdargs mode,
-- after adding values to any valueless --debug flags,
-- with debug logging showing the given description of this parsing pass
-- (useful when cmdargsParse is called more than once).
-- If parsing fails, exit the program with an informative error message.
cmdargsParse :: String -> Mode RawOpts -> [String] -> RawOpts
cmdargsParse desc m args0 =
CmdArgs.process m (ensureDebugFlagHasVal args0)
& either
(\e -> error' $ e <> " while parsing these args " <> desc <> ": " <> unwords (map quoteIfNeeded args0))
(traceOrLogAt verboseDebugLevel ("cmdargs: parsing " <> desc <> ": " <> show args0))
-- | cmdargs does not allow flags (options) to appear before the subcommand argument.
-- We prefer to hide this restriction from the user, making the CLI more forgiving.
-- So this tries to move flags, and their values if any, after the command argument.
-- It also returns the (possibly empty) command argument and the other arguments,
-- separately for convenience.
--
-- Detecting the command argument is tricky because of the flexibility of traditional flag syntax.
-- Short flags can be joined together, some flags can have a value or no value,
-- flags and values can be separated by =, a space, or nothing, etc.
--
-- We make a best-effort attempt like so:
-- whether a flag argument (- or -- followed by a non-space character and zero or more others),
-- and its following argument, are movable, falls into these cases, to be checked in this order:
--
-- - it exactly matches a known short or long no-value flag; move it
-- - it exactly matches a short or long requires-value flag; move it and the following argument
-- - it exactly matches a short optional-value flag; assume these don't exist or we don't have any
-- - it exactly matches a long optional-value flag; assume there's no value, move it
-- - it begins with a short requires-value flag; the value is joined to it, move it
-- - it begins with a long requires-value flag followed by =; likewise
-- - it begins with a long optional-value flag followed by =; likewise
--
-- Notes:
--
-- - This hackery increases the risk of misleading errors, bugs, and confusion.
-- But it should be fairly robust now, being aware of all builtin flags.
--
-- - All general and builtin command flags (and their values) will be moved. It's clearer to
-- write command flags after the command, but if not we'll handle it (for greater robustness).
--
-- - Long flags should be spelled in full; abbreviated long flags may not be moved.
--
-- - Unknown flags (from addons) are assumed to be valueless or have a joined value,
-- and will be moved - but later rejected by cmdargs.
-- Instead these should be written to the right of a "--" argument, which hides them.
--
moveFlagsAfterCommand :: [String] -> (String, [String], [String])
moveFlagsAfterCommand args =
case moveFlagArgs (args, []) of
([],as) -> ("", as, as)
(unmoved@(('-':_):_), moved) -> ("", as, as) where as = unmoved<>moved
(cmdarg:unmoved, moved) -> (cmdarg, as, cmdarg:as) where as = unmoved<>moved
where
moveFlagArgs :: ([String], [String]) -> ([String], [String])
moveFlagArgs ((a:b:cs), moved)
| isMovableFlagArg a == 2 = moveFlagArgs (cs, moved++[a,b])
| isMovableFlagArg a == 1 = moveFlagArgs (b:cs, moved++[a])
| otherwise = (a:b:cs, moved)
where
-- Is this a short or long flag argument that should be moved,
-- and is its following argument a value that also should be moved ?
-- Returns:
-- 0 (not a flag)
-- 1 (single flag, maybe with joined argument; or multiple joined short flags)
-- 2 (flag with value in the next argument).
isMovableFlagArg :: String -> Int
isMovableFlagArg a1
| a1 `elem` novalflagargs = 1 -- short or long no-val flag
| a1 `elem` reqvalflagargs, not $ "--debug" `isPrefixOf` a1 = 2
-- short or long req-val flag, value is in next argument
-- --debug is really optional-value (see CliOptions), assume it has no value or joined value
| a1 `elem` optvalflagargs = 1 -- long (or short ?) opt-val flag, assume no value
| any (`isPrefixOf` a1) shortreqvalflagargs = 1 -- short req-val flag, value is joined
| any (`isPrefixOf` a1) longreqvalflagargs_ = 1 -- long req-val flag, value is joined with =
| any (`isPrefixOf` a1) longoptvalflagargs_ = 1 -- long opt-val flag, value is joined with =
-- | isLongFlagArg a1 && any (takeWhile (/='=') `isPrefixOf`) longreqvalflagargs_ ... -- try to move abbreviated long flags ?
| isFlagArg a1 = 1 -- an addon flag (or mistyped flag) we don't know, assume no value or value is joined
| otherwise = 0 -- not a flag
moveFlagArgs (as, moved) = (as, moved)
-- All Flags provided by hledger and its builtin comands.
allbuiltinflags = modeAndSubmodeFlags $ mainmode []
-- Flag arguments are command line arguments beginning with - or --
-- (followed by a short of long flag name, and possibly joined short flags or a joined value).
isShortFlagArg ('-':c:_) = c /= '-'
isShortFlagArg _ = False
isLongFlagArg ('-':'-':_:_) = True
isLongFlagArg _ = False
isFlagArg a = isShortFlagArg a || isLongFlagArg a
-- Given a list of Flags, return all of their supported short and long flag names as flag arguments
-- (a sorted list of the unique flag names with - or -- prefixes).
flagsToArgs flags = nubSort [ if length f == 1 then "-"++f else "--"++f | f <- nubSort $ concatMap flagNames flags]
-- hledger flag args grouped by whether their flag expects no value, a required value, or an optional value.
novalflagargs = flagsToArgs $ filter ((==FlagNone).flagInfo) allbuiltinflags
reqvalflagargs = flagsToArgs $ filter ((==FlagReq).flagInfo) allbuiltinflags
optvalflagargs = flagsToArgs $ filter isOptValFlag allbuiltinflags
where
isOptValFlag f = case flagInfo f of
FlagOpt _ -> True
FlagOptRare _ -> True
_ -> False
-- Short flag args that expect a required value.
shortreqvalflagargs = filter isShortFlagArg reqvalflagargs
-- Long flag args that expect a required value or optional value respectively, with = appended.
longreqvalflagargs_ = map (++"=") $ filter isLongFlagArg reqvalflagargs
longoptvalflagargs_ = map (++"=") $ filter isLongFlagArg optvalflagargs ++ ["--debug"]
-- Is this flag arg one that requires a value ?
isReqValFlagArg a = a `elem` reqvalflagargs
-- Drop any arguments which look like cli-specific options (--no-conf, --conf CONFFILE, etc.)
-- Keep synced with mainmode's groupUnnamed.
dropCliSpecificOpts :: [String] -> [String]
dropCliSpecificOpts = \case
"--conf":_:as -> dropCliSpecificOpts as
a:as | "--conf=" `isPrefixOf` a -> dropCliSpecificOpts as
"--no-conf":as -> dropCliSpecificOpts as
"-n":as -> dropCliSpecificOpts as
a:as -> a:dropCliSpecificOpts as
[] -> []
-- | Given a hledger cmdargs mode and a list of command line arguments, try to drop any of the
-- arguments which seem to be flags not supported by this mode. Also drop their values if any.
dropUnsupportedOpts :: Mode RawOpts -> [String] -> [String]
dropUnsupportedOpts m = \case
[] -> []
a:as -> if
| isLongFlagArg a,
let f = takeWhile (/='=') a,
let as' = if isReqValFlagArg f && '=' `notElem` a then drop 1 as else as
-> if m `supportsFlag` f then a : go as else go as'
| isShortFlagArg a,
let f = take 2 a,
let as' = if isReqValFlagArg f && length a == 2 then drop 1 as else as
-> if m `supportsFlag` f then a : go as else go as'
| otherwise -> a : dropUnsupportedOpts m as
where
go = dropUnsupportedOpts m
supportsFlag m1 flagarg = elem flagarg $ flagsToArgs $ modeAndSubmodeFlags m1
-- | Get all the flags defined in a mode or its immediate subcommands,
-- whether in named, unnamed or hidden groups (does not recurse into subsubcommands).
modeAndSubmodeFlags :: Mode a -> [Flag a]
modeAndSubmodeFlags m@Mode{modeGroupModes=Group{..}} =
modeFlags m <> concatMap modeFlags (concatMap snd groupNamed <> groupUnnamed <> groupHidden)
-- unit tests (tests_Hledger_Cli) are defined in Hledger.Cli.Commands