From 3ee6a351f386b2c5fa8ecc05cb622bf2eb8cac49 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 27 May 2012 18:14:20 +0000 Subject: [PATCH] big query/tests/show refactoring - use new query system for command line too, filterspec is no more - move unit tests near the code they test, run them in bottom up order, add more - more precise Show instances, used for debugging not ui --- MANUAL.md | 76 +-- hledger-lib/Hledger.hs | 2 +- hledger-lib/Hledger/Data/Account.hs | 2 +- hledger-lib/Hledger/Data/Amount.hs | 54 +- hledger-lib/Hledger/Data/Journal.hs | 443 ++++++++++++--- hledger-lib/Hledger/Data/Ledger.hs | 27 +- hledger-lib/Hledger/Data/Posting.hs | 2 +- hledger-lib/Hledger/Data/Query.hs | 282 +++++++--- hledger-lib/Hledger/Data/Transaction.hs | 14 +- hledger-lib/Hledger/Data/Types.hs | 14 +- hledger-lib/Hledger/Read.hs | 39 +- hledger-lib/Hledger/Read/JournalReader.hs | 40 +- hledger-lib/Hledger/Reports.hs | 651 +++++++++++++++++----- hledger-lib/Hledger/Utils.hs | 8 +- hledger/Hledger/Cli.hs | 365 +----------- hledger/Hledger/Cli/Add.hs | 14 +- hledger/Hledger/Cli/Balance.hs | 19 +- hledger/Hledger/Cli/Balancesheet.hs | 8 +- hledger/Hledger/Cli/Cashflow.hs | 10 +- hledger/Hledger/Cli/Histogram.hs | 21 +- hledger/Hledger/Cli/Incomestatement.hs | 6 +- hledger/Hledger/Cli/Main.hs | 10 +- hledger/Hledger/Cli/Options.hs | 8 +- hledger/Hledger/Cli/Print.hs | 52 +- hledger/Hledger/Cli/Register.hs | 17 +- hledger/Hledger/Cli/Stats.hs | 6 +- hledger/Hledger/Cli/Tests.hs | 6 +- 27 files changed, 1405 insertions(+), 791 deletions(-) diff --git a/MANUAL.md b/MANUAL.md index 6993be82e..256024b7f 100644 --- a/MANUAL.md +++ b/MANUAL.md @@ -873,73 +873,53 @@ Examples: The following additional features and options allow for fine-grained reporting. They are common to most commands, where applicable. -### Filter patterns +### Queries -Most commands accept one or more filter pattern arguments after the -command name, to select a subset of transactions or postings. There are -two kinds of pattern: +Most commands accept an optional query expression, written as arguments +after the command name (or entered in the hledger-web search field), to +filter the data. The syntax is similar a Google search expression: one or +more space separated search terms, optional prefixes to match specific +fields, quotes to enclose whitespace etc. Here are the kinds of query term +currently supported: -- an account pattern, which is a regular expression. This is - matched against postings' accounts. Optionally, it may be prefixed - with `not:` in which case the match is negated. - -- a description pattern, like the above but prefixed with - `desc:`. This is matched against transactions' descriptions. Note, - when negating a desc: pattern, not: goes last, eg: - `desc:not:someregexp`. +- `REGEX` (no prefix) - match account names by this regular expression +- `acct:REGEX` - same as above +- `desc:REGEX` - match transaction descriptions by regular expression +- `date:PERIODEXPR` - match dates within the specified [period] (which may not contain a reporting interval) +- `edate:DATEEXPR` - as above, but match the effective date +- `status:1` or `status:0` - match cleared/uncleared transactions +- `depth:N` - match (or display, depending on command) accounts at or above this depth +- `not:` before any of the above negates the match - `type:regular|virtual|balancedvirtual` - - `comment:COMMENTREGEX` - - `amount:AMOUNTEXPR` - - `commodity:COMMODITYSYMBOLREGEX` - Any of these can be prefixed with `not:` or `!` to negate the match. --> -When you specify multiple filter patterns, hledger generally selects the -transactions or postings which match (or negatively match) +Note these query terms can also be expressed as command-line flags; you +can use either, or both. -> *any of the account patterns* AND -> *any of the description patterns* +With multiple query terms, most commands select the +transactions/postings/accounts which match (or negatively match) + +> *any of the account terms* AND +> *any of the description terms* AND +> *all the other terms* The [print](#print) command selects transactions which -> *match any of the description patterns* AND -> *have any postings matching any of the positive account patterns* -> AND -> *have no postings matching any of the negative account patterns* +> *match any of the description terms* AND +> *have any postings matching any of the positive account terms* AND +> *have no postings matching any of the negative account terms* AND +> *match all the other terms* ### Smart dates diff --git a/hledger-lib/Hledger.hs b/hledger-lib/Hledger.hs index 224ec70dc..7454adc0b 100644 --- a/hledger-lib/Hledger.hs +++ b/hledger-lib/Hledger.hs @@ -11,7 +11,7 @@ import Test.HUnit import Hledger.Data import Hledger.Data.Query -import Hledger.Read +import Hledger.Read hiding (samplejournal) import Hledger.Reports import Hledger.Utils diff --git a/hledger-lib/Hledger/Data/Account.hs b/hledger-lib/Hledger/Data/Account.hs index 5ce9212af..fb7095857 100644 --- a/hledger-lib/Hledger/Data/Account.hs +++ b/hledger-lib/Hledger/Data/Account.hs @@ -20,7 +20,7 @@ import Hledger.Data.Types instance Show Account where - show (Account a ts b) = printf "Account %s with %d txns and %s balance" a (length ts) (showMixedAmount b) + show (Account a ps b) = printf "Account %s with %d postings and %s balance" a (length ps) (showMixedAmountDebug b) instance Eq Account where (==) (Account n1 t1 b1) (Account n2 t2 b2) = n1 == n2 && t1 == t2 && b1 == b2 diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 09c0602b0..bdd46d50d 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -44,6 +44,7 @@ exchange rates. module Hledger.Data.Amount ( -- * Amount nullamt, + missingamt, amountWithCommodity, canonicaliseAmountCommodity, setAmountPrecision, @@ -58,7 +59,7 @@ module Hledger.Data.Amount ( maxprecisionwithpoint, -- * MixedAmount nullmixedamt, - missingamt, + missingmixedamt, amounts, normaliseMixedAmountPreservingFirstPrice, canonicaliseMixedAmountCommodity, @@ -96,7 +97,7 @@ deriving instance Show HistoricalPrice ------------------------------------------------------------------------------- -- Amount -instance Show Amount where show = showAmount +instance Show Amount where show = showAmountDebug instance Num Amount where abs (Amount c q p) = Amount c (abs q) p @@ -147,12 +148,14 @@ isNegativeAmount Amount{quantity=q} = q < 0 -- | Does this amount appear to be zero when displayed with its given precision ? isZeroAmount :: Amount -> Bool -isZeroAmount = null . filter (`elem` "123456789") . showAmountWithoutPriceOrCommodity +isZeroAmount a -- | a==missingamt = False + | otherwise = (null . filter (`elem` "123456789") . showAmountWithoutPriceOrCommodity) a -- | Is this amount "really" zero, regardless of the display precision ? -- Since we are using floating point, for now just test to some high precision. isReallyZeroAmount :: Amount -> Bool -isReallyZeroAmount = null . filter (`elem` "123456789") . printf ("%."++show zeroprecision++"f") . quantity +isReallyZeroAmount a -- | a==missingamt = False + | otherwise = (null . filter (`elem` "123456789") . printf ("%."++show zeroprecision++"f") . quantity) a where zeroprecision = 8 -- | Get the string representation of an amount, based on its commodity's @@ -166,8 +169,9 @@ setAmountPrecision p a@Amount{commodity=c} = a{commodity=c{precision=p}} -- | Get the unambiguous string representation of an amount, for debugging. showAmountDebug :: Amount -> String +showAmountDebug (Amount (Commodity {symbol="AUTO"}) _ _) = "(missing)" showAmountDebug (Amount c q pri) = printf "Amount {commodity = %s, quantity = %s, price = %s}" - (show c) (show q) (maybe "" showPriceDebug pri) + (show c) (show q) (maybe "Nothing" showPriceDebug pri) -- | Get the string representation of an amount, without any \@ price. showAmountWithoutPrice :: Amount -> String @@ -189,7 +193,7 @@ showPriceDebug (TotalPrice pa) = " @@ " ++ showMixedAmountDebug pa -- display settings. String representations equivalent to zero are -- converted to just \"0\". showAmount :: Amount -> String -showAmount (Amount (Commodity {symbol="AUTO"}) _ _) = "" -- can appear in an error message +showAmount (Amount (Commodity {symbol="AUTO"}) _ _) = "" showAmount a@(Amount (Commodity {symbol=sym,side=side,spaced=spaced}) _ pri) = case side of L -> printf "%s%s%s%s" sym' space quantity' price @@ -257,7 +261,7 @@ canonicaliseAmountCommodity (Just canonicalcommoditymap) = fixamount ------------------------------------------------------------------------------- -- MixedAmount -instance Show MixedAmount where show = showMixedAmount +instance Show MixedAmount where show = showMixedAmountDebug instance Num MixedAmount where fromInteger i = Mixed [Amount (comm "") (fromInteger i) Nothing] @@ -272,22 +276,31 @@ nullmixedamt :: MixedAmount nullmixedamt = Mixed [] -- | A temporary value for parsed transactions which had no amount specified. -missingamt :: MixedAmount -missingamt = Mixed [Amount unknown{symbol="AUTO"} 0 Nothing] +missingamt :: Amount +missingamt = Amount unknown{symbol="AUTO"} 0 Nothing --- | Simplify a mixed amount's component amounts: combine amounts with --- the same commodity and price. Also remove any zero amounts and +missingmixedamt :: MixedAmount +missingmixedamt = Mixed [missingamt] + +-- | Simplify a mixed amount's component amounts: combine amounts with the +-- same commodity and price. Also remove any zero or missing amounts and -- replace an empty amount list with a single zero amount. normaliseMixedAmountPreservingPrices :: MixedAmount -> MixedAmount normaliseMixedAmountPreservingPrices (Mixed as) = Mixed as'' where as'' = if null nonzeros then [nullamt] else nonzeros - (_,nonzeros) = partition (\a -> isReallyZeroAmount a && Mixed [a] /= missingamt) as' + (_,nonzeros) = partition isReallyZeroAmount $ filter (/= missingamt) as' as' = map sumAmountsUsingFirstPrice $ group $ sort as sort = sortBy (\a1 a2 -> compare (sym a1,price a1) (sym a2,price a2)) group = groupBy (\a1 a2 -> sym a1 == sym a2 && price a1 == price a2) sym = symbol . commodity +tests_normaliseMixedAmountPreservingPrices = [ + "normaliseMixedAmountPreservingPrices" ~: do + -- assertEqual "" (Mixed [dollars 2]) (normaliseMixedAmountPreservingPrices $ Mixed [dollars 0, dollars 2]) + assertEqual "" (Mixed [nullamt]) (normaliseMixedAmountPreservingPrices $ Mixed [dollars 0, missingamt]) + ] + -- | Simplify a mixed amount's component amounts: combine amounts with -- the same commodity, using the first amount's price for subsequent -- amounts in each commodity (ie, this function alters the amount and @@ -297,7 +310,7 @@ normaliseMixedAmountPreservingFirstPrice :: MixedAmount -> MixedAmount normaliseMixedAmountPreservingFirstPrice (Mixed as) = Mixed as'' where as'' = if null nonzeros then [nullamt] else nonzeros - (_,nonzeros) = partition (\a -> isReallyZeroAmount a && Mixed [a] /= missingamt) as' + (_,nonzeros) = partition (\a -> isReallyZeroAmount a && a /= missingamt) as' as' = map sumAmountsUsingFirstPrice $ group $ sort as sort = sortBy (\a1 a2 -> compare (sym a1) (sym a2)) group = groupBy (\a1 a2 -> sym a1 == sym a2) @@ -362,7 +375,7 @@ mixedAmountWithCommodity c (Mixed as) = Amount c total Nothing -- its component amounts. NB a mixed amount can have an empty amounts -- list in which case it shows as \"\". showMixedAmount :: MixedAmount -> String -showMixedAmount m = vConcatRightAligned $ map show $ amounts $ normaliseMixedAmountPreservingFirstPrice m +showMixedAmount m = vConcatRightAligned $ map showAmount $ amounts $ normaliseMixedAmountPreservingFirstPrice m -- | Set the display precision in the amount's commodities. setMixedAmountPrecision :: Int -> MixedAmount -> MixedAmount @@ -377,8 +390,9 @@ showMixedAmountWithPrecision p m = -- | Get an unambiguous string representation of a mixed amount for debugging. showMixedAmountDebug :: MixedAmount -> String -showMixedAmountDebug m = printf "Mixed [%s]" as - where as = intercalate "\n " $ map showAmountDebug $ amounts $ normaliseMixedAmountPreservingFirstPrice m +showMixedAmountDebug m | m == missingmixedamt = "(missing)" + | otherwise = printf "Mixed [%s]" as + where as = intercalate "\n " $ map showAmountDebug $ amounts m -- $ normaliseMixedAmountPreservingFirstPrice m -- | Get the string representation of a mixed amount, but without -- any \@ prices. @@ -387,7 +401,7 @@ showMixedAmountWithoutPrice m = concat $ intersperse "\n" $ map showfixedwidth a where (Mixed as) = normaliseMixedAmountPreservingFirstPrice $ stripPrices m stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{price=Nothing} - width = maximum $ map (length . show) as + width = maximum $ map (length . showAmount) as showfixedwidth = printf (printf "%%%ds" width) . showAmountWithoutPrice -- | Replace a mixed amount's commodity with the canonicalised version from @@ -398,7 +412,9 @@ canonicaliseMixedAmountCommodity canonicalcommoditymap (Mixed as) = Mixed $ map ------------------------------------------------------------------------------- -- misc -tests_Hledger_Data_Amount = TestList [ +tests_Hledger_Data_Amount = TestList $ + tests_normaliseMixedAmountPreservingPrices + ++ [ -- Amount @@ -461,7 +477,7 @@ tests_Hledger_Data_Amount = TestList [ showMixedAmount (Mixed [(dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]}]) `is` "$1.00 @ €2.00" showMixedAmount (Mixed [dollars 0]) `is` "0" showMixedAmount (Mixed []) `is` "0" - showMixedAmount missingamt `is` "" + showMixedAmount missingmixedamt `is` "" ,"showMixedAmountWithoutPrice" ~: do let a = (dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]} diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index bca6b5a05..bd4d06cf6 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -14,18 +14,17 @@ module Hledger.Data.Journal ( addTimeLogEntry, addTransaction, journalApplyAliases, + journalBalanceTransactions, journalCanonicaliseAmounts, journalConvertAmountsToCost, journalFinalise, journalSelectingDate, -- * Filtering filterJournalPostings, - filterJournalPostings2, filterJournalTransactions, - filterJournalTransactions2, - filterJournalTransactionsByAccount, -- * Querying journalAccountInfo, + journalAccountNames, journalAccountNamesUsed, journalAmountAndPriceCommodities, journalAmounts, @@ -46,14 +45,14 @@ module Hledger.Data.Journal ( groupPostings, matchpats, nullctx, - nullfilterspec, nulljournal, -- * Tests + samplejournal, tests_Hledger_Data_Journal, ) where import Data.List -import Data.Map (findWithDefault, (!)) +import Data.Map (findWithDefault, (!), toAscList) import Data.Ord import Data.Time.Calendar import Data.Time.LocalTime @@ -67,10 +66,11 @@ import qualified Data.Map as Map import Hledger.Utils import Hledger.Data.Types import Hledger.Data.AccountName +import Hledger.Data.Account() import Hledger.Data.Amount -import Hledger.Data.Commodity (canonicaliseCommodities) -import Hledger.Data.Dates (nulldatespan) -import Hledger.Data.Transaction (journalTransactionWithDate,balanceTransaction) -- nulltransaction, +import Hledger.Data.Commodity +import Hledger.Data.Dates +import Hledger.Data.Transaction import Hledger.Data.Posting import Hledger.Data.TimeLog import Hledger.Data.Query @@ -114,18 +114,6 @@ nulljournal = Journal { jmodifiertxns = [] nullctx :: JournalContext nullctx = Ctx { ctxYear = Nothing, ctxCommodity = Nothing, ctxAccount = [], ctxAliases = [] } -nullfilterspec :: FilterSpec -nullfilterspec = FilterSpec { - datespan=nulldatespan - ,cleared=Nothing - ,real=False - ,empty=False - ,acctpats=[] - ,descpats=[] - ,depth=Nothing - ,fMetadata=[] - } - journalFilePath :: Journal -> FilePath journalFilePath = fst . mainfile @@ -213,15 +201,16 @@ journalEquityAccountQuery _ = Acct "^equity(:|$)" -- | Keep only postings matching the query expression. -- This can leave unbalanced transactions. -filterJournalPostings2 :: Query -> Journal -> Journal -filterJournalPostings2 m j@Journal{jtxns=ts} = j{jtxns=map filtertransactionpostings ts} +filterJournalPostings :: Query -> Journal -> Journal +filterJournalPostings q j@Journal{jtxns=ts} = j{jtxns=map filtertransactionpostings ts} where - filtertransactionpostings t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps} + filtertransactionpostings t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps} -- | Keep only transactions matching the query expression. -filterJournalTransactions2 :: Query -> Journal -> Journal -filterJournalTransactions2 m j@Journal{jtxns=ts} = j{jtxns=filter (m `matchesTransaction`) ts} +filterJournalTransactions :: Query -> Journal -> Journal +filterJournalTransactions q j@Journal{jtxns=ts} = j{jtxns=filter (q `matchesTransaction`) ts} +{- ------------------------------------------------------------------------------- -- filtering V1 @@ -324,6 +313,12 @@ filterJournalPostingsByDepth (Just d) j@Journal{jtxns=ts} = where filtertxns t@Transaction{tpostings=ps} = t{tpostings=filter ((<= d) . accountNameLevel . paccount) ps} +-- | Keep only postings which affect accounts matched by the account patterns. +-- This can leave transactions unbalanced. +filterJournalPostingsByAccount :: [String] -> Journal -> Journal +filterJournalPostingsByAccount apats j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts} + where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (matchpats apats . paccount) ps} + -- | Keep only transactions which affect accounts matched by the account patterns. -- More precisely: each positive account pattern excludes transactions -- which do not contain a posting to a matched account, and each negative @@ -338,11 +333,7 @@ filterJournalTransactionsByAccount apats j@Journal{jtxns=ts} = j{jtxns=filter tm amatch pat a = regexMatchesCI (abspat pat) a (negatives,positives) = partition isnegativepat apats --- | Keep only postings which affect accounts matched by the account patterns. --- This can leave transactions unbalanced. -filterJournalPostingsByAccount :: [String] -> Journal -> Journal -filterJournalPostingsByAccount apats j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts} - where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (matchpats apats . paccount) ps} +-} -- | Convert this journal's transactions' primary date to either the -- actual or effective date. @@ -487,13 +478,168 @@ journalAccountInfo j = (ant, amap) amap = Map.fromList [(a, acctinfo a) | a <- flatten ant] acctinfo a = Account a (psof a) (inclbalof a) +tests_journalAccountInfo = [ + "journalAccountInfo" ~: do + let (t,m) = journalAccountInfo samplejournal + assertEqual "account tree" + (Node "top" [ + Node "assets" [ + Node "assets:bank" [ + Node "assets:bank:checking" [], + Node "assets:bank:saving" [] + ], + Node "assets:cash" [] + ], + Node "expenses" [ + Node "expenses:food" [], + Node "expenses:supplies" [] + ], + Node "income" [ + Node "income:gifts" [], + Node "income:salary" [] + ], + Node "liabilities" [ + Node "liabilities:debts" [] + ] + ] + ) + t + mapM_ + (\(e,a) -> assertEqual "" e a) + (zip [ + ("assets",Account "assets" [] (Mixed [dollars (-1)])) + ,("assets:bank",Account "assets:bank" [] (Mixed [dollars 1])) + ,("assets:bank:checking",Account "assets:bank:checking" [ + Posting { + pstatus=False, + paccount="assets:bank:checking", + pamount=(Mixed [dollars 1]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + }, + Posting { + pstatus=False, + paccount="assets:bank:checking", + pamount=(Mixed [dollars 1]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + }, + Posting { + pstatus=False, + paccount="assets:bank:checking", + pamount=(Mixed [dollars (-1)]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + }, + Posting { + pstatus=False, + paccount="assets:bank:checking", + pamount=(Mixed [dollars (-1)]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ] (Mixed [nullamt])) + ,("assets:bank:saving",Account "assets:bank:saving" [ + Posting { + pstatus=False, + paccount="assets:bank:saving", + pamount=(Mixed [dollars 1]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ] (Mixed [dollars 1])) + ,("assets:cash",Account "assets:cash" [ + Posting { + pstatus=False, + paccount="assets:cash", + pamount=(Mixed [dollars (-2)]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ] (Mixed [dollars (-2)])) + ,("expenses",Account "expenses" [] (Mixed [dollars 2])) + ,("expenses:food",Account "expenses:food" [ + Posting { + pstatus=False, + paccount="expenses:food", + pamount=(Mixed [dollars 1]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ] (Mixed [dollars 1])) + ,("expenses:supplies",Account "expenses:supplies" [ + Posting { + pstatus=False, + paccount="expenses:supplies", + pamount=(Mixed [dollars 1]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ] (Mixed [dollars 1])) + ,("income",Account "income" [] (Mixed [dollars (-2)])) + ,("income:gifts",Account "income:gifts" [ + Posting { + pstatus=False, + paccount="income:gifts", + pamount=(Mixed [dollars (-1)]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ] (Mixed [dollars (-1)])) + ,("income:salary",Account "income:salary" [ + Posting { + pstatus=False, + paccount="income:salary", + pamount=(Mixed [dollars (-1)]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ] (Mixed [dollars (-1)])) + ,("liabilities",Account "liabilities" [] (Mixed [dollars 1])) + ,("liabilities:debts",Account "liabilities:debts" [ + Posting { + pstatus=False, + paccount="liabilities:debts", + pamount=(Mixed [dollars 1]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ] (Mixed [dollars 1])) + ,("top",Account "top" [] (Mixed [nullamt])) + ] + (toAscList m) + ) + ] + -- | Given a list of postings, return an account name tree and three query -- functions that fetch postings, subaccount-excluding-balance and -- subaccount-including-balance by account name. groupPostings :: [Posting] -> (Tree AccountName, - (AccountName -> [Posting]), - (AccountName -> MixedAmount), - (AccountName -> MixedAmount)) + (AccountName -> [Posting]), + (AccountName -> MixedAmount), + (AccountName -> MixedAmount)) groupPostings ps = (ant, psof, exclbalof, inclbalof) where anames = sort $ nub $ map paccount ps @@ -532,37 +678,210 @@ postingsByAccount ps = m' -- tests -tests_Hledger_Data_Journal = TestList [ +-- A sample journal for testing, similar to data/sample.journal: +-- +-- 2008/01/01 income +-- assets:bank:checking $1 +-- income:salary +-- +-- 2008/06/01 gift +-- assets:bank:checking $1 +-- income:gifts +-- +-- 2008/06/02 save +-- assets:bank:saving $1 +-- assets:bank:checking +-- +-- 2008/06/03 * eat & shop +-- expenses:food $1 +-- expenses:supplies $1 +-- assets:cash +-- +-- 2008/12/31 * pay off +-- liabilities:debts $1 +-- assets:bank:checking +-- +Right samplejournal = journalBalanceTransactions $ Journal + [] + [] + [ + txnTieKnot $ Transaction { + tdate=parsedate "2008/01/01", + teffectivedate=Nothing, + tstatus=False, + tcode="", + tdescription="income", + tcomment="", + tmetadata=[], + tpostings=[ + Posting { + pstatus=False, + paccount="assets:bank:checking", + pamount=(Mixed [dollars 1]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + }, + Posting { + pstatus=False, + paccount="income:salary", + pamount=(missingmixedamt), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ], + tpreceding_comment_lines="" + } + , + txnTieKnot $ Transaction { + tdate=parsedate "2008/06/01", + teffectivedate=Nothing, + tstatus=False, + tcode="", + tdescription="gift", + tcomment="", + tmetadata=[], + tpostings=[ + Posting { + pstatus=False, + paccount="assets:bank:checking", + pamount=(Mixed [dollars 1]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + }, + Posting { + pstatus=False, + paccount="income:gifts", + pamount=(missingmixedamt), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ], + tpreceding_comment_lines="" + } + , + txnTieKnot $ Transaction { + tdate=parsedate "2008/06/02", + teffectivedate=Nothing, + tstatus=False, + tcode="", + tdescription="save", + tcomment="", + tmetadata=[], + tpostings=[ + Posting { + pstatus=False, + paccount="assets:bank:saving", + pamount=(Mixed [dollars 1]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + }, + Posting { + pstatus=False, + paccount="assets:bank:checking", + pamount=(Mixed [dollars (-1)]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ], + tpreceding_comment_lines="" + } + , + txnTieKnot $ Transaction { + tdate=parsedate "2008/06/03", + teffectivedate=Nothing, + tstatus=True, + tcode="", + tdescription="eat & shop", + tcomment="", + tmetadata=[], + tpostings=[ + Posting { + pstatus=False, + paccount="expenses:food", + pamount=(Mixed [dollars 1]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + }, + Posting { + pstatus=False, + paccount="expenses:supplies", + pamount=(Mixed [dollars 1]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + }, + Posting { + pstatus=False, + paccount="assets:cash", + pamount=(missingmixedamt), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ], + tpreceding_comment_lines="" + } + , + txnTieKnot $ Transaction { + tdate=parsedate "2008/12/31", + teffectivedate=Nothing, + tstatus=False, + tcode="", + tdescription="pay off", + tcomment="", + tmetadata=[], + tpostings=[ + Posting { + pstatus=False, + paccount="liabilities:debts", + pamount=(Mixed [dollars 1]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + }, + Posting { + pstatus=False, + paccount="assets:bank:checking", + pamount=(Mixed [dollars (-1)]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ], + tpreceding_comment_lines="" + } + ] + [] + [] + "" + nullctx + [] + (TOD 0 0) + +tests_Hledger_Data_Journal = TestList $ + tests_journalAccountInfo + -- [ -- "query standard account types" ~: -- do -- let j = journal1 -- journalBalanceSheetAccountNames j `is` ["assets","assets:a","equity","equity:q","equity:q:qq","liabilities","liabilities:l"] -- journalProfitAndLossAccountNames j `is` ["expenses","expenses:e","income","income:i"] - - ] - --- journal1 = --- Journal --- [] --- [] --- [ --- nulltransaction{ --- tpostings=[ --- nullposting{paccount="liabilities:l"} --- ,nullposting{paccount="expenses:e"} --- ] --- } --- ,nulltransaction{ --- tpostings=[ --- nullposting{paccount="income:i"} --- ,nullposting{paccount="assets:a"} --- ,nullposting{paccount="equity:q:qq"} --- ] --- } --- ] --- [] --- [] --- "" --- nullctx --- [] --- (TOD 0 0) + -- ] diff --git a/hledger-lib/Hledger/Data/Ledger.hs b/hledger-lib/Hledger/Data/Ledger.hs index caab59276..d6cf9f6e7 100644 --- a/hledger-lib/Hledger/Data/Ledger.hs +++ b/hledger-lib/Hledger/Data/Ledger.hs @@ -41,20 +41,18 @@ nullledger = Ledger{ -- | Filter a journal's transactions as specified, and then process them -- to derive a ledger containing all balances, the chart of accounts, -- canonicalised commodities etc. -journalToLedger :: FilterSpec -> Journal -> Ledger -journalToLedger fs j = nullledger{ledgerJournal=j',ledgerAccountNameTree=t,ledgerAccountMap=m} - where j' = filterJournalPostings fs{depth=Nothing} j - (t, m) = journalAccountInfo j' - --- | Filter a journal's transactions as specified, and then process them --- to derive a ledger containing all balances, the chart of accounts, --- canonicalised commodities etc. --- Like journalToLedger but uses the new queries. -journalToLedger2 :: Query -> Journal -> Ledger -journalToLedger2 m j = nullledger{ledgerJournal=j',ledgerAccountNameTree=t,ledgerAccountMap=amap} - where j' = filterJournalPostings2 m j +journalToLedger :: Query -> Journal -> Ledger +journalToLedger q j = nullledger{ledgerJournal=j',ledgerAccountNameTree=t,ledgerAccountMap=amap} + where j' = filterJournalPostings q j (t, amap) = journalAccountInfo j' +tests_journalToLedger = [ + "journalToLedger" ~: do + assertEqual "" (0) (length $ ledgerPostings $ journalToLedger Any nulljournal) + assertEqual "" (11) (length $ ledgerPostings $ journalToLedger Any samplejournal) + assertEqual "" (6) (length $ ledgerPostings $ journalToLedger (Depth 2) samplejournal) + ] + -- | List a ledger's account names. ledgerAccountNames :: Ledger -> [AccountName] ledgerAccountNames = drop 1 . flatten . ledgerAccountNameTree @@ -105,7 +103,6 @@ ledgerDateSpan = postingsDateSpan . ledgerPostings ledgerCommodities :: Ledger -> Map String Commodity ledgerCommodities = journalCanonicalCommodities . ledgerJournal -tests_Hledger_Data_Ledger = TestList - [ - ] +tests_Hledger_Data_Ledger = TestList $ + tests_journalToLedger diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 96a9d2e42..a6924c91b 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -107,7 +107,7 @@ isBalancedVirtual :: Posting -> Bool isBalancedVirtual p = ptype p == BalancedVirtualPosting hasAmount :: Posting -> Bool -hasAmount = (/= missingamt) . pamount +hasAmount = (/= missingmixedamt) . pamount accountNamesFromPostings :: [Posting] -> [AccountName] accountNamesFromPostings = nub . map paccount diff --git a/hledger-lib/Hledger/Data/Query.hs b/hledger-lib/Hledger/Data/Query.hs index bfefae887..1c29c00c1 100644 --- a/hledger-lib/Hledger/Data/Query.hs +++ b/hledger-lib/Hledger/Data/Query.hs @@ -1,7 +1,7 @@ {-| -A general query system for matching items by standard criteria, in one -step unlike FilterSpec and filterJournal*. Currently used by hledger-web. +A general query system for matching things (accounts, postings, +transactions..) by various criteria, and a parser for query expressions. -} @@ -12,15 +12,22 @@ module Hledger.Data.Query ( -- * parsing parseQuery, simplifyQuery, + filterQuery, -- * accessors queryIsNull, - queryStartDate, + queryIsDepth, + queryIsDate, queryIsStartDateOnly, + queryStartDate, + queryDateSpan, + queryDepth, + queryEmpty, inAccount, inAccountQuery, -- * matching - matchesTransaction, + matchesAccount, matchesPosting, + matchesTransaction, -- * tests tests_Hledger_Data_Query ) @@ -55,14 +62,12 @@ data Query = Any -- ^ always match | EDate DateSpan -- ^ match if effective date in this date span | Status Bool -- ^ match if cleared status has this value | Real Bool -- ^ match if "realness" (involves a real non-virtual account ?) has this value - | Empty Bool -- ^ match if "emptiness" (from the --empty command-line flag) has this value. - -- Currently this means a posting with zero amount. + | Empty Bool -- ^ if true, show zero-amount postings/accounts which are usually not shown + -- more of a query option than a query criteria ? | Depth Int -- ^ match if account depth is less than or equal to this value deriving (Show, Eq) -- | A query option changes a query's/report's behaviour and output in some way. - --- XXX could use regular CliOpts ? data QueryOpt = QueryOptInAcctOnly AccountName -- ^ show an account register focussed on this account | QueryOptInAcct AccountName -- ^ as above but include sub-accounts in the account register -- | QueryOptCostBasis -- ^ show amounts converted to cost where possible @@ -77,36 +82,54 @@ data QueryOpt = QueryOptInAcctOnly AccountName -- ^ show an account register fo -- showAccountMatcher (QueryOptInAcctSubsOnly a:_) = Just $ Acct True $ accountNameToAccountRegex a -- showAccountMatcher _ = Nothing + -- | Convert a query expression containing zero or more space-separated -- terms to a query and zero or more query options. A query term is either: -- --- 1. a search criteria, used to match transactions. This is usually a prefixed pattern such as: --- acct:REGEXP --- date:PERIODEXP --- not:desc:REGEXP +-- 1. a search pattern, which matches on one or more fields, eg: -- --- 2. a query option, which changes behaviour in some way. There is currently one of these: --- inacct:FULLACCTNAME - should appear only once +-- acct:REGEXP - match the account name with a regular expression +-- desc:REGEXP - match the transaction description +-- date:PERIODEXP - match the date with a period expression -- --- Multiple search criteria are AND'ed together. --- When a pattern contains spaces, it or the whole term should be enclosed in single or double quotes. --- A reference date is required to interpret relative dates in period expressions. +-- The prefix indicates the field to match, or if there is no prefix +-- account name is assumed. -- +-- 2. a query option, which modifies the reporting behaviour in some +-- way. There is currently one of these, which may appear only once: +-- +-- inacct:FULLACCTNAME +-- +-- The usual shell quoting rules are assumed. When a pattern contains +-- whitespace, it (or the whole term including prefix) should be enclosed +-- in single or double quotes. +-- +-- Period expressions may contain relative dates, so a reference date is +-- required to fully parse these. +-- +-- Multiple terms are combined as follows: +-- 1. multiple account patterns are OR'd together +-- 2. multiple description patterns are OR'd together +-- 3. then all terms are AND'd together parseQuery :: Day -> String -> (Query,[QueryOpt]) -parseQuery d s = (m,qopts) +parseQuery d s = (q, opts) where terms = words'' prefixes s - (queries, qopts) = partitionEithers $ map (parseQueryTerm d) terms - m = case queries of [] -> Any - (m':[]) -> m' - ms -> And ms + (pats, opts) = partitionEithers $ map (parseQueryTerm d) terms + (descpats, pats') = partition queryIsDesc pats + (acctpats, otherpats) = partition queryIsAcct pats' + q = simplifyQuery $ And $ [Or acctpats, Or descpats] ++ otherpats tests_parseQuery = [ "parseQuery" ~: do - let d = parsedate "2011/1/1" + let d = nulldate -- parsedate "2011/1/1" parseQuery d "acct:'expenses:autres d\233penses' desc:b" `is` (And [Acct "expenses:autres d\233penses", Desc "b"], []) parseQuery d "inacct:a desc:\"b b\"" `is` (Desc "b b", [QueryOptInAcct "a"]) parseQuery d "inacct:a inacct:b" `is` (Any, [QueryOptInAcct "a", QueryOptInAcct "b"]) + parseQuery d "desc:'x x'" `is` (Desc "x x", []) + parseQuery d "'a a' 'b" `is` (Or [Acct "a a",Acct "'b"], []) + -- parseQuery d "a b desc:x desc:y status:1" `is` + -- (And [Or [Acct "a", Acct "b"], Or [Desc "x", Desc "y"], Status True], []) ] -- keep synced with patterns below, excluding "not" @@ -209,26 +232,83 @@ truestrings :: [String] truestrings = ["1","t","true"] simplifyQuery :: Query -> Query -simplifyQuery (And [q]) = q -simplifyQuery q = q +simplifyQuery q = + let q' = simplify q + in if q' == q then q else simplifyQuery q' + where + simplify (And []) = Any + simplify (And [q]) = simplify q + simplify (And qs) | same qs = simplify $ head qs + | any (==None) qs = None + | all queryIsDate qs = Date $ spansIntersect $ mapMaybe queryTermDateSpan qs + | otherwise = And $ concat $ [map simplify dateqs, map simplify otherqs] + where (dateqs, otherqs) = partition queryIsDate $ filter (/=Any) qs + simplify (Or []) = Any + simplify (Or [q]) = simplifyQuery q + simplify (Or qs) | same qs = simplify $ head qs + | any (==Any) qs = Any + -- all queryIsDate qs = Date $ spansUnion $ mapMaybe queryTermDateSpan qs ? + | otherwise = Or $ map simplify $ filter (/=None) qs + simplify (Date (DateSpan Nothing Nothing)) = Any + simplify q = q + +tests_simplifyQuery = [ + "simplifyQuery" ~: do + let q `gives` r = assertEqual "" r (simplifyQuery q) + Or [Acct "a"] `gives` Acct "a" + Or [Any,None] `gives` Any + And [Any,None] `gives` None + And [Any,Any] `gives` Any + And [Acct "b",Any] `gives` Acct "b" + And [Any,And [Date (DateSpan Nothing Nothing)]] `gives` Any + And [Date (DateSpan Nothing (Just $ parsedate "2013-01-01")), Date (DateSpan (Just $ parsedate "2012-01-01") Nothing)] + `gives` Date (DateSpan (Just $ parsedate "2012-01-01") (Just $ parsedate "2013-01-01")) + And [Or [],Or [Desc "b b"]] `gives` Desc "b b" + ] + +same [] = True +same (a:as) = all (a==) as + +-- | Remove query terms (or whole sub-expressions) not matching the given +-- predicate from this query. XXX Semantics not yet clear. +filterQuery :: (Query -> Bool) -> Query -> Query +filterQuery p (And qs) = And $ filter p qs +filterQuery p (Or qs) = Or $ filter p qs +-- filterQuery p (Not q) = Not $ filterQuery p q +filterQuery p q = if p q then q else Any + +tests_filterQuery = [ + "filterQuery" ~: do + let (q,p) `gives` r = assertEqual "" r (filterQuery p q) + (Any, queryIsDepth) `gives` Any + (Depth 1, queryIsDepth) `gives` Depth 1 + -- (And [Date nulldatespan, Not (Or [Any, Depth 1])], queryIsDepth) `gives` And [Not (Or [Depth 1])] + ] -- * accessors -- | Does this query match everything ? +queryIsNull :: Query -> Bool queryIsNull Any = True queryIsNull (And []) = True queryIsNull (Not (Or [])) = True queryIsNull _ = False --- | What start date does this query specify, if any ? --- If the query is an OR expression, returns the earliest of the alternatives. --- When the flag is true, look for a starting effective date instead. -queryStartDate :: Bool -> Query -> Maybe Day -queryStartDate effective (Or ms) = earliestMaybeDate $ map (queryStartDate effective) ms -queryStartDate effective (And ms) = latestMaybeDate $ map (queryStartDate effective) ms -queryStartDate False (Date (DateSpan (Just d) _)) = Just d -queryStartDate True (EDate (DateSpan (Just d) _)) = Just d -queryStartDate _ _ = Nothing +queryIsDepth :: Query -> Bool +queryIsDepth (Depth _) = True +queryIsDepth _ = False + +queryIsDate :: Query -> Bool +queryIsDate (Date _) = True +queryIsDate _ = False + +queryIsDesc :: Query -> Bool +queryIsDesc (Desc _) = True +queryIsDesc _ = False + +queryIsAcct :: Query -> Bool +queryIsAcct (Acct _) = True +queryIsAcct _ = False -- | Does this query specify a start date and nothing else (that would -- filter postings prior to the date) ? @@ -242,6 +322,32 @@ queryIsStartDateOnly False (Date (DateSpan (Just _) _)) = True queryIsStartDateOnly True (EDate (DateSpan (Just _) _)) = True queryIsStartDateOnly _ _ = False +-- | What start date (or effective date) does this query specify, if any ? +-- For OR expressions, use the earliest of the dates. NOT is ignored. +queryStartDate :: Bool -> Query -> Maybe Day +queryStartDate effective (Or ms) = earliestMaybeDate $ map (queryStartDate effective) ms +queryStartDate effective (And ms) = latestMaybeDate $ map (queryStartDate effective) ms +queryStartDate False (Date (DateSpan (Just d) _)) = Just d +queryStartDate True (EDate (DateSpan (Just d) _)) = Just d +queryStartDate _ _ = Nothing + +queryTermDateSpan (Date span) = Just span +queryTermDateSpan _ = Nothing + +-- | What date span (or effective date span) does this query specify ? +-- For OR expressions, use the widest possible span. NOT is ignored. +queryDateSpan :: Bool -> Query -> DateSpan +queryDateSpan effective q = spansUnion $ queryDateSpans effective q + +-- | Extract all date (or effective date) spans specified in this query. +-- NOT is ignored. +queryDateSpans :: Bool -> Query -> [DateSpan] +queryDateSpans effective (Or qs) = concatMap (queryDateSpans effective) qs +queryDateSpans effective (And qs) = concatMap (queryDateSpans effective) qs +queryDateSpans False (Date span) = [span] +queryDateSpans True (EDate span) = [span] +queryDateSpans _ _ = [] + -- | What is the earliest of these dates, where Nothing is earliest ? earliestMaybeDate :: [Maybe Day] -> Maybe Day earliestMaybeDate = headDef Nothing . sortBy compareMaybeDates @@ -257,6 +363,33 @@ compareMaybeDates Nothing (Just _) = LT compareMaybeDates (Just _) Nothing = GT compareMaybeDates (Just a) (Just b) = compare a b +-- | The depth limit this query specifies, or a large number if none. +queryDepth :: Query -> Int +queryDepth q = case queryDepth' q of [] -> 99999 + ds -> minimum ds + where + queryDepth' (Depth d) = [d] + queryDepth' (Or qs) = concatMap queryDepth' qs + queryDepth' (And qs) = concatMap queryDepth' qs + queryDepth' _ = [] + +-- | The empty (zero amount) status specified by this query, defaulting to false. +queryEmpty :: Query -> Bool +queryEmpty = headDef False . queryEmpty' + where + queryEmpty' (Empty v) = [v] + queryEmpty' (Or qs) = concatMap queryEmpty' qs + queryEmpty' (And qs) = concatMap queryEmpty' qs + queryEmpty' _ = [] + +-- -- | The "include empty" option specified by this query, defaulting to false. +-- emptyQueryOpt :: [QueryOpt] -> Bool +-- emptyQueryOpt = headDef False . emptyQueryOpt' +-- where +-- emptyQueryOpt' [] = False +-- emptyQueryOpt' (QueryOptEmpty v:_) = v +-- emptyQueryOpt' (_:vs) = emptyQueryOpt' vs + -- | The account we are currently focussed on, if any, and whether subaccounts are included. -- Just looks at the first query option. inAccount :: [QueryOpt] -> Maybe (AccountName,Bool) @@ -277,13 +410,37 @@ inAccountQuery (QueryOptInAcct a:_) = Just $ Acct $ accountNameToAccountRegex a -- matching +-- | Does the match expression match this account ? +-- A matching in: clause is also considered a match. +matchesAccount :: Query -> AccountName -> Bool +matchesAccount (None) _ = False +matchesAccount (Not m) a = not $ matchesAccount m a +matchesAccount (Or ms) a = any (`matchesAccount` a) ms +matchesAccount (And ms) a = all (`matchesAccount` a) ms +matchesAccount (Acct r) a = regexMatchesCI r a +matchesAccount (Depth d) a = accountNameLevel a <= d +matchesAccount _ _ = True + +tests_matchesAccount = [ + "matchesAccount" ~: do + assertBool "positive acct match" $ matchesAccount (Acct "b:c") "a:bb:c:d" + -- assertBool "acct should match at beginning" $ not $ matchesAccount (Acct True "a:b") "c:a:b" + let q `matches` a = assertBool "" $ q `matchesAccount` a + Depth 2 `matches` "a:b" + assertBool "" $ Depth 2 `matchesAccount` "a" + assertBool "" $ Depth 2 `matchesAccount` "a:b" + assertBool "" $ not $ Depth 2 `matchesAccount` "a:b:c" + assertBool "" $ Date nulldatespan `matchesAccount` "a" + assertBool "" $ EDate nulldatespan `matchesAccount` "a" + ] + -- | Does the match expression match this posting ? matchesPosting :: Query -> Posting -> Bool -matchesPosting (Not m) p = not $ matchesPosting m p +matchesPosting (Not q) p = not $ q `matchesPosting` p matchesPosting (Any) _ = True matchesPosting (None) _ = False -matchesPosting (Or ms) p = any (`matchesPosting` p) ms -matchesPosting (And ms) p = all (`matchesPosting` p) ms +matchesPosting (Or qs) p = any (`matchesPosting` p) qs +matchesPosting (And qs) p = all (`matchesPosting` p) qs matchesPosting (Desc r) p = regexMatchesCI r $ maybe "" tdescription $ ptransaction p matchesPosting (Acct r) p = regexMatchesCI r $ paccount p matchesPosting (Date span) p = @@ -295,8 +452,12 @@ matchesPosting (EDate span) p = Nothing -> False matchesPosting (Status v) p = v == postingCleared p matchesPosting (Real v) p = v == isReal p -matchesPosting (Empty v) Posting{pamount=a} = v == isZeroMixedAmount a -matchesPosting _ _ = False +matchesPosting (Depth d) Posting{paccount=a} = Depth d `matchesAccount` a +-- matchesPosting (Empty v) Posting{pamount=a} = v == isZeroMixedAmount a +-- matchesPosting (Empty False) Posting{pamount=a} = True +-- matchesPosting (Empty True) Posting{pamount=a} = isZeroMixedAmount a +matchesPosting (Empty _) _ = True +-- matchesPosting _ _ = False tests_matchesPosting = [ "matchesPosting" ~: do @@ -314,50 +475,47 @@ tests_matchesPosting = [ assertBool "real:1 on real posting" $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting} assertBool "real:1 on virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting} assertBool "real:1 on balanced virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting} + assertBool "" $ (Acct "'b") `matchesPosting` nullposting{paccount="'b"} ] -- | Does the match expression match this transaction ? matchesTransaction :: Query -> Transaction -> Bool -matchesTransaction (Not m) t = not $ matchesTransaction m t +matchesTransaction (Not q) t = not $ q `matchesTransaction` t matchesTransaction (Any) _ = True matchesTransaction (None) _ = False -matchesTransaction (Or ms) t = any (`matchesTransaction` t) ms -matchesTransaction (And ms) t = all (`matchesTransaction` t) ms +matchesTransaction (Or qs) t = any (`matchesTransaction` t) qs +matchesTransaction (And qs) t = all (`matchesTransaction` t) qs matchesTransaction (Desc r) t = regexMatchesCI r $ tdescription t -matchesTransaction m@(Acct _) t = any (m `matchesPosting`) $ tpostings t +matchesTransaction q@(Acct _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction (Date span) t = spanContainsDate span $ tdate t matchesTransaction (EDate span) t = spanContainsDate span $ transactionEffectiveDate t matchesTransaction (Status v) t = v == tstatus t matchesTransaction (Real v) t = v == hasRealPostings t -matchesTransaction _ _ = False +matchesTransaction (Empty _) _ = True +matchesTransaction (Depth d) t = any (Depth d `matchesPosting`) $ tpostings t +-- matchesTransaction _ _ = False + +tests_matchesTransaction = [ + "matchesTransaction" ~: do + let q `matches` t = assertBool "" $ q `matchesTransaction` t + Any `matches` nulltransaction + assertBool "" $ not $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x"} + assertBool "" $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x x"} + ] postingEffectiveDate :: Posting -> Maybe Day postingEffectiveDate p = maybe Nothing (Just . transactionEffectiveDate) $ ptransaction p --- | Does the match expression match this account ? --- A matching in: clause is also considered a match. -matchesAccount :: Query -> AccountName -> Bool -matchesAccount (Not m) a = not $ matchesAccount m a -matchesAccount (Any) _ = True -matchesAccount (None) _ = False -matchesAccount (Or ms) a = any (`matchesAccount` a) ms -matchesAccount (And ms) a = all (`matchesAccount` a) ms -matchesAccount (Acct r) a = regexMatchesCI r a -matchesAccount _ _ = False - -tests_matchesAccount = [ - "matchesAccount" ~: do - assertBool "positive acct match" $ matchesAccount (Acct "b:c") "a:bb:c:d" - -- assertBool "acct should match at beginning" $ not $ matchesAccount (Acct True "a:b") "c:a:b" - ] - -- tests tests_Hledger_Data_Query :: Test tests_Hledger_Data_Query = TestList $ - tests_words'' + tests_simplifyQuery + ++ tests_words'' + ++ tests_filterQuery ++ tests_parseQueryTerm ++ tests_parseQuery ++ tests_matchesAccount ++ tests_matchesPosting + ++ tests_matchesTransaction diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 1683fdf19..75b09fe8a 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -337,9 +337,9 @@ nonzerobalanceerror t = printf "could not balance this transaction (%s%s%s)" rms where (rsum, _, bvsum) = transactionPostingBalances t rmsg | isReallyZeroMixedAmountCost rsum = "" - | otherwise = "real postings are off by " ++ show (costOfMixedAmount rsum) + | otherwise = "real postings are off by " ++ showMixedAmount (costOfMixedAmount rsum) bvmsg | isReallyZeroMixedAmountCost bvsum = "" - | otherwise = "balanced virtual postings are off by " ++ show (costOfMixedAmount bvsum) + | otherwise = "balanced virtual postings are off by " ++ showMixedAmount (costOfMixedAmount bvsum) sep = if not (null rmsg) && not (null bvmsg) then "; " else "" transactionActualDate :: Transaction -> Day @@ -431,7 +431,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ ]) (showTransaction (txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" [] - [Posting False "expenses:food:groceries" missingamt "" RegularPosting [] Nothing + [Posting False "expenses:food:groceries" missingmixedamt "" RegularPosting [] Nothing ] "")) ,"showTransaction" ~: do @@ -445,7 +445,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ (showTransaction (txnTieKnot $ Transaction (parsedate "2010/01/01") Nothing False "" "x" "" [] [Posting False "a" (Mixed [Amount unknown 1 (Just $ UnitPrice $ Mixed [Amount dollar{precision=0} 2 Nothing])]) "" RegularPosting [] Nothing - ,Posting False "b" missingamt "" RegularPosting [] Nothing + ,Posting False "b" missingmixedamt "" RegularPosting [] Nothing ] "")) ,"balanceTransaction" ~: do @@ -458,12 +458,12 @@ tests_Hledger_Data_Transaction = TestList $ concat [ assertBool "detect unbalanced entry, multiple missing amounts" (isLeft $ balanceTransaction Nothing (Transaction (parsedate "2007/01/28") Nothing False "" "test" "" [] - [Posting False "a" missingamt "" RegularPosting [] Nothing, - Posting False "b" missingamt "" RegularPosting [] Nothing + [Posting False "a" missingmixedamt "" RegularPosting [] Nothing, + Posting False "b" missingmixedamt "" RegularPosting [] Nothing ] "")) let e = balanceTransaction Nothing (Transaction (parsedate "2007/01/28") Nothing False "" "" "" [] [Posting False "a" (Mixed [dollars 1]) "" RegularPosting [] Nothing, - Posting False "b" missingamt "" RegularPosting [] Nothing + Posting False "b" missingmixedamt "" RegularPosting [] Nothing ] "") assertBool "balanceTransaction allows one missing amount" (isRight e) assertEqual "balancing amount is inferred" diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index d3bf1fd60..c29636d36 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -254,17 +254,5 @@ data Account = Account { aname :: AccountName, apostings :: [Posting], -- ^ postings in this account abalance :: MixedAmount -- ^ sum of postings in this account and subaccounts - } - --- | A generic, pure specification of how to filter (or search) transactions and postings. -data FilterSpec = FilterSpec { - datespan :: DateSpan -- ^ only include if in this date span - ,cleared :: Maybe Bool -- ^ only include if cleared\/uncleared\/don't care - ,real :: Bool -- ^ only include if real\/don't care - ,empty :: Bool -- ^ include if empty (ie amount is zero) - ,acctpats :: [String] -- ^ only include if matching these account patterns - ,descpats :: [String] -- ^ only include if matching these description patterns - ,depth :: Maybe Int - ,fMetadata :: [(String,String)] -- ^ only include if matching these metadata - } deriving (Show) + } -- deriving (Eq) XXX diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index 4ac92fcde..063702b0d 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -19,7 +19,9 @@ module Hledger.Read ( -- * Parsers used elsewhere accountname, amount, + amount', -- * Tests + samplejournal, tests_Hledger_Read, ) where @@ -94,6 +96,13 @@ readerForFormat s | null rs = Nothing readJournal' :: String -> IO Journal readJournal' s = readJournal Nothing Nothing Nothing s >>= either error' return +tests_readJournal' = [ + "readJournal' parses sample journal" ~: do + _ <- samplejournal + assertBool "" True + ] + + -- | Read a Journal from this string or give an error message, using the -- specified data format or trying all known formats. A CSV conversion -- rules file may be specified for better conversion of that format, @@ -177,8 +186,34 @@ newJournalContent = do d <- getCurrentDay return $ printf "; journal created %s by hledger\n" (show d) -tests_Hledger_Read = TestList - [ +-- tests + +samplejournal = readJournal' $ unlines + ["2008/01/01 income" + ," assets:bank:checking $1" + ," income:salary" + ,"" + ,"2008/06/01 gift" + ," assets:bank:checking $1" + ," income:gifts" + ,"" + ,"2008/06/02 save" + ," assets:bank:saving $1" + ," assets:bank:checking" + ,"" + ,"2008/06/03 * eat & shop" + ," expenses:food $1" + ," expenses:supplies $1" + ," assets:cash" + ,"" + ,"2008/12/31 * pay off" + ," liabilities:debts $1" + ," assets:bank:checking" + ] + +tests_Hledger_Read = TestList $ + tests_readJournal' + ++ [ tests_Hledger_Read_JournalReader, tests_Hledger_Read_TimelogReader, tests_Hledger_Read_CsvReader, diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 2728f90a4..d969aa1eb 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -28,6 +28,7 @@ module Hledger.Read.JournalReader ( datetime, accountname, amount, + amount', emptyline, -- * Tests tests_Hledger_Read_JournalReader @@ -383,7 +384,13 @@ tests_transaction = [ let t = parseWithCtx nullctx transaction "2009/1/1 a ;comment\n b 1\n" assertBool "transaction should not include a comment in the description" $ either (const False) ((== "a") . tdescription) t - + assertBool "parse transaction with following whitespace line" $ + isRight $ parseWithCtx nullctx transaction $ unlines [ + "2012/1/1" + ," a 1" + ," b" + ," " + ] ] -- | Parse a date in YYYY/MM/DD format. Fewer digits are allowed. The year @@ -461,7 +468,7 @@ code = try (do { many1 spacenonewline; char '(' "code"; code <- anyChar `man -- Parse the following whitespace-beginning lines as postings, posting metadata, and/or comments. -- complicated to handle intermixed comment and metadata lines.. make me better ? postings :: GenParser Char JournalContext [Posting] -postings = many1 posting "postings" +postings = many1 (try posting) "postings" -- linebeginningwithspaces :: GenParser Char JournalContext String -- linebeginningwithspaces = do @@ -543,15 +550,15 @@ spaceandamountormissing :: GenParser Char JournalContext MixedAmount spaceandamountormissing = try (do many1 spacenonewline - amount <|> return missingamt - ) <|> return missingamt + amount <|> return missingmixedamt + ) <|> return missingmixedamt tests_spaceandamountormissing = [ "spaceandamountormissing" ~: do assertParseEqual (parseWithCtx nullctx spaceandamountormissing " $47.18") (Mixed [dollars 47.18]) - assertParseEqual (parseWithCtx nullctx spaceandamountormissing "$47.18") missingamt - assertParseEqual (parseWithCtx nullctx spaceandamountormissing " ") missingamt - assertParseEqual (parseWithCtx nullctx spaceandamountormissing "") missingamt + assertParseEqual (parseWithCtx nullctx spaceandamountormissing "$47.18") missingmixedamt + assertParseEqual (parseWithCtx nullctx spaceandamountormissing " ") missingmixedamt + assertParseEqual (parseWithCtx nullctx spaceandamountormissing "") missingmixedamt ] -- | Parse an amount, with an optional left or right currency symbol and @@ -582,6 +589,10 @@ tests_amount = [ price=Nothing}])}]) ] +-- | Run the amount parser on a string to get the result or an error. +amount' :: String -> MixedAmount +amount' s = either (error' . show) id $ parseWithCtx nullctx amount s + leftsymbolamount :: GenParser Char JournalContext MixedAmount leftsymbolamount = do sign <- optionMaybe $ string "-" @@ -865,7 +876,6 @@ tests_Hledger_Read_JournalReader = TestList $ concat [ ,"endtagdirective" ~: do assertParse (parseWithCtx nullctx endtagdirective "end tag \n") - ,"endtagdirective" ~: do assertParse (parseWithCtx nullctx endtagdirective "pop \n") ,"accountname" ~: do @@ -874,13 +884,6 @@ tests_Hledger_Read_JournalReader = TestList $ concat [ assertBool "accountname rejects an empty leading component" (isLeft $ parsewith accountname ":b:c") assertBool "accountname rejects an empty trailing component" (isLeft $ parsewith accountname "a:b:") - ,"amount" ~: do - let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity - assertMixedAmountParse parseresult mixedamount = - (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount) - assertMixedAmountParse (parseWithCtx nullctx amount "1 @ $2") - (Mixed [Amount unknown 1 (Just $ UnitPrice $ Mixed [Amount dollar{precision=0} 2 Nothing])]) - ,"leftsymbolamount" ~: do assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1") (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,decimalpoint='.',precision=0,separator=',',separatorpositions=[]} 1 Nothing]) @@ -889,6 +892,13 @@ tests_Hledger_Read_JournalReader = TestList $ concat [ assertParseEqual (parseWithCtx nullctx leftsymbolamount "-$1") (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,decimalpoint='.',precision=0,separator=',',separatorpositions=[]} (-1) Nothing]) + ,"amount" ~: do + let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity + assertMixedAmountParse parseresult mixedamount = + (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount) + assertMixedAmountParse (parseWithCtx nullctx amount "1 @ $2") + (Mixed [Amount unknown 1 (Just $ UnitPrice $ Mixed [Amount dollar{precision=0} 2 Nothing])]) + ]] entry1_str = unlines diff --git a/hledger-lib/Hledger/Reports.hs b/hledger-lib/Hledger/Reports.hs index 30667610b..3021f1dd8 100644 --- a/hledger-lib/Hledger/Reports.hs +++ b/hledger-lib/Hledger/Reports.hs @@ -20,8 +20,8 @@ module Hledger.Reports ( whichDateFromOpts, journalSelectingDateFromOpts, journalSelectingAmountFromOpts, - filterSpecFromOpts, queryFromOpts, + queryOptsFromOpts, -- * Entries report EntriesReport, EntriesReportItem, @@ -42,7 +42,6 @@ module Hledger.Reports ( AccountsReport, AccountsReportItem, accountsReport, - accountsReport2, isInteresting, -- * Tests tests_Hledger_Reports @@ -54,17 +53,22 @@ import Data.List import Data.Maybe import Data.Ord import Data.Time.Calendar -import Data.Tree +-- import Data.Tree import Safe (headMay, lastMay) import System.Console.CmdArgs -- for defaults support +import System.Time (ClockTime(TOD)) import Test.HUnit import Text.ParserCombinators.Parsec import Text.Printf import Hledger.Data +import Hledger.Read (amount') +import Hledger.Data.Query import Hledger.Utils - -- standard report options, used in hledger-lib and above +-- | Standard options for customising report filtering and output, +-- corresponding to hledger's command-line options and query language +-- arguments. Used in hledger-lib and above. data ReportOpts = ReportOpts { begin_ :: Maybe Day ,end_ :: Maybe Day @@ -78,16 +82,16 @@ data ReportOpts = ReportOpts { ,empty_ :: Bool ,no_elide_ :: Bool ,real_ :: Bool - ,flat_ :: Bool -- balance - ,drop_ :: Int -- balance - ,no_total_ :: Bool -- balance + ,flat_ :: Bool -- for balance command + ,drop_ :: Int -- " + ,no_total_ :: Bool -- " ,daily_ :: Bool ,weekly_ :: Bool ,monthly_ :: Bool ,quarterly_ :: Bool ,yearly_ :: Bool ,format_ :: Maybe FormatStr - ,patterns_ :: [String] + ,query_ :: String -- all arguments, as a string } deriving (Show) type DisplayExp = String @@ -167,59 +171,48 @@ journalSelectingAmountFromOpts opts | cost_ opts = journalConvertAmountsToCost | otherwise = id --- | Convert report options to a (old) filter specification. -filterSpecFromOpts :: ReportOpts -> Day -> FilterSpec -filterSpecFromOpts opts@ReportOpts{..} d = FilterSpec { - datespan=dateSpanFromOpts d opts - ,cleared= clearedValueFromOpts opts - ,real=real_ - ,empty=empty_ - ,acctpats=apats - ,descpats=dpats - ,depth = depth_ - ,fMetadata = mds - } - where (apats,dpats,mds) = parsePatternArgs patterns_ +-- | Convert report options and arguments to a query. +queryFromOpts :: Day -> ReportOpts -> Query +queryFromOpts d opts@ReportOpts{..} = simplifyQuery $ And $ [flagsq, argsq] + where + flagsq = And $ + [Date $ dateSpanFromOpts d opts] + ++ (if real_ then [Real True] else []) + ++ (if empty_ then [Empty True] else []) -- ? + ++ (maybe [] ((:[]) . Status) (clearedValueFromOpts opts)) + ++ (maybe [] ((:[]) . Depth) depth_) + argsq = fst $ parseQuery d query_ --- | Convert report options to a (new) query. -queryFromOpts :: ReportOpts -> Day -> (Query, [QueryOpt]) -queryFromOpts opts@ReportOpts{..} d = -- strace $ - (And $ - [Date $ dateSpanFromOpts d opts] - ++ (if null apats then [] else [Or $ map Acct apats]) - ++ (if null dpats then [] else [Or $ map Desc dpats]) - -- ++ (if null mds then [] else [Or $ map MatchMetadata mds]) - ++ (if real_ then [Real True] else []) - ++ (if empty_ then [Empty True] else []) - ++ (maybe [] ((:[]) . Status) (clearedValueFromOpts opts)) - ++ (maybe [] ((:[]) . Depth) depth_) - ,[]) - where - (apats,dpats,_) = parsePatternArgs patterns_ +tests_queryFromOpts = [ + "queryFromOpts" ~: do + assertEqual "" Any (queryFromOpts nulldate defreportopts) + assertEqual "" (Acct "a") (queryFromOpts nulldate defreportopts{query_="a"}) + assertEqual "" (Desc "a a") (queryFromOpts nulldate defreportopts{query_="desc:'a a'"}) + assertEqual "" (Date $ mkdatespan "2012/01/01" "2013/01/01") + (queryFromOpts nulldate defreportopts{begin_=Just (parsedate "2012/01/01") + ,query_="date:'to 2013'" + }) + assertEqual "" (EDate $ mkdatespan "2012/01/01" "2013/01/01") + (queryFromOpts nulldate defreportopts{query_="edate:'in 2012'"}) + assertEqual "" (Or [Acct "a a", Acct "'b"]) + (queryFromOpts nulldate defreportopts{query_="'a a' 'b"}) + ] --- queryFromOpts :: ReportOpts -> Day -> (Query, [QueryOpt]) --- queryFromOpts opts d = parseQuery d (unwords $ patterns_ opts) +-- | Convert report options and arguments to query options. +queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt] +queryOptsFromOpts d ReportOpts{..} = flagsqopts ++ argsqopts + where + flagsqopts = [] + argsqopts = snd $ parseQuery d query_ --- | Gather filter pattern arguments into a list of account patterns and a --- list of description patterns. We interpret pattern arguments as --- follows: those prefixed with "desc:" are description patterns, all --- others are account patterns; also patterns prefixed with "not:" are --- negated. not: should come after desc: if both are used. --- pattern "tag" means the word after it should be interpreted as metadata --- constraint. -parsePatternArgs :: [String] -> ([String],[String],[(String,String)]) -parsePatternArgs args = (as, ds', mds) - where - (tags, args') = filterOutTags False [] [] args - descprefix = "desc:" - (ds, as) = partition (descprefix `isPrefixOf`) args' - ds' = map (drop (length descprefix)) ds - mds = map (\(a,b)->(a,tail b)) $ map (\t->span (/='=') t) tags - - filterOutTags _ tags args' [] = (reverse tags, reverse args') - filterOutTags False tags args' ("tag":xs) = filterOutTags True tags args' xs - filterOutTags False tags args' (x:xs) = filterOutTags False tags (x:args') xs - filterOutTags True tags args' (x:xs) = filterOutTags False (x:tags) args' xs +tests_queryOptsFromOpts = [ + "queryOptsFromOpts" ~: do + assertEqual "" [] (queryOptsFromOpts nulldate defreportopts) + assertEqual "" [] (queryOptsFromOpts nulldate defreportopts{query_="a"}) + assertEqual "" [] (queryOptsFromOpts nulldate defreportopts{begin_=Just (parsedate "2012/01/01") + ,query_="date:'to 2013'" + }) + ] ------------------------------------------------------------------------------- @@ -230,23 +223,24 @@ type EntriesReport = [EntriesReportItem] type EntriesReportItem = Transaction -- | Select transactions for an entries report. -entriesReport :: ReportOpts -> FilterSpec -> Journal -> EntriesReport -entriesReport opts fspec j = sortBy (comparing f) $ jtxns $ filterJournalTransactions fspec j' +-- "The print command selects transactions which +-- @ +-- match any of the description patterns +-- and have any postings matching any of the positive account patterns +-- and have no postings matching any of the negative account patterns" +-- @ +entriesReport :: ReportOpts -> Query -> Journal -> EntriesReport +entriesReport opts q j = + sortBy (comparing date) $ filter (q `matchesTransaction`) ts where - f = transactionDateFn opts - j' = journalSelectingAmountFromOpts opts j + date = transactionDateFn opts + ts = jtxns $ journalSelectingAmountFromOpts opts j --- | Select transactions for an entries report. -entriesReport2 :: ReportOpts -> Query -> Journal -> EntriesReport -entriesReport2 opts q j = - sortBy (comparing f) $ filter (not . null . tpostings) $ map (filterTransactionPostings q) $ jtxns j' - where - f = transactionDateFn opts - j' = journalSelectingAmountFromOpts opts j - -tests_entriesReport2 = [ - "entriesReport2" ~: do - assertEqual "" [] (entriesReport2 defreportopts Any nulljournal) +tests_entriesReport = [ + "entriesReport" ~: do + assertEqual "not acct" 1 (length $ entriesReport defreportopts (Not $ Acct "bank") samplejournal) + let span = mkdatespan "2008/06/01" "2008/07/01" + assertEqual "date" 3 (length $ entriesReport defreportopts (Date $ span) samplejournal) ] ------------------------------------------------------------------------------- @@ -257,32 +251,37 @@ type PostingsReport = (String -- label for the running balance col ,[PostingsReportItem] -- line items, one per posting ) type PostingsReportItem = (Maybe (Day, String) -- transaction date and description if this is the first posting - ,Posting -- the posting - ,MixedAmount -- the running total after this posting - ) + ,Posting -- the posting, possibly with account name depth-clipped + ,MixedAmount -- the running total after this posting + ) -- | Select postings from the journal and add running balance and other -- information to make a postings report. Used by eg hledger's register command. -postingsReport :: ReportOpts -> FilterSpec -> Journal -> PostingsReport -postingsReport opts fspec j = (totallabel, postingsReportItems ps nullposting startbal (+)) +postingsReport :: ReportOpts -> Query -> Journal -> PostingsReport +postingsReport opts q j = (totallabel, postingsReportItems ps nullposting depth startbal (+)) where ps | interval == NoInterval = displayableps | otherwise = summarisePostingsByInterval interval depth empty reportspan displayableps - j' = journalSelectingDateFromOpts opts - $ journalSelectingAmountFromOpts opts - j - (precedingps, displayableps, _) = postingsMatchingDisplayExpr (display_ opts) - $ depthClipPostings depth - $ journalPostings - $ filterJournalPostings fspec{depth=Nothing} - j' - (interval, depth, empty, displayexpr) = (intervalFromOpts opts, depth_ opts, empty_ opts, display_ opts) + j' = journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j + -- don't do depth filtering until the end + (depth, q') = (queryDepth q, filterQuery (not . queryIsDepth) q) + (precedingps, displayableps, _) = dbg "ps3" $ postingsMatchingDisplayExpr (display_ opts) + $ dbg "ps2" $ filter (q' `matchesPosting`) + $ dbg "ps1" $ journalPostings j' + dbg :: Show a => String -> a -> a + -- dbg = ltrace + dbg = flip const + + empty = queryEmpty q + displayexpr = display_ opts -- XXX + interval = intervalFromOpts opts -- XXX journalspan = journalDateSpan j' -- requestedspan should be the intersection of any span specified -- with period options and any span specified with display option. -- The latter is not easily available, fake it for now. requestedspan = periodspan `spanIntersect` displayspan - periodspan = datespan fspec + periodspan = queryDateSpan effectivedate q + effectivedate = whichDateFromOpts opts == EffectiveDate displayspan = postingsDateSpan ps where (_,ps,_) = postingsMatchingDisplayExpr displayexpr $ journalPostings j' matchedspan = postingsDateSpan displayableps @@ -290,21 +289,184 @@ postingsReport opts fspec j = (totallabel, postingsReportItems ps nullposting st | otherwise = requestedspan `spanIntersect` matchedspan startbal = sumPostings precedingps +tests_postingsReport = [ + "postingsReport" ~: do + let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts query journal) `is` n + (Any, nulljournal) `gives` 0 + (Any, samplejournal) `gives` 11 + -- register --depth just clips account names + (Depth 2, samplejournal) `gives` 11 + -- (Depth 2, samplejournal) `gives` 6 + -- (Depth 1, samplejournal) `gives` 4 + + assertEqual "" 11 (length $ snd $ postingsReport defreportopts Any samplejournal) + assertEqual "" 9 (length $ snd $ postingsReport defreportopts{monthly_=True} Any samplejournal) + assertEqual "" 19 (length $ snd $ postingsReport defreportopts{monthly_=True} (Empty True) samplejournal) + + -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0 + -- [(Just (parsedate "2008-01-01","income"),assets:bank:checking $1,$1) + -- ,(Nothing,income:salary $-1,0) + -- ,(Just (2008-06-01,"gift"),assets:bank:checking $1,$1) + -- ,(Nothing,income:gifts $-1,0) + -- ,(Just (2008-06-02,"save"),assets:bank:saving $1,$1) + -- ,(Nothing,assets:bank:checking $-1,0) + -- ,(Just (2008-06-03,"eat & shop"),expenses:food $1,$1) + -- ,(Nothing,expenses:supplies $1,$2) + -- ,(Nothing,assets:cash $-2,0) + -- ,(Just (2008-12-31,"pay off"),liabilities:debts $1,$1) + -- ,(Nothing,assets:bank:checking $-1,0) + -- ] + +{- + let opts = defreportopts + (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines + ["2008/01/01 income assets:bank:checking $1 $1" + ," income:salary $-1 0" + ,"2008/06/01 gift assets:bank:checking $1 $1" + ," income:gifts $-1 0" + ,"2008/06/02 save assets:bank:saving $1 $1" + ," assets:bank:checking $-1 0" + ,"2008/06/03 eat & shop expenses:food $1 $1" + ," expenses:supplies $1 $2" + ," assets:cash $-2 0" + ,"2008/12/31 pay off liabilities:debts $1 $1" + ," assets:bank:checking $-1 0" + ] + + ,"postings report with cleared option" ~: + do + let opts = defreportopts{cleared_=True} + j <- readJournal' sample_journal_str + (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines + ["2008/06/03 eat & shop expenses:food $1 $1" + ," expenses:supplies $1 $2" + ," assets:cash $-2 0" + ,"2008/12/31 pay off liabilities:debts $1 $1" + ," assets:bank:checking $-1 0" + ] + + ,"postings report with uncleared option" ~: + do + let opts = defreportopts{uncleared_=True} + j <- readJournal' sample_journal_str + (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines + ["2008/01/01 income assets:bank:checking $1 $1" + ," income:salary $-1 0" + ,"2008/06/01 gift assets:bank:checking $1 $1" + ," income:gifts $-1 0" + ,"2008/06/02 save assets:bank:saving $1 $1" + ," assets:bank:checking $-1 0" + ] + + ,"postings report sorts by date" ~: + do + j <- readJournal' $ unlines + ["2008/02/02 a" + ," b 1" + ," c" + ,"" + ,"2008/01/01 d" + ," e 1" + ," f" + ] + let opts = defreportopts + registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/02/02"] + + ,"postings report with account pattern" ~: + do + j <- samplejournal + let opts = defreportopts{patterns_=["cash"]} + (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines + ["2008/06/03 eat & shop assets:cash $-2 $-2" + ] + + ,"postings report with account pattern, case insensitive" ~: + do + j <- samplejournal + let opts = defreportopts{patterns_=["cAsH"]} + (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines + ["2008/06/03 eat & shop assets:cash $-2 $-2" + ] + + ,"postings report with display expression" ~: + do + j <- samplejournal + let gives displayexpr = + (registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is`) + where opts = defreportopts{display_=Just displayexpr} + "d<[2008/6/2]" `gives` ["2008/01/01","2008/06/01"] + "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"] + "d=[2008/6/2]" `gives` ["2008/06/02"] + "d>=[2008/6/2]" `gives` ["2008/06/02","2008/06/03","2008/12/31"] + "d>[2008/6/2]" `gives` ["2008/06/03","2008/12/31"] + + ,"postings report with period expression" ~: + do + j <- samplejournal + let periodexpr `gives` dates = do + j' <- samplejournal + registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j') `is` dates + where opts = defreportopts{period_=maybePeriod date1 periodexpr} + "" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] + "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] + "2007" `gives` [] + "june" `gives` ["2008/06/01","2008/06/02","2008/06/03"] + "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"] + "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"] + let opts = defreportopts{period_=maybePeriod date1 "yearly"} + (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines + ["2008/01/01 - 2008/12/31 assets:bank:saving $1 $1" + ," assets:cash $-2 $-1" + ," expenses:food $1 0" + ," expenses:supplies $1 $1" + ," income:gifts $-1 0" + ," income:salary $-1 $-1" + ," liabilities:debts $1 0" + ] + let opts = defreportopts{period_=maybePeriod date1 "quarterly"} + registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/10/01"] + let opts = defreportopts{period_=maybePeriod date1 "quarterly",empty_=True} + registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] + + ] + + , "postings report with depth arg" ~: + do + j <- samplejournal + let opts = defreportopts{depth_=Just 2} + (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines + ["2008/01/01 income assets:bank $1 $1" + ," income:salary $-1 0" + ,"2008/06/01 gift assets:bank $1 $1" + ," income:gifts $-1 0" + ,"2008/06/02 save assets:bank $1 $1" + ," assets:bank $-1 0" + ,"2008/06/03 eat & shop expenses:food $1 $1" + ," expenses:supplies $1 $2" + ," assets:cash $-2 0" + ,"2008/12/31 pay off liabilities:debts $1 $1" + ," assets:bank $-1 0" + ] + +-} + ] + totallabel = "Total" balancelabel = "Balance" -- | Generate postings report line items. -postingsReportItems :: [Posting] -> Posting -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [PostingsReportItem] -postingsReportItems [] _ _ _ = [] -postingsReportItems (p:ps) pprev b sumfn = i:(postingsReportItems ps p b' sumfn) +postingsReportItems :: [Posting] -> Posting -> Int -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [PostingsReportItem] +postingsReportItems [] _ _ _ _ = [] +postingsReportItems (p:ps) pprev d b sumfn = i:(postingsReportItems ps p d b' sumfn) where - i = mkpostingsReportItem isfirst p b' + i = mkpostingsReportItem isfirst p' b' + p' = p{paccount=clipAccountName d $ paccount p} isfirst = ptransaction p /= ptransaction pprev b' = b `sumfn` pamount p --- | Generate one postings report line item, from a flag indicating --- whether to include transaction info, a posting, and the current running --- balance. +-- | Generate one postings report line item, given a flag indicating +-- whether to include transaction info, the posting, and the current +-- running balance. mkpostingsReportItem :: Bool -> Posting -> MixedAmount -> PostingsReportItem mkpostingsReportItem False p b = (Nothing, p, b) mkpostingsReportItem True p b = (ds, p, b) @@ -348,26 +510,31 @@ datedisplayexpr = do where compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"] --- | Clip the account names to the specified depth in a list of postings. -depthClipPostings :: Maybe Int -> [Posting] -> [Posting] -depthClipPostings depth = map (depthClipPosting depth) +-- -- | Clip the account names to the specified depth in a list of postings. +-- depthClipPostings :: Maybe Int -> [Posting] -> [Posting] +-- depthClipPostings depth = map (depthClipPosting depth) --- | Clip a posting's account name to the specified depth. -depthClipPosting :: Maybe Int -> Posting -> Posting -depthClipPosting Nothing p = p -depthClipPosting (Just d) p@Posting{paccount=a} = p{paccount=clipAccountName d a} +-- -- | Clip a posting's account name to the specified depth. +-- depthClipPosting :: Maybe Int -> Posting -> Posting +-- depthClipPosting Nothing p = p +-- depthClipPosting (Just d) p@Posting{paccount=a} = p{paccount=clipAccountName d a} -- XXX confusing, refactor -- | Convert a list of postings into summary postings. Summary postings -- are one per account per interval and aggregated to the specified depth -- if any. -summarisePostingsByInterval :: Interval -> Maybe Int -> Bool -> DateSpan -> [Posting] -> [Posting] +summarisePostingsByInterval :: Interval -> Int -> Bool -> DateSpan -> [Posting] -> [Posting] summarisePostingsByInterval interval depth empty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan where summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s) postingsinspan s = filter (isPostingInDateSpan s) ps +tests_summarisePostingsByInterval = [ + "summarisePostingsByInterval" ~: do + summarisePostingsByInterval (Quarters 1) 99999 False (DateSpan Nothing Nothing) [] ~?= [] + ] + -- | Given a date span (representing a reporting interval) and a list of -- postings within it: aggregate the postings so there is only one per -- account, and adjust their date/description so that they will render @@ -381,7 +548,7 @@ summarisePostingsByInterval interval depth empty reportspan ps = concatMap summa -- -- The showempty flag includes spans with no postings and also postings -- with 0 amount. -summarisePostingsInDateSpan :: DateSpan -> Maybe Int -> Bool -> [Posting] -> [Posting] +summarisePostingsInDateSpan :: DateSpan -> Int -> Bool -> [Posting] -> [Posting] summarisePostingsInDateSpan (DateSpan b e) depth showempty ps | null ps && (isNothing b || isNothing e) = [] | null ps && showempty = [summaryp] @@ -397,9 +564,8 @@ summarisePostingsInDateSpan (DateSpan b e) depth showempty ps anames = sort $ nub $ map paccount ps -- aggregate balances by account, like journalToLedger, then do depth-clipping (_,_,exclbalof,inclbalof) = groupPostings ps - clippedanames = nub $ map (clipAccountName d) anames - isclipped a = accountNameLevel a >= d - d = fromMaybe 99999 $ depth + clippedanames = nub $ map (clipAccountName depth) anames + isclipped a = accountNameLevel a >= depth balancetoshowfor a = (if isclipped a then inclbalof else exclbalof) (if null a then "top" else a) @@ -534,29 +700,18 @@ type AccountsReportItem = (AccountName -- full account name ,MixedAmount) -- account balance, includes subs unless --flat is present -- | Select accounts, and get their balances at the end of the selected --- period, and misc. display information, for an accounts report. Used by --- eg hledger's balance command. -accountsReport :: ReportOpts -> FilterSpec -> Journal -> AccountsReport -accountsReport opts filterspec j = accountsReport' opts j (journalToLedger filterspec) - --- | Select accounts, and get their balances at the end of the selected --- period, and misc. display information, for an accounts report. Like --- "accountsReport" but uses the new queries. Used by eg hledger-web's --- accounts sidebar. -accountsReport2 :: ReportOpts -> Query -> Journal -> AccountsReport -accountsReport2 opts query j = accountsReport' opts j (journalToLedger2 query) - --- Accounts report helper. -accountsReport' :: ReportOpts -> Journal -> (Journal -> Ledger) -> AccountsReport -accountsReport' opts j jtol = (items, total) +-- period, and misc. display information, for an accounts report. +accountsReport :: ReportOpts -> Query -> Journal -> AccountsReport +accountsReport opts query j = (items, total) where - items = map mkitem interestingaccts + -- don't do depth filtering until the end + q' = filterQuery (not . queryIsDepth) query + l = journalToLedger q' $ journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j + acctnames = filter (query `matchesAccount`) $ journalAccountNames j interestingaccts | no_elide_ opts = acctnames | otherwise = filter (isInteresting opts l) acctnames - acctnames = sort $ tail $ flatten $ treemap aname accttree - accttree = ledgerAccountTree (fromMaybe 99999 $ depth_ opts) l + items = map mkitem interestingaccts total = sum $ map abalance $ ledgerTopAccounts l - l = jtol $ journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j -- | Get data for one balance report line item. mkitem :: AccountName -> AccountsReportItem @@ -573,6 +728,223 @@ accountsReport' opts j jtol = (items, total) | otherwise = abalance acct where acct = ledgerAccount l a +tests_accountsReport = [ + "accountsReport" ~: do + let (opts,journal) `gives` r = do + let (eitems, etotal) = r + (aitems, atotal) = accountsReport opts (queryFromOpts nulldate opts) journal + assertEqual "items" eitems aitems + -- assertEqual "" (length eitems) (length aitems) + -- mapM (\(e,a) -> assertEqual "" e a) $ zip eitems aitems + assertEqual "total" etotal atotal + + -- "accounts report with no args" ~: + (defreportopts, nulljournal) `gives` ([], Mixed [nullamt]) + (defreportopts, samplejournal) `gives` + ([ + ("assets","assets",0, amount' "$-1.00") + ,("assets:bank:saving","bank:saving",1, amount' "$1.00") + ,("assets:cash","cash",1, amount' "$-2.00") + ,("expenses","expenses",0, amount' "$2.00") + ,("expenses:food","food",1, amount' "$1.00") + ,("expenses:supplies","supplies",1, amount' "$1.00") + ,("income","income",0, amount' "$-2.00") + ,("income:gifts","gifts",1, amount' "$-1.00") + ,("income:salary","salary",1, amount' "$-1.00") + ,("liabilities:debts","liabilities:debts",0, amount' "$1.00") + ], + Mixed [nullamt]) + + -- "accounts report can be limited with --depth=N" ~: + (defreportopts{depth_=Just 1}, samplejournal) `gives` + ([ + ("assets", "assets", 0, amount' "$-1.00") + ,("expenses", "expenses", 0, amount' "$2.00") + ,("income", "income", 0, amount' "$-2.00") + ,("liabilities", "liabilities", 0, amount' "$1.00") + ], + Mixed [nullamt]) + + -- or with depth:N + (defreportopts{query_="depth:1"}, samplejournal) `gives` + ([ + ("assets", "assets", 0, amount' "$-1.00") + ,("expenses", "expenses", 0, amount' "$2.00") + ,("income", "income", 0, amount' "$-2.00") + ,("liabilities", "liabilities", 0, amount' "$1.00") + ], + Mixed [nullamt]) + + -- with a date span + (defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives` + ([], + Mixed [nullamt]) + (defreportopts{query_="edate:'in 2009'"}, samplejournal2) `gives` + ([ + ("assets:bank:checking","assets:bank:checking",0,amount' "$1.00") + ,("income:salary","income:salary",0,amount' "$-1.00") + ], + Mixed [nullamt]) + + +{- + ,"accounts report with account pattern o" ~: + defreportopts{patterns_=["o"]} `gives` + [" $1 expenses:food" + ," $-2 income" + ," $-1 gifts" + ," $-1 salary" + ,"--------------------" + ," $-1" + ] + + ,"accounts report with account pattern o and --depth 1" ~: + defreportopts{patterns_=["o"],depth_=Just 1} `gives` + [" $1 expenses" + ," $-2 income" + ,"--------------------" + ," $-1" + ] + + ,"accounts report with account pattern a" ~: + defreportopts{patterns_=["a"]} `gives` + [" $-1 assets" + ," $1 bank:saving" + ," $-2 cash" + ," $-1 income:salary" + ," $1 liabilities:debts" + ,"--------------------" + ," $-1" + ] + + ,"accounts report with account pattern e" ~: + defreportopts{patterns_=["e"]} `gives` + [" $-1 assets" + ," $1 bank:saving" + ," $-2 cash" + ," $2 expenses" + ," $1 food" + ," $1 supplies" + ," $-2 income" + ," $-1 gifts" + ," $-1 salary" + ," $1 liabilities:debts" + ,"--------------------" + ," 0" + ] + + ,"accounts report with unmatched parent of two matched subaccounts" ~: + defreportopts{patterns_=["cash","saving"]} `gives` + [" $-1 assets" + ," $1 bank:saving" + ," $-2 cash" + ,"--------------------" + ," $-1" + ] + + ,"accounts report with multi-part account name" ~: + defreportopts{patterns_=["expenses:food"]} `gives` + [" $1 expenses:food" + ,"--------------------" + ," $1" + ] + + ,"accounts report with negative account pattern" ~: + defreportopts{patterns_=["not:assets"]} `gives` + [" $2 expenses" + ," $1 food" + ," $1 supplies" + ," $-2 income" + ," $-1 gifts" + ," $-1 salary" + ," $1 liabilities:debts" + ,"--------------------" + ," $1" + ] + + ,"accounts report negative account pattern always matches full name" ~: + defreportopts{patterns_=["not:e"]} `gives` + ["--------------------" + ," 0" + ] + + ,"accounts report negative patterns affect totals" ~: + defreportopts{patterns_=["expenses","not:food"]} `gives` + [" $1 expenses:supplies" + ,"--------------------" + ," $1" + ] + + ,"accounts report with -E shows zero-balance accounts" ~: + defreportopts{patterns_=["assets"],empty_=True} `gives` + [" $-1 assets" + ," $1 bank" + ," 0 checking" + ," $1 saving" + ," $-2 cash" + ,"--------------------" + ," $-1" + ] + + ,"accounts report with cost basis" ~: do + j <- (readJournal Nothing Nothing Nothing $ unlines + ["" + ,"2008/1/1 test " + ," a:b 10h @ $50" + ," c:d " + ]) >>= either error' return + let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment + accountsReportAsText defreportopts (accountsReport defreportopts Any j') `is` + [" $500 a:b" + ," $-500 c:d" + ,"--------------------" + ," 0" + ] +-} + ] + +Right samplejournal2 = journalBalanceTransactions $ Journal + [] + [] + [ + txnTieKnot $ Transaction { + tdate=parsedate "2008/01/01", + teffectivedate=Just $ parsedate "2009/01/01", + tstatus=False, + tcode="", + tdescription="income", + tcomment="", + tmetadata=[], + tpostings=[ + Posting { + pstatus=False, + paccount="assets:bank:checking", + pamount=(Mixed [dollars 1]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + }, + Posting { + pstatus=False, + paccount="income:salary", + pamount=(missingmixedamt), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ], + tpreceding_comment_lines="" + } + ] + [] + [] + "" + nullctx + [] + (TOD 0 0) + exclusiveBalance :: Account -> MixedAmount exclusiveBalance = sumPostings . apostings @@ -598,7 +970,7 @@ isInterestingIndented opts l a | numinterestingsubs < 2 && zerobalance && not emptyflag = False | otherwise = True where - atmaxdepth = isJust d && Just (accountNameLevel a) == d where d = depth_ opts + atmaxdepth = accountNameLevel a == depthFromOpts opts emptyflag = empty_ opts acct = ledgerAccount l a zerobalance = isZeroMixedAmount inclbalance where inclbalance = abalance acct @@ -608,16 +980,29 @@ isInterestingIndented opts l a isInterestingTree = treeany (isInteresting opts l . aname) subtrees = map (fromJust . ledgerAccountTreeAt l) $ ledgerSubAccounts l $ ledgerAccount l a +tests_isInterestingIndented = [ + "isInterestingIndented" ~: do + let (opts, journal, acctname) `gives` r = isInterestingIndented opts l acctname `is` r + where l = journalToLedger (queryFromOpts nulldate opts) journal + + (defreportopts, samplejournal, "expenses") `gives` True + ] + +depthFromOpts :: ReportOpts -> Int +depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts) + ------------------------------------------------------------------------------- tests_Hledger_Reports :: Test tests_Hledger_Reports = TestList $ - tests_entriesReport2 ++ - [ - - "summarisePostingsByInterval" ~: do - summarisePostingsByInterval (Quarters 1) Nothing False (DateSpan Nothing Nothing) [] ~?= [] - + tests_queryFromOpts + ++ tests_queryOptsFromOpts + ++ tests_entriesReport + ++ tests_summarisePostingsByInterval + ++ tests_postingsReport + ++ tests_isInterestingIndented + ++ tests_accountsReport + ++ [ -- ,"summarisePostingsInDateSpan" ~: do -- let gives (b,e,depth,showempty,ps) = -- (summarisePostingsInDateSpan (mkdatespan b e) depth showempty ps `is`) diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index 3d083ee21..9501dc8a3 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/hledger-lib/Hledger/Utils.hs @@ -74,7 +74,12 @@ quoteIfSpaced :: String -> String quoteIfSpaced s | isSingleQuoted s || isDoubleQuoted s = s | not $ any (`elem` s) whitespacechars = s | otherwise = "'"++escapeSingleQuotes s++"'" - where escapeSingleQuotes = regexReplace "'" "\'" + +escapeSingleQuotes :: String -> String +escapeSingleQuotes = regexReplace "'" "\'" + +escapeQuotes :: String -> String +escapeQuotes = regexReplace "([\"'])" "\\1" -- | Quote-aware version of words - don't split on spaces which are inside quotes. -- NB correctly handles "a'b" but not "''a''". @@ -91,6 +96,7 @@ words' = map stripquotes . fromparse . parsewith p unwords' :: [String] -> String unwords' = unwords . map singleQuoteIfNeeded +-- | Single-quote this string if it contains whitespace or double-quotes singleQuoteIfNeeded s | any (`elem` s) whitespacechars = "'"++s++"'" | otherwise = s diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index 8bf90cf0e..36ca70d77 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -18,7 +18,6 @@ module Hledger.Cli ( tests_Hledger_Cli ) where -import Control.Monad import qualified Data.Map as Map import Data.Time.Calendar import System.Time (ClockTime(TOD)) @@ -105,158 +104,6 @@ tests_Hledger_Cli = TestList "expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation", "liabilities","liabilities:credit cards","liabilities:credit cards:discover"] - ,"sample journal parses" ~: do - _ <- samplejournal - assertBool "" True - - ,"balance report tests" ~: - let opts `gives` es = do - j <- samplejournal - d <- getCurrentDay - accountsReportAsText opts (accountsReport opts (filterSpecFromOpts opts d) j) `is` es - in TestList - [ - "balance report with no args" ~: - defreportopts `gives` - [" $-1 assets" - ," $1 bank:saving" - ," $-2 cash" - ," $2 expenses" - ," $1 food" - ," $1 supplies" - ," $-2 income" - ," $-1 gifts" - ," $-1 salary" - ," $1 liabilities:debts" - ,"--------------------" - ," 0" - ] - - ,"balance report can be limited with --depth" ~: - defreportopts{depth_=Just 1} `gives` - [" $-1 assets" - ," $2 expenses" - ," $-2 income" - ," $1 liabilities" - ,"--------------------" - ," 0" - ] - - ,"balance report with account pattern o" ~: - defreportopts{patterns_=["o"]} `gives` - [" $1 expenses:food" - ," $-2 income" - ," $-1 gifts" - ," $-1 salary" - ,"--------------------" - ," $-1" - ] - - ,"balance report with account pattern o and --depth 1" ~: - defreportopts{patterns_=["o"],depth_=Just 1} `gives` - [" $1 expenses" - ," $-2 income" - ,"--------------------" - ," $-1" - ] - - ,"balance report with account pattern a" ~: - defreportopts{patterns_=["a"]} `gives` - [" $-1 assets" - ," $1 bank:saving" - ," $-2 cash" - ," $-1 income:salary" - ," $1 liabilities:debts" - ,"--------------------" - ," $-1" - ] - - ,"balance report with account pattern e" ~: - defreportopts{patterns_=["e"]} `gives` - [" $-1 assets" - ," $1 bank:saving" - ," $-2 cash" - ," $2 expenses" - ," $1 food" - ," $1 supplies" - ," $-2 income" - ," $-1 gifts" - ," $-1 salary" - ," $1 liabilities:debts" - ,"--------------------" - ," 0" - ] - - ,"balance report with unmatched parent of two matched subaccounts" ~: - defreportopts{patterns_=["cash","saving"]} `gives` - [" $-1 assets" - ," $1 bank:saving" - ," $-2 cash" - ,"--------------------" - ," $-1" - ] - - ,"balance report with multi-part account name" ~: - defreportopts{patterns_=["expenses:food"]} `gives` - [" $1 expenses:food" - ,"--------------------" - ," $1" - ] - - ,"balance report with negative account pattern" ~: - defreportopts{patterns_=["not:assets"]} `gives` - [" $2 expenses" - ," $1 food" - ," $1 supplies" - ," $-2 income" - ," $-1 gifts" - ," $-1 salary" - ," $1 liabilities:debts" - ,"--------------------" - ," $1" - ] - - ,"balance report negative account pattern always matches full name" ~: - defreportopts{patterns_=["not:e"]} `gives` - ["--------------------" - ," 0" - ] - - ,"balance report negative patterns affect totals" ~: - defreportopts{patterns_=["expenses","not:food"]} `gives` - [" $1 expenses:supplies" - ,"--------------------" - ," $1" - ] - - ,"balance report with -E shows zero-balance accounts" ~: - defreportopts{patterns_=["assets"],empty_=True} `gives` - [" $-1 assets" - ," $1 bank" - ," 0 checking" - ," $1 saving" - ," $-2 cash" - ,"--------------------" - ," $-1" - ] - - ,"balance report with cost basis" ~: do - j <- (readJournal Nothing Nothing Nothing $ unlines - ["" - ,"2008/1/1 test " - ," a:b 10h @ $50" - ," c:d " - ]) >>= either error' return - let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment - accountsReportAsText defreportopts (accountsReport defreportopts nullfilterspec j') `is` - [" $500 a:b" - ," $-500 c:d" - ,"--------------------" - ," 0" - ] - - ] - ,"journalCanonicaliseAmounts" ~: "use the greatest precision" ~: (map precision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2] @@ -276,211 +123,13 @@ tests_Hledger_Cli = TestList tdate (head $ jtxns j) `is` fromGregorian 2009 1 1 return () - ,"print report tests" ~: TestList - [ + ,"show dollars" ~: showAmount (dollars 1) ~?= "$1.00" - "print expenses" ~: - do - let opts = defreportopts{patterns_=["expenses"]} - j <- samplejournal - d <- getCurrentDay - showTransactions opts (filterSpecFromOpts opts d) j `is` unlines - ["2008/06/03 * eat & shop" - ," expenses:food $1" - ," expenses:supplies $1" - ," assets:cash $-2" - ,"" - ] - - , "print report with depth arg" ~: - do - let opts = defreportopts{depth_=Just 2} - j <- samplejournal - d <- getCurrentDay - showTransactions opts (filterSpecFromOpts opts d) j `is` unlines - ["2008/01/01 income" - ," income:salary $-1" - ,"" - ,"2008/06/01 gift" - ," income:gifts $-1" - ,"" - ,"2008/06/03 * eat & shop" - ," expenses:food $1" - ," expenses:supplies $1" - ," assets:cash $-2" - ,"" - ,"2008/12/31 * pay off" - ," liabilities:debts $1" - ,"" - ] - - ] - - ,"register report tests" ~: - let registerdates = filter (not . null) . map (strip . take 10) . lines - in - TestList - [ - - "register report with no args" ~: - do - j <- samplejournal - let opts = defreportopts - (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` unlines - ["2008/01/01 income assets:bank:checking $1 $1" - ," income:salary $-1 0" - ,"2008/06/01 gift assets:bank:checking $1 $1" - ," income:gifts $-1 0" - ,"2008/06/02 save assets:bank:saving $1 $1" - ," assets:bank:checking $-1 0" - ,"2008/06/03 eat & shop expenses:food $1 $1" - ," expenses:supplies $1 $2" - ," assets:cash $-2 0" - ,"2008/12/31 pay off liabilities:debts $1 $1" - ," assets:bank:checking $-1 0" - ] - - ,"register report with cleared option" ~: - do - let opts = defreportopts{cleared_=True} - j <- readJournal' sample_journal_str - (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` unlines - ["2008/06/03 eat & shop expenses:food $1 $1" - ," expenses:supplies $1 $2" - ," assets:cash $-2 0" - ,"2008/12/31 pay off liabilities:debts $1 $1" - ," assets:bank:checking $-1 0" - ] - - ,"register report with uncleared option" ~: - do - let opts = defreportopts{uncleared_=True} - j <- readJournal' sample_journal_str - (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` unlines - ["2008/01/01 income assets:bank:checking $1 $1" - ," income:salary $-1 0" - ,"2008/06/01 gift assets:bank:checking $1 $1" - ," income:gifts $-1 0" - ,"2008/06/02 save assets:bank:saving $1 $1" - ," assets:bank:checking $-1 0" - ] - - ,"register report sorts by date" ~: - do - j <- readJournal' $ unlines - ["2008/02/02 a" - ," b 1" - ," c" - ,"" - ,"2008/01/01 d" - ," e 1" - ," f" - ] - let opts = defreportopts - registerdates (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` ["2008/01/01","2008/02/02"] - - ,"register report with account pattern" ~: - do - j <- samplejournal - let opts = defreportopts{patterns_=["cash"]} - (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` unlines - ["2008/06/03 eat & shop assets:cash $-2 $-2" - ] - - ,"register report with account pattern, case insensitive" ~: - do - j <- samplejournal - let opts = defreportopts{patterns_=["cAsH"]} - (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` unlines - ["2008/06/03 eat & shop assets:cash $-2 $-2" - ] - - ,"register report with display expression" ~: - do - j <- samplejournal - let gives displayexpr = - (registerdates (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is`) - where opts = defreportopts{display_=Just displayexpr} - "d<[2008/6/2]" `gives` ["2008/01/01","2008/06/01"] - "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"] - "d=[2008/6/2]" `gives` ["2008/06/02"] - "d>=[2008/6/2]" `gives` ["2008/06/02","2008/06/03","2008/12/31"] - "d>[2008/6/2]" `gives` ["2008/06/03","2008/12/31"] - - ,"register report with period expression" ~: - do - j <- samplejournal - let periodexpr `gives` dates = do - j' <- samplejournal - registerdates (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j') `is` dates - where opts = defreportopts{period_=maybePeriod date1 periodexpr} - "" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] - "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] - "2007" `gives` [] - "june" `gives` ["2008/06/01","2008/06/02","2008/06/03"] - "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"] - "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"] - let opts = defreportopts{period_=maybePeriod date1 "yearly"} - (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` unlines - ["2008/01/01 - 2008/12/31 assets:bank:saving $1 $1" - ," assets:cash $-2 $-1" - ," expenses:food $1 0" - ," expenses:supplies $1 $1" - ," income:gifts $-1 0" - ," income:salary $-1 $-1" - ," liabilities:debts $1 0" - ] - let opts = defreportopts{period_=maybePeriod date1 "quarterly"} - registerdates (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` ["2008/01/01","2008/04/01","2008/10/01"] - let opts = defreportopts{period_=maybePeriod date1 "quarterly",empty_=True} - registerdates (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] - - ] - - , "register report with depth arg" ~: - do - j <- samplejournal - let opts = defreportopts{depth_=Just 2} - (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` unlines - ["2008/01/01 income assets:bank $1 $1" - ," income:salary $-1 0" - ,"2008/06/01 gift assets:bank $1 $1" - ," income:gifts $-1 0" - ,"2008/06/02 save assets:bank $1 $1" - ," assets:bank $-1 0" - ,"2008/06/03 eat & shop expenses:food $1 $1" - ," expenses:supplies $1 $2" - ," assets:cash $-2 0" - ,"2008/12/31 pay off liabilities:debts $1 $1" - ," assets:bank $-1 0" - ] - - ,"show dollars" ~: show (dollars 1) ~?= "$1.00" - - ,"show hours" ~: show (hours 1) ~?= "1.0h" - - ,"unicode in balance layout" ~: do - j <- readJournal' - "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" - let opts = defreportopts - accountsReportAsText opts (accountsReport opts (filterSpecFromOpts opts date1) j) `is` - [" -100 актив:наличные" - ," 100 расходы:покупки" - ,"--------------------" - ," 0" - ] - - ,"unicode in register layout" ~: do - j <- readJournal' - "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" - let opts = defreportopts - (postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts date1) j) `is` unlines - ["2009/01/01 медвежья шкура расходы:покупки 100 100" - ," актив:наличные -100 0"] + ,"show hours" ~: showAmount (hours 1) ~?= "1.0h" ,"subAccounts" ~: do - l <- liftM (journalToLedger nullfilterspec) samplejournal - let a = ledgerAccount l "assets" + let l = journalToLedger Any samplejournal + a = ledgerAccount l "assets" map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"] ] @@ -488,9 +137,10 @@ tests_Hledger_Cli = TestList -- fixtures/test data -date1 = parsedate "2008/11/26" +-- date1 = parsedate "2008/11/26" -- t1 = LocalTime date1 midday +{- samplejournal = readJournal' sample_journal_str sample_journal_str = unlines @@ -535,6 +185,7 @@ sample_journal_str = unlines ,"" ,";final comment" ] +-} defaultyear_journal_str = unlines ["Y2009" @@ -882,7 +533,7 @@ journal7 = Journal [] (TOD 0 0) -ledger7 = journalToLedger nullfilterspec journal7 +ledger7 = journalToLedger Any journal7 -- journal8_str = unlines -- ["2008/1/1 test " diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index 31a3440c6..aa6ce71f4 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -81,7 +81,7 @@ getTransaction j opts defaultDate = do || isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s)) when (datestr == ".") $ ioError $ mkIOError eofErrorType "" Nothing Nothing description <- runInteractionDefault $ askFor "description" (Just "") Nothing - let historymatches = transactionsSimilarTo j (patterns_ $ reportopts_ opts) description + let historymatches = transactionsSimilarTo j (queryFromOpts today $ reportopts_ opts) description bestmatch | null historymatches = Nothing | otherwise = Just $ snd $ head historymatches bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch @@ -149,8 +149,8 @@ getPostings st enteredps = do -- I think 1 or 4, whichever would show the most decimal places p = maxprecisionwithpoint amountstr <- runInteractionDefault $ askFor (printf "amount %d" n) defaultamountstr validateamount - let a = fromparse $ runParser (amount <|> return missingamt) ctx "" amountstr - a' = fromparse $ runParser (amount <|> return missingamt) nullctx "" amountstr + let a = fromparse $ runParser (amount <|> return missingmixedamt) ctx "" amountstr + a' = fromparse $ runParser (amount <|> return missingmixedamt) nullctx "" amountstr defaultamtused = Just (showMixedAmount a) == defaultamountstr commodityadded | c == cwithnodef = Nothing | otherwise = c @@ -228,7 +228,7 @@ registerFromString :: String -> IO String registerFromString s = do d <- getCurrentDay j <- readJournal' s - return $ postingsReportAsText opts $ postingsReport opts (filterSpecFromOpts opts d) j + return $ postingsReportAsText opts $ postingsReport opts (queryFromOpts d opts) j where opts = defreportopts{empty_=True} -- | Return a similarity measure, from 0 to 1, for two strings. @@ -256,14 +256,14 @@ compareDescriptions s t = compareStrings s' t' t' = simplify t simplify = filter (not . (`elem` "0123456789")) -transactionsSimilarTo :: Journal -> [String] -> String -> [(Double,Transaction)] -transactionsSimilarTo j apats s = +transactionsSimilarTo :: Journal -> Query -> String -> [(Double,Transaction)] +transactionsSimilarTo j q s = sortBy compareRelevanceAndRecency $ filter ((> threshold).fst) [(compareDescriptions s $ tdescription t, t) | t <- ts] where compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,tdate t2) (n1,tdate t1) - ts = jtxns $ filterJournalTransactionsByAccount apats j + ts = filter (q `matchesTransaction`) $ jtxns j threshold = 0 runInteraction :: Journal -> InputT IO a -> IO a diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index af7cc15f5..e395997a8 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -117,7 +117,7 @@ balance CliOpts{reportopts_=ropts} j = do d <- getCurrentDay let lines = case formatFromOpts ropts of Left err -> [err] - Right _ -> accountsReportAsText ropts $ accountsReport ropts (filterSpecFromOpts ropts d) j + Right _ -> accountsReportAsText ropts $ accountsReport ropts (queryFromOpts d ropts) j putStr $ unlines lines -- | Render a balance report as plain text suitable for console output. @@ -134,6 +134,20 @@ accountsReportAsText opts (items, total) = concat lines ++ t ,padleft 20 $ showMixedAmountWithoutPrice total ] +tests_accountsReportAsText = [ + "accountsReportAsText" ~: do + -- "unicode in balance layout" ~: do + j <- readJournal' + "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" + let opts = defreportopts + accountsReportAsText opts (accountsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is` + [" -100 актив:наличные" + ," 100 расходы:покупки" + ,"--------------------" + ," 0" + ] + ] + {- This implementation turned out to be a bit convoluted but implements the following algorithm for formatting: @@ -180,5 +194,4 @@ formatField opts accountName depth total ljust min max field = case field of _ -> "" tests_Hledger_Cli_Balance = TestList - [ - ] + tests_accountsReportAsText diff --git a/hledger/Hledger/Cli/Balancesheet.hs b/hledger/Hledger/Cli/Balancesheet.hs index e926e354f..56c087d57 100644 --- a/hledger/Hledger/Cli/Balancesheet.hs +++ b/hledger/Hledger/Cli/Balancesheet.hs @@ -27,10 +27,10 @@ balancesheet :: CliOpts -> Journal -> IO () balancesheet CliOpts{reportopts_=ropts} j = do -- let lines = case formatFromOpts ropts of Left err, Right ... d <- getCurrentDay - let (m,_) = queryFromOpts (withoutBeginDate ropts) d - assetreport@(_,assets) = accountsReport2 ropts (And [m, journalAssetAccountQuery j]) j - liabilityreport@(_,liabilities) = accountsReport2 ropts (And [m, journalLiabilityAccountQuery j]) j - equityreport@(_,equity) = accountsReport2 ropts (And [m, journalEquityAccountQuery j]) j + let q = queryFromOpts d (withoutBeginDate ropts) + assetreport@(_,assets) = accountsReport ropts (And [q, journalAssetAccountQuery j]) j + liabilityreport@(_,liabilities) = accountsReport ropts (And [q, journalLiabilityAccountQuery j]) j + equityreport@(_,equity) = accountsReport ropts (And [q, journalEquityAccountQuery j]) j total = assets + liabilities + equity LT.putStr $ [lt|Balance Sheet diff --git a/hledger/Hledger/Cli/Cashflow.hs b/hledger/Hledger/Cli/Cashflow.hs index 9fbe32815..52f9c7877 100644 --- a/hledger/Hledger/Cli/Cashflow.hs +++ b/hledger/Hledger/Cli/Cashflow.hs @@ -30,11 +30,11 @@ cashflow :: CliOpts -> Journal -> IO () cashflow CliOpts{reportopts_=ropts} j = do -- let lines = case formatFromOpts ropts of Left err, Right ... d <- getCurrentDay - let (m,_) = queryFromOpts (withoutBeginDate ropts) d - cashreport@(_,total) = accountsReport2 ropts (And [m, journalCashAccountQuery j]) j - -- operatingreport@(_,operating) = accountsReport2 ropts (And [m, journalOperatingAccountMatcher j]) j - -- investingreport@(_,investing) = accountsReport2 ropts (And [m, journalInvestingAccountMatcher j]) j - -- financingreport@(_,financing) = accountsReport2 ropts (And [m, journalFinancingAccountMatcher j]) j + let q = queryFromOpts d (withoutBeginDate ropts) + cashreport@(_,total) = accountsReport ropts (And [q, journalCashAccountQuery j]) j + -- operatingreport@(_,operating) = accountsReport ropts (And [q, journalOperatingAccountMatcher j]) j + -- investingreport@(_,investing) = accountsReport ropts (And [q, journalInvestingAccountMatcher j]) j + -- financingreport@(_,financing) = accountsReport ropts (And [q, journalFinancingAccountMatcher j]) j -- total = operating + investing + financing LT.putStr $ [lt|Cashflow Statement diff --git a/hledger/Hledger/Cli/Histogram.hs b/hledger/Hledger/Cli/Histogram.hs index f07025115..a6ebf2f29 100644 --- a/hledger/Hledger/Cli/Histogram.hs +++ b/hledger/Hledger/Cli/Histogram.hs @@ -14,6 +14,7 @@ import Text.Printf import Hledger.Cli.Options import Hledger.Data import Hledger.Reports +import Hledger.Data.Query import Prelude hiding (putStr) import Hledger.Utils.UTF8IOCompat (putStr) @@ -23,30 +24,26 @@ barchar = '*' -- | Print a histogram of some statistic per reporting interval, such as -- number of postings per day. histogram :: CliOpts -> Journal -> IO () -histogram CliOpts{reportopts_=reportopts_} j = do +histogram CliOpts{reportopts_=ropts} j = do d <- getCurrentDay - putStr $ showHistogram reportopts_ (filterSpecFromOpts reportopts_ d) j + putStr $ showHistogram ropts (queryFromOpts d ropts) j -showHistogram :: ReportOpts -> FilterSpec -> Journal -> String -showHistogram opts filterspec j = concatMap (printDayWith countBar) spanps +showHistogram :: ReportOpts -> Query -> Journal -> String +showHistogram opts q j = concatMap (printDayWith countBar) spanps where i = intervalFromOpts opts interval | i == NoInterval = Days 1 | otherwise = i - span = datespan filterspec `orDatesFrom` journalDateSpan j + span = queryDateSpan (effective_ opts) q `orDatesFrom` journalDateSpan j spans = filter (DateSpan Nothing Nothing /=) $ splitSpan interval span spanps = [(s, filter (isPostingInDateSpan s) ps) | s <- spans] -- same as Register -- should count transactions, not postings ? - ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j + -- ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j + ps = sortBy (comparing postingDate) $ filterempties $ filter (q `matchesPosting`) $ journalPostings j filterempties - | empty_ opts = id + | queryEmpty q = id | otherwise = filter (not . isZeroMixedAmount . pamount) - matchapats = matchpats apats . paccount - apats = acctpats filterspec - filterdepth | interval == NoInterval = filter (\p -> accountNameLevel (paccount p) <= depth) - | otherwise = id - depth = fromMaybe 99999 $ depth_ opts printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts) diff --git a/hledger/Hledger/Cli/Incomestatement.hs b/hledger/Hledger/Cli/Incomestatement.hs index 2d706a907..013b2a442 100644 --- a/hledger/Hledger/Cli/Incomestatement.hs +++ b/hledger/Hledger/Cli/Incomestatement.hs @@ -22,9 +22,9 @@ import Hledger.Cli.Balance incomestatement :: CliOpts -> Journal -> IO () incomestatement CliOpts{reportopts_=ropts} j = do d <- getCurrentDay - let (m,_) = queryFromOpts ropts d - incomereport@(_,income) = accountsReport2 ropts (And [m, journalIncomeAccountQuery j]) j - expensereport@(_,expenses) = accountsReport2 ropts (And [m, journalExpenseAccountQuery j]) j + let q = queryFromOpts d ropts + incomereport@(_,income) = accountsReport ropts (And [q, journalIncomeAccountQuery j]) j + expensereport@(_,expenses) = accountsReport ropts (And [q, journalExpenseAccountQuery j]) j total = income + expenses LT.putStr $ [lt|Income Statement diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index 7bf4f093c..93b5a91cb 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -60,13 +60,21 @@ import Hledger.Cli.Tests import Hledger.Cli.Utils import Hledger.Cli.Version import Hledger.Utils +import Hledger.Reports +import Hledger.Data.Dates main :: IO () main = do args <- getArgs addons <- getHledgerAddonCommands opts <- getHledgerCliOpts addons - when (debug_ opts) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts) + when (debug_ opts) $ do + printf "%s\n" prognameandversion + printf "args: %s\n" (show args) + printf "opts: %s\n" (show opts) + d <- getCurrentDay + printf "query: %s\n" (show $ queryFromOpts d $ reportopts_ opts) + run' opts addons args where run' opts@CliOpts{command_=cmd} addons args diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index b39c0d097..be611c546 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -27,7 +27,7 @@ import Hledger.Cli.Version -- 1. cmdargs mode and flag definitions, for the main and subcommand modes. --- Flag values are parsed initially to simple RawOpts to permit reuse. +-- Flag values are parsed initially to a simple association list to allow reuse. type RawOpts = [(String,String)] @@ -306,7 +306,7 @@ toCliOpts rawopts = do ,command_ = stringopt "command" rawopts ,file_ = maybestringopt "file" rawopts ,rules_file_ = maybestringopt "rules-file" rawopts - ,alias_ = listofstringopt "alias" rawopts + ,alias_ = map stripquotes $ listofstringopt "alias" rawopts ,debug_ = boolopt "debug" rawopts ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add ,reportopts_ = defreportopts { @@ -331,7 +331,7 @@ toCliOpts rawopts = do ,quarterly_ = boolopt "quarterly" rawopts ,yearly_ = boolopt "yearly" rawopts ,format_ = maybestringopt "format" rawopts - ,patterns_ = listofstringopt "args" rawopts + ,query_ = unwords $ listofstringopt "args" rawopts } } @@ -387,7 +387,7 @@ maybestringopt name = maybe Nothing (Just . stripquotes) . lookup name stringopt name = fromMaybe "" . maybestringopt name -listofstringopt name rawopts = [stripquotes v | (n,v) <- rawopts, n==name] +listofstringopt name rawopts = [v | (k,v) <- rawopts, k==name] maybeintopt :: String -> RawOpts -> Maybe Int maybeintopt name rawopts = diff --git a/hledger/Hledger/Cli/Print.hs b/hledger/Hledger/Cli/Print.hs index a68255820..a09ebff9f 100644 --- a/hledger/Hledger/Cli/Print.hs +++ b/hledger/Hledger/Cli/Print.hs @@ -7,8 +7,10 @@ A ledger-compatible @print@ command. module Hledger.Cli.Print ( print' ,showTransactions + ,tests_Hledger_Cli_Print ) where import Data.List +import Test.HUnit import Hledger import Prelude hiding (putStr) @@ -19,11 +21,53 @@ import Hledger.Cli.Options print' :: CliOpts -> Journal -> IO () print' CliOpts{reportopts_=ropts} j = do d <- getCurrentDay - putStr $ showTransactions ropts (filterSpecFromOpts ropts d) j + putStr $ showTransactions ropts (queryFromOpts d ropts) j -showTransactions :: ReportOpts -> FilterSpec -> Journal -> String -showTransactions opts fspec j = entriesReportAsText opts fspec $ entriesReport opts fspec j +showTransactions :: ReportOpts -> Query -> Journal -> String +showTransactions opts q j = entriesReportAsText opts q $ entriesReport opts q j -entriesReportAsText :: ReportOpts -> FilterSpec -> EntriesReport -> String +tests_showTransactions = [ + "showTransactions" ~: do + + -- "print expenses" ~: + do + let opts = defreportopts{query_="expenses"} + d <- getCurrentDay + showTransactions opts (queryFromOpts d opts) samplejournal `is` unlines + ["2008/06/03 * eat & shop" + ," expenses:food $1" + ," expenses:supplies $1" + ," assets:cash $-2" + ,"" + ] + + -- , "print report with depth arg" ~: + do + let opts = defreportopts{depth_=Just 2} + d <- getCurrentDay + showTransactions opts (queryFromOpts d opts) samplejournal `is` unlines + ["2008/01/01 income" + ," assets:bank:checking $1" + ," income:salary $-1" + ,"" + ,"2008/06/01 gift" + ," assets:bank:checking $1" + ," income:gifts $-1" + ,"" + ,"2008/06/03 * eat & shop" + ," expenses:food $1" + ," expenses:supplies $1" + ," assets:cash $-2" + ,"" + ,"2008/12/31 * pay off" + ," liabilities:debts $1" + ," assets:bank:checking $-1" + ,"" + ] + ] + +entriesReportAsText :: ReportOpts -> Query -> EntriesReport -> String entriesReportAsText _ _ items = concatMap showTransactionUnelided items +tests_Hledger_Cli_Print = TestList + tests_showTransactions \ No newline at end of file diff --git a/hledger/Hledger/Cli/Register.hs b/hledger/Hledger/Cli/Register.hs index 538c60634..af2fe6382 100644 --- a/hledger/Hledger/Cli/Register.hs +++ b/hledger/Hledger/Cli/Register.hs @@ -26,12 +26,23 @@ import Hledger.Cli.Options register :: CliOpts -> Journal -> IO () register CliOpts{reportopts_=ropts} j = do d <- getCurrentDay - putStr $ postingsReportAsText ropts $ postingsReport ropts (filterSpecFromOpts ropts d) j + putStr $ postingsReportAsText ropts $ postingsReport ropts (queryFromOpts d ropts) j -- | Render a register report as plain text suitable for console output. postingsReportAsText :: ReportOpts -> PostingsReport -> String postingsReportAsText opts = unlines . map (postingsReportItemAsText opts) . snd +tests_postingsReportAsText = [ + "postingsReportAsText" ~: do + -- "unicode in register layout" ~: do + j <- readJournal' + "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" + let opts = defreportopts + (postingsReportAsText opts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is` unlines + ["2009/01/01 медвежья шкура расходы:покупки 100 100" + ," актив:наличные -100 0"] + ] + -- | Render one register report line item as plain text. Eg: -- @ -- date (10) description (20) account (22) amount (11) balance (12) @@ -59,6 +70,4 @@ showPostingWithBalanceForVty showtxninfo p b = postingsReportItemAsText defrepor tests_Hledger_Cli_Register :: Test tests_Hledger_Cli_Register = TestList - [ - - ] + tests_postingsReportAsText diff --git a/hledger/Hledger/Cli/Stats.hs b/hledger/Hledger/Cli/Stats.hs index a8123ee83..6777d13d9 100644 --- a/hledger/Hledger/Cli/Stats.hs +++ b/hledger/Hledger/Cli/Stats.hs @@ -24,9 +24,9 @@ import Hledger.Utils.UTF8IOCompat (putStr) stats :: CliOpts -> Journal -> IO () stats CliOpts{reportopts_=reportopts_} j = do d <- getCurrentDay - let filterspec = filterSpecFromOpts reportopts_ d - l = journalToLedger filterspec j - reportspan = (ledgerDateSpan l) `orDatesFrom` (datespan filterspec) + let q = queryFromOpts d reportopts_ + l = journalToLedger q j + reportspan = (ledgerDateSpan l) `orDatesFrom` (queryDateSpan False q) intervalspans = splitSpan (intervalFromOpts reportopts_) reportspan showstats = showLedgerStats l d s = intercalate "\n" $ map showstats intervalspans diff --git a/hledger/Hledger/Cli/Tests.hs b/hledger/Hledger/Cli/Tests.hs index ec0621955..eec325cc1 100644 --- a/hledger/Hledger/Cli/Tests.hs +++ b/hledger/Hledger/Cli/Tests.hs @@ -57,9 +57,7 @@ runTestsTillFailure opts = undefined -- do -- firstproblem = find (\counts -> ) -- | All or pattern-matched tests, as a flat list to show simple names. -flatTests opts = TestList $ filter (matcherFromOpts opts) $ 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. -hierarchicalTests opts = filterTests (matcherFromOpts opts) tests_Hledger_Cli - -matcherFromOpts opts = matchpats (patterns_ $ reportopts_ opts) . testName +hierarchicalTests opts = filterTests (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . testName) tests_Hledger_Cli