overhaul command line processing

Command line processing has been overhauled and made more consistent,
and now has tests and extensive debug output.  More flags now work
both before and after COMMAND: -f, --rule-file, --alias, --help,
--debug, --version.  Command line help, command aliases, API docs and
code have been improved.
This commit is contained in:
Simon Michael 2013-09-22 01:17:41 -07:00
parent c912108d89
commit 13f8c0f938
5 changed files with 615 additions and 273 deletions

View File

@ -47,12 +47,13 @@ Basic usage is:
Most [commands](#commands) query or operate on a
[journal file](#the-journal-file), which by default is `.hledger.journal`
in your home directory. You can specify a different file with the `-f`
option or `LEDGER_FILE` environment variable, or standard input with `-f
-`.
option or `LEDGER_FILE` environment variable, or standard input with `-f-`.
Options are similar across most commands, with some variations; use
`hledger COMMAND --help` for details. Most options must appear somewhere
after COMMAND, not before it. The `-f` option can appear anywhere.
`hledger COMMAND --help` for details. Most options must appear
somewhere after COMMAND, not before it. These input and help-related
options can appear anywhere: `-f`, `--rules-file`, `--alias`,
`--help`, `--debug`, `--version`.
Arguments are also command-specific, but usually they form a
[query](#queries) which selects a subset of the journal, eg transactions

View File

@ -6,6 +6,11 @@ title: hledger news
## unreleased
- command line processing has been overhauled and made more
consistent, and now has tests and extensive debug output. More
flags now work both before and after COMMAND: -f, --rule-file,
--alias, --help, --debug, --version. Command line help, command
aliases, API docs and code have been improved.
- print: comment positions (same line or next line) are now preserved
- register: `--average/-A` shows a running average, like ledger
- queries: `sym:REGEXP` matches commodity symbols

View File

@ -40,7 +40,10 @@ module Hledger.Cli.Main where
import Control.Monad
import Data.List
import Data.PPrint
import Safe
import System.Console.CmdArgs.Explicit (modeHelp)
-- import System.Console.CmdArgs.Helper
import System.Environment
import System.Exit
import System.Process
@ -66,62 +69,109 @@ import Hledger.Data.Dates
main :: IO ()
main = do
-- Choose and run the appropriate internal or external command based
-- on the raw command-line arguments, cmdarg's interpretation of
-- same, and hledger-* executables in the user's PATH. A somewhat
-- complex mishmash of cmdargs and custom processing, hence all the
-- debugging support and tests. See also Hledger.Cli.Options and
-- command-line.test.
-- some preliminary (imperfect) argument parsing to supplement cmdargs
args <- getArgs
let
args' = moveFlagsAfterCommand args
isFlag = ("-" `isPrefixOf`)
isNonEmptyNonFlag s = not (isFlag s) && not (null s)
rawcmd = headDef "" $ takeWhile isNonEmptyNonFlag args'
isNullCommand = null rawcmd
(argsbeforecmd, argsaftercmd') = break (==rawcmd) args
argsaftercmd = drop 1 argsaftercmd'
when ("--debug" `elem` args) $ do
printf "running: %s\n" prognameandversion
printf "raw args: %s\n" (show args)
printf "raw args rearranged for cmdargs: %s\n" (show args')
printf "raw command might be: %s\n" (show rawcmd)
printf "raw args before command: %s\n" (show argsbeforecmd)
printf "raw args after command: %s\n" (show argsaftercmd)
-- search PATH for add-ons
addons <- getHledgerAddonCommands
-- parse arguments with cmdargs
opts <- getHledgerCliOpts addons
when (debug_ opts) $ do
printf "%s\n" prognameandversion
printf "args: %s\n" (show args)
printf "opts: %s\n" (show opts)
d <- getCurrentDay
printf "query: %s\n" (show $ queryFromOpts d $ reportopts_ opts)
run' opts addons args
where
run' opts@CliOpts{command_=cmd} addons args
-- delicate, add tests before changing (eg --version, ADDONCMD --version, INTERNALCMD --version)
| (null matchedaddon) && "version" `in_` (rawopts_ opts) = putStrLn prognameandversion
| (null matchedaddon) && "binary-filename" `in_` (rawopts_ opts) = putStrLn $ binaryfilename progname
| null cmd = putStr $ showModeHelp mainmode'
| cmd `isPrefixOf` "add" = showModeHelpOr addmode $ journalFilePathFromOpts opts >>= ensureJournalFileExists >> withJournalDo opts add
| cmd `isPrefixOf` "test" = showModeHelpOr testmode $ test' opts
| any (cmd `isPrefixOf`) ["accounts","balance"] = showModeHelpOr accountsmode $ withJournalDo opts balance
| any (cmd `isPrefixOf`) ["entries","print"] = showModeHelpOr entriesmode $ withJournalDo opts print'
| any (cmd `isPrefixOf`) ["postings","register"] = showModeHelpOr postingsmode $ withJournalDo opts register
| any (cmd `isPrefixOf`) ["activity","histogram"] = showModeHelpOr activitymode $ withJournalDo opts histogram
| any (cmd `isPrefixOf`) ["incomestatement","is"] = showModeHelpOr incomestatementmode $ withJournalDo opts incomestatement
| any (cmd `isPrefixOf`) ["balancesheet","bs"] = showModeHelpOr balancesheetmode $ withJournalDo opts balancesheet
| any (cmd `isPrefixOf`) ["cashflow","cf"] = showModeHelpOr cashflowmode $ withJournalDo opts cashflow
| cmd `isPrefixOf` "stats" = showModeHelpOr statsmode $ withJournalDo opts stats
| not (null matchedaddon) = do
when (debug_ opts) $ printf "running %s\n" shellcmd
system shellcmd >>= exitWith
| cmd == "convert" = optserror ("convert is no longer needed, just use -f FILE.csv") >> exitFailure
| otherwise = optserror ("command "++cmd++" is not recognized") >> exitFailure
where
-- select an action and run it.
let
cmd = command_ opts -- the full matched internal or external command name, if any
isInternalCommand = not (null cmd) && not (cmd `elem` addons) -- probably
isExternalCommand = not (null cmd) && cmd `elem` addons -- probably
isBadCommand = not (null rawcmd) && null cmd
hasHelp args = any (`elem` args) ["--help","-h","-?"]
hasVersion = ("--version" `elem`)
mainmode' = mainmode addons
showModeHelpOr mode f | "help" `in_` (rawopts_ opts) = putStr $ showModeHelp mode
| otherwise = f
matchedaddon | null cmd = ""
| otherwise = headDef "" $ filter (cmd `isPrefixOf`) addons
shellcmd = printf "%s-%s %s" progname matchedaddon (unwords' subcmdargs)
subcmdargs = args1 ++ drop 1 args2 where (args1,args2) = break (== cmd) $ filter (/="--") args
generalHelp = putStr $ showModeHelp mainmode'
version = putStrLn prognameandversion
badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure
f `orShowHelp` mode = if hasHelp args then putStr (showModeHelp mode) else f
when (debug_ opts) $ do
putStrLn $ "processed opts:\n" ++ show opts
putStrLn . show =<< pprint opts
d <- getCurrentDay
putStrLn $ "search query: " ++ (show $ queryFromOpts d $ reportopts_ opts)
putStrLn $ "command matched: " ++ show cmd
putStrLn $ "isNullCommand: " ++ show isNullCommand
putStrLn $ "isInternalCommand: " ++ show isInternalCommand
putStrLn $ "isExternalCommand: " ++ show isExternalCommand
putStrLn $ "isBadCommand: " ++ show isBadCommand
let
dbg s = if debug_ opts then trace s else id
runHledgerCommand
-- high priority flags and situations. --help should be highest priority.
| hasHelp argsbeforecmd = dbg "--help before command, showing general help" generalHelp
| not (hasHelp argsaftercmd) && (hasVersion argsbeforecmd || (hasVersion argsaftercmd && isInternalCommand))
= version
-- \| (null externalcmd) && "binary-filename" `inRawOpts` rawopts = putStrLn $ binaryfilename progname
-- \| "--browse-args" `elem` args = System.Console.CmdArgs.Helper.execute "cmdargs-browser" mainmode' args >>= (putStr . show)
| isNullCommand = dbg "no command, showing general help" generalHelp
| isBadCommand = badCommandError
{- tests:
-- internal commands
| cmd == "activity" = withJournalDo opts histogram `orShowHelp` activitymode
| cmd == "add" = (journalFilePathFromOpts opts >>= ensureJournalFileExists >> withJournalDo opts add) `orShowHelp` addmode
| cmd == "balance" = withJournalDo opts balance `orShowHelp` balancemode
| cmd == "balancesheet" = withJournalDo opts balancesheet `orShowHelp` balancesheetmode
| cmd == "cashflow" = withJournalDo opts cashflow `orShowHelp` cashflowmode
| cmd == "incomestatement" = withJournalDo opts incomestatement `orShowHelp` incomestatementmode
| cmd == "print" = withJournalDo opts print' `orShowHelp` printmode
| cmd == "register" = withJournalDo opts register `orShowHelp` registermode
| cmd == "stats" = withJournalDo opts stats `orShowHelp` statsmode
| cmd == "test" = test' opts `orShowHelp` testmode
-- an external command
| isExternalCommand = do
let shellcmd = printf "%s-%s %s" progname cmd (unwords' argsaftercmd)
when (debug_ opts) $ do
printf "external command selected: %s\n" cmd
printf "external command arguments: %s\n" (show argsaftercmd)
printf "running shell command: %s\n" (show shellcmd)
system shellcmd >>= exitWith
-- deprecated commands
| cmd == "convert" = error' (modeHelp convertmode) >> exitFailure
-- shouldn't reach here
| otherwise = optserror ("could not understand the arguments "++show args) >> exitFailure
runHledgerCommand
-- tests_runHledgerCommand = [
-- -- "runHledgerCommand" ~: do
-- -- let opts = defreportopts{query_="expenses"}
-- -- d <- getCurrentDay
-- -- runHledgerCommand addons opts@CliOpts{command_=cmd} args
-- ]
hledger -> main help
hledger --help -> main help
hledger --help command -> command help
hledger command --help -> command help
hledger badcommand -> unrecognized command, try --help (non-zero exit)
hledger badcommand --help -> main help
hledger --help badcommand -> main help
hledger --mainflag command -> works
hledger command --mainflag -> works
hledger command --commandflag -> works
hledger command --mainflag --commandflag -> works
XX hledger --mainflag command --commandflag -> works
XX hledger --commandflag command -> works
XX hledger --commandflag command --mainflag -> works
-}

View File

@ -1,13 +1,71 @@
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DeriveDataTypeable #-}
{-|
Command-line options for the hledger program, and option-parsing utilities.
Command-line options for the hledger program, and related utilities.
-}
module Hledger.Cli.Options
module Hledger.Cli.Options (
-- * cmdargs modes
-- | These tell cmdargs how to parse the command line arguments.
-- There's one mode for each internal subcommand, plus a main mode.
mainmode,
activitymode,
addmode,
balancemode,
balancesheetmode,
cashflowmode,
incomestatementmode,
printmode,
registermode,
statsmode,
testmode,
convertmode,
-- * raw options
-- | To allow the cmdargs modes to be reused and extended by other
-- packages (eg, add-ons which want to mimic the standard hledger
-- options), we parse the command-line arguments to a simple
-- association list, not a fixed ADT.
RawOpts,
inRawOpts,
-- * CLI options
-- | Raw options are converted to a more convenient,
-- package-specific options structure. This is the \"opts\" used
-- throughout hledger CLI code.
CliOpts(..),
defcliopts,
toCliOpts,
-- * CLI option accessors
-- | Some options require more processing. Possibly these should be merged into toCliOpts.
aliasesFromOpts,
formatFromOpts,
journalFilePathFromOpts,
rulesFilePathFromOpts,
OutputWidth(..),
Width(..),
defaultWidth,
defaultWidthWithFlag,
widthFromOpts,
-- * utilities
getHledgerAddonCommands,
getHledgerCliOpts,
moveFlagsAfterCommand,
optserror,
showModeHelp,
-- * tests
tests_Hledger_Cli_Options
)
where
import qualified Control.Exception as C
-- import Control.Monad (filterM)
import Data.List
import Data.List.Split
import Data.Maybe
@ -27,108 +85,32 @@ import Hledger.Data.FormatStrings as Format
import Hledger.Cli.Version
-- 1. cmdargs mode and flag definitions, for the main and subcommand modes.
-- Flag values are parsed initially to a simple association list to allow reuse.
type RawOpts = [(String,String)]
defmode :: Mode RawOpts
defmode = Mode {
modeNames = []
,modeHelp = ""
,modeHelpSuffix = []
,modeValue = []
,modeCheck = Right
,modeReform = const Nothing
,modeExpandAt = True
,modeGroupFlags = toGroup []
,modeArgs = ([], Nothing)
,modeGroupModes = toGroup []
}
mainmode addons = defmode {
modeNames = [progname]
,modeHelp = "run the specified hledger command. hledger COMMAND --help for more detail. \nIn general, COMMAND should precede OPTIONS."
,modeHelpSuffix = [""]
,modeGroupFlags = Group {
groupUnnamed = helpflags
,groupHidden = [flagNone ["binary-filename"] (setboolopt "binary-filename") "show the download filename for this executable, and exit"]
++ fileflags -- quietly permit these flags before COMMAND as well
,groupNamed = []
}
,modeArgs = ([], Just mainargsflag)
,modeGroupModes = Group {
groupUnnamed = [
]
,groupHidden = [
convertmode
]
,groupNamed = [
("Misc commands", [
addmode
,testmode
])
,("\nReport commands", [
accountsmode
,entriesmode
,postingsmode
-- ,transactionsmode
,activitymode
,incomestatementmode
,balancesheetmode
,cashflowmode
,statsmode
])
]
++ case addons of [] -> []
cs -> [("\nAdd-on commands found", map addonmode cs)]
}
}
-- backwards compatibility - allow cmdargs to recognise this command so we can detect and warn
convertmode = (commandmode ["convert"]) {
modeValue = [("command","convert")]
,modeHelp = ""
,modeArgs = ([], Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "[CSVFILE]")
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = []
}
}
--
-- 1. cmdargs mode and flag (option) definitions for the hledger CLI,
-- can be reused by other packages as well.
--
addonmode name = defmode {
modeNames = [name]
,modeHelp = printf "[-- OPTIONS] run the %s-%s program" progname name
,modeValue=[("command",name)]
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
}
,modeArgs = ([], Just addonargsflag)
}
-- | Our cmdargs modes parse arguments into an association list for better reuse.
type RawOpts = [(String,String)]
help_postscript = [
-- "DATES can be Y/M/D or smart dates like \"last month\"."
-- ,"PATTERNS are regular"
-- ,"expressions which filter by account name. Prefix a pattern with desc: to"
-- ,"filter by transaction description instead, prefix with not: to negate it."
-- ,"When using both, not: comes last."
-- common flags and flag groups
-- | Common help flags: --help, --debug, --version...
helpflags = [
flagNone ["help","h","?"] (setboolopt "help") "Display general help or (with --help after COMMAND) command help."
-- ,flagNone ["browse-args"] (setboolopt "browse-args") "use a web UI to select options and build up a command line"
,flagNone ["debug"] (setboolopt "debug") "Show extra debug output"
,flagNone ["version","V"] (setboolopt "version") "Print version information"
]
generalflagstitle = "\nGeneral flags"
generalflags1 = fileflags ++ reportflags ++ helpflags
generalflags2 = fileflags ++ helpflags
generalflags3 = helpflags
fileflags = [
-- | Common input-related flags: --file, --rules-file, --alias...
inputflags = [
flagReq ["file","f"] (\s opts -> Right $ setopt "file" s opts) "FILE" "use a different journal file; - means stdin"
,flagReq ["rules-file"] (\s opts -> Right $ setopt "rules-file" s opts) "RULESFILE" "conversion rules for CSV (default: FILE.rules)"
,flagReq ["alias"] (\s opts -> Right $ setopt "alias" s opts) "ACCT=ALIAS" "display ACCT's name as ALIAS in reports"
]
-- | Common report-related flags: --period, --cost, --display etc.
reportflags = [
flagReq ["begin","b"] (\s opts -> Right $ setopt "begin" s opts) "DATE" "report on transactions on or after this date"
,flagReq ["end","e"] (\s opts -> Right $ setopt "end" s opts) "DATE" "report on transactions before this date"
@ -148,44 +130,145 @@ reportflags = [
,flagNone ["real","R"] (\opts -> setboolopt "real" opts) "report only on real (non-virtual) transactions"
]
helpflags = [
flagHelpSimple (setboolopt "help")
,flagNone ["debug"] (setboolopt "debug") "Show extra debug output"
,flagVersion (setboolopt "version")
argsFlag desc = flagArg (\s opts -> Right $ setopt "args" s opts) desc
generalflagstitle = "\nGeneral flags"
generalflagsgroup1 = (generalflagstitle, inputflags ++ reportflags ++ helpflags)
generalflagsgroup2 = (generalflagstitle, inputflags ++ helpflags)
generalflagsgroup3 = (generalflagstitle, helpflags)
-- | Template for creating our modes.
defMode :: Mode RawOpts
defMode = Mode {
modeNames = []
,modeHelp = ""
,modeHelpSuffix = []
,modeValue = []
,modeCheck = Right
,modeReform = const Nothing
,modeExpandAt = True
,modeGroupFlags = toGroup []
,modeArgs = ([], Nothing)
,modeGroupModes = toGroup []
}
-- | The top-level cmdargs mode for hledger.
mainmode addons = defMode {
modeNames = [progname]
,modeHelp = unlines [
"run the specified hledger command. Commands:"
]
,modeHelpSuffix = [""]
,modeArgs = ([], Just $ argsFlag "[ARGS]")
,modeGroupModes = Group {
-- modes (commands) in named groups:
groupNamed = [
("Adding data", [
addmode
])
,("\nBasic reports", [
printmode
,balancemode
,registermode
-- ,transactionsmode
])
,("\nMore reports", [
activitymode
,incomestatementmode
,balancesheetmode
,cashflowmode
,statsmode
])
,("\nMiscellaneous", [
testmode
])
]
++ case addons of [] -> []
cs -> [("\nAdd-on commands found", map defAddonCommandMode cs)]
-- modes in the unnamed group, shown first without a heading:
,groupUnnamed = [
]
-- modes handled but not shown
,groupHidden = [
convertmode
]
}
,modeGroupFlags = Group {
-- flags in named groups:
groupNamed = [generalflagsgroup3]
-- flags in the unnamed group, shown last without a heading:
,groupUnnamed = []
-- flags accepted but not shown in the help:
,groupHidden = inputflags -- included here so they'll not raise a confusing error if present with no COMMAND
}
}
mainargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) ""
commandargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) "[PATTERNS]"
addonargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) "[ARGS]"
-- help_postscript = [
-- -- "DATES can be Y/M/D or smart dates like \"last month\"."
-- -- ,"PATTERNS are regular"
-- -- ,"expressions which filter by account name. Prefix a pattern with desc: to"
-- -- ,"filter by transaction description instead, prefix with not: to negate it."
-- -- ,"When using both, not: comes last."
-- ]
commandmode names = defmode {modeNames=names, modeValue=[("command",headDef "" names)]}
--
-- cmdargs modes for subcommands
--
addmode = (commandmode ["add"]) {
modeHelp = "prompt for new transactions and append them to the journal"
-- | Make a basic command mode given the command's name and any aliases.
defCommandMode names = defMode {
modeNames=names
,modeValue=[("command", headDef "" names)]
,modeArgs = ([], Just $ argsFlag "[PATTERNS]")
}
-- | Make a basic command mode suitable for an add-on command.
defAddonCommandMode addon = defMode {
modeNames = [addon]
,modeHelp = printf "run %s-%s" progname addon
,modeValue=[("command",addon)]
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [generalflagsgroup1]
}
,modeArgs = ([], Just $ argsFlag "[ARGS]")
}
withAliases :: String -> [String] -> String
s `withAliases` [] = s
s `withAliases` (a:[]) = s ++ " (alias: " ++ a ++ ")"
s `withAliases` as = s ++ " (aliases: " ++ intercalate ", " as ++ ")"
-- hidden commands
convertmode = (defCommandMode ["convert"]) {
modeValue = [("command","convert")]
,modeHelp = "convert is no longer needed, just use -f FILE.csv"
,modeArgs = ([], Just $ argsFlag "[CSVFILE]")
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = helpflags
,groupNamed = []
}
}
-- visible commands
addmode = (defCommandMode ["add"]) {
modeHelp = "prompt for new transaction entries and add them to the journal"
,modeHelpSuffix = ["Defaults come from previous similar transactions; use query patterns to restrict these."]
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group {
groupUnnamed = [
flagNone ["no-new-accounts"] (\opts -> setboolopt "no-new-accounts" opts) "don't allow creating new accounts"
]
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags2)]
,groupNamed = [generalflagsgroup2]
}
}
testmode = (commandmode ["test"]) {
modeHelp = "run self-tests, or just the ones matching REGEXPS"
,modeArgs = ([], Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "[REGEXPS]")
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags3)]
}
}
accountsmode = (commandmode ["balance","bal","accounts"]) {
modeHelp = "(or accounts) show matched accounts and their balances"
,modeArgs = ([], Just commandargsflag)
balancemode = (defCommandMode $ ["balance"] ++ aliases) {
modeHelp = "show matched accounts and their balances" `withAliases` aliases
,modeGroupFlags = Group {
groupUnnamed = [
flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show full account names, unindented"
@ -195,23 +278,23 @@ accountsmode = (commandmode ["balance","bal","accounts"]) {
,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total"
]
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
,groupNamed = [generalflagsgroup1]
}
}
where aliases = ["b","bal"]
entriesmode = (commandmode ["print","entries"]) {
modeHelp = "(or entries) show matched journal entries"
,modeArgs = ([], Just commandargsflag)
printmode = (defCommandMode $ ["print"] ++ aliases) {
modeHelp = "show matched journal entries" `withAliases` aliases
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
,groupNamed = [generalflagsgroup1]
}
}
where aliases = ["p"]
postingsmode = (commandmode ["register","postings"]) {
modeHelp = "(or postings) show matched postings and running total"
,modeArgs = ([], Just commandargsflag)
registermode = (defCommandMode $ ["register"] ++ aliases) {
modeHelp = "show matched postings and running total" `withAliases` aliases
,modeGroupFlags = Group {
groupUnnamed = [
flagOpt (show defaultWidthWithFlag) ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N" "increase or set the output width (default: 80)"
@ -219,74 +302,85 @@ postingsmode = (commandmode ["register","postings"]) {
,flagNone ["related","r"] (\opts -> setboolopt "related" opts) "show the other postings in the transactions of those that would have been shown"
]
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
,groupNamed = [generalflagsgroup1]
}
}
where aliases = ["r","reg"]
transactionsmode = (commandmode ["transactions"]) {
modeHelp = "show matched transactions and balance in some account(s)"
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
}
}
-- transactionsmode = (defCommandMode ["transactions"]) {
-- modeHelp = "show matched transactions and balance in some account(s)"
-- ,modeGroupFlags = Group {
-- groupUnnamed = []
-- ,groupHidden = []
-- ,groupNamed = [generalflagsgroup1]
-- }
-- }
activitymode = (commandmode ["activity","histogram"]) {
activitymode = (defCommandMode ["activity"]) {
modeHelp = "show a barchart of transactions per interval"
,modeHelpSuffix = ["The default interval is daily."]
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
,groupNamed = [generalflagsgroup1]
}
}
incomestatementmode = (commandmode ["incomestatement","is"]) {
modeHelp = "show a standard income statement"
,modeArgs = ([], Just commandargsflag)
incomestatementmode = (defCommandMode $ ["incomestatement"]++aliases) {
modeHelp = "show a simple income statement" `withAliases` aliases
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
,groupNamed = [generalflagsgroup1]
}
}
where aliases = ["is","pl"]
balancesheetmode = (commandmode ["balancesheet","bs"]) {
modeHelp = "show a standard balance sheet"
,modeArgs = ([], Just commandargsflag)
balancesheetmode = (defCommandMode $ ["balancesheet"]++aliases) {
modeHelp = "show a simple balance sheet" `withAliases` aliases
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
,groupNamed = [generalflagsgroup1]
}
}
where aliases = ["bs"]
cashflowmode = (commandmode ["cashflow","cf"]) {
modeHelp = "show a simple cashflow statement"
,modeArgs = ([], Just commandargsflag)
cashflowmode = (defCommandMode ["cashflow","cf"]) {
modeHelp = "show a simple cashflow statement" `withAliases` ["cf"]
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
,groupNamed = [generalflagsgroup1]
}
}
statsmode = (commandmode ["stats"]) {
modeHelp = "show quick statistics for a journal (or part of it)"
,modeArgs = ([], Just commandargsflag)
statsmode = (defCommandMode $ ["stats"] ++ aliases) {
modeHelp = "show quick statistics for a journal" `withAliases` aliases
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
,groupNamed = [generalflagsgroup1]
}
}
where aliases = ["s"]
testmode = (defCommandMode ["test"]) {
modeHelp = "run self-tests, or just the ones matching REGEXPS"
,modeArgs = ([], Just $ argsFlag "[REGEXPS]")
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [generalflagsgroup3]
}
}
-- 2. ADT holding options used in this package and above, parsed from RawOpts.
-- This represents the command-line options that were provided, with all
-- parsing completed, but before adding defaults or derived values (XXX add)
--
-- 2. A package-specific data structure holding options used in this
-- package and above, parsed from RawOpts. This represents the
-- command-line options that were provided, with all parsing
-- completed, but before adding defaults or derived values (XXX add)
--
-- cli options, used in hledger and above
data CliOpts = CliOpts {
@ -299,7 +393,7 @@ data CliOpts = CliOpts {
,no_new_accounts_ :: Bool -- add
,width_ :: Maybe String -- register
,reportopts_ :: ReportOpts
} deriving (Show)
} deriving (Show, Data, Typeable)
defcliopts = CliOpts
def
@ -357,11 +451,59 @@ toCliOpts rawopts = do
}
}
-- | Get all command-line options, specifying any extra commands that are allowed, or fail on parse errors.
-- | Parse hledger CLI options from the command line arguments and
-- specified add-on command names, or raise any error.
getHledgerCliOpts :: [String] -> IO CliOpts
getHledgerCliOpts addons = do
args <- getArgs
toCliOpts (decodeRawOpts $ processValue (mainmode addons) $ rearrangeForCmdArgs args) >>= checkCliOpts
let
args' = moveFlagsAfterCommand args
cmdargsopts = System.Console.CmdArgs.Explicit.processValue (mainmode addons) args'
cmdargsopts' = decodeRawOpts cmdargsopts
toCliOpts cmdargsopts' >>= checkCliOpts
-- | A hacky workaround for cmdargs not accepting flags before the
-- subcommand name: try to detect and move such flags after the
-- command. This allows the user to put them in either position.
-- The order of options is not preserved, but this should be ok.
--
-- Since we're not parsing flags as precisely as cmdargs here, this is
-- imperfect. We make a decent effort to:
-- - move all no-argument help and input flags
-- - move all required-argument help and input flags along with their values, space-separated or not
-- - not confuse things further or cause misleading errors.
moveFlagsAfterCommand :: [String] -> [String]
moveFlagsAfterCommand args = move args
where
move (f:a:as) | isMovableNoArgFlag f = (move $ a:as) ++ [f]
move (f:v:a:as) | isMovableReqArgFlag f = (move $ a:as) ++ [f,v]
move (fv:a:as) | isMovableReqArgFlagAndValue fv = (move $ a:as) ++ [fv]
move as = as
isMovableNoArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` noargflagstomove
isMovableReqArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` reqargflagstomove
isMovableReqArgFlagAndValue ('-':'-':a:as) = case break (== '=') (a:as) of (f:fs,_) -> (f:fs) `elem` reqargflagstomove
_ -> False
isMovableReqArgFlagAndValue ('-':f:_:_) = [f] `elem` reqargflagstomove
isMovableReqArgFlagAndValue _ = False
noargflagstomove = concatMap flagNames $ filter ((==FlagNone).flagInfo) flagstomove
reqargflagstomove = concatMap flagNames $ filter ((==FlagReq ).flagInfo) flagstomove
flagstomove = inputflags ++ helpflags
-- | Convert possibly encoded option values to regular unicode strings.
decodeRawOpts = map (\(name,val) -> (name, fromSystemString val))
-- | Do final validation of processed opts, raising an error if there is trouble.
checkCliOpts :: CliOpts -> IO CliOpts -- or pure..
checkCliOpts opts@CliOpts{reportopts_=ropts} = do
case formatFromOpts ropts of
Left err -> optserror $ "could not parse format option: "++err
Right _ -> return ()
case widthFromOpts opts of
Left err -> optserror $ "could not parse width option: "++err
Right _ -> return ()
return opts
-- utils
@ -369,41 +511,43 @@ getHledgerCliOpts addons = do
-- found in the current user's PATH, or the empty list if there is any
-- problem.
getHledgerAddonCommands :: IO [String]
getHledgerAddonCommands = map (drop (length progname + 1)) `fmap` getHledgerProgramsInPath
getHledgerAddonCommands = map (drop (length progname + 1)) `fmap` getHledgerExesInPath
-- | Get the unique names of hledger-* executables found in the current
-- | Get the unique names of hledger-*{,.hs} executables found in the current
-- user's PATH, or the empty list if there is any problem.
getHledgerProgramsInPath :: IO [String]
getHledgerProgramsInPath = do
getHledgerExesInPath :: IO [String]
getHledgerExesInPath = do
pathdirs <- splitOn ":" `fmap` getEnvSafe "PATH"
pathexes <- concat `fmap` mapM getDirectoryContentsSafe pathdirs
return $ nub $ sort $ filter (isRight . parsewith hledgerprog) pathexes
where
hledgerprog = string progname >> char '-' >> many1 (letter <|> char '-') >> eof
pathfiles <- concat `fmap` mapM getDirectoryContentsSafe pathdirs
let hledgernamed = nub $ sort $ filter isHledgerNamed pathfiles
-- hledgerexes <- filterM isExecutable hledgernamed
return hledgernamed
-- isExecutable f = getPermissions f >>= (return . executable)
isHledgerNamed = isRight . parsewith (do
string progname
char '-'
many1 (letter <|> char '-')
optional $ (string ".hs" <|> string ".lhs")
eof
)
getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "")
getDirectoryContentsSafe d = getDirectoryContents d `C.catch` (\(_::C.IOException) -> return [])
-- | Convert possibly encoded option values to regular unicode strings.
decodeRawOpts = map (\(name,val) -> (name, fromSystemString val))
-- A hacky workaround for http://code.google.com/p/ndmitchell/issues/detail?id=470 :
-- we'd like to permit options before COMMAND as well as after it.
-- Here we make sure at least -f FILE will be accepted in either position.
rearrangeForCmdArgs (fopt@('-':'f':_:_):cmd:rest) = cmd:fopt:rest
rearrangeForCmdArgs ("-f":fval:cmd:rest) = cmd:"-f":fval:rest
rearrangeForCmdArgs as = as
-- | Raise an error, showing the specified message plus a hint about --help.
optserror = error' . (++ " (run with --help for usage)")
setopt name val = (++ [(name,singleQuoteIfNeeded val)])
setboolopt name = (++ [(name,"")])
in_ :: String -> RawOpts -> Bool
in_ name = isJust . lookup name
-- | Is the named option present ?
inRawOpts :: String -> RawOpts -> Bool
inRawOpts name = isJust . lookup name
boolopt = in_
boolopt = inRawOpts
maybestringopt name = maybe Nothing (Just . stripquotes) . lookup name
@ -444,17 +588,6 @@ maybeperiodopt d rawopts =
Just
$ parsePeriodExpr d s
-- | Do final validation of processed opts, raising an error if there is trouble.
checkCliOpts :: CliOpts -> IO CliOpts -- or pure..
checkCliOpts opts@CliOpts{reportopts_=ropts} = do
case formatFromOpts ropts of
Left err -> optserror $ "could not parse format option: "++err
Right _ -> return ()
case widthFromOpts opts of
Left err -> optserror $ "could not parse width option: "++err
Right _ -> return ()
return opts
-- | Parse the format option if provided, possibly returning an error,
-- otherwise get the default value.
formatFromOpts :: ReportOpts -> Either String [FormatString]
@ -469,10 +602,22 @@ defaultBalanceFormatString = [
, FormatField True Nothing Nothing AccountField
]
data OutputWidth = TotalWidth Width | FieldWidths [Width] deriving Show
data Width = Width Int | Auto deriving Show
-- | Output width configuration (for register).
data OutputWidth =
TotalWidth Width -- ^ specify the overall width
| FieldWidths [Width] -- ^ specify each field's width
deriving Show
-- | A width value.
data Width =
Width Int -- ^ set width to exactly this number of characters
| Auto -- ^ set width automatically from available space
deriving Show
-- | Default width of hledger console output.
defaultWidth = 80
-- | Width of hledger console output when the -w flag is used with no value.
defaultWidthWithFlag = 120
-- | Parse the width option if provided, possibly returning an error,
@ -483,34 +628,22 @@ widthFromOpts CliOpts{width_=Just ""} = Right $ TotalWidth $ Width defaultWidthW
widthFromOpts CliOpts{width_=Just s} = parseWidth s
parseWidth :: String -> Either String OutputWidth
parseWidth s = case (runParser outputwidth () "(unknown)") s of
parseWidth s = case (runParser outputwidthp () "(unknown)") s of
Left e -> Left $ show e
Right x -> Right x
outputwidth :: GenParser Char st OutputWidth
outputwidth =
try (do w <- width
ws <- many1 (char ',' >> width)
outputwidthp :: GenParser Char st OutputWidth
outputwidthp =
try (do w <- widthp
ws <- many1 (char ',' >> widthp)
return $ FieldWidths $ w:ws)
<|> TotalWidth `fmap` width
<|> TotalWidth `fmap` widthp
width :: GenParser Char st Width
width = (string "auto" >> return Auto)
widthp :: GenParser Char st Width
widthp = (string "auto" >> return Auto)
<|> (Width . read) `fmap` many1 digit
-- | Get the (tilde-expanded, absolute) journal file path from options, an environment variable, or a default.
journalFilePathFromOpts :: CliOpts -> IO String
journalFilePathFromOpts opts = do
f <- defaultJournalPath
d <- getCurrentDirectory
expandPath d $ fromMaybe f $ file_ opts
-- | Get the (tilde-expanded) rules file path from options, if any.
rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath)
rulesFilePathFromOpts opts = do
d <- getCurrentDirectory
maybe (return Nothing) (fmap Just . expandPath d) $ rules_file_ opts
-- | Get the account name aliases from options, if any.
aliasesFromOpts :: CliOpts -> [(AccountName,AccountName)]
aliasesFromOpts = map parseAlias . alias_
where
@ -523,12 +656,28 @@ aliasesFromOpts = map parseAlias . alias_
alias' = case alias of ('=':rest) -> rest
_ -> orig
-- | Get the (tilde-expanded, absolute) journal file path from
-- 1. options, 2. an environment variable, or 3. the default.
journalFilePathFromOpts :: CliOpts -> IO String
journalFilePathFromOpts opts = do
f <- defaultJournalPath
d <- getCurrentDirectory
expandPath d $ fromMaybe f $ file_ opts
-- | Get the (tilde-expanded) rules file path from options, if any.
rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath)
rulesFilePathFromOpts opts = do
d <- getCurrentDirectory
maybe (return Nothing) (fmap Just . expandPath d) $ rules_file_ opts
-- | Get a mode's help message as a nicely wrapped string.
showModeHelp :: Mode a -> String
showModeHelp =
(showText defaultWrap :: [Text] -> String)
.
(helpText [] HelpFormatDefault :: Mode a -> [Text])
tests_Hledger_Cli_Options = TestList
[
]

137
tests/command-line.test Normal file
View File

@ -0,0 +1,137 @@
# hledger command line processing
#
# Quick guide to terms used here:
#
# - flag: generally a synonym for option. Or sometimes, just the first
# part of an option: a hyphen followed by a letter (short flag) or a
# word (long flag).
#
# - option: a command modifier. An option consists of a short flag, a
# long flag, or both, and possibly an optional or required value.
# Each option has some effect on program execution, and is described
# in the command line help.
#
# - argument:
# - raw command line arguments: everything following the program
# name on the command line, ie what is returned by getArgs
# - parsed arguments: all raw command line arguments that are not
# options (flags or values).
# - (sub)command arguments: all parsed arguments except the first
# (which is the subcommand's name)
#
# - RawOpts: the command, options and arguments as parsed by cmdargs,
# as an assocation list. Eg:
# [("command","register"),("args","a"),("debug",""),("help","")]
#
# - CliOpts: the command, options and arguments from cmdargs, plus
# additional cleanup, in a more convenient data structure used
# throughout the hledger CLI code.
#
# - command:
# - command line, shell command: what you type in the shell/terminal window to start a program
# - hledger command, subcommand: one of hledger's several modes of operation,
# usually selected by the first command-line argument that isn't an option.
# Commands are listed in the general command line help. There are two kinds:
# - internal commands: built in to the main hledger executable
# - external commands, or add-ons: any other hledger-* executables in the users's PATH
#
# Description of existing/expected behaviour as of 2013/9/16:
#
# - general usage is hledger [COMMAND] [OPTIONS] [ARGS]
#
# - commands are internal (built in to the main hledger executable) or external (any hledger-* executables found in the PATH)
# - some internal commands have aliases, which are displayed in the general help
# - there are also a few hidden internal commands
# - COMMAND is an exact command or alias name, or any unique prefix of one (eg reg for register)
# - when COMMAND is a non-unique prefix, matching commands will be listed, including hidden ones (eg hledger c)
# - an unrecognised command shows an error and gives non-zero exit status
#
# - usually the command must come first, followed by options and arguments in any order
# - a few options may also go before the command: -f, --rules-file, --alias, --help, --version, --debug.
# - option flags may be written in full or as a unique prefix, eg --rules for --rules-file
# - if the command is external, options and arguments after the command are handled by that executable, not hledger
#
# - the --help flag has highest priority
# - --help before the command, or no command, shows general help, including available commands
# - --help after an internal command shows command-specific help, including command and general flags
# - there is no built-in "help" command
# - the --version flag has second highest priority, and shows the program version
# version
# 1. --version shows version
hledgerdev --version
>>> /^hledger [0-9]/
>>>=0
# 2. --version also works after a command, if it's internal
hledgerdev balance --version
>>> /^hledger [0-9]/
>>>=0
# help
# 3. with no command, show general help
hledgerdev
>>> /^hledger \[COMMAND\]/
>>>=0
# 4. no-command help still works if there are flags, at least the common ones
hledgerdev -fsomefile
>>> /^hledger \[COMMAND\]/
>>>=0
# 5. and also with a space between flag and value
hledgerdev -f somefile
>>> /^hledger \[COMMAND\]/
>>>=0
# 6. with --help, and possibly other common flags present, show general help
hledgerdev --help --version -f /dev/null
>>> /^hledger \[COMMAND\]/
>>>=0
# 7. with --help before COMMAND, show general help
hledgerdev --help balance --cost
>>> /^hledger \[COMMAND\]/
>>>=0
# 8. with --help after command, show command help
hledgerdev balance --help
>>> /^balance \[OPTIONS\]/
>>>=0
# 9. should work with deprecated commands too
hledgerdev convert --help
>>>
>>>2 /no longer needed/
>>>=1
# 10. with an unrecognised command, give general help and non-zero exit status
hledgerdev nosuchcommand
>>>
>>>2 /not recognized/
>>>=1
# flag positions
# 11. most flags can not go before command
hledgerdev --daily register
>>>
>>>2 /Unknown flag: --daily/
>>>=1
# 12. help and input flags can go before command
hledgerdev -f /dev/null --alias somealiases --rules-file -? -h --help --version --debug register --daily
>>> /^hledger \[COMMAND\]/
>>>=0
# 13. or after it, and spaces in options are optional
hledgerdev register -f/dev/null --alias=somealiases --rules-file -? -h --help --version --debug --daily
>>> /^register \[OPTIONS\]/
>>>=0
# 14. flags after and add-command are handled by the add-on
hledgerdev accountnames.hs --help
>>> /^assets$/
>>>=0