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 Most [commands](#commands) query or operate on a
[journal file](#the-journal-file), which by default is `.hledger.journal` [journal file](#the-journal-file), which by default is `.hledger.journal`
in your home directory. You can specify a different file with the `-f` 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 Options are similar across most commands, with some variations; use
`hledger COMMAND --help` for details. Most options must appear somewhere `hledger COMMAND --help` for details. Most options must appear
after COMMAND, not before it. The `-f` option can appear anywhere. 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 Arguments are also command-specific, but usually they form a
[query](#queries) which selects a subset of the journal, eg transactions [query](#queries) which selects a subset of the journal, eg transactions

View File

@ -6,6 +6,11 @@ title: hledger news
## unreleased ## 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 - print: comment positions (same line or next line) are now preserved
- register: `--average/-A` shows a running average, like ledger - register: `--average/-A` shows a running average, like ledger
- queries: `sym:REGEXP` matches commodity symbols - queries: `sym:REGEXP` matches commodity symbols

View File

@ -40,7 +40,10 @@ module Hledger.Cli.Main where
import Control.Monad import Control.Monad
import Data.List import Data.List
import Data.PPrint
import Safe import Safe
import System.Console.CmdArgs.Explicit (modeHelp)
-- import System.Console.CmdArgs.Helper
import System.Environment import System.Environment
import System.Exit import System.Exit
import System.Process import System.Process
@ -66,62 +69,109 @@ import Hledger.Data.Dates
main :: IO () main :: IO ()
main = do 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 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 addons <- getHledgerAddonCommands
-- parse arguments with cmdargs
opts <- getHledgerCliOpts addons opts <- getHledgerCliOpts addons
-- 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
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 when (debug_ opts) $ do
printf "%s\n" prognameandversion putStrLn $ "processed opts:\n" ++ show opts
printf "args: %s\n" (show args) putStrLn . show =<< pprint opts
printf "opts: %s\n" (show opts)
d <- getCurrentDay d <- getCurrentDay
printf "query: %s\n" (show $ queryFromOpts d $ reportopts_ opts) 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
run' opts addons args -- internal commands
where | cmd == "activity" = withJournalDo opts histogram `orShowHelp` activitymode
run' opts@CliOpts{command_=cmd} addons args | cmd == "add" = (journalFilePathFromOpts opts >>= ensureJournalFileExists >> withJournalDo opts add) `orShowHelp` addmode
-- delicate, add tests before changing (eg --version, ADDONCMD --version, INTERNALCMD --version) | cmd == "balance" = withJournalDo opts balance `orShowHelp` balancemode
| (null matchedaddon) && "version" `in_` (rawopts_ opts) = putStrLn prognameandversion | cmd == "balancesheet" = withJournalDo opts balancesheet `orShowHelp` balancesheetmode
| (null matchedaddon) && "binary-filename" `in_` (rawopts_ opts) = putStrLn $ binaryfilename progname | cmd == "cashflow" = withJournalDo opts cashflow `orShowHelp` cashflowmode
| null cmd = putStr $ showModeHelp mainmode' | cmd == "incomestatement" = withJournalDo opts incomestatement `orShowHelp` incomestatementmode
| cmd `isPrefixOf` "add" = showModeHelpOr addmode $ journalFilePathFromOpts opts >>= ensureJournalFileExists >> withJournalDo opts add | cmd == "print" = withJournalDo opts print' `orShowHelp` printmode
| cmd `isPrefixOf` "test" = showModeHelpOr testmode $ test' opts | cmd == "register" = withJournalDo opts register `orShowHelp` registermode
| any (cmd `isPrefixOf`) ["accounts","balance"] = showModeHelpOr accountsmode $ withJournalDo opts balance | cmd == "stats" = withJournalDo opts stats `orShowHelp` statsmode
| any (cmd `isPrefixOf`) ["entries","print"] = showModeHelpOr entriesmode $ withJournalDo opts print' | cmd == "test" = test' opts `orShowHelp` testmode
| 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
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
{- tests: -- 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 where
import qualified Control.Exception as C import qualified Control.Exception as C
-- import Control.Monad (filterM)
import Data.List import Data.List
import Data.List.Split import Data.List.Split
import Data.Maybe import Data.Maybe
@ -27,108 +85,32 @@ import Hledger.Data.FormatStrings as Format
import Hledger.Cli.Version 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. -- 1. cmdargs mode and flag (option) definitions for the hledger CLI,
-- can be reused by other packages as well.
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 = []
}
}
-- --
addonmode name = defmode { -- | Our cmdargs modes parse arguments into an association list for better reuse.
modeNames = [name] type RawOpts = [(String,String)]
,modeHelp = printf "[-- OPTIONS] run the %s-%s program" progname name
,modeValue=[("command",name)]
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
}
,modeArgs = ([], Just addonargsflag)
}
help_postscript = [ -- common flags and flag groups
-- "DATES can be Y/M/D or smart dates like \"last month\"."
-- ,"PATTERNS are regular" -- | Common help flags: --help, --debug, --version...
-- ,"expressions which filter by account name. Prefix a pattern with desc: to" helpflags = [
-- ,"filter by transaction description instead, prefix with not: to negate it." flagNone ["help","h","?"] (setboolopt "help") "Display general help or (with --help after COMMAND) command help."
-- ,"When using both, not: comes last." -- ,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" -- | Common input-related flags: --file, --rules-file, --alias...
generalflags1 = fileflags ++ reportflags ++ helpflags inputflags = [
generalflags2 = fileflags ++ helpflags
generalflags3 = helpflags
fileflags = [
flagReq ["file","f"] (\s opts -> Right $ setopt "file" s opts) "FILE" "use a different journal file; - means stdin" 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 ["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" ,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 = [ reportflags = [
flagReq ["begin","b"] (\s opts -> Right $ setopt "begin" s opts) "DATE" "report on transactions on or after this date" 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" ,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" ,flagNone ["real","R"] (\opts -> setboolopt "real" opts) "report only on real (non-virtual) transactions"
] ]
helpflags = [ argsFlag desc = flagArg (\s opts -> Right $ setopt "args" s opts) desc
flagHelpSimple (setboolopt "help")
,flagNone ["debug"] (setboolopt "debug") "Show extra debug output"
,flagVersion (setboolopt "version")
]
mainargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) "" generalflagstitle = "\nGeneral flags"
commandargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) "[PATTERNS]" generalflagsgroup1 = (generalflagstitle, inputflags ++ reportflags ++ helpflags)
addonargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) "[ARGS]" generalflagsgroup2 = (generalflagstitle, inputflags ++ helpflags)
generalflagsgroup3 = (generalflagstitle, helpflags)
commandmode names = defmode {modeNames=names, modeValue=[("command",headDef "" names)]} -- | 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 []
}
addmode = (commandmode ["add"]) { -- | The top-level cmdargs mode for hledger.
modeHelp = "prompt for new transactions and append them to the journal" 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
}
}
-- 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."
-- ]
--
-- cmdargs modes for subcommands
--
-- | 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."] ,modeHelpSuffix = ["Defaults come from previous similar transactions; use query patterns to restrict these."]
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group { ,modeGroupFlags = Group {
groupUnnamed = [ groupUnnamed = [
flagNone ["no-new-accounts"] (\opts -> setboolopt "no-new-accounts" opts) "don't allow creating new accounts" flagNone ["no-new-accounts"] (\opts -> setboolopt "no-new-accounts" opts) "don't allow creating new accounts"
] ]
,groupHidden = [] ,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags2)] ,groupNamed = [generalflagsgroup2]
} }
} }
testmode = (commandmode ["test"]) { balancemode = (defCommandMode $ ["balance"] ++ aliases) {
modeHelp = "run self-tests, or just the ones matching REGEXPS" modeHelp = "show matched accounts and their balances" `withAliases` aliases
,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)
,modeGroupFlags = Group { ,modeGroupFlags = Group {
groupUnnamed = [ groupUnnamed = [
flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show full account names, unindented" 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" ,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total"
] ]
,groupHidden = [] ,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)] ,groupNamed = [generalflagsgroup1]
} }
} }
where aliases = ["b","bal"]
entriesmode = (commandmode ["print","entries"]) { printmode = (defCommandMode $ ["print"] ++ aliases) {
modeHelp = "(or entries) show matched journal entries" modeHelp = "show matched journal entries" `withAliases` aliases
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group { ,modeGroupFlags = Group {
groupUnnamed = [] groupUnnamed = []
,groupHidden = [] ,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)] ,groupNamed = [generalflagsgroup1]
} }
} }
where aliases = ["p"]
postingsmode = (commandmode ["register","postings"]) { registermode = (defCommandMode $ ["register"] ++ aliases) {
modeHelp = "(or postings) show matched postings and running total" modeHelp = "show matched postings and running total" `withAliases` aliases
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group { ,modeGroupFlags = Group {
groupUnnamed = [ groupUnnamed = [
flagOpt (show defaultWidthWithFlag) ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N" "increase or set the output width (default: 80)" 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" ,flagNone ["related","r"] (\opts -> setboolopt "related" opts) "show the other postings in the transactions of those that would have been shown"
] ]
,groupHidden = [] ,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)] ,groupNamed = [generalflagsgroup1]
} }
} }
where aliases = ["r","reg"]
transactionsmode = (commandmode ["transactions"]) { -- transactionsmode = (defCommandMode ["transactions"]) {
modeHelp = "show matched transactions and balance in some account(s)" -- modeHelp = "show matched transactions and balance in some account(s)"
,modeArgs = ([], Just commandargsflag) -- ,modeGroupFlags = Group {
,modeGroupFlags = Group { -- groupUnnamed = []
groupUnnamed = [] -- ,groupHidden = []
,groupHidden = [] -- ,groupNamed = [generalflagsgroup1]
,groupNamed = [(generalflagstitle, generalflags1)] -- }
} -- }
}
activitymode = (commandmode ["activity","histogram"]) { activitymode = (defCommandMode ["activity"]) {
modeHelp = "show a barchart of transactions per interval" modeHelp = "show a barchart of transactions per interval"
,modeHelpSuffix = ["The default interval is daily."] ,modeHelpSuffix = ["The default interval is daily."]
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group { ,modeGroupFlags = Group {
groupUnnamed = [] groupUnnamed = []
,groupHidden = [] ,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)] ,groupNamed = [generalflagsgroup1]
} }
} }
incomestatementmode = (commandmode ["incomestatement","is"]) { incomestatementmode = (defCommandMode $ ["incomestatement"]++aliases) {
modeHelp = "show a standard income statement" modeHelp = "show a simple income statement" `withAliases` aliases
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group { ,modeGroupFlags = Group {
groupUnnamed = [] groupUnnamed = []
,groupHidden = [] ,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)] ,groupNamed = [generalflagsgroup1]
} }
} }
where aliases = ["is","pl"]
balancesheetmode = (commandmode ["balancesheet","bs"]) { balancesheetmode = (defCommandMode $ ["balancesheet"]++aliases) {
modeHelp = "show a standard balance sheet" modeHelp = "show a simple balance sheet" `withAliases` aliases
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group { ,modeGroupFlags = Group {
groupUnnamed = [] groupUnnamed = []
,groupHidden = [] ,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)] ,groupNamed = [generalflagsgroup1]
} }
} }
where aliases = ["bs"]
cashflowmode = (commandmode ["cashflow","cf"]) { cashflowmode = (defCommandMode ["cashflow","cf"]) {
modeHelp = "show a simple cashflow statement" modeHelp = "show a simple cashflow statement" `withAliases` ["cf"]
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group { ,modeGroupFlags = Group {
groupUnnamed = [] groupUnnamed = []
,groupHidden = [] ,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)] ,groupNamed = [generalflagsgroup1]
} }
} }
statsmode = (commandmode ["stats"]) { statsmode = (defCommandMode $ ["stats"] ++ aliases) {
modeHelp = "show quick statistics for a journal (or part of it)" modeHelp = "show quick statistics for a journal" `withAliases` aliases
,modeArgs = ([], Just commandargsflag)
,modeGroupFlags = Group { ,modeGroupFlags = Group {
groupUnnamed = [] groupUnnamed = []
,groupHidden = [] ,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 -- 2. A package-specific data structure holding options used in this
-- parsing completed, but before adding defaults or derived values (XXX add) -- 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 -- cli options, used in hledger and above
data CliOpts = CliOpts { data CliOpts = CliOpts {
@ -299,7 +393,7 @@ data CliOpts = CliOpts {
,no_new_accounts_ :: Bool -- add ,no_new_accounts_ :: Bool -- add
,width_ :: Maybe String -- register ,width_ :: Maybe String -- register
,reportopts_ :: ReportOpts ,reportopts_ :: ReportOpts
} deriving (Show) } deriving (Show, Data, Typeable)
defcliopts = CliOpts defcliopts = CliOpts
def 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 :: [String] -> IO CliOpts
getHledgerCliOpts addons = do getHledgerCliOpts addons = do
args <- getArgs 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 -- utils
@ -369,41 +511,43 @@ getHledgerCliOpts addons = do
-- found in the current user's PATH, or the empty list if there is any -- found in the current user's PATH, or the empty list if there is any
-- problem. -- problem.
getHledgerAddonCommands :: IO [String] 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. -- user's PATH, or the empty list if there is any problem.
getHledgerProgramsInPath :: IO [String] getHledgerExesInPath :: IO [String]
getHledgerProgramsInPath = do getHledgerExesInPath = do
pathdirs <- splitOn ":" `fmap` getEnvSafe "PATH" pathdirs <- splitOn ":" `fmap` getEnvSafe "PATH"
pathexes <- concat `fmap` mapM getDirectoryContentsSafe pathdirs pathfiles <- concat `fmap` mapM getDirectoryContentsSafe pathdirs
return $ nub $ sort $ filter (isRight . parsewith hledgerprog) pathexes let hledgernamed = nub $ sort $ filter isHledgerNamed pathfiles
where -- hledgerexes <- filterM isExecutable hledgernamed
hledgerprog = string progname >> char '-' >> many1 (letter <|> char '-') >> eof 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 "") getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "")
getDirectoryContentsSafe d = getDirectoryContents d `C.catch` (\(_::C.IOException) -> return []) getDirectoryContentsSafe d = getDirectoryContents d `C.catch` (\(_::C.IOException) -> return [])
-- | Convert possibly encoded option values to regular unicode strings. -- | Raise an error, showing the specified message plus a hint about --help.
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
optserror = error' . (++ " (run with --help for usage)") optserror = error' . (++ " (run with --help for usage)")
setopt name val = (++ [(name,singleQuoteIfNeeded val)]) setopt name val = (++ [(name,singleQuoteIfNeeded val)])
setboolopt name = (++ [(name,"")]) setboolopt name = (++ [(name,"")])
in_ :: String -> RawOpts -> Bool -- | Is the named option present ?
in_ name = isJust . lookup name inRawOpts :: String -> RawOpts -> Bool
inRawOpts name = isJust . lookup name
boolopt = in_ boolopt = inRawOpts
maybestringopt name = maybe Nothing (Just . stripquotes) . lookup name maybestringopt name = maybe Nothing (Just . stripquotes) . lookup name
@ -444,17 +588,6 @@ maybeperiodopt d rawopts =
Just Just
$ parsePeriodExpr d s $ 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, -- | Parse the format option if provided, possibly returning an error,
-- otherwise get the default value. -- otherwise get the default value.
formatFromOpts :: ReportOpts -> Either String [FormatString] formatFromOpts :: ReportOpts -> Either String [FormatString]
@ -469,10 +602,22 @@ defaultBalanceFormatString = [
, FormatField True Nothing Nothing AccountField , FormatField True Nothing Nothing AccountField
] ]
data OutputWidth = TotalWidth Width | FieldWidths [Width] deriving Show -- | Output width configuration (for register).
data Width = Width Int | Auto deriving Show 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 defaultWidth = 80
-- | Width of hledger console output when the -w flag is used with no value.
defaultWidthWithFlag = 120 defaultWidthWithFlag = 120
-- | Parse the width option if provided, possibly returning an error, -- | 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 widthFromOpts CliOpts{width_=Just s} = parseWidth s
parseWidth :: String -> Either String OutputWidth 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 Left e -> Left $ show e
Right x -> Right x Right x -> Right x
outputwidth :: GenParser Char st OutputWidth outputwidthp :: GenParser Char st OutputWidth
outputwidth = outputwidthp =
try (do w <- width try (do w <- widthp
ws <- many1 (char ',' >> width) ws <- many1 (char ',' >> widthp)
return $ FieldWidths $ w:ws) return $ FieldWidths $ w:ws)
<|> TotalWidth `fmap` width <|> TotalWidth `fmap` widthp
width :: GenParser Char st Width widthp :: GenParser Char st Width
width = (string "auto" >> return Auto) widthp = (string "auto" >> return Auto)
<|> (Width . read) `fmap` many1 digit <|> (Width . read) `fmap` many1 digit
-- | Get the (tilde-expanded, absolute) journal file path from options, an environment variable, or a default. -- | Get the account name aliases from options, if any.
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
aliasesFromOpts :: CliOpts -> [(AccountName,AccountName)] aliasesFromOpts :: CliOpts -> [(AccountName,AccountName)]
aliasesFromOpts = map parseAlias . alias_ aliasesFromOpts = map parseAlias . alias_
where where
@ -523,12 +656,28 @@ aliasesFromOpts = map parseAlias . alias_
alias' = case alias of ('=':rest) -> rest alias' = case alias of ('=':rest) -> rest
_ -> orig _ -> 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 :: Mode a -> String
showModeHelp = showModeHelp =
(showText defaultWrap :: [Text] -> String) (showText defaultWrap :: [Text] -> String)
. .
(helpText [] HelpFormatDefault :: Mode a -> [Text]) (helpText [] HelpFormatDefault :: Mode a -> [Text])
tests_Hledger_Cli_Options = TestList 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