diff --git a/Hledger/Cli/Add.hs b/Hledger/Cli/Add.hs --- a/Hledger/Cli/Add.hs +++ b/Hledger/Cli/Add.hs @@ -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]} diff --git a/Hledger/Cli/Balance.hs b/Hledger/Cli/Balance.hs --- a/Hledger/Cli/Balance.hs +++ b/Hledger/Cli/Balance.hs @@ -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 diff --git a/Hledger/Cli/Balancesheet.hs b/Hledger/Cli/Balancesheet.hs --- a/Hledger/Cli/Balancesheet.hs +++ b/Hledger/Cli/Balancesheet.hs @@ -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: -------------------- diff --git a/Hledger/Cli/Cashflow.hs b/Hledger/Cli/Cashflow.hs --- a/Hledger/Cli/Cashflow.hs +++ b/Hledger/Cli/Cashflow.hs @@ -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 [ diff --git a/Hledger/Cli/Incomestatement.hs b/Hledger/Cli/Incomestatement.hs --- a/Hledger/Cli/Incomestatement.hs +++ b/Hledger/Cli/Incomestatement.hs @@ -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: -------------------- diff --git a/Hledger/Cli/Main.hs b/Hledger/Cli/Main.hs --- a/Hledger/Cli/Main.hs +++ b/Hledger/Cli/Main.hs @@ -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 + +-- ] + + diff --git a/Hledger/Cli/Options.hs b/Hledger/Cli/Options.hs --- a/Hledger/Cli/Options.hs +++ b/Hledger/Cli/Options.hs @@ -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 [ diff --git a/hledger.cabal b/hledger.cabal --- a/hledger.cabal +++ b/hledger.cabal @@ -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 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