--options-anywhere to use ^ for negative patterns and permit options anywhere in command-line

This commit is contained in:
Simon Michael 2008-11-25 19:29:33 +00:00
parent 20bf9ae7ad
commit dc007e69a5
8 changed files with 38 additions and 30 deletions

View File

@ -125,7 +125,7 @@ showBalanceReport opts args l = acctsstr ++ (if collapse then "" else totalstr)
showatree t = showAccountTreeWithBalances matchedacctnames t showatree t = showAccountTreeWithBalances matchedacctnames t
matchedacctnames = balancereportacctnames l sub apats t matchedacctnames = balancereportacctnames l sub apats t
t = (if empty then id else pruneZeroBalanceLeaves) $ ledgerAccountTree maxdepth l t = (if empty then id else pruneZeroBalanceLeaves) $ ledgerAccountTree maxdepth l
apats = fst $ parseAccountDescriptionArgs args apats = fst $ parseAccountDescriptionArgs opts args
maxdepth = fromMaybe 9999 $ depthFromOpts opts maxdepth = fromMaybe 9999 $ depthFromOpts opts
sub = SubTotal `elem` opts || (isJust $ depthFromOpts opts) sub = SubTotal `elem` opts || (isJust $ depthFromOpts opts)
empty = Empty `elem` opts empty = Empty `elem` opts

View File

@ -11,9 +11,6 @@ import Ledger.Utils
import Ledger.Types import Ledger.Types
-- change to permit options anywhere on the command line. ^ is a good choice
negativepatternchar = '-'
-- change to use a different separator for nested accounts -- change to use a different separator for nested accounts
acctsepchar = ':' acctsepchar = ':'
@ -171,9 +168,8 @@ match_negative_pats pats str = (not $ null ns) && (any match ns)
match "" = True match "" = True
match p = matchregex (abspat p) str match p = matchregex (abspat p) str
isnegativepat pat = (== [negativepatternchar]) $ take 1 pat isnegativepat pat = take 1 pat `elem` ["-","^"]
abspat pat = if isnegativepat pat then drop 1 pat else pat abspat pat = if isnegativepat pat then drop 1 pat else pat
positivepats = filter (not . isnegativepat) positivepats = filter (not . isnegativepat)
negativepats = filter isnegativepat negativepats = filter isnegativepat
matchregex pat str = containsRegex (mkRegexWithOpts pat True True) str matchregex pat str = containsRegex (mkRegexWithOpts pat True True) str

View File

@ -4,29 +4,35 @@ import System
import System.Console.GetOpt import System.Console.GetOpt
import System.Directory import System.Directory
import Text.Printf import Text.Printf
import Ledger.AccountName (negativepatternchar)
import Ledger.Parse (smartparsedate) import Ledger.Parse (smartparsedate)
import Ledger.Dates import Ledger.Dates
import Ledger.Utils import Ledger.Utils
usagehdr = "Usage: hledger [OPTS] COMMAND [ACCTPATTERNS] [-- DESCPATTERNS]\n\nOptions"++warning++":" usage opts = usageInfo usagehdr options ++ usageftr
warning = if negativepatternchar=='-' then " (must appear before command)" else " (can appear anywhere)"
negativePatternChar opts
| OptionsAnywhere `elem` opts = '^'
| otherwise = '-'
usagehdr = "Usage: hledger [OPTS] COMMAND [ACCTPATTERNS] [-- DESCPATTERNS]\n" ++
"\n" ++
"Options (before command, unless using --options-anywhere):"
usageftr = "\n" ++ usageftr = "\n" ++
"Commands (may be abbreviated):\n" ++ "Commands (may be abbreviated):\n" ++
" balance - show account balances\n" ++ " balance - show account balances\n" ++
" print - show formatted ledger entries\n" ++ " print - show formatted ledger entries\n" ++
" register - show register transactions\n" ++ " register - show register transactions\n" ++
"\n" ++ "\n" ++
"Account and description patterns can be used to filter by account name\n" ++ "Account and description patterns are regular expressions which filter by\n" ++
"and entry description. They are regular expressions, optionally prefixed\n" ++ "account name and entry description. Prefix a pattern with - to negate it,\n" ++
"with " ++ [negativepatternchar] ++ " to make them negative.\n" ++ "and separate account and description patterns with --.\n" ++
"(With --options-anywhere, use ^ and ^^.)\n" ++
"\n" ++ "\n" ++
"Also: hledger [-v] test [TESTPATTERNS] to run self-tests.\n" ++ "Also: hledger [-v] test [TESTPATTERNS] to run self-tests.\n" ++
"\n" "\n"
defaultfile = "~/.ledger" defaultfile = "~/.ledger"
fileenvvar = "LEDGER" fileenvvar = "LEDGER"
optionorder = if negativepatternchar=='-' then RequireOrder else Permute
-- | Command-line options we accept. -- | Command-line options we accept.
options :: [OptDescr Opt] options :: [OptDescr Opt]
@ -41,6 +47,7 @@ options = [
"(where EXPR is 'dOP[Y/M/D]', OP is <, <=, =, >=, >)"), "(where EXPR is 'dOP[Y/M/D]', OP is <, <=, =, >=, >)"),
Option ['E'] ["empty"] (NoArg Empty) "balance report: show accounts with zero balance", Option ['E'] ["empty"] (NoArg Empty) "balance report: show accounts with zero balance",
Option ['R'] ["real"] (NoArg Real) "report only on real (non-virtual) transactions", Option ['R'] ["real"] (NoArg Real) "report only on real (non-virtual) transactions",
Option [] ["options-anywhere"] (NoArg OptionsAnywhere) "allow options anywhere, use ^ to negate patterns",
Option ['n'] ["collapse"] (NoArg Collapse) "balance report: no grand total", Option ['n'] ["collapse"] (NoArg Collapse) "balance report: no grand total",
Option ['s'] ["subtotal"] (NoArg SubTotal) "balance report: show subaccounts", Option ['s'] ["subtotal"] (NoArg SubTotal) "balance report: show subaccounts",
Option ['h'] ["help"] (NoArg Help) "show this help", Option ['h'] ["help"] (NoArg Help) "show this help",
@ -62,6 +69,7 @@ data Opt =
Display String | Display String |
Empty | Empty |
Real | Real |
OptionsAnywhere |
Collapse | Collapse |
SubTotal | SubTotal |
Help | Help |
@ -69,8 +77,6 @@ data Opt =
Version Version
deriving (Show,Eq) deriving (Show,Eq)
usage = usageInfo usagehdr options ++ usageftr
versionno = "0.3pre" versionno = "0.3pre"
version = printf "hledger version %s \n" versionno :: String version = printf "hledger version %s \n" versionno :: String
@ -79,10 +85,11 @@ version = printf "hledger version %s \n" versionno :: String
parseArguments :: IO ([Opt], String, [String]) parseArguments :: IO ([Opt], String, [String])
parseArguments = do parseArguments = do
args <- getArgs args <- getArgs
case (getOpt optionorder options args) of let order = if "--options-anywhere" `elem` args then Permute else RequireOrder
case (getOpt order options args) of
(opts,cmd:args,[]) -> return (opts, cmd, args) (opts,cmd:args,[]) -> return (opts, cmd, args)
(opts,[],[]) -> return (opts, [], []) (opts,[],[]) -> return (opts, [], [])
(_,_,errs) -> ioError (userError (concat errs ++ usage)) (opts,_,errs) -> ioError (userError (concat errs ++ usage opts))
-- | Get the ledger file path from options, an environment variable, or a default -- | Get the ledger file path from options, an environment variable, or a default
ledgerFilePathFromOpts :: [Opt] -> IO String ledgerFilePathFromOpts :: [Opt] -> IO String
@ -153,11 +160,15 @@ displayFromOpts opts =
-- | Gather any ledger-style account/description pattern arguments into -- | Gather any ledger-style account/description pattern arguments into
-- two lists. These are 0 or more account patterns optionally followed by -- two lists. These are 0 or more account patterns optionally followed by
-- -- and 0 or more description patterns. -- a separator and then 0 or more description patterns. The separator is
parseAccountDescriptionArgs :: [String] -> ([String],[String]) -- usually -- but with --options-anywhere is ^^ so we need to provide the
parseAccountDescriptionArgs args = (as, ds') -- options as well.
where (as, ds) = break (=="--") args parseAccountDescriptionArgs :: [Opt] -> [String] -> ([String],[String])
ds' = dropWhile (=="--") ds parseAccountDescriptionArgs opts args = (as, ds')
where (as, ds) = break (==patseparator) args
ds' = dropWhile (==patseparator) ds
patseparator = replicate 2 negchar
negchar = negativePatternChar opts
-- testoptions RequireOrder ["foo","-v"] -- testoptions RequireOrder ["foo","-v"]
-- testoptions Permute ["foo","-v"] -- testoptions Permute ["foo","-v"]
@ -168,5 +179,5 @@ parseAccountDescriptionArgs args = (as, ds')
testoptions order cmdline = putStr $ testoptions order cmdline = putStr $
case getOpt order options cmdline of case getOpt order options cmdline of
(o,n,[] ) -> "options=" ++ show o ++ " args=" ++ show n (o,n,[] ) -> "options=" ++ show o ++ " args=" ++ show n
(_,_,errs) -> concat errs ++ usage (o,_,errs) -> concat errs ++ usage o

View File

@ -18,4 +18,4 @@ showEntries :: [Opt] -> [String] -> Ledger -> String
showEntries opts args l = concatMap showEntry $ filteredentries showEntries opts args l = concatMap showEntry $ filteredentries
where where
filteredentries = entries $ filterRawLedgerEntriesByAccount apats $ rawledger l filteredentries = entries $ filterRawLedgerEntriesByAccount apats $ rawledger l
(apats,_) = parseAccountDescriptionArgs args (apats,_) = parseAccountDescriptionArgs opts args

1
README
View File

@ -80,6 +80,7 @@ hledger-specific features:
--depth=N balance report: maximum account depth to show --depth=N balance report: maximum account depth to show
--cost alias for basis --cost alias for basis
--options-anywhere allow options anywhere, use ^ for negative patterns
ledger features not supported: ledger features not supported:

View File

@ -30,7 +30,7 @@ showRegisterReport opts args l = showtxns ts nulltxn nullmixedamt
where where
ts = filter matchapats $ ledgerTransactions l ts = filter matchapats $ ledgerTransactions l
matchapats t = matchpats apats $ account t matchapats t = matchpats apats $ account t
apats = fst $ parseAccountDescriptionArgs args apats = fst $ parseAccountDescriptionArgs opts args
matchdisplayopt Nothing t = True matchdisplayopt Nothing t = True
matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t
dopt = displayFromOpts opts dopt = displayFromOpts opts

View File

@ -21,7 +21,7 @@ ledgerfromstring :: [String] -> String -> Ledger
ledgerfromstring args s = ledgerfromstring args s =
cacheLedger apats $ filterRawLedger Nothing Nothing dpats False False l cacheLedger apats $ filterRawLedger Nothing Nothing dpats False False l
where where
(apats,dpats) = parseAccountDescriptionArgs args (apats,dpats) = parseAccountDescriptionArgs [] args
l = rawledgerfromstring s l = rawledgerfromstring s
-- | Get a RawLedger from the given file path, or a dummy one if there was an error. -- | Get a RawLedger from the given file path, or a dummy one if there was an error.
@ -37,7 +37,7 @@ ledgerfromfile args f = do
l <- rawledgerfromfile f l <- rawledgerfromfile f
return $ cacheLedger apats $ filterRawLedger Nothing Nothing dpats False False l return $ cacheLedger apats $ filterRawLedger Nothing Nothing dpats False False l
where where
(apats,dpats) = parseAccountDescriptionArgs args (apats,dpats) = parseAccountDescriptionArgs [] args
-- | Get a RawLedger from the file your LEDGER environment variable -- | Get a RawLedger from the file your LEDGER environment variable
-- variable points to, or a dummy one if there was a problem. -- variable points to, or a dummy one if there was a problem.

View File

@ -57,13 +57,13 @@ main = do
run cmd opts args run cmd opts args
where where
run cmd opts args run cmd opts args
| Help `elem` opts = putStr usage | Help `elem` opts = putStr $ usage opts
| Version `elem` opts = putStr version | Version `elem` opts = putStr version
| cmd `isPrefixOf` "balance" = parseLedgerAndDo opts args balance | cmd `isPrefixOf` "balance" = parseLedgerAndDo opts args balance
| cmd `isPrefixOf` "print" = parseLedgerAndDo opts args print' | cmd `isPrefixOf` "print" = parseLedgerAndDo opts args print'
| cmd `isPrefixOf` "register" = parseLedgerAndDo opts args register | cmd `isPrefixOf` "register" = parseLedgerAndDo opts args register
| cmd `isPrefixOf` "test" = runtests opts args >> return () | cmd `isPrefixOf` "test" = runtests opts args >> return ()
| otherwise = putStr usage | otherwise = putStr $ usage opts
-- | parse the user's specified ledger file and do some action with it -- | parse the user's specified ledger file and do some action with it
-- (or report a parse error). This function makes the whole thing go. -- (or report a parse error). This function makes the whole thing go.
@ -74,7 +74,7 @@ parseLedgerAndDo opts args cmd =
runcmd = cmd opts args . cacheLedger apats . filterRawLedger b e dpats c r . canonicaliseAmounts costbasis runcmd = cmd opts args . cacheLedger apats . filterRawLedger b e dpats c r . canonicaliseAmounts costbasis
b = beginDateFromOpts opts b = beginDateFromOpts opts
e = endDateFromOpts opts e = endDateFromOpts opts
(apats,dpats) = parseAccountDescriptionArgs args (apats,dpats) = parseAccountDescriptionArgs opts args
c = Cleared `elem` opts c = Cleared `elem` opts
r = Real `elem` opts r = Real `elem` opts
costbasis = CostBasis `elem` opts costbasis = CostBasis `elem` opts