hledger 0.21.3 → 0.22

raw patch · 8 files changed

+860/−367 lines, 8 filesdep +data-pprintdep +regex-compat-tdfadep +tabulardep −regex-compatdep ~hledger-libdep ~textPVP ok

version bump matches the API change (PVP)

Dependencies added: data-pprint, regex-compat-tdfa, tabular

Dependencies removed: regex-compat

Dependency ranges changed: hledger-lib, text

API changes (from Hackage documentation)

Files

• Hledger/Cli/Add.hs +1/−1
• Hledger/Cli/Balance.hs +278/−57
• Hledger/Cli/Balancesheet.hs +5/−8
• Hledger/Cli/Cashflow.hs +6/−11
• Hledger/Cli/Incomestatement.hs +4/−4
• Hledger/Cli/Main.hs +102/−52
• Hledger/Cli/Options.hs +448/−224
• hledger.cabal +16/−10

@@ -264,7 +264,7 @@ journalAddTransaction j@Journal{jtxns=ts} opts t = do   let f = journalFilePath j   appendToJournalFileOrStdout f $ showTransaction t-  when (debug_ opts) $ do+  when (debug_ opts > 0) $ do     putStrLn $ printf "\nAdded transaction to %s:" f     putStrLn =<< registerFromString (show t)   return j{jtxns=ts++[t]}

@@ -1,11 +1,20 @@ {-| -A ledger-compatible @balance@ command.+A ledger-compatible @balance@ command, with additional support for+multi-column reports. -ledger's balance command is easy to use but not easy to describe-precisely.  In the examples below we'll use sample.journal, which has the-following account tree:+Here is a description/specification for the balance command.  See also+"Hledger.Reports" -> \"Balance reports\". ++/Basic balance report/++With no reporting interval (@--monthly@ etc.), hledger's balance+command emulates ledger's, showing accounts indented according to+hierarchy, along with their total amount posted (including subaccounts).++Here's an example. With @data/sample.journal@, which defines the following account tree:+ @  assets    bank@@ -22,10 +31,7 @@    debts @ -The balance command shows accounts with their aggregate balances.-Subaccounts are displayed indented below their parent. Each balance is the-sum of any transactions in that account plus any balances from-subaccounts:+the basic @balance@ command gives this output:  @  $ hledger -f sample.journal balance@@ -39,31 +45,60 @@                  $-1    gifts                  $-1    salary                   $1  liabilities:debts+--------------------+                   0 @ -Usually, the non-interesting accounts are elided or omitted. Above,-@checking@ is omitted because it has no subaccounts and a zero balance.-@bank@ is elided because it has only a single displayed subaccount-(@saving@) and it would be showing the same balance as that ($1). Ditto-for @liabilities@. We will return to this in a moment.+Subaccounts are displayed indented below their parent. Only the account leaf name (the final part) is shown.+(With @--flat@, account names are shown in full and unindented.) -The --depth argument can be used to limit the depth of the balance report.-So, to see just the top level accounts:+Each account's \"balance\" is the sum of postings in that account and any subaccounts during the report period.+When the report period includes all transactions, this is equivalent to the account's current balance. +The overall total of the highest-level displayed accounts is shown below the line.+(The @--no-total/-N@ flag prevents this.)++/Eliding and omitting/++Accounts which have a zero balance, and no non-zero subaccount+balances, are normally omitted from the report.+(The @--empty/-E@ flag forces such accounts to be displayed.)+Eg, above @checking@ is omitted because it has a zero balance and no subaccounts.++Accounts which have a single subaccount also being displayed, with the same balance,+are normally elided into the subaccount's line.+(The @--no-elide@ flag prevents this.)+Eg, above @bank@ is elided to @bank:saving@ because it has only a+single displayed subaccount (@saving@) and their balance is the same+($1). Similarly, @liabilities@ is elided to @liabilities:debts@.++/Date limiting/++The default report period is that of the whole journal, including all+known transactions. The @--begin\/-b@, @--end\/-e@, @--period\/-p@+options or @date:@/@date2:@ patterns can be used to report only+on transactions before and/or after specified dates.++/Depth limiting/++The @--depth@ option can be used to limit the depth of the balance report.+Eg, to see just the top level accounts (still including their subaccount balances):+ @ $ hledger -f sample.journal balance --depth 1                  $-1  assets                   $2  expenses                  $-2  income                   $1  liabilities+--------------------+                   0 @ -This time liabilities has no displayed subaccounts (due to --depth) and-is not elided.+/Account limiting/ -With one or more account pattern arguments, the balance command shows-accounts whose name matches one of the patterns, plus their parents-(elided) and subaccounts. So with the pattern o we get:+With one or more account pattern arguments, the report is restricted+to accounts whose name matches one of the patterns, plus their parents+and subaccounts. Eg, adding the pattern @o@ to the first example gives:  @  $ hledger -f sample.journal balance o@@ -75,33 +110,142 @@                  $-1 @ -The o pattern matched @food@ and @income@, so they are shown. Unmatched-parents of matched accounts are also shown (elided) for context (@expenses@).+* The @o@ pattern matched @food@ and @income@, so they are shown. -Also, the balance report shows the total of all displayed accounts, when-that is non-zero. Here, it is displayed because the accounts shown add up-to $-1.+* @food@'s parent (@expenses@) is shown even though the pattern didn't+  match it, to clarify the hierarchy. The usual eliding rules cause it to be elided here. -Also, non-interesting accounts may be elided.  Here's an imperfect-description of the ledger balance command's eliding behaviour:-\"Interesting\" accounts are displayed on their own line. An account less-deep than the report's max depth, with just one interesting subaccount,-and the same balance as the subaccount, is non-interesting, and prefixed-to the subaccount's line, unless (hledger's) --no-elide is in effect.-An account with a zero inclusive balance and less than two interesting-subaccounts is not displayed at all, unless --empty is in effect.+* @income@'s subaccounts are also shown. +/Multi-column balance report/++hledger's balance command will show multiple columns when a reporting+interval is specified (eg with @--monthly@), one column for each sub-period.++There are three kinds of multi-column balance report, indicated by the heading:++* A \"period balance\" (or \"flow\") report (the default) shows the change of account+  balance in each period, which is equivalent to the sum of postings in each+  period. Here, checking's balance increased by 10 in Feb:++  > Change of balance (flow):+  > +  >                  Jan   Feb   Mar+  > assets:checking   20    10    -5++* A \"cumulative balance\" report (with @--cumulative@) shows the accumulated ending balance+  across periods, starting from zero at the report's start date.+  Here, 30 is the sum of checking postings during Jan and Feb:++  > Ending balance (cumulative):+  > +  >                  Jan   Feb   Mar+  > assets:checking   20    30    25++* A \"historical balance\" report (with @--historical/-H@) also shows ending balances,+  but it includes the starting balance from any postings before the report start date.+  Here, 130 is the balance from all checking postings at the end of Feb, including+  pre-Jan postings which created a starting balance of 100:++  > Ending balance (historical):+  > +  >                  Jan   Feb   Mar+  > assets:checking  120   130   125++/Eliding and omitting, 2/++Here's a (imperfect?) specification for the eliding/omitting behaviour:++* Each account is normally displayed on its own line.++* An account less deep than the report's max depth, with just one+interesting subaccount, and the same balance as the subaccount, is+non-interesting, and prefixed to the subaccount's line, unless+@--no-elide@ is in effect. ++* An account with a zero inclusive balance and less than two interesting+subaccounts is not displayed at all, unless @--empty@ is in effect.++* Multi-column balance reports show full account names with no eliding+  (like @--flat@). Accounts (and periods) are omitted as described below.++/Which accounts to show in balance reports/++By default:++* single-column: accounts with non-zero balance in report period.+                 (With @--flat@: accounts with non-zero balance and postings.)++* periodic:      accounts with postings and non-zero period balance in any period++* cumulative:    accounts with non-zero cumulative balance in any period++* historical:    accounts with non-zero historical balance in any period++With @-E/--empty@:++* single-column: accounts with postings in report period++* periodic:      accounts with postings in report period++* cumulative:    accounts with postings in report period++* historical:    accounts with non-zero starting balance ++                 accounts with postings in report period++/Which periods (columns) to show in balance reports/++An empty period/column is one where no report account has any postings.+A zero period/column is one where no report account has a non-zero period balance.++Currently,++by default:++* single-column: N/A++* periodic:      all periods within the overall report period,+                 except for leading and trailing empty periods++* cumulative:    all periods within the overall report period,+                 except for leading and trailing empty periods++* historical:    all periods within the overall report period,+                 except for leading and trailing empty periods++With @-E/--empty@:++* single-column: N/A++* periodic:      all periods within the overall report period++* cumulative:    all periods within the overall report period++* historical:    all periods within the overall report period++/What to show in empty cells/++An empty periodic balance report cell is one which has no corresponding postings.+An empty cumulative/historical balance report cell is one which has no correponding+or prior postings, ie the account doesn't exist yet.+Currently, empty cells show 0.+ -}  module Hledger.Cli.Balance (   balance- ,accountsReportAsText+ ,balanceReportAsText+ ,periodBalanceReportAsText+ ,cumulativeBalanceReportAsText+ ,historicalBalanceReportAsText  ,tests_Hledger_Cli_Balance ) where  import Data.List import Data.Maybe import Test.HUnit+import Text.Tabular+import Text.Tabular.AsciiArt  import Hledger import Prelude hiding (putStr)@@ -114,17 +258,24 @@ balance :: CliOpts -> Journal -> IO () balance CliOpts{reportopts_=ropts} j = do   d <- getCurrentDay-  let lines = case formatFromOpts ropts of-            Left err -> [err]-            Right _ -> accountsReportAsText ropts $ accountsReport ropts (queryFromOpts d ropts) j-  putStr $ unlines lines+  let output =+       case formatFromOpts ropts of+         Left err -> [err]+         Right _ ->+          case (intervalFromOpts ropts, balancetype_ ropts) of+            (NoInterval,_)        -> balanceReportAsText           ropts $ balanceReport ropts (queryFromOpts d ropts) j+            (_,PeriodBalance)     -> periodBalanceReportAsText     ropts $ periodBalanceReport                 ropts (queryFromOpts d ropts) j+            (_,CumulativeBalance) -> cumulativeBalanceReportAsText ropts $ cumulativeOrHistoricalBalanceReport ropts (queryFromOpts d ropts) j+            (_,HistoricalBalance) -> historicalBalanceReportAsText ropts $ cumulativeOrHistoricalBalanceReport ropts (queryFromOpts d ropts) j --- | Render a balance report as plain text suitable for console output.-accountsReportAsText :: ReportOpts -> AccountsReport -> [String]-accountsReportAsText opts (items, total) = concat lines ++ t-    where+  putStr $ unlines output++-- | Render an old-style single-column balance report as plain text.+balanceReportAsText :: ReportOpts -> BalanceReport -> [String]+balanceReportAsText opts ((items, total)) = concat lines ++ t+  where       lines = case formatFromOpts opts of-                Right f -> map (accountsReportItemAsText opts f) items+                Right f -> map (balanceReportItemAsText opts f) items                 Left err -> [[err]]       t = if no_total_ opts            then []@@ -133,13 +284,13 @@                 ,padleft 20 $ showMixedAmountWithoutPrice total                 ] -tests_accountsReportAsText = [-  "accountsReportAsText" ~: do+tests_balanceReportAsText = [+  "balanceReportAsText" ~: do   -- "unicode in balance layout" ~: do     j <- readJournal'       "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"     let opts = defreportopts-    accountsReportAsText opts (accountsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is`+    balanceReportAsText opts (balanceReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is`       ["                -100  актив:наличные"       ,"                 100  расходы:покупки"       ,"--------------------"@@ -157,27 +308,27 @@               EUR -1     b         USD -1  ; Account 'b' has two amounts. The account name is printed on the last line. -}--- | Render one balance report line item as plain text.-accountsReportItemAsText :: ReportOpts -> [FormatString] -> AccountsReportItem -> [String]-accountsReportItemAsText opts format (_, accountName, depth, Mixed amounts) =+-- | Render one balance report line item as plain text suitable for console output.+balanceReportItemAsText :: ReportOpts -> [FormatString] -> BalanceReportItem -> [String]+balanceReportItemAsText opts format (_, accountName, depth, Mixed amounts) =     -- 'amounts' could contain several quantities of the same commodity with different price.     -- In order to combine them into single value (which is expected) we take the first price and     -- use it for the whole mixed amount. This could be suboptimal. XXX     let Mixed normAmounts = normaliseMixedAmountPreservingFirstPrice (Mixed amounts) in     case normAmounts of       [] -> []-      [a] -> [formatAccountsReportItem opts (Just accountName) depth a format]+      [a] -> [formatBalanceReportItem opts (Just accountName) depth a format]       (as) -> multiline as     where       multiline :: [Amount] -> [String]       multiline []     = []-      multiline [a]    = [formatAccountsReportItem opts (Just accountName) depth a format]-      multiline (a:as) = (formatAccountsReportItem opts Nothing depth a format) : multiline as+      multiline [a]    = [formatBalanceReportItem opts (Just accountName) depth a format]+      multiline (a:as) = (formatBalanceReportItem opts Nothing depth a format) : multiline as -formatAccountsReportItem :: ReportOpts -> Maybe AccountName -> Int -> Amount -> [FormatString] -> String-formatAccountsReportItem _ _ _ _ [] = ""-formatAccountsReportItem opts accountName depth amount (fmt:fmts) =-  s ++ (formatAccountsReportItem opts accountName depth amount fmts)+formatBalanceReportItem :: ReportOpts -> Maybe AccountName -> Int -> Amount -> [FormatString] -> String+formatBalanceReportItem _ _ _ _ [] = ""+formatBalanceReportItem opts accountName depth amount (fmt:fmts) =+  s ++ (formatBalanceReportItem opts accountName depth amount fmts)   where     s = case fmt of          FormatLiteral l -> l@@ -192,5 +343,75 @@         TotalField       -> formatValue ljust min max $ showAmountWithoutPrice total         _                  -> "" +-- | Render a multi-column period balance report as plain text suitable for console output.+periodBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> [String]+periodBalanceReportAsText opts (MultiBalanceReport (colspans, items, coltotals)) =+  (["Change of balance (flow):"] ++) $+  trimborder $ lines $+   render+    id+    ((" "++) . showDateSpan)+    showMixedAmountWithoutPrice+    $ Table+      (Group NoLine $ map (Header . padright acctswidth) accts)+      (Group NoLine $ map Header colspans)+      (map snd items')+    +----++    totalrow+  where+    trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init)+    items' | empty_ opts = items+           | otherwise   = items -- dbg "2" $ filter (any (not . isZeroMixedAmount) . snd) $ dbg "1" items+    accts = map renderacct items'+    renderacct ((a,a',_i),_)+      | flat_ opts = a+      | otherwise  = a' -- replicate i ' ' ++ +    acctswidth = maximum $ map length $ accts+    totalrow | no_total_ opts = row "" []+             | otherwise      = row "" coltotals++-- | Render a multi-column cumulative balance report as plain text suitable for console output.+cumulativeBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> [String]+cumulativeBalanceReportAsText opts (MultiBalanceReport (colspans, items, coltotals)) =+  (["Ending balance (cumulative):"] ++) $+  trimborder $ lines $+   render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountWithoutPrice $+    addtotalrow $ +     Table+       (Group NoLine $ map (Header . padright acctswidth) accts)+       (Group NoLine $ map Header colspans)+       (map snd items)+  where+    trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init)+    accts = map renderacct items+    renderacct ((a,a',_),_)+      | flat_ opts = a+      | otherwise  = a' -- replicate i ' ' ++ +    acctswidth = maximum $ map length $ accts+    addtotalrow | no_total_ opts = id+                | otherwise      = (+----+ row "" coltotals)++-- | Render a multi-column historical balance report as plain text suitable for console output.+historicalBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> [String]+historicalBalanceReportAsText opts (MultiBalanceReport (colspans, items, coltotals)) =+  (["Ending balance (historical):"] ++) $+  trimborder $ lines $+   render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountWithoutPrice $+    addtotalrow $ +     Table+       (Group NoLine $ map (Header . padright acctswidth) accts)+       (Group NoLine $ map Header colspans)+       (map snd items)+  where+    trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init)+    accts = map renderacct items+    renderacct ((a,a',_),_)+      | flat_ opts = a+      | otherwise  = a' -- replicate i ' ' ++ +    acctswidth = maximum $ map length $ accts+    addtotalrow | no_total_ opts = id+                | otherwise      = (+----+ row "" coltotals)++ tests_Hledger_Cli_Balance = TestList-  tests_accountsReportAsText+  tests_balanceReportAsText

@@ -25,18 +25,15 @@   -- let lines = case formatFromOpts ropts of Left err, Right ...   d <- getCurrentDay   let q = queryFromOpts d (withoutBeginDate ropts)-      assetreport@(_,assets)          = accountsReport ropts (And [q, journalAssetAccountQuery j]) j-      liabilityreport@(_,liabilities) = accountsReport ropts (And [q, journalLiabilityAccountQuery j]) j-      equityreport@(_,equity)         = accountsReport ropts (And [q, journalEquityAccountQuery j]) j-      total = assets + liabilities + equity+      assetreport@(_,assets)          = balanceReport ropts (And [q, journalAssetAccountQuery j]) j+      liabilityreport@(_,liabilities) = balanceReport ropts (And [q, journalLiabilityAccountQuery j]) j+      total = assets + liabilities   LT.putStr $ [lt|Balance Sheet  Assets:-#{unlines $ accountsReportAsText ropts assetreport}+#{unlines $ balanceReportAsText ropts assetreport} Liabilities:-#{unlines $ accountsReportAsText ropts liabilityreport}-Equity:-#{unlines $ accountsReportAsText ropts equityreport}+#{unlines $ balanceReportAsText ropts liabilityreport}  Total: --------------------

@@ -27,26 +27,21 @@ cashflow CliOpts{reportopts_=ropts} j = do   -- let lines = case formatFromOpts ropts of Left err, Right ...   d <- getCurrentDay-  let q = queryFromOpts d (withoutBeginDate ropts)-      cashreport@(_,total) = accountsReport ropts (And [q, journalCashAccountQuery j]) j-      -- operatingreport@(_,operating) = accountsReport ropts (And [q, journalOperatingAccountMatcher j]) j-      -- investingreport@(_,investing) = accountsReport ropts (And [q, journalInvestingAccountMatcher j]) j-      -- financingreport@(_,financing) = accountsReport ropts (And [q, journalFinancingAccountMatcher j]) j+  let q = queryFromOpts d ropts+      cashreport@(_,total) = balanceReport ropts (And [q, journalCashAccountQuery j]) j+      -- operatingreport@(_,operating) = balanceReport ropts (And [q, journalOperatingAccountMatcher j]) j+      -- investingreport@(_,investing) = balanceReport ropts (And [q, journalInvestingAccountMatcher j]) j+      -- financingreport@(_,financing) = balanceReport ropts (And [q, journalFinancingAccountMatcher j]) j       -- total = operating + investing + financing   LT.putStr $ [lt|Cashflow Statement  Cash flows:-#{unlines $ accountsReportAsText ropts cashreport}+#{unlines $ balanceReportAsText ropts cashreport}  Total: -------------------- #{padleft 20 $ showMixedAmountWithoutPrice total} |]--withoutBeginDate :: ReportOpts -> ReportOpts-withoutBeginDate ropts@ReportOpts{..} = ropts{begin_=Nothing, period_=p}-  where p = case period_ of Nothing -> Nothing-                            Just (i, DateSpan _ e) -> Just (i, DateSpan Nothing e)  tests_Hledger_Cli_Cashflow = TestList  [

@@ -23,15 +23,15 @@ incomestatement CliOpts{reportopts_=ropts} j = do   d <- getCurrentDay   let q = queryFromOpts d ropts-      incomereport@(_,income)    = accountsReport ropts (And [q, journalIncomeAccountQuery j]) j-      expensereport@(_,expenses) = accountsReport ropts (And [q, journalExpenseAccountQuery j]) j+      incomereport@(_,income)    = balanceReport ropts (And [q, journalIncomeAccountQuery j]) j+      expensereport@(_,expenses) = balanceReport ropts (And [q, journalExpenseAccountQuery j]) j       total = income + expenses   LT.putStr $ [lt|Income Statement  Revenues:-#{unlines $ accountsReportAsText ropts incomereport}+#{unlines $ balanceReportAsText ropts incomereport} Expenses:-#{unlines $ accountsReportAsText ropts expensereport}+#{unlines $ balanceReportAsText ropts expensereport}  Total: --------------------

@@ -41,6 +41,8 @@ import Control.Monad import Data.List import Safe+import System.Console.CmdArgs.Explicit (modeHelp)+-- import System.Console.CmdArgs.Helper import System.Environment import System.Exit import System.Process@@ -66,62 +68,110 @@  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 (debugLevel > 0) $ 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-  opts <- getHledgerCliOpts addons-  when (debug_ opts) $ do-    printf "%s\n" prognameandversion-    printf "args: %s\n" (show args)-    printf "opts: %s\n" (show opts)++  -- parse arguments with cmdargs+  opts <- argsToCliOpts args 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 > 0) $ do+    putStrLn $ "processed opts:\n" ++ ppShow opts+    putStrLn $ "command matched: " ++ show cmd+    putStrLn $ "isNullCommand: " ++ show isNullCommand+    putStrLn $ "isInternalCommand: " ++ show isInternalCommand+    putStrLn $ "isExternalCommand: " ++ show isExternalCommand+    putStrLn $ "isBadCommand: " ++ show isBadCommand     d <- getCurrentDay-    printf "query: %s\n" (show $ queryFromOpts d $ reportopts_ opts)+    putStrLn $ "date span from opts: " ++ (show $ dateSpanFromOpts d $ reportopts_ opts)+    putStrLn $ "interval from opts: " ++ (show $ intervalFromOpts $ reportopts_ opts)+    putStrLn $ "query from opts & args: " ++ (show $ queryFromOpts d $ reportopts_ opts)+  let+    dbg s = if debug_ opts > 0 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 > 0) $ 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 -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+      -- 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++--  ]++

@@ -1,13 +1,93 @@-{-# 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 & flags+  -- | 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,+  defCommandMode,+  argsFlag,+  helpflags,+  inputflags,+  reportflags,+  generalflagsgroup1,+  generalflagsgroup2,+  generalflagsgroup3,+  +  -- * 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,+  boolopt,+  intopt,+  maybeintopt,+  stringopt,+  maybestringopt,+  listofstringopt,+  setopt,+  setboolopt,++  -- * 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,++  -- * CLI option accessors+  -- | Some options require more processing. Possibly these should be merged into argsToCliOpts.+  aliasesFromOpts,+  formatFromOpts,+  journalFilePathFromOpts,+  rulesFilePathFromOpts,+  OutputWidth(..),+  Width(..),+  defaultWidth,+  defaultWidthWithFlag,+  widthFromOpts,++  -- * utilities+  getHledgerAddonCommands,+  argsToCliOpts,+  moveFlagsAfterCommand,+  decodeRawOpts,+  checkCliOpts,+  rawOptsToCliOpts,+  optserror,+  showModeHelp,+  debugArgs,+  getCliOpts,++  -- * tests+  tests_Hledger_Cli_Options++)  where+   import qualified Control.Exception as C+-- import Control.Monad (filterM)+import Control.Monad (when)+import Data.Char (isDigit) import Data.List import Data.List.Split import Data.Maybe@@ -18,6 +98,7 @@ import System.Console.CmdArgs.Text import System.Directory import System.Environment+import System.Exit import Test.HUnit import Text.ParserCombinators.Parsec as P import Text.Printf@@ -26,109 +107,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.+-- +-- 1. cmdargs mode and flag (option) definitions for the hledger CLI,+-- can be reused by other packages as well.+-- +-- | Our cmdargs modes parse arguments into an association list for better 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 = []-    }- }-----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)- }+-- common flags and flag groups -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 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"+ ,flagOpt "1" ["debug"] (\s opts -> Right $ setopt "debug" s opts) "N" "Show debug output (optional argument sets debug level)"+ ,flagNone ["version"] (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"+ ,flagReq ["alias"]  (\s opts -> Right $ setopt "alias" s opts)  "ACCT=ALIAS" "convert ACCT's name to ALIAS"  ] +-- | 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,157 +152,278 @@  ,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)]}+-- cmdargs modes -addmode = (commandmode ["add"]) {-  modeHelp = "prompt for new transactions and append them to the journal"- ,modeHelpSuffix = ["Defaults come from previous similar transactions; use query patterns to restrict these."]- ,modeArgs = ([], Just commandargsflag)+-- | A basic mode template.+defMode :: Mode RawOpts+defMode =   Mode {+  modeNames = []+ ,modeHelp = ""+ ,modeHelpSuffix = []+ ,modeValue = []+ ,modeCheck = Right+ ,modeReform = const Nothing+ ,modeExpandAt = True  ,modeGroupFlags = Group {-     groupUnnamed = [-      flagNone ["no-new-accounts"]  (\opts -> setboolopt "no-new-accounts" opts) "don't allow creating new accounts"-     ]+     groupNamed = []+    ,groupUnnamed = [+        flagNone ["help","h","?"] (setboolopt "help") "Display command help."+        ]     ,groupHidden = []-    ,groupNamed = [(generalflagstitle, generalflags2)]     }+ ,modeArgs = ([], Nothing)+ ,modeGroupModes = toGroup []  } -testmode = (commandmode ["test"]) {-  modeHelp = "run self-tests, or just the ones matching REGEXPS"- ,modeArgs = ([], Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "[REGEXPS]")+-- | A basic subcommand mode with the given command name(s).+defCommandMode names = defMode {+   modeNames=names+  ,modeValue=[("command", headDef "" names)]+  ,modeArgs = ([], Just $ argsFlag "[PATTERNS]")+  }++-- | A basic subcommand 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]")+  }++-- | Add command aliases to the command's help string.+withAliases :: String -> [String] -> String+s `withAliases` []     = s+s `withAliases` (a:[]) = s ++ " (alias: " ++ a ++ ")"+s `withAliases` as     = s ++ " (aliases: " ++ intercalate ", " as ++ ")"+++-- | 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 {-     groupUnnamed = []+     -- 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."+--  ]++-- visible subcommand modes++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."]+ ,modeGroupFlags = Group {+     groupUnnamed = [+      flagNone ["no-new-accounts"]  (\opts -> setboolopt "no-new-accounts" opts) "don't allow creating new accounts"+     ]     ,groupHidden = []-    ,groupNamed = [(generalflagstitle, generalflags3)]+    ,groupNamed = [generalflagsgroup2]     }  } -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"+      flagNone ["cumulative"] (\opts -> setboolopt "cumulative" opts) "with a reporting interval, show accumulated totals starting from 0"+     ,flagNone ["historical","H"] (\opts -> setboolopt "historical" opts) "with a reporting interval, show accurate historical ending balances"+     ,flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show full account names, unindented"      ,flagReq  ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components"      ,flagReq  ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format"      ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "no eliding at all, stronger than --empty"      ,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)"+     ,flagNone ["average","A"] (\opts -> setboolopt "average" opts) "show the running average instead of the running total"      ,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)+-- transactionsmode = (defCommandMode ["transactions"]) {+--   modeHelp = "show matched transactions and balance in some account(s)"+--  ,modeGroupFlags = Group {+--      groupUnnamed = []+--     ,groupHidden = []+--     ,groupNamed = [generalflagsgroup1]+--     }+--  }++activitymode = (defCommandMode ["activity"]) {+  modeHelp = "show a barchart of transactions per interval"+ ,modeHelpSuffix = ["The default interval is daily."]  ,modeGroupFlags = Group {      groupUnnamed = []     ,groupHidden = []-    ,groupNamed = [(generalflagstitle, generalflags1)]+    ,groupNamed = [generalflagsgroup1]     }  } -activitymode = (commandmode ["activity","histogram"]) {-  modeHelp = "show a barchart of transactions per interval"- ,modeHelpSuffix = ["The default interval is daily."]- ,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"] -incomestatementmode = (commandmode ["incomestatement","is"]) {-  modeHelp = "show a standard income statement"- ,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"] -balancesheetmode = (commandmode ["balancesheet","bs"]) {-  modeHelp = "show a standard balance sheet"- ,modeArgs = ([], Just commandargsflag)+cashflowmode = (defCommandMode ["cashflow","cf"]) {+  modeHelp = "show a simple cashflow statement" `withAliases` ["cf"]  ,modeGroupFlags = Group {      groupUnnamed = []     ,groupHidden = []-    ,groupNamed = [(generalflagstitle, generalflags1)]+    ,groupNamed = [generalflagsgroup1]     }  } -cashflowmode = (commandmode ["cashflow","cf"]) {-  modeHelp = "show a simple cashflow statement"- ,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"] -statsmode = (commandmode ["stats"]) {-  modeHelp = "show quick statistics for a journal (or part of it)"- ,modeArgs = ([], Just commandargsflag)+testmode = (defCommandMode ["test"]) {+  modeHelp = "run self-tests, or just the ones matching REGEXPS"+ ,modeArgs = ([], Just $ argsFlag "[REGEXPS]")  ,modeGroupFlags = Group {      groupUnnamed = []     ,groupHidden = []-    ,groupNamed = [(generalflagstitle, generalflags1)]+    ,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)+-- hidden commands --- cli options, used in hledger and above+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 = []+    }+ }++--+-- 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)+--++-- | Command line options. Used in the @hledger@ package and above. data CliOpts = CliOpts {      rawopts_         :: RawOpts     ,command_         :: String     ,file_            :: Maybe FilePath     ,rules_file_      :: Maybe FilePath     ,alias_           :: [String]-    ,debug_           :: Bool+    ,debug_           :: Int            -- ^ debug level, set by @--debug[=N]@. See also 'Hledger.Utils.debugLevel'.     ,no_new_accounts_ :: Bool           -- add     ,width_           :: Maybe String   -- register     ,reportopts_      :: ReportOpts- } deriving (Show)+ } deriving (Show, Data, Typeable)  defcliopts = CliOpts     def@@ -316,8 +441,8 @@ -- | Parse raw option string values to the desired final data types. -- Any relative smart dates will be converted to fixed dates based on -- today's date. Parsing failures will raise an error.-toCliOpts :: RawOpts -> IO CliOpts-toCliOpts rawopts = do+rawOptsToCliOpts :: RawOpts -> IO CliOpts+rawOptsToCliOpts rawopts = do   d <- getCurrentDay   return defcliopts {               rawopts_         = rawopts@@ -325,7 +450,7 @@              ,file_            = maybestringopt "file" rawopts              ,rules_file_      = maybestringopt "rules-file" rawopts              ,alias_           = map stripquotes $ listofstringopt "alias" rawopts-             ,debug_           = boolopt "debug" rawopts+             ,debug_           = intopt "debug" rawopts              ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add              ,width_           = maybestringopt "width" rawopts    -- register              ,reportopts_ = defreportopts {@@ -341,6 +466,7 @@                             ,empty_     = boolopt "empty" rawopts                             ,no_elide_  = boolopt "no-elide" rawopts                             ,real_      = boolopt "real" rawopts+                            ,balancetype_ = balancetypeopt rawopts -- balance                             ,flat_      = boolopt "flat" rawopts -- balance                             ,drop_      = intopt "drop" rawopts -- balance                             ,no_total_  = boolopt "no-total" rawopts -- balance@@ -350,58 +476,113 @@                             ,quarterly_ = boolopt "quarterly" rawopts                             ,yearly_    = boolopt "yearly" rawopts                             ,format_    = maybestringopt "format" rawopts+                            ,average_   = boolopt "average" rawopts  -- register                             ,related_   = boolopt "related" rawopts  -- register                             ,query_     = unwords $ listofstringopt "args" rawopts                             }              } --- | Get all command-line options, specifying any extra commands that are allowed, or fail on parse errors.-getHledgerCliOpts :: [String] -> IO CliOpts-getHledgerCliOpts addons = do-  args <- getArgs-  toCliOpts (decodeRawOpts $ processValue (mainmode addons) $ rearrangeForCmdArgs args) >>= checkCliOpts+-- | Parse hledger CLI options from these command line arguments and+-- add-on command names, or raise any error.+argsToCliOpts :: [String] -> [String] -> IO CliOpts+argsToCliOpts args addons = do+  let+    args'        = moveFlagsAfterCommand args+    cmdargsopts  = System.Console.CmdArgs.Explicit.processValue (mainmode addons) args'+    cmdargsopts' = decodeRawOpts cmdargsopts+  rawOptsToCliOpts 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 ("--debug":v:a:as) | not (null v) && all isDigit v  = (move $ a:as) ++ ["--debug",v]+    move ("--debug":a:as)                                    = (move $ a:as) ++ ["--debug"]+    move (fv@('-':'-':'d':'e':'b':'u':'g':'=':_):a:as)       = (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+--  -- | Get the unique suffixes (without hledger-) of hledger-* executables -- 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 -getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "")-getDirectoryContentsSafe d = getDirectoryContents d `C.catch` (\(_::C.IOException) -> return [])+-- isExecutable f = getPermissions f >>= (return . executable) --- | Convert possibly encoded option values to regular unicode strings.-decodeRawOpts = map (\(name,val) -> (name, fromSystemString val))+isHledgerNamed = isRight . parsewith (do+        string progname+        char '-'+        many1 (letter <|> char '-')+        optional $ (string ".hs" <|> string ".lhs")+        eof+        ) --- 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+getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "")+getDirectoryContentsSafe d = getDirectoryContents d `C.catch` (\(_::C.IOException) -> return []) +-- | 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 @@ -442,16 +623,15 @@                 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+balancetypeopt :: RawOpts -> BalanceType+balancetypeopt rawopts+    | length [o | o <- ["cumulative","historical"], isset o] > 1+                         = optserror "please specify at most one of --cumulative and --historical"+    | isset "cumulative" = CumulativeBalance+    | isset "historical" = HistoricalBalance+    | otherwise          = PeriodBalance+    where+      isset = flip boolopt rawopts  -- | Parse the format option if provided, possibly returning an error, -- otherwise get the default value.@@ -467,10 +647,22 @@     , 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,@@ -481,34 +673,22 @@ 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@@ -521,11 +701,55 @@             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])++-- not used:++-- | Print debug info about arguments and options if --debug is present.+debugArgs :: [String] -> CliOpts -> IO ()+debugArgs args opts =+  when ("--debug" `elem` args) $ do+    progname <- getProgName+    putStrLn $ "running: " ++ progname+    putStrLn $ "raw args: " ++ show args+    putStrLn $ "processed opts:\n" ++ show opts+    d <- getCurrentDay+    putStrLn $ "search query: " ++ (show $ queryFromOpts d $ reportopts_ opts)++-- not used:++-- | Parse hledger CLI options from the command line using the given+-- cmdargs mode, and either return them or, if a help flag is present,+-- print the mode help and exit the program.+getCliOpts :: Mode RawOpts -> IO CliOpts+getCliOpts mode = do+  args <- getArgs+  let rawopts = decodeRawOpts $ processValue mode args+  opts <- rawOptsToCliOpts rawopts >>= checkCliOpts+  debugArgs args opts+  -- if any (`elem` args) ["--help","-h","-?"]+  when ("help" `inRawOpts` rawopts_ opts) $+    putStr (showModeHelp mode) >> exitSuccess+  return opts  tests_Hledger_Cli_Options = TestList  [

@@ -1,6 +1,7 @@ name:           hledger -- also in cpp-options below-version: 0.21.3+version: 0.22+stability:      beta category:       Finance synopsis:       The main command-line interface for the hledger accounting tool. description:@@ -17,8 +18,7 @@ maintainer:     Simon Michael <simon@joyful.com> homepage:       http://hledger.org bug-reports:    http://hledger.org/bugs-stability:      beta-tested-with:    GHC==7.2.2, GHC==7.4.2, GHC==7.6.1+tested-with:    GHC==7.4.2, GHC==7.6.3 cabal-version:  >= 1.10 build-type:     Simple -- data-dir:       data@@ -41,7 +41,7 @@     Default:       True  library-  cpp-options:    -DVERSION="0.21.3"+  cpp-options:    -DVERSION="0.22"   ghc-options:    -W   -- should be the same as below   exposed-modules:@@ -62,11 +62,12 @@                   Hledger.Cli.Stats   -- should be the same as below   build-depends:-                  hledger-lib == 0.21.3+                  hledger-lib == 0.22                  ,base >= 4.3 && < 5                  -- ,cabal-file-th                  ,containers                  ,cmdargs >= 0.10 && < 0.11+                 ,data-pprint >= 0.2.1 && < 0.3                  ,directory                  ,filepath                  ,haskeline >= 0.6 && <= 0.8@@ -80,7 +81,8 @@                  ,safe >= 0.2                  ,shakespeare-text == 1.0.*                  ,split >= 0.1 && < 0.3-                 ,text == 0.11.*+                 ,text >= 0.11 && < 1.1+                 ,tabular >= 0.2 && < 0.3                  ,time                  ,utf8-string >= 0.3.5 && < 0.4   default-language: Haskell2010@@ -111,16 +113,17 @@                   Hledger.Cli.Print                   Hledger.Cli.Register                   Hledger.Cli.Stats-  cpp-options:    -DVERSION="0.21.3"+  cpp-options:    -DVERSION="0.22"   ghc-options:    -W   if flag(threaded)        ghc-options:   -threaded  -- should be the same as above   build-depends:-                  hledger-lib == 0.21.3+                  hledger-lib == 0.22                  ,base >= 4.3 && < 5                  ,containers                  ,cmdargs >= 0.10 && < 0.11+                 ,data-pprint >= 0.2.1 && < 0.3                  ,directory                  ,filepath                  ,haskeline >= 0.6 && <= 0.8@@ -134,7 +137,8 @@                  ,safe >= 0.2                  ,shakespeare-text == 1.0.*                  ,split >= 0.1 && < 0.3-                 ,text == 0.11.*+                 ,tabular >= 0.2 && < 0.3+                 ,text >= 0.11 && < 1.1                  ,time                  ,utf8-string >= 0.3.5 && < 0.4   default-language: Haskell2010@@ -149,6 +153,7 @@                , cmdargs                , containers                , csv+               , data-pprint >= 0.2.1 && < 0.3                , directory                , filepath                , haskeline@@ -159,11 +164,12 @@                , parsec                , pretty-show                , process-               , regex-compat+               , regex-compat-tdfa                , regexpr                , safe                , shakespeare-text                , split+               ,tabular >= 0.2 && < 0.3                , test-framework                , test-framework-hunit                , text