--options-anywhere to use ^ for negative patterns and permit options anywhere in command-line
This commit is contained in:
		
							parent
							
								
									20bf9ae7ad
								
							
						
					
					
						commit
						dc007e69a5
					
				| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
| 
 |  | ||||||
|  | |||||||
							
								
								
									
										45
									
								
								Options.hs
									
									
									
									
									
								
							
							
						
						
									
										45
									
								
								Options.hs
									
									
									
									
									
								
							| @ -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 | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -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
									
									
									
									
									
								
							
							
						
						
									
										1
									
								
								README
									
									
									
									
									
								
							| @ -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: | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
							
								
								
									
										4
									
								
								Utils.hs
									
									
									
									
									
								
							
							
						
						
									
										4
									
								
								Utils.hs
									
									
									
									
									
								
							| @ -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. | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user