move command-specific options to the respective command modules

This commit is contained in:
Simon Michael 2014-03-21 10:45:13 -07:00
parent e99c3c4b01
commit 2d1e0d7cd4
12 changed files with 304 additions and 295 deletions

View File

@ -17,6 +17,7 @@ import Data.Maybe
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import Data.Typeable (Typeable) import Data.Typeable (Typeable)
import Safe (headDef, headMay) import Safe (headDef, headMay)
import System.Console.CmdArgs.Explicit
import System.Console.Haskeline (runInputT, defaultSettings, setComplete) import System.Console.Haskeline (runInputT, defaultSettings, setComplete)
import System.Console.Haskeline.Completion import System.Console.Haskeline.Completion
import System.Console.Wizard import System.Console.Wizard
@ -29,6 +30,19 @@ import Hledger
import Hledger.Cli.Options import Hledger.Cli.Options
import Hledger.Cli.Register (postingsReportAsText) 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. -- | State used while entering transactions.
data EntryState = EntryState { data EntryState = EntryState {
esOpts :: CliOpts -- ^ command line options esOpts :: CliOpts -- ^ command line options

View File

@ -233,7 +233,8 @@ Currently, empty cells show 0.
-} -}
module Hledger.Cli.Balance ( module Hledger.Cli.Balance (
balance balancemode
,balance
,balanceReportAsText ,balanceReportAsText
,periodBalanceReportAsText ,periodBalanceReportAsText
,cumulativeBalanceReportAsText ,cumulativeBalanceReportAsText
@ -243,8 +244,11 @@ module Hledger.Cli.Balance (
import Data.List import Data.List
import Data.Maybe import Data.Maybe
-- import System.Console.CmdArgs
import System.Console.CmdArgs.Explicit as C
-- import System.Console.CmdArgs.Text
import Test.HUnit import Test.HUnit
import Text.Tabular import Text.Tabular as T
import Text.Tabular.AsciiArt import Text.Tabular.AsciiArt
import Hledger import Hledger
@ -254,7 +258,26 @@ import Hledger.Data.OutputFormat
import Hledger.Cli.Options 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 -> Journal -> IO ()
balance CliOpts{reportopts_=ropts} j = do balance CliOpts{reportopts_=ropts} j = do
d <- getCurrentDay d <- getCurrentDay
@ -353,8 +376,8 @@ periodBalanceReportAsText opts (MultiBalanceReport (colspans, items, coltotals))
((" "++) . showDateSpan) ((" "++) . showDateSpan)
showMixedAmountWithoutPrice showMixedAmountWithoutPrice
$ Table $ Table
(Group NoLine $ map (Header . padright acctswidth) accts) (T.Group NoLine $ map (Header . padright acctswidth) accts)
(Group NoLine $ map Header colspans) (T.Group NoLine $ map Header colspans)
(map snd items') (map snd items')
+----+ +----+
totalrow totalrow
@ -378,8 +401,8 @@ cumulativeBalanceReportAsText opts (MultiBalanceReport (colspans, items, coltota
render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountWithoutPrice $ render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountWithoutPrice $
addtotalrow $ addtotalrow $
Table Table
(Group NoLine $ map (Header . padright acctswidth) accts) (T.Group NoLine $ map (Header . padright acctswidth) accts)
(Group NoLine $ map Header colspans) (T.Group NoLine $ map Header colspans)
(map snd items) (map snd items)
where where
trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init) 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 $ render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountWithoutPrice $
addtotalrow $ addtotalrow $
Table Table
(Group NoLine $ map (Header . padright acctswidth) accts) (T.Group NoLine $ map (Header . padright acctswidth) accts)
(Group NoLine $ map Header colspans) (T.Group NoLine $ map Header colspans)
(map snd items) (map snd items)
where where
trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init) trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init)

View File

@ -6,11 +6,13 @@ The @balancesheet@ command prints a simple balance sheet.
-} -}
module Hledger.Cli.Balancesheet ( module Hledger.Cli.Balancesheet (
balancesheet balancesheetmode
,balancesheet
,tests_Hledger_Cli_Balancesheet ,tests_Hledger_Cli_Balancesheet
) where ) where
import qualified Data.Text.Lazy.IO as LT import qualified Data.Text.Lazy.IO as LT
import System.Console.CmdArgs.Explicit
import Test.HUnit import Test.HUnit
import Text.Shakespeare.Text import Text.Shakespeare.Text
@ -19,6 +21,16 @@ import Hledger.Cli.Options
import Hledger.Cli.Balance 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. -- | Print a simple balance sheet.
balancesheet :: CliOpts -> Journal -> IO () balancesheet :: CliOpts -> Journal -> IO ()
balancesheet CliOpts{reportopts_=ropts} j = do balancesheet CliOpts{reportopts_=ropts} j = do

View File

@ -9,11 +9,13 @@ cash flows.)
-} -}
module Hledger.Cli.Cashflow ( module Hledger.Cli.Cashflow (
cashflow cashflowmode
,cashflow
,tests_Hledger_Cli_Cashflow ,tests_Hledger_Cli_Cashflow
) where ) where
import qualified Data.Text.Lazy.IO as LT import qualified Data.Text.Lazy.IO as LT
import System.Console.CmdArgs.Explicit
import Test.HUnit import Test.HUnit
import Text.Shakespeare.Text import Text.Shakespeare.Text
@ -22,6 +24,15 @@ import Hledger.Cli.Options
import Hledger.Cli.Balance 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. -- | Print a simple cashflow statement.
cashflow :: CliOpts -> Journal -> IO () cashflow :: CliOpts -> Journal -> IO ()
cashflow CliOpts{reportopts_=ropts} j = do cashflow CliOpts{reportopts_=ropts} j = do

View File

@ -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.List
import Data.Maybe import Data.Maybe
import Data.Ord import Data.Ord
import System.Console.CmdArgs.Explicit
import Text.Printf import Text.Printf
import Hledger.Cli.Options import Hledger.Cli.Options
@ -19,6 +20,16 @@ import Prelude hiding (putStr)
import Hledger.Utils.UTF8IOCompat (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 = '*' barchar = '*'
-- | Print a histogram of some statistic per reporting interval, such as -- | Print a histogram of some statistic per reporting interval, such as

View File

@ -6,11 +6,13 @@ The @incomestatement@ command prints a simple income statement (profit & loss) r
-} -}
module Hledger.Cli.Incomestatement ( module Hledger.Cli.Incomestatement (
incomestatement incomestatementmode
,incomestatement
,tests_Hledger_Cli_Incomestatement ,tests_Hledger_Cli_Incomestatement
) where ) where
import qualified Data.Text.Lazy.IO as LT import qualified Data.Text.Lazy.IO as LT
import System.Console.CmdArgs.Explicit
import Test.HUnit import Test.HUnit
import Text.Shakespeare.Text import Text.Shakespeare.Text
@ -18,6 +20,17 @@ import Hledger
import Hledger.Cli.Options import Hledger.Cli.Options
import Hledger.Cli.Balance 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. -- | Print a simple income statement.
incomestatement :: CliOpts -> Journal -> IO () incomestatement :: CliOpts -> Journal -> IO ()
incomestatement CliOpts{reportopts_=ropts} j = do incomestatement CliOpts{reportopts_=ropts} j = do

View File

@ -39,10 +39,10 @@ See "Hledger.Data.Ledger" for more examples.
module Hledger.Cli.Main where module Hledger.Cli.Main where
import Control.Monad import Control.Monad
import Data.Char (isDigit)
import Data.List import Data.List
import Safe import Safe
import System.Console.CmdArgs.Explicit (modeHelp) import System.Console.CmdArgs.Explicit as C
-- import System.Console.CmdArgs.Helper
import System.Environment import System.Environment
import System.Exit import System.Exit
import System.Process import System.Process
@ -66,6 +66,106 @@ import Hledger.Utils
import Hledger.Reports import Hledger.Reports
import Hledger.Data.Dates 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 :: IO ()
main = do main = do
@ -158,7 +258,7 @@ main = do
system shellcmd >>= exitWith system shellcmd >>= exitWith
-- deprecated commands -- deprecated commands
| cmd == "convert" = error' (modeHelp convertmode) >> exitFailure | cmd == "convert" = error' (modeHelp oldconvertmode) >> exitFailure
-- shouldn't reach here -- shouldn't reach here
| otherwise = optserror ("could not understand the arguments "++show args) >> exitFailure | otherwise = optserror ("could not understand the arguments "++show args) >> exitFailure

View File

@ -1,51 +1,40 @@
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DeriveDataTypeable #-} {-# 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 ( module Hledger.Cli.Options (
-- * cmdargs modes & flags -- * cmdargs modes & flags
-- | These tell cmdargs how to parse the command line arguments. -- | These tell cmdargs how to parse the command line arguments for each hledger subcommand.
-- 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, argsFlag,
helpflags, defAddonCommandMode,
inputflags, defCommandMode,
reportflags, defMode,
generalflagsgroup1, generalflagsgroup1,
generalflagsgroup2, generalflagsgroup2,
generalflagsgroup3, generalflagsgroup3,
helpflags,
inputflags,
reportflags,
-- * raw options -- * Raw options
-- | To allow the cmdargs modes to be reused and extended by other -- | To allow the cmdargs modes to be reused and extended by other
-- packages (eg, add-ons which want to mimic the standard hledger -- packages (eg, add-ons which want to mimic the standard hledger
-- options), we parse the command-line arguments to a simple -- options), our cmdargs modes parse to an extensible association
-- association list, not a fixed ADT. -- list (RawOpts) rather than a closed ADT like CliOpts.
RawOpts, RawOpts,
inRawOpts,
boolopt, boolopt,
inRawOpts,
intopt, intopt,
maybeintopt,
stringopt,
maybestringopt,
listofstringopt, listofstringopt,
setopt, maybeintopt,
maybestringopt,
setboolopt, setboolopt,
setopt,
stringopt,
-- * CLI options -- * CLI options
-- | Raw options are converted to a more convenient, -- | Raw options are converted to a more convenient,
@ -56,27 +45,26 @@ module Hledger.Cli.Options (
-- * CLI option accessors -- * CLI option accessors
-- | Some options require more processing. Possibly these should be merged into argsToCliOpts. -- | Some options require more processing. Possibly these should be merged into argsToCliOpts.
OutputWidth(..),
Width(..),
aliasesFromOpts, aliasesFromOpts,
defaultWidth,
defaultWidthWithFlag,
formatFromOpts, formatFromOpts,
journalFilePathFromOpts, journalFilePathFromOpts,
rulesFilePathFromOpts, rulesFilePathFromOpts,
OutputWidth(..),
Width(..),
defaultWidth,
defaultWidthWithFlag,
widthFromOpts, widthFromOpts,
-- * utilities -- * utilities
getHledgerAddonCommands,
argsToCliOpts,
moveFlagsAfterCommand,
decodeRawOpts,
checkCliOpts, checkCliOpts,
rawOptsToCliOpts,
optserror,
showModeHelp,
debugArgs, debugArgs,
decodeRawOpts,
getCliOpts, getCliOpts,
getHledgerAddonCommands,
optserror,
rawOptsToCliOpts,
showModeHelp,
withAliases,
-- * tests -- * tests
tests_Hledger_Cli_Options tests_Hledger_Cli_Options
@ -87,7 +75,6 @@ where
import qualified Control.Exception as C import qualified Control.Exception as C
-- import Control.Monad (filterM) -- import Control.Monad (filterM)
import Control.Monad (when) import Control.Monad (when)
import Data.Char (isDigit)
import Data.List import Data.List
import Data.List.Split import Data.List.Split
import Data.Maybe import Data.Maybe
@ -158,7 +145,7 @@ generalflagsgroup1 = (generalflagstitle, inputflags ++ reportflags ++ helpflags)
generalflagsgroup2 = (generalflagstitle, inputflags ++ helpflags) generalflagsgroup2 = (generalflagstitle, inputflags ++ helpflags)
generalflagsgroup3 = (generalflagstitle, helpflags) generalflagsgroup3 = (generalflagstitle, helpflags)
-- cmdargs modes -- cmdargs mode constructors
-- | A basic mode template. -- | A basic mode template.
defMode :: Mode RawOpts defMode :: Mode RawOpts
@ -203,6 +190,8 @@ defAddonCommandMode addon = defMode {
striphs = regexReplace "\\.l?hs$" "" 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 :: [(String,String)]
standardAddonsHelp = [ standardAddonsHelp = [
("chart", "generate simple balance pie charts") ("chart", "generate simple balance pie charts")
@ -226,51 +215,6 @@ s `withAliases` as = s ++ " (" ++ intercalate ", " as ++ ")"
-- s `withAliases` as = s ++ " (aliases: " ++ 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 = [ -- help_postscript = [
-- -- "DATES can be Y/M/D or smart dates like \"last month\"." -- -- "DATES can be Y/M/D or smart dates like \"last month\"."
-- -- ,"PATTERNS are regular" -- -- ,"PATTERNS are regular"
@ -279,143 +223,6 @@ mainmode addons = defMode {
-- -- ,"When using both, not: comes last." -- -- ,"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 -- 2. A package-specific data structure holding options used in this
-- package and above, parsed from RawOpts. This represents the -- 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. -- | Convert possibly encoded option values to regular unicode strings.
decodeRawOpts = map (\(name,val) -> (name, fromSystemString val)) decodeRawOpts = map (\(name,val) -> (name, fromSystemString val))

View File

@ -5,11 +5,15 @@ A ledger-compatible @print@ command.
-} -}
module Hledger.Cli.Print ( module Hledger.Cli.Print (
print' printmode
,print'
,showTransactions ,showTransactions
,tests_Hledger_Cli_Print ,tests_Hledger_Cli_Print
) where )
where
import Data.List import Data.List
import System.Console.CmdArgs.Explicit
import Test.HUnit import Test.HUnit
import Hledger import Hledger
@ -17,6 +21,17 @@ import Prelude hiding (putStr)
import Hledger.Utils.UTF8IOCompat (putStr) import Hledger.Utils.UTF8IOCompat (putStr)
import Hledger.Cli.Options 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 journal transactions in standard format.
print' :: CliOpts -> Journal -> IO () print' :: CliOpts -> Journal -> IO ()
print' CliOpts{reportopts_=ropts} j = do print' CliOpts{reportopts_=ropts} j = do
@ -70,4 +85,4 @@ entriesReportAsText :: ReportOpts -> Query -> EntriesReport -> String
entriesReportAsText _ _ items = concatMap showTransactionUnelided items entriesReportAsText _ _ items = concatMap showTransactionUnelided items
tests_Hledger_Cli_Print = TestList tests_Hledger_Cli_Print = TestList
tests_showTransactions tests_showTransactions

View File

@ -5,7 +5,8 @@ A ledger-compatible @register@ command.
-} -}
module Hledger.Cli.Register ( module Hledger.Cli.Register (
register registermode
,register
,postingsReportAsText ,postingsReportAsText
-- ,showPostingWithBalanceForVty -- ,showPostingWithBalanceForVty
,tests_Hledger_Cli_Register ,tests_Hledger_Cli_Register
@ -13,6 +14,7 @@ module Hledger.Cli.Register (
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import System.Console.CmdArgs.Explicit
import Test.HUnit import Test.HUnit
import Text.Printf import Text.Printf
@ -22,6 +24,20 @@ import Hledger.Utils.UTF8IOCompat (putStr)
import Hledger.Cli.Options 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. -- | Print a (posting) register report.
register :: CliOpts -> Journal -> IO () register :: CliOpts -> Journal -> IO ()
register opts@CliOpts{reportopts_=ropts} j = do register opts@CliOpts{reportopts_=ropts} j = do

View File

@ -4,12 +4,17 @@ Print some statistics for the journal.
-} -}
module Hledger.Cli.Stats module Hledger.Cli.Stats (
statsmode
,stats
)
where where
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Ord import Data.Ord
import Data.Time.Calendar import Data.Time.Calendar
import System.Console.CmdArgs.Explicit
import Text.Printf import Text.Printf
import qualified Data.Map as Map import qualified Data.Map as Map
@ -19,6 +24,16 @@ import Prelude hiding (putStr)
import Hledger.Utils.UTF8IOCompat (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 -- like Register.summarisePostings
-- | Print various statistics for the journal. -- | Print various statistics for the journal.
stats :: CliOpts -> Journal -> IO () stats :: CliOpts -> Journal -> IO ()

View File

@ -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 where
import Control.Monad import Control.Monad
import System.Exit import System.Exit
import Test.HUnit import Test.HUnit
@ -34,22 +38,32 @@ test' opts = do
then exitFailure then exitFailure
else exitWith ExitSuccess 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. -- | Run all or just the matched unit tests and return their HUnit result counts.
runTests :: CliOpts -> IO Counts runTests :: CliOpts -> IO Counts
runTests = liftM (fst . flip (,) 0) . runTestTT . flatTests runTests = liftM (fst . flip (,) 0) . runTestTT . flatTests
-- | Run all or just the matched unit tests until the first failure or -- -- | Run all or just the matched unit tests until the first failure or
-- error, returning the name of the problem test if any. -- -- error, returning the name of the problem test if any.
runTestsTillFailure :: CliOpts -> IO (Maybe String) -- runTestsTillFailure :: CliOpts -> IO (Maybe String)
runTestsTillFailure _ = undefined -- do -- runTestsTillFailure _ = undefined -- do
-- let ts = flatTests opts -- -- let ts = flatTests opts
-- results = liftM (fst . flip (,) 0) $ runTestTT $ -- -- results = liftM (fst . flip (,) 0) $ runTestTT $
-- firstproblem = find (\counts -> ) -- -- firstproblem = find (\counts -> )
-- | All or pattern-matched tests, as a flat list to show simple names. -- | 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 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. -- -- | 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 -- hierarchicalTests opts = filterTests (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . testName) tests_Hledger_Cli
#endif #endif