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:
		
							parent
							
								
									c912108d89
								
							
						
					
					
						commit
						13f8c0f938
					
				| @ -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 | ||||||
|  | |||||||
							
								
								
									
										5
									
								
								NEWS.md
									
									
									
									
									
								
							
							
						
						
									
										5
									
								
								NEWS.md
									
									
									
									
									
								
							| @ -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 | ||||||
|  | |||||||
| @ -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 |  | ||||||
| 
 | 
 | ||||||
| -} |  | ||||||
| @ -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
									
								
							
							
						
						
									
										137
									
								
								tests/command-line.test
									
									
									
									
									
										Normal 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 | ||||||
		Loading…
	
		Reference in New Issue
	
	Block a user