diff --git a/MANUAL.md b/MANUAL.md index f71568d15..10a9c7a1f 100644 --- a/MANUAL.md +++ b/MANUAL.md @@ -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 diff --git a/NEWS.md b/NEWS.md index 0d7cd4db8..e061adbf9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -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 diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index d15154eab..2bc92e5af 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -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 + + -- 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 - printf "%s\n" prognameandversion - printf "args: %s\n" (show args) - printf "opts: %s\n" (show opts) + putStrLn $ "processed opts:\n" ++ show opts + putStrLn . show =<< pprint opts 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 - 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 - 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 + -- 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 -{- 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 --} \ No newline at end of file diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index 95cf5dbae..ad3d9a5f5 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -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 -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]" +generalflagstitle = "\nGeneral flags" +generalflagsgroup1 = (generalflagstitle, inputflags ++ reportflags ++ helpflags) +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"]) { - modeHelp = "prompt for new transactions and append them to the journal" +-- | 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 + } + } + +-- 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."] - ,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 [ ] diff --git a/tests/command-line.test b/tests/command-line.test new file mode 100644 index 000000000..70c56e6ec --- /dev/null +++ b/tests/command-line.test @@ -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