slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

big query/tests/show refactoring

Browse Source 
- 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
This commit is contained in:
Simon Michael 2012-05-27 18:14:20 +00:00
parent 1654776f4a
commit 3ee6a351f3
27 changed files with 1405 additions and 791 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
MANUAL.md
View File

@ -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
<!--
New:
Most commands accept one or more filter pattern arguments after the
command name, to select a subset of the data. There are several kinds
of filter pattern:
- `acct:ACCTREGEX` - match account names by regular expression
- `desc:DESCREGEX` - match transaction descriptions by regular expression
- `tag:TAGNAMEREGEX[:TAGVALUEREGEX]` - match a [tag](#tags) name, and
optionally the value, by regular expression
- `TAGNAME:[TAGVALUEREGEX]` - match a tag name exactly, and optionally
the value by regular expression.
- `ACCTREGEX` - match account names by regular expression
Later:
- `status:[*]`
- `code:CODEREGEX`
- `date:DATEEXPR`
- `edate:DATEEXPR`
- `code:CODEREGEX` -->
- `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

2
hledger-lib/Hledger.hs
View File

@ -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

2
hledger-lib/Hledger/Data/Account.hs
View File

@ -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

54
hledger-lib/Hledger/Data/Amount.hs
View File

@ -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]}

435
hledger-lib/Hledger/Data/Journal.hs
View File

@ -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,6 +478,161 @@ 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.
@ -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)

27
hledger-lib/Hledger/Data/Ledger.hs
View File

@ -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

2
hledger-lib/Hledger/Data/Posting.hs
View File

@ -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

282
hledger-lib/Hledger/Data/Query.hs
View File

@ -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

14
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -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"

14
hledger-lib/Hledger/Data/Types.hs
View File

@ -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

39
hledger-lib/Hledger/Read.hs
View File

@ -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,

40
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -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

641
hledger-lib/Hledger/Reports.hs
View File

@ -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 to a (new) query.
queryFromOpts :: ReportOpts -> Day -> (Query, [QueryOpt])
queryFromOpts opts@ReportOpts{..} d = -- strace $
(And $
-- | 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 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 [])
++ (if empty_ then [Empty True] else []) -- ?
++ (maybe [] ((:[]) . Status) (clearedValueFromOpts opts))
++ (maybe [] ((:[]) . Depth) depth_)
,[])
argsq = fst $ parseQuery d query_
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"})
]
-- | Convert report options and arguments to query options.
queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt]
queryOptsFromOpts d ReportOpts{..} = flagsqopts ++ argsqopts
where
(apats,dpats,_) = parsePatternArgs patterns_
flagsqopts = []
argsqopts = snd $ parseQuery d query_
-- queryFromOpts :: ReportOpts -> Day -> (Query, [QueryOpt])
-- queryFromOpts opts d = parseQuery d (unwords $ patterns_ opts)
-- | 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
,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`)

8
hledger-lib/Hledger/Utils.hs
View File

@ -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

365
hledger/Hledger/Cli.hs
View File

@ -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 "

14
hledger/Hledger/Cli/Add.hs
View File

@ -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

19
hledger/Hledger/Cli/Balance.hs
View File

@ -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

8
hledger/Hledger/Cli/Balancesheet.hs
View File

@ -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

10
hledger/Hledger/Cli/Cashflow.hs
View File

@ -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

21
hledger/Hledger/Cli/Histogram.hs
View File

@ -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)

6
hledger/Hledger/Cli/Incomestatement.hs
View File

@ -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

10
hledger/Hledger/Cli/Main.hs
View File

@ -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

8
hledger/Hledger/Cli/Options.hs
View File

@ -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 =

52
hledger/Hledger/Cli/Print.hs
View File

@ -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

17
hledger/Hledger/Cli/Register.hs
View File

@ -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

6
hledger/Hledger/Cli/Stats.hs
View File

@ -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

6
hledger/Hledger/Cli/Tests.hs
View File

@ -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