diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index efb450a2a..6ec2da033 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -17,6 +17,7 @@ import Data.Maybe import Data.Time.Calendar (Day) import Data.Typeable (Typeable) import Safe (headDef, headMay) +import System.Console.CmdArgs.Explicit import System.Console.Haskeline (runInputT, defaultSettings, setComplete) import System.Console.Haskeline.Completion import System.Console.Wizard @@ -29,6 +30,19 @@ import Hledger import Hledger.Cli.Options import Hledger.Cli.Register (postingsReportAsText) + +addmode = (defCommandMode ["add"]) { + modeHelp = "prompt for transactions 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 = [generalflagsgroup2] + } + } + -- | State used while entering transactions. data EntryState = EntryState { esOpts :: CliOpts -- ^ command line options diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index 83a42d733..e91c6039a 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -233,7 +233,8 @@ Currently, empty cells show 0. -} module Hledger.Cli.Balance ( - balance + balancemode + ,balance ,balanceReportAsText ,periodBalanceReportAsText ,cumulativeBalanceReportAsText @@ -243,8 +244,11 @@ module Hledger.Cli.Balance ( import Data.List import Data.Maybe +-- import System.Console.CmdArgs +import System.Console.CmdArgs.Explicit as C +-- import System.Console.CmdArgs.Text import Test.HUnit -import Text.Tabular +import Text.Tabular as T import Text.Tabular.AsciiArt import Hledger @@ -254,7 +258,26 @@ import Hledger.Data.OutputFormat import Hledger.Cli.Options --- | Print a balance report. +-- | Command line options for this command. +balancemode = (defCommandMode $ ["balance"] ++ aliases ++ ["bal"]) { -- also accept but don't show the common bal alias + modeHelp = "show accounts and balances" `withAliases` aliases + ,modeGroupFlags = C.Group { + groupUnnamed = [ + 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 = [generalflagsgroup1] + } + } + where aliases = ["b"] + +-- | The balance command, prints a balance report. balance :: CliOpts -> Journal -> IO () balance CliOpts{reportopts_=ropts} j = do d <- getCurrentDay @@ -353,8 +376,8 @@ periodBalanceReportAsText opts (MultiBalanceReport (colspans, items, coltotals)) ((" "++) . showDateSpan) showMixedAmountWithoutPrice $ Table - (Group NoLine $ map (Header . padright acctswidth) accts) - (Group NoLine $ map Header colspans) + (T.Group NoLine $ map (Header . padright acctswidth) accts) + (T.Group NoLine $ map Header colspans) (map snd items') +----+ totalrow @@ -378,8 +401,8 @@ cumulativeBalanceReportAsText opts (MultiBalanceReport (colspans, items, coltota render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountWithoutPrice $ addtotalrow $ Table - (Group NoLine $ map (Header . padright acctswidth) accts) - (Group NoLine $ map Header colspans) + (T.Group NoLine $ map (Header . padright acctswidth) accts) + (T.Group NoLine $ map Header colspans) (map snd items) where trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init) @@ -399,8 +422,8 @@ historicalBalanceReportAsText opts (MultiBalanceReport (colspans, items, coltota render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountWithoutPrice $ addtotalrow $ Table - (Group NoLine $ map (Header . padright acctswidth) accts) - (Group NoLine $ map Header colspans) + (T.Group NoLine $ map (Header . padright acctswidth) accts) + (T.Group NoLine $ map Header colspans) (map snd items) where trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init) diff --git a/hledger/Hledger/Cli/Balancesheet.hs b/hledger/Hledger/Cli/Balancesheet.hs index 4c7a35412..dea632c10 100644 --- a/hledger/Hledger/Cli/Balancesheet.hs +++ b/hledger/Hledger/Cli/Balancesheet.hs @@ -6,11 +6,13 @@ The @balancesheet@ command prints a simple balance sheet. -} module Hledger.Cli.Balancesheet ( - balancesheet + balancesheetmode + ,balancesheet ,tests_Hledger_Cli_Balancesheet ) where import qualified Data.Text.Lazy.IO as LT +import System.Console.CmdArgs.Explicit import Test.HUnit import Text.Shakespeare.Text @@ -19,6 +21,16 @@ import Hledger.Cli.Options import Hledger.Cli.Balance +balancesheetmode = (defCommandMode $ ["balancesheet"]++aliases) { + modeHelp = "show a balance sheet" `withAliases` aliases + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [generalflagsgroup1] + } + } + where aliases = ["bs"] + -- | Print a simple balance sheet. balancesheet :: CliOpts -> Journal -> IO () balancesheet CliOpts{reportopts_=ropts} j = do diff --git a/hledger/Hledger/Cli/Cashflow.hs b/hledger/Hledger/Cli/Cashflow.hs index 8930df6bb..5344f2728 100644 --- a/hledger/Hledger/Cli/Cashflow.hs +++ b/hledger/Hledger/Cli/Cashflow.hs @@ -9,11 +9,13 @@ cash flows.) -} module Hledger.Cli.Cashflow ( - cashflow + cashflowmode + ,cashflow ,tests_Hledger_Cli_Cashflow ) where import qualified Data.Text.Lazy.IO as LT +import System.Console.CmdArgs.Explicit import Test.HUnit import Text.Shakespeare.Text @@ -22,6 +24,15 @@ import Hledger.Cli.Options import Hledger.Cli.Balance +cashflowmode = (defCommandMode ["cashflow","cf"]) { + modeHelp = "show a cashflow statement" `withAliases` ["cf"] + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [generalflagsgroup1] + } + } + -- | Print a simple cashflow statement. cashflow :: CliOpts -> Journal -> IO () cashflow CliOpts{reportopts_=ropts} j = do diff --git a/hledger/Hledger/Cli/Histogram.hs b/hledger/Hledger/Cli/Histogram.hs index 0543a881f..c61a0dc50 100644 --- a/hledger/Hledger/Cli/Histogram.hs +++ b/hledger/Hledger/Cli/Histogram.hs @@ -1,6 +1,6 @@ {-| -Print a histogram report. +Print a histogram report. (The "activity" command). -} @@ -9,6 +9,7 @@ where import Data.List import Data.Maybe import Data.Ord +import System.Console.CmdArgs.Explicit import Text.Printf import Hledger.Cli.Options @@ -19,6 +20,16 @@ import Prelude hiding (putStr) import Hledger.Utils.UTF8IOCompat (putStr) +activitymode = (defCommandMode ["activity"]) { + modeHelp = "show a barchart of transactions per interval" + ,modeHelpSuffix = ["The default interval is daily."] + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [generalflagsgroup1] + } + } + barchar = '*' -- | Print a histogram of some statistic per reporting interval, such as diff --git a/hledger/Hledger/Cli/Incomestatement.hs b/hledger/Hledger/Cli/Incomestatement.hs index 823b602f3..ab83a0839 100644 --- a/hledger/Hledger/Cli/Incomestatement.hs +++ b/hledger/Hledger/Cli/Incomestatement.hs @@ -6,11 +6,13 @@ The @incomestatement@ command prints a simple income statement (profit & loss) r -} module Hledger.Cli.Incomestatement ( - incomestatement + incomestatementmode + ,incomestatement ,tests_Hledger_Cli_Incomestatement ) where import qualified Data.Text.Lazy.IO as LT +import System.Console.CmdArgs.Explicit import Test.HUnit import Text.Shakespeare.Text @@ -18,6 +20,17 @@ import Hledger import Hledger.Cli.Options import Hledger.Cli.Balance + +incomestatementmode = (defCommandMode $ ["incomestatement"]++aliases) { + modeHelp = "show an income statement" `withAliases` aliases + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [generalflagsgroup1] + } + } + where aliases = ["is"] + -- | Print a simple income statement. incomestatement :: CliOpts -> Journal -> IO () incomestatement CliOpts{reportopts_=ropts} j = do diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index 2edf0b2b6..14ba5cc8d 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -39,10 +39,10 @@ See "Hledger.Data.Ledger" for more examples. module Hledger.Cli.Main where import Control.Monad +import Data.Char (isDigit) import Data.List import Safe -import System.Console.CmdArgs.Explicit (modeHelp) --- import System.Console.CmdArgs.Helper +import System.Console.CmdArgs.Explicit as C import System.Environment import System.Exit import System.Process @@ -66,6 +66,106 @@ import Hledger.Utils import Hledger.Reports import Hledger.Data.Dates + +-- | The overall cmdargs mode describing command-line options for hledger. +mainmode addons = defMode { + modeNames = [progname] + ,modeHelp = unlines [ + ] + ,modeHelpSuffix = [""] + ,modeArgs = ([], Just $ argsFlag "[ARGS]") + ,modeGroupModes = Group { + -- modes (commands) in named groups: + groupNamed = [ + ("Data entry commands", [ + addmode + ]) + ,("\nReporting commands", [ + printmode + ,balancemode + ,registermode + ,incomestatementmode + ,balancesheetmode + ,cashflowmode + ,activitymode + ,statsmode + ]) + ] + ++ case addons of [] -> [] + cs -> [("\nAdd-on commands", map defAddonCommandMode cs)] + -- modes in the unnamed group, shown first without a heading: + ,groupUnnamed = [ + ] + -- modes handled but not shown + ,groupHidden = [ + testmode + ,oldconvertmode + ] + } + ,modeGroupFlags = Group { + -- flags in named groups: + groupNamed = [generalflagsgroup3] + -- flags in the unnamed group, shown last without a heading: + ,groupUnnamed = [] + -- flags accepted but not shown in the help: + ,groupHidden = inputflags -- included here so they'll not raise a confusing error if present with no COMMAND + } + } + +oldconvertmode = (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 = [] + } + } + +-- | 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 = 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 + +-- | Let's go. main :: IO () main = do @@ -158,7 +258,7 @@ main = do system shellcmd >>= exitWith -- deprecated commands - | cmd == "convert" = error' (modeHelp convertmode) >> exitFailure + | cmd == "convert" = error' (modeHelp oldconvertmode) >> exitFailure -- shouldn't reach here | otherwise = optserror ("could not understand the arguments "++show args) >> exitFailure diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index 5ddfe3395..ae0999869 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -1,51 +1,40 @@ {-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DeriveDataTypeable #-} {-| -Command-line options for the hledger program, and related utilities. +Common command-line options and utilities used by hledger's subcommands and addons. -} 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, + -- | These tell cmdargs how to parse the command line arguments for each hledger subcommand. argsFlag, - helpflags, - inputflags, - reportflags, + defAddonCommandMode, + defCommandMode, + defMode, generalflagsgroup1, generalflagsgroup2, generalflagsgroup3, + helpflags, + inputflags, + reportflags, - -- * raw options + -- * 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. + -- options), our cmdargs modes parse to an extensible association + -- list (RawOpts) rather than a closed ADT like CliOpts. RawOpts, - inRawOpts, boolopt, + inRawOpts, intopt, - maybeintopt, - stringopt, - maybestringopt, listofstringopt, - setopt, + maybeintopt, + maybestringopt, setboolopt, + setopt, + stringopt, -- * CLI options -- | Raw options are converted to a more convenient, @@ -56,27 +45,26 @@ module Hledger.Cli.Options ( -- * CLI option accessors -- | Some options require more processing. Possibly these should be merged into argsToCliOpts. + OutputWidth(..), + Width(..), aliasesFromOpts, + defaultWidth, + defaultWidthWithFlag, formatFromOpts, journalFilePathFromOpts, rulesFilePathFromOpts, - OutputWidth(..), - Width(..), - defaultWidth, - defaultWidthWithFlag, widthFromOpts, -- * utilities - getHledgerAddonCommands, - argsToCliOpts, - moveFlagsAfterCommand, - decodeRawOpts, checkCliOpts, - rawOptsToCliOpts, - optserror, - showModeHelp, debugArgs, + decodeRawOpts, getCliOpts, + getHledgerAddonCommands, + optserror, + rawOptsToCliOpts, + showModeHelp, + withAliases, -- * tests tests_Hledger_Cli_Options @@ -87,7 +75,6 @@ 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 @@ -158,7 +145,7 @@ generalflagsgroup1 = (generalflagstitle, inputflags ++ reportflags ++ helpflags) generalflagsgroup2 = (generalflagstitle, inputflags ++ helpflags) generalflagsgroup3 = (generalflagstitle, helpflags) --- cmdargs modes +-- cmdargs mode constructors -- | A basic mode template. defMode :: Mode RawOpts @@ -203,6 +190,8 @@ defAddonCommandMode addon = defMode { striphs = regexReplace "\\.l?hs$" "" +-- | Built-in descriptions for some of the known external addons, +-- since we don't currently have any way to ask them. standardAddonsHelp :: [(String,String)] standardAddonsHelp = [ ("chart", "generate simple balance pie charts") @@ -226,51 +215,6 @@ s `withAliases` as = s ++ " (" ++ intercalate ", " as ++ ")" -- s `withAliases` as = s ++ " (aliases: " ++ intercalate ", " as ++ ")" --- | The top-level cmdargs mode for hledger. -mainmode addons = defMode { - modeNames = [progname] - ,modeHelp = unlines [ - ] - ,modeHelpSuffix = [""] - ,modeArgs = ([], Just $ argsFlag "[ARGS]") - ,modeGroupModes = Group { - -- modes (commands) in named groups: - groupNamed = [ - ("Data entry commands", [ - addmode - ]) - ,("\nReporting commands", [ - printmode - ,balancemode - ,registermode - ,incomestatementmode - ,balancesheetmode - ,cashflowmode - ,activitymode - ,statsmode - ]) - ] - ++ case addons of [] -> [] - cs -> [("\nAdd-on commands", map defAddonCommandMode cs)] - -- modes in the unnamed group, shown first without a heading: - ,groupUnnamed = [ - ] - -- modes handled but not shown - ,groupHidden = [ - testmode - ,convertmode - ] - } - ,modeGroupFlags = Group { - -- flags in named groups: - groupNamed = [generalflagsgroup3] - -- flags in the unnamed group, shown last without a heading: - ,groupUnnamed = [] - -- flags accepted but not shown in the help: - ,groupHidden = inputflags -- included here so they'll not raise a confusing error if present with no COMMAND - } - } - -- help_postscript = [ -- -- "DATES can be Y/M/D or smart dates like \"last month\"." -- -- ,"PATTERNS are regular" @@ -279,143 +223,6 @@ mainmode addons = defMode { -- -- ,"When using both, not: comes last." -- ] --- visible subcommand modes - -addmode = (defCommandMode ["add"]) { - modeHelp = "prompt for transactions 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 = [generalflagsgroup2] - } - } - -balancemode = (defCommandMode $ ["balance"] ++ aliases ++ ["bal"]) { -- also accept but don't show the common bal alias - modeHelp = "show accounts and balances" `withAliases` aliases - ,modeGroupFlags = Group { - groupUnnamed = [ - 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 = [generalflagsgroup1] - } - } - where aliases = ["b"] - -printmode = (defCommandMode $ ["print"] ++ aliases) { - modeHelp = "show transaction entries" `withAliases` aliases - ,modeGroupFlags = Group { - groupUnnamed = [] - ,groupHidden = [] - ,groupNamed = [generalflagsgroup1] - } - } - where aliases = ["p"] - -registermode = (defCommandMode $ ["register"] ++ aliases ++ ["reg"]) { - modeHelp = "show 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 = [generalflagsgroup1] - } - } - where aliases = ["r"] - --- 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 = [generalflagsgroup1] - } - } - -incomestatementmode = (defCommandMode $ ["incomestatement"]++aliases) { - modeHelp = "show an income statement" `withAliases` aliases - ,modeGroupFlags = Group { - groupUnnamed = [] - ,groupHidden = [] - ,groupNamed = [generalflagsgroup1] - } - } - where aliases = ["is"] - -balancesheetmode = (defCommandMode $ ["balancesheet"]++aliases) { - modeHelp = "show a balance sheet" `withAliases` aliases - ,modeGroupFlags = Group { - groupUnnamed = [] - ,groupHidden = [] - ,groupNamed = [generalflagsgroup1] - } - } - where aliases = ["bs"] - -cashflowmode = (defCommandMode ["cashflow","cf"]) { - modeHelp = "show a cashflow statement" `withAliases` ["cf"] - ,modeGroupFlags = Group { - groupUnnamed = [] - ,groupHidden = [] - ,groupNamed = [generalflagsgroup1] - } - } - -statsmode = (defCommandMode $ ["stats"] ++ aliases) { - modeHelp = "show quick journal statistics" `withAliases` aliases - ,modeGroupFlags = Group { - groupUnnamed = [] - ,groupHidden = [] - ,groupNamed = [generalflagsgroup1] - } - } - where aliases = ["s"] - --- hidden commands - -testmode = (defCommandMode ["test"]) { - modeHelp = "run built-in self-tests" - ,modeArgs = ([], Just $ argsFlag "[REGEXPS]") - ,modeGroupFlags = Group { - groupUnnamed = [] - ,groupHidden = [] - ,groupNamed = [generalflagsgroup3] - } - } - -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 @@ -493,48 +300,6 @@ rawOptsToCliOpts rawopts = do } } --- | 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)) diff --git a/hledger/Hledger/Cli/Print.hs b/hledger/Hledger/Cli/Print.hs index a09ebff9f..2cd63ad7b 100644 --- a/hledger/Hledger/Cli/Print.hs +++ b/hledger/Hledger/Cli/Print.hs @@ -5,11 +5,15 @@ A ledger-compatible @print@ command. -} module Hledger.Cli.Print ( - print' + printmode + ,print' ,showTransactions ,tests_Hledger_Cli_Print -) where +) +where + import Data.List +import System.Console.CmdArgs.Explicit import Test.HUnit import Hledger @@ -17,6 +21,17 @@ import Prelude hiding (putStr) import Hledger.Utils.UTF8IOCompat (putStr) import Hledger.Cli.Options + +printmode = (defCommandMode $ ["print"] ++ aliases) { + modeHelp = "show transaction entries" `withAliases` aliases + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [generalflagsgroup1] + } + } + where aliases = ["p"] + -- | Print journal transactions in standard format. print' :: CliOpts -> Journal -> IO () print' CliOpts{reportopts_=ropts} j = do @@ -70,4 +85,4 @@ entriesReportAsText :: ReportOpts -> Query -> EntriesReport -> String entriesReportAsText _ _ items = concatMap showTransactionUnelided items tests_Hledger_Cli_Print = TestList - tests_showTransactions \ No newline at end of file + tests_showTransactions diff --git a/hledger/Hledger/Cli/Register.hs b/hledger/Hledger/Cli/Register.hs index 5b90e2468..f623235ae 100644 --- a/hledger/Hledger/Cli/Register.hs +++ b/hledger/Hledger/Cli/Register.hs @@ -5,7 +5,8 @@ A ledger-compatible @register@ command. -} module Hledger.Cli.Register ( - register + registermode + ,register ,postingsReportAsText -- ,showPostingWithBalanceForVty ,tests_Hledger_Cli_Register @@ -13,6 +14,7 @@ module Hledger.Cli.Register ( import Data.List import Data.Maybe +import System.Console.CmdArgs.Explicit import Test.HUnit import Text.Printf @@ -22,6 +24,20 @@ import Hledger.Utils.UTF8IOCompat (putStr) import Hledger.Cli.Options +registermode = (defCommandMode $ ["register"] ++ aliases ++ ["reg"]) { + modeHelp = "show 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 = [generalflagsgroup1] + } + } + where aliases = ["r"] + -- | Print a (posting) register report. register :: CliOpts -> Journal -> IO () register opts@CliOpts{reportopts_=ropts} j = do diff --git a/hledger/Hledger/Cli/Stats.hs b/hledger/Hledger/Cli/Stats.hs index 89d1510d5..be9738588 100644 --- a/hledger/Hledger/Cli/Stats.hs +++ b/hledger/Hledger/Cli/Stats.hs @@ -4,12 +4,17 @@ Print some statistics for the journal. -} -module Hledger.Cli.Stats +module Hledger.Cli.Stats ( + statsmode + ,stats +) where + import Data.List import Data.Maybe import Data.Ord import Data.Time.Calendar +import System.Console.CmdArgs.Explicit import Text.Printf import qualified Data.Map as Map @@ -19,6 +24,16 @@ import Prelude hiding (putStr) import Hledger.Utils.UTF8IOCompat (putStr) +statsmode = (defCommandMode $ ["stats"] ++ aliases) { + modeHelp = "show quick journal statistics" `withAliases` aliases + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [generalflagsgroup1] + } + } + where aliases = ["s"] + -- like Register.summarisePostings -- | Print various statistics for the journal. stats :: CliOpts -> Journal -> IO () diff --git a/hledger/Hledger/Cli/Tests.hs b/hledger/Hledger/Cli/Tests.hs index 3b654e33f..15c8764e2 100644 --- a/hledger/Hledger/Cli/Tests.hs +++ b/hledger/Hledger/Cli/Tests.hs @@ -6,8 +6,12 @@ A simple test runner for hledger's built-in unit tests. -} -module Hledger.Cli.Tests +module Hledger.Cli.Tests ( + testmode + ,test' +) where + import Control.Monad import System.Exit import Test.HUnit @@ -34,22 +38,32 @@ test' opts = do then exitFailure else exitWith ExitSuccess +testmode = (defCommandMode ["test"]) { + modeHelp = "run built-in self-tests" + ,modeArgs = ([], Just $ argsFlag "[REGEXPS]") + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [generalflagsgroup3] + } + } + -- | Run all or just the matched unit tests and return their HUnit result counts. runTests :: CliOpts -> IO Counts runTests = liftM (fst . flip (,) 0) . runTestTT . flatTests --- | Run all or just the matched unit tests until the first failure or --- error, returning the name of the problem test if any. -runTestsTillFailure :: CliOpts -> IO (Maybe String) -runTestsTillFailure _ = undefined -- do - -- let ts = flatTests opts - -- results = liftM (fst . flip (,) 0) $ runTestTT $ - -- firstproblem = find (\counts -> ) +-- -- | Run all or just the matched unit tests until the first failure or +-- -- error, returning the name of the problem test if any. +-- runTestsTillFailure :: CliOpts -> IO (Maybe String) +-- runTestsTillFailure _ = undefined -- do +-- -- let ts = flatTests opts +-- -- results = liftM (fst . flip (,) 0) $ runTestTT $ +-- -- firstproblem = find (\counts -> ) -- | All or pattern-matched tests, as a flat list to show simple names. flatTests opts = TestList $ filter (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . testName) $ flattenTests tests_Hledger_Cli --- | All or pattern-matched tests, in the original suites to show hierarchical names. -hierarchicalTests opts = filterTests (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . testName) tests_Hledger_Cli +-- -- | All or pattern-matched tests, in the original suites to show hierarchical names. +-- hierarchicalTests opts = filterTests (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . testName) tests_Hledger_Cli #endif