preliminary --display/-d support (-d "d>DATE", sufficient for reconciling)
This commit is contained in:
parent
5f47e4d259
commit
0582046648
@ -538,3 +538,16 @@ y = do
|
|||||||
smartparsedate :: String -> Date
|
smartparsedate :: String -> Date
|
||||||
smartparsedate s = parsedate $ printf "%04s/%02s/%02s" y m d
|
smartparsedate s = parsedate $ printf "%04s/%02s/%02s" y m d
|
||||||
where (y,m,d) = fromparse $ parsewith smartdate s
|
where (y,m,d) = fromparse $ parsewith smartdate s
|
||||||
|
|
||||||
|
-- | Parse a --display expression of the form "d>DATE"
|
||||||
|
|
||||||
|
type TransactionMatcher = Transaction -> Bool
|
||||||
|
|
||||||
|
datedisplayexpr :: Parser TransactionMatcher
|
||||||
|
datedisplayexpr = do
|
||||||
|
char 'd'
|
||||||
|
char '>'
|
||||||
|
(y,m,d) <- smartdate
|
||||||
|
let edate = parsedate $ printf "%04s/%02s/%02s" y m d
|
||||||
|
return $ \(Transaction{date=tdate}) -> tdate > edate
|
||||||
|
|
||||||
|
|||||||
15
Options.hs
15
Options.hs
@ -7,6 +7,8 @@ import Text.Printf
|
|||||||
import Ledger.AccountName (negativepatternchar)
|
import Ledger.AccountName (negativepatternchar)
|
||||||
import Ledger.Parse (smartparsedate)
|
import Ledger.Parse (smartparsedate)
|
||||||
import Ledger.Dates
|
import Ledger.Dates
|
||||||
|
import Ledger.Utils
|
||||||
|
|
||||||
|
|
||||||
usagehdr = "Usage: hledger [OPTS] COMMAND [ACCTPATTERNS] [-- DESCPATTERNS]\n\nOptions"++warning++":"
|
usagehdr = "Usage: hledger [OPTS] COMMAND [ACCTPATTERNS] [-- DESCPATTERNS]\n\nOptions"++warning++":"
|
||||||
warning = if negativepatternchar=='-' then " (must appear before command)" else " (can appear anywhere)"
|
warning = if negativepatternchar=='-' then " (must appear before command)" else " (can appear anywhere)"
|
||||||
@ -35,6 +37,7 @@ options = [
|
|||||||
Option ['C'] ["cleared"] (NoArg Cleared) "report only on cleared entries",
|
Option ['C'] ["cleared"] (NoArg Cleared) "report only on cleared entries",
|
||||||
Option ['B'] ["cost","basis"] (NoArg CostBasis) "report cost basis of commodities",
|
Option ['B'] ["cost","basis"] (NoArg CostBasis) "report cost basis of commodities",
|
||||||
Option [] ["depth"] (ReqArg Depth "N") "balance report: maximum account depth to show",
|
Option [] ["depth"] (ReqArg Depth "N") "balance report: maximum account depth to show",
|
||||||
|
Option ['d'] ["display"] (ReqArg Display "EXPR") "display only transactions matching EXPR\n(where EXPR is 'd>Y/M/D')",
|
||||||
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 ['n'] ["collapse"] (NoArg Collapse) "balance report: no grand total",
|
Option ['n'] ["collapse"] (NoArg Collapse) "balance report: no grand total",
|
||||||
@ -55,6 +58,7 @@ data Opt =
|
|||||||
Cleared |
|
Cleared |
|
||||||
CostBasis |
|
CostBasis |
|
||||||
Depth String |
|
Depth String |
|
||||||
|
Display String |
|
||||||
Empty |
|
Empty |
|
||||||
Real |
|
Real |
|
||||||
Collapse |
|
Collapse |
|
||||||
@ -135,6 +139,17 @@ depthFromOpts opts =
|
|||||||
getdepth (Depth s) = [s]
|
getdepth (Depth s) = [s]
|
||||||
getdepth _ = []
|
getdepth _ = []
|
||||||
|
|
||||||
|
-- | Get the value of the display option, if any.
|
||||||
|
displayFromOpts :: [Opt] -> Maybe String
|
||||||
|
displayFromOpts opts =
|
||||||
|
case displayopts of
|
||||||
|
(s:_) -> Just s
|
||||||
|
_ -> Nothing
|
||||||
|
where
|
||||||
|
displayopts = concatMap getdisplay opts
|
||||||
|
getdisplay (Display s) = [s]
|
||||||
|
getdisplay _ = []
|
||||||
|
|
||||||
-- | 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.
|
-- -- and 0 or more description patterns.
|
||||||
|
|||||||
@ -28,14 +28,17 @@ DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA
|
|||||||
showRegisterReport :: [Opt] -> [String] -> Ledger -> String
|
showRegisterReport :: [Opt] -> [String] -> Ledger -> String
|
||||||
showRegisterReport opts args l = showtxns ts nulltxn nullmixedamt
|
showRegisterReport opts args l = showtxns ts nulltxn nullmixedamt
|
||||||
where
|
where
|
||||||
ts = filter matchtxn $ ledgerTransactions l
|
ts = filter matchapats $ ledgerTransactions l
|
||||||
matchtxn Transaction{account=a} = matchpats apats a
|
matchapats t = matchpats apats $ account t
|
||||||
apats = fst $ parseAccountDescriptionArgs args
|
apats = fst $ parseAccountDescriptionArgs args
|
||||||
|
matchdisplayopt Nothing t = True
|
||||||
|
matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t
|
||||||
|
dopt = displayFromOpts opts
|
||||||
|
|
||||||
-- show transactions, one per line, with a running balance
|
-- show display-filtered transactions, one per line, with a running balance
|
||||||
showtxns [] _ _ = ""
|
showtxns [] _ _ = ""
|
||||||
showtxns (t@Transaction{amount=a}:ts) tprev bal =
|
showtxns (t@Transaction{amount=a}:ts) tprev bal =
|
||||||
(if isZeroMixedAmount a then "" else this) ++ showtxns ts t bal'
|
(if (isZeroMixedAmount a || (not $ matchdisplayopt dopt t)) then "" else this) ++ showtxns ts t bal'
|
||||||
where
|
where
|
||||||
this = showtxn (t `issame` tprev) t bal'
|
this = showtxn (t `issame` tprev) t bal'
|
||||||
issame t1 t2 = entryno t1 == entryno t2
|
issame t1 t2 = entryno t1 == entryno t2
|
||||||
@ -51,3 +54,4 @@ showRegisterReport opts args l = showtxns ts nulltxn nullmixedamt
|
|||||||
txn = showRawTransaction $ RawTransaction a amt "" tt
|
txn = showRawTransaction $ RawTransaction a amt "" tt
|
||||||
bal = padleft 12 (showMixedAmountOrZero b)
|
bal = padleft 12 (showMixedAmountOrZero b)
|
||||||
Transaction{date=da,description=de,account=a,amount=amt,ttype=tt} = t
|
Transaction{date=da,description=de,account=a,amount=amt,ttype=tt} = t
|
||||||
|
|
||||||
|
|||||||
9
Tests.hs
9
Tests.hs
@ -315,6 +315,15 @@ registercommand_tests = TestList [
|
|||||||
"2007/01/01 eat & shop assets:cash $-2 $-2\n" ++
|
"2007/01/01 eat & shop assets:cash $-2 $-2\n" ++
|
||||||
"")
|
"")
|
||||||
$ showRegisterReport [] ["cash"] l
|
$ showRegisterReport [] ["cash"] l
|
||||||
|
,
|
||||||
|
"register report with display expression" ~:
|
||||||
|
do
|
||||||
|
l <- ledgerfromfile [] "sample.ledger"
|
||||||
|
assertequal (
|
||||||
|
"2008/01/01 pay off liabilities:debts $1 $1\n" ++
|
||||||
|
" assets:checking $-1 0\n" ++
|
||||||
|
"")
|
||||||
|
$ showRegisterReport [Display "d>2007/12"] [] l
|
||||||
]
|
]
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user