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

lib,cli: Store parsed Query in ReportOpts, rather than an unparsed

Browse Source 
String.
This commit is contained in:
Stephen Morgan 2020-09-02 21:00:45 +10:00 committed by Simon Michael
parent 103308e795
commit c45663d41d
32 changed files with 241 additions and 305 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
hledger-lib/Hledger/Query.hs
View File

@ -59,6 +59,7 @@ module Hledger.Query (
where
import Control.Applicative ((<|>), many, optional)
import Data.Default (Default(..))
import Data.Either (partitionEithers)
import Data.List (partition)
import Data.Maybe (fromMaybe, isJust, mapMaybe)
@ -105,6 +106,8 @@ data Query = Any -- ^ always match
-- matching the regexp if provided, exists
deriving (Eq,Show)
instance Default Query where def = Any
-- | Construct a payee tag
payeeTag :: Maybe String -> Either RegexError Query
payeeTag = fmap (Tag (toRegexCI' "payee")) . maybe (pure Nothing) (fmap Just . toRegexCI)

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

@ -41,5 +41,4 @@ tests_Reports = tests "Reports" [
,tests_EntriesReport
,tests_MultiBalanceReport
,tests_PostingsReport
,tests_ReportOptions
]

21
hledger-lib/Hledger/Reports/BalanceReport.hs
View File

@ -61,10 +61,10 @@ flatShowsExclusiveBalance = True
-- their balances (change of balance) during the specified period.
-- If the normalbalance_ option is set, it adjusts the sorting and sign of
-- amounts (see ReportOpts and CompoundBalanceCommand).
balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport
balanceReport ropts q j = (rows, total)
balanceReport :: ReportOpts -> Journal -> BalanceReport
balanceReport ropts j = (rows, total)
where
report = multiBalanceReportWith ropts q j (journalPriceOracle (infer_value_ ropts) j)
report = multiBalanceReportWith ropts j (journalPriceOracle (infer_value_ ropts) j)
rows = [( prrFullName row
, prrDisplayName row
, prrDepth row - 1 -- BalanceReport uses 0-based account depths
@ -102,8 +102,9 @@ tests_BalanceReport = tests "BalanceReport" [
let
(opts,journal) `gives` r = do
let (eitems, etotal) = r
(aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal
let opts' = opts{query_=And [queryFromFlags opts, query_ opts]}
(eitems, etotal) = r
(aitems, atotal) = balanceReport opts' journal
showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt)
(map showw aitems) @?= (map showw eitems)
(showMixedAmountDebug atotal) @?= (showMixedAmountDebug etotal)
@ -152,7 +153,7 @@ tests_BalanceReport = tests "BalanceReport" [
Mixed [usd 0])
,test "with depth:N" $
(defreportopts{query_="depth:1"}, samplejournal) `gives`
(defreportopts{query_=Depth 1}, samplejournal) `gives`
([
("expenses", "expenses", 0, mamountp' "$2.00")
,("income", "income", 0, mamountp' "$-2.00")
@ -160,11 +161,11 @@ tests_BalanceReport = tests "BalanceReport" [
Mixed [usd 0])
,test "with date:" $
(defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives`
(defreportopts{query_=Date $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
([], 0)
,test "with date2:" $
(defreportopts{query_="date2:'in 2009'"}, samplejournal2) `gives`
(defreportopts{query_=Date2 $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
([
("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
,("income:salary","income:salary",0,mamountp' "$-1.00")
@ -172,7 +173,7 @@ tests_BalanceReport = tests "BalanceReport" [
Mixed [usd 0])
,test "with desc:" $
(defreportopts{query_="desc:income"}, samplejournal) `gives`
(defreportopts{query_=Desc $ toRegexCI' "income"}, samplejournal) `gives`
([
("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
,("income:salary","income:salary",0, mamountp' "$-1.00")
@ -180,7 +181,7 @@ tests_BalanceReport = tests "BalanceReport" [
Mixed [usd 0])
,test "with not:desc:" $
(defreportopts{query_="not:desc:income"}, samplejournal) `gives`
(defreportopts{query_=Not . Desc $ toRegexCI' "income"}, samplejournal) `gives`
([
("assets:bank:saving","assets:bank:saving",0, mamountp' "$1.00")
,("assets:cash","assets:cash",0, mamountp' "$-2.00")

9
hledger-lib/Hledger/Reports/BudgetReport.hs
View File

@ -33,7 +33,6 @@ import Data.Maybe
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import Data.Time.Calendar
import Safe
--import Data.List
--import Data.Maybe
@ -66,8 +65,8 @@ type BudgetReport = PeriodicReport DisplayName BudgetCell
-- actual balance changes from the regular transactions,
-- and compare these to get a 'BudgetReport'.
-- Unbudgeted accounts may be hidden or renamed (see budgetRollup).
budgetReport :: ReportOpts -> Bool -> DateSpan -> Day -> Journal -> BudgetReport
budgetReport ropts' assrt reportspan d j = dbg1 "sortedbudgetreport" budgetreport
budgetReport :: ReportOpts -> Bool -> DateSpan -> Journal -> BudgetReport
budgetReport ropts' assrt reportspan j = dbg1 "sortedbudgetreport" budgetreport
where
-- Budget report demands ALTree mode to ensure subaccounts and subaccount budgets are properly handled
-- and that reports with and without --empty make sense when compared side by side
@ -84,9 +83,9 @@ budgetReport ropts' assrt reportspan d j = dbg1 "sortedbudgetreport" budgetrepor
actualj = dbg1With (("actualj"++).show.jtxns) $ budgetRollUp budgetedaccts showunbudgeted j
budgetj = dbg1With (("budgetj"++).show.jtxns) $ budgetJournal assrt ropts reportspan j
actualreport@(PeriodicReport actualspans _ _) =
dbg1 "actualreport" $ multiBalanceReport d ropts{empty_=True} actualj
dbg1 "actualreport" $ multiBalanceReport ropts{empty_=True} actualj
budgetgoalreport@(PeriodicReport _ budgetgoalitems budgetgoaltotals) =
dbg1 "budgetgoalreport" $ multiBalanceReport d ropts{empty_=True} budgetj
dbg1 "budgetgoalreport" $ multiBalanceReport ropts{empty_=True} budgetj
budgetgoalreport'
-- If no interval is specified:
-- budgetgoalreport's span might be shorter actualreport's due to periodic txns;

10
hledger-lib/Hledger/Reports/EntriesReport.hs
View File

@ -32,9 +32,9 @@ type EntriesReport = [EntriesReportItem]
type EntriesReportItem = Transaction
-- | Select transactions for an entries report.
entriesReport :: ReportOpts -> Query -> Journal -> EntriesReport
entriesReport ropts@ReportOpts{..} q j@Journal{..} =
sortBy (comparing getdate) $ filter (q `matchesTransaction`) $ map tvalue jtxns
entriesReport :: ReportOpts -> Journal -> EntriesReport
entriesReport ropts@ReportOpts{..} j@Journal{..} =
sortBy (comparing getdate) $ filter (query_ `matchesTransaction`) $ map tvalue jtxns
where
getdate = transactionDateFn ropts
-- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
@ -50,8 +50,8 @@ entriesReport ropts@ReportOpts{..} q j@Journal{..} =
tests_EntriesReport = tests "EntriesReport" [
tests "entriesReport" [
test "not acct" $ (length $ entriesReport defreportopts (Not . Acct $ toRegex' "bank") samplejournal) @?= 1
,test "date" $ (length $ entriesReport defreportopts (Date $ DateSpan (Just $ fromGregorian 2008 06 01) (Just $ fromGregorian 2008 07 01)) samplejournal) @?= 3
test "not acct" $ (length $ entriesReport defreportopts{query_=Not . Acct $ toRegex' "bank"} samplejournal) @?= 1
,test "date" $ (length $ entriesReport defreportopts{query_=Date $ DateSpan (Just $ fromGregorian 2008 06 01) (Just $ fromGregorian 2008 07 01)} samplejournal) @?= 3
]
]

138
hledger-lib/Hledger/Reports/MultiBalanceReport.hs
View File

@ -91,64 +91,57 @@ type ClippedAccountName = AccountName
-- CompoundBalanceCommand). hledger's most powerful and useful report, used
-- by the balance command (in multiperiod mode) and (via compoundBalanceReport)
-- by the bs/cf/is commands.
multiBalanceReport :: Day -> ReportOpts -> Journal -> MultiBalanceReport
multiBalanceReport today ropts j =
multiBalanceReportWith ropts q j (journalPriceOracle infer j)
where
q = queryFromOpts today ropts
infer = infer_value_ ropts
multiBalanceReport :: ReportOpts -> Journal -> MultiBalanceReport
multiBalanceReport ropts j = multiBalanceReportWith ropts j (journalPriceOracle infer j)
where infer = infer_value_ ropts
-- | A helper for multiBalanceReport. This one takes an explicit Query
-- instead of deriving one from ReportOpts, and an extra argument, a
-- PriceOracle to be used for looking up market prices. Commands which
-- | A helper for multiBalanceReport. This one takes an extra argument,
-- a PriceOracle to be used for looking up market prices. Commands which
-- run multiple reports (bs etc.) can generate the price oracle just
-- once for efficiency, passing it to each report by calling this
-- function directly.
multiBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle -> MultiBalanceReport
multiBalanceReportWith ropts q j priceoracle = report
multiBalanceReportWith :: ReportOpts -> Journal -> PriceOracle -> MultiBalanceReport
multiBalanceReportWith ropts' j priceoracle = report
where
-- Queries, report/column dates.
reportspan = dbg "reportspan" $ calculateReportSpan ropts q j
reportq = dbg "reportq" $ makeReportQuery ropts reportspan q
reportspan = dbg "reportspan" $ calculateReportSpan ropts' j
ropts = dbg "reportopts" $ makeReportQuery ropts' reportspan
-- Group postings into their columns.
colps = dbg'' "colps" $ getPostingsByColumn ropts reportq j reportspan
colps = dbg'' "colps" $ getPostingsByColumn ropts j reportspan
colspans = dbg "colspans" $ M.keys colps
-- The matched accounts with a starting balance. All of these should appear
-- in the report, even if they have no postings during the report period.
startbals = dbg' "startbals" $ startingBalances ropts reportq j reportspan
startbals = dbg' "startbals" $ startingBalances ropts j reportspan
-- Generate and postprocess the report, negating balances and taking percentages if needed
report = dbg' "report" $
generateMultiBalanceReport ropts reportq j priceoracle colspans colps startbals
generateMultiBalanceReport ropts j priceoracle colspans colps startbals
-- | Generate a compound balance report from a list of CBCSubreportSpec. This
-- shares postings between the subreports.
compoundBalanceReport :: Day -> ReportOpts -> Journal -> [CBCSubreportSpec]
compoundBalanceReport :: ReportOpts -> Journal -> [CBCSubreportSpec]
-> CompoundBalanceReport
compoundBalanceReport today ropts j =
compoundBalanceReportWith ropts q j (journalPriceOracle infer j)
where
q = queryFromOpts today ropts
infer = infer_value_ ropts
compoundBalanceReport ropts j = compoundBalanceReportWith ropts j (journalPriceOracle infer j)
where infer = infer_value_ ropts
-- | A helper for compoundBalanceReport, similar to multiBalanceReportWith.
compoundBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle
compoundBalanceReportWith :: ReportOpts -> Journal -> PriceOracle
-> [CBCSubreportSpec] -> CompoundBalanceReport
compoundBalanceReportWith ropts q j priceoracle subreportspecs = cbr
compoundBalanceReportWith ropts' j priceoracle subreportspecs = cbr
where
-- Queries, report/column dates.
reportspan = dbg "reportspan" $ calculateReportSpan ropts q j
reportq = dbg "reportq" $ makeReportQuery ropts reportspan q
reportspan = dbg "reportspan" $ calculateReportSpan ropts' j
ropts = dbg "reportopts" $ makeReportQuery ropts' reportspan
-- Group postings into their columns.
colps = dbg'' "colps" $ getPostingsByColumn ropts{empty_=True} reportq j reportspan
colps = dbg'' "colps" $ getPostingsByColumn ropts{empty_=True} j reportspan
colspans = dbg "colspans" $ M.keys colps
-- The matched accounts with a starting balance. All of these should appear
-- in the report, even if they have no postings during the report period.
startbals = dbg' "startbals" $ startingBalances ropts reportq j reportspan
startbals = dbg' "startbals" $ startingBalances ropts j reportspan
subreports = map generateSubreport subreportspecs
where
@ -156,7 +149,7 @@ compoundBalanceReportWith ropts q j priceoracle subreportspecs = cbr
( cbcsubreporttitle
-- Postprocess the report, negating balances and taking percentages if needed
, prNormaliseSign cbcsubreportnormalsign $
generateMultiBalanceReport ropts' reportq j priceoracle colspans colps' startbals'
generateMultiBalanceReport ropts' j priceoracle colspans colps' startbals'
, cbcsubreportincreasestotal
)
where
@ -186,21 +179,19 @@ compoundBalanceReportWith ropts q j priceoracle subreportspecs = cbr
-- TODO: Do we want to check whether to bother calculating these? isHistorical
-- and startDate is not nothing, otherwise mempty? This currently gives a
-- failure with some totals which are supposed to be 0 being blank.
startingBalances :: ReportOpts -> Query -> Journal -> DateSpan -> HashMap AccountName Account
startingBalances ropts q j reportspan = acctchanges
startingBalances :: ReportOpts -> Journal -> DateSpan -> HashMap AccountName Account
startingBalances ropts j reportspan =
acctChangesFromPostings ropts' . map fst $ getPostings ropts' j
where
acctchanges = acctChangesFromPostings ropts' startbalq . map fst $
getPostings ropts' startbalq j
ropts' = case accountlistmode_ ropts of
ALTree -> ropts{query_=startbalq, period_=precedingperiod, no_elide_=True}
ALFlat -> ropts{query_=startbalq, period_=precedingperiod}
-- q projected back before the report start date.
-- When there's no report start date, in case there are future txns (the hledger-ui case above),
-- we use emptydatespan to make sure they aren't counted as starting balance.
startbalq = dbg'' "startbalq" $ And [datelessq, precedingspanq]
datelessq = dbg "datelessq" $ filterQuery (not . queryIsDateOrDate2) q
ropts' = case accountlistmode_ ropts of
ALTree -> ropts{no_elide_=True, period_=precedingperiod}
ALFlat -> ropts{period_=precedingperiod}
datelessq = dbg "datelessq" . filterQuery (not . queryIsDateOrDate2) $ query_ ropts
precedingperiod = dateSpanAsPeriod . spanIntersect precedingspan .
periodAsDateSpan $ period_ ropts
@ -210,11 +201,11 @@ startingBalances ropts q j reportspan = acctchanges
a -> a
-- | Calculate the span of the report to be generated.
calculateReportSpan :: ReportOpts -> Query -> Journal -> DateSpan
calculateReportSpan ropts q j = reportspan
calculateReportSpan :: ReportOpts -> Journal -> DateSpan
calculateReportSpan ropts j = reportspan
where
-- The date span specified by -b/-e/-p options and query args if any.
requestedspan = dbg "requestedspan" $ queryDateSpan (date2_ ropts) q
requestedspan = dbg "requestedspan" $ queryDateSpan (date2_ ropts) $ query_ ropts
-- If the requested span is open-ended, close it using the journal's end dates.
-- This can still be the null (open) span if the journal is empty.
requestedspan' = dbg "requestedspan'" $
@ -233,21 +224,22 @@ calculateReportSpan ropts q j = reportspan
-- The user's query expanded to the report span
-- if there is one (otherwise any date queries are left as-is, which
-- handles the hledger-ui+future txns case above).
makeReportQuery :: ReportOpts -> DateSpan -> Query -> Query
makeReportQuery ropts reportspan q
| reportspan == nulldatespan = q
| otherwise = And [dateless q, reportspandatesq]
makeReportQuery :: ReportOpts -> DateSpan -> ReportOpts
makeReportQuery ropts reportspan
| reportspan == nulldatespan = ropts
| otherwise = ropts{query_=query}
where
query = simplifyQuery $ And [dateless $ query_ ropts, reportspandatesq]
reportspandatesq = dbg "reportspandatesq" $ dateqcons reportspan
dateless = dbg "dateless" . filterQuery (not . queryIsDateOrDate2)
dateqcons = if date2_ ropts then Date2 else Date
dateless = dbg "dateless" . filterQuery (not . queryIsDateOrDate2)
dateqcons = if date2_ ropts then Date2 else Date
-- | Group postings, grouped by their column
getPostingsByColumn :: ReportOpts -> Query -> Journal -> DateSpan -> Map DateSpan [Posting]
getPostingsByColumn ropts q j reportspan = columns
getPostingsByColumn :: ReportOpts -> Journal -> DateSpan -> Map DateSpan [Posting]
getPostingsByColumn ropts j reportspan = columns
where
-- Postings matching the query within the report period.
ps :: [(Posting, Day)] = dbg'' "ps" $ getPostings ropts q j
ps :: [(Posting, Day)] = dbg'' "ps" $ getPostings ropts j
days = map snd ps
-- The date spans to be included as report columns.
@ -259,13 +251,14 @@ getPostingsByColumn ropts q j reportspan = columns
columns = foldr addPosting emptyMap ps
-- | Gather postings matching the query within the report period.
getPostings :: ReportOpts -> Query -> Journal -> [(Posting, Day)]
getPostings ropts q =
getPostings :: ReportOpts -> Journal -> [(Posting, Day)]
getPostings ropts =
map (\p -> (p, date p)) .
journalPostings .
filterJournalAmounts symq . -- remove amount parts excluded by cur:
filterJournalPostings reportq -- remove postings not matched by (adjusted) query
where
q = query_ ropts
symq = dbg "symq" . filterQuery queryIsSym $ dbg "requested q" q
-- The user's query with no depth limit, and expanded to the report span
-- if there is one (otherwise any date queries are left as-is, which
@ -290,18 +283,17 @@ calculateColSpans ropts reportspan days =
-- | Gather the account balance changes into a regular matrix
-- including the accounts from all columns.
calculateAccountChanges :: ReportOpts -> Query -> [DateSpan]
-> Map DateSpan [Posting]
calculateAccountChanges :: ReportOpts -> [DateSpan] -> Map DateSpan [Posting]
-> HashMap ClippedAccountName (Map DateSpan Account)
calculateAccountChanges ropts q colspans colps
| queryDepth q == Just 0 = acctchanges <> elided
| otherwise = acctchanges
calculateAccountChanges ropts colspans colps
| queryDepth (query_ ropts) == Just 0 = acctchanges <> elided
| otherwise = acctchanges
where
-- Transpose to get each account's balance changes across all columns.
acctchanges = transposeMap colacctchanges
colacctchanges :: Map DateSpan (HashMap ClippedAccountName Account) =
dbg'' "colacctchanges" $ fmap (acctChangesFromPostings ropts q) colps
dbg'' "colacctchanges" $ fmap (acctChangesFromPostings ropts) colps
elided = HM.singleton "..." $ M.fromList [(span, nullacct) | span <- colspans]
@ -309,15 +301,15 @@ calculateAccountChanges ropts q colspans colps
-- the accounts that have postings and calculate the change amount for
-- each. Accounts and amounts will be depth-clipped appropriately if
-- a depth limit is in effect.
acctChangesFromPostings :: ReportOpts -> Query -> [Posting] -> HashMap ClippedAccountName Account
acctChangesFromPostings ropts q ps = HM.fromList [(aname a, a) | a <- as]
acctChangesFromPostings :: ReportOpts -> [Posting] -> HashMap ClippedAccountName Account
acctChangesFromPostings ropts ps = HM.fromList [(aname a, a) | a <- as]
where
as = filterAccounts . drop 1 $ accountsFromPostings ps
filterAccounts = case accountlistmode_ ropts of
ALTree -> filter ((depthq `matchesAccount`) . aname) -- exclude deeper balances
ALFlat -> clipAccountsAndAggregate (queryDepth depthq) . -- aggregate deeper balances at the depth limit.
filter ((0<) . anumpostings)
depthq = dbg "depthq" $ filterQuery queryIsDepth q
depthq = dbg "depthq" . filterQuery queryIsDepth $ query_ ropts
-- | Accumulate and value amounts, as specified by the report options.
--
@ -370,21 +362,19 @@ accumValueAmounts ropts j priceoracle colspans startbals acctchanges = -- PARTI
-- | Lay out a set of postings grouped by date span into a regular matrix with rows
-- given by AccountName and columns by DateSpan, then generate a MultiBalanceReport
-- from the columns.
generateMultiBalanceReport :: ReportOpts -> Query -> Journal -> PriceOracle
-> [DateSpan]
-> Map DateSpan [Posting]
-> HashMap AccountName Account
generateMultiBalanceReport :: ReportOpts -> Journal -> PriceOracle -> [DateSpan]
-> Map DateSpan [Posting] -> HashMap AccountName Account
-> MultiBalanceReport
generateMultiBalanceReport ropts q j priceoracle colspans colps startbals = report
generateMultiBalanceReport ropts j priceoracle colspans colps startbals = report
where
-- Each account's balance changes across all columns.
acctchanges = dbg'' "acctchanges" $ calculateAccountChanges ropts q colspans colps
acctchanges = dbg'' "acctchanges" $ calculateAccountChanges ropts colspans colps
-- Process changes into normal, cumulative, or historical amounts, plus value them
accumvalued = accumValueAmounts ropts j priceoracle colspans startbals acctchanges
-- All account names that will be displayed, possibly depth-clipped.
displaynames = dbg'' "displaynames" $ displayedAccounts ropts q accumvalued
displaynames = dbg'' "displaynames" $ displayedAccounts ropts accumvalued
-- All the rows of the report.
rows = dbg'' "rows" $ buildReportRows ropts displaynames accumvalued
@ -423,10 +413,9 @@ buildReportRows ropts displaynames = toList . HM.mapMaybeWithKey mkRow
-- | Calculate accounts which are to be displayed in the report, as well as
-- their name and depth
displayedAccounts :: ReportOpts -> Query
-> HashMap AccountName (Map DateSpan Account)
displayedAccounts :: ReportOpts -> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName DisplayName
displayedAccounts ropts q valuedaccts
displayedAccounts ropts valuedaccts
| depth == 0 = HM.singleton "..." $ DisplayName "..." "..." 1
| otherwise = HM.mapWithKey (\a _ -> displayedName a) displayedAccts
where
@ -467,7 +456,7 @@ displayedAccounts ropts q valuedaccts
minSubs = if no_elide_ ropts then 1 else 2
isZeroRow balance = all (mixedAmountLooksZero . balance)
depth = fromMaybe maxBound $ queryDepth q
depth = fromMaybe maxBound . queryDepth $ query_ ropts
numSubs = subaccountTallies . HM.keys $ HM.filterWithKey isInteresting valuedaccts
-- | Sort the rows by amount or by account declaration order.
@ -612,8 +601,9 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
let
amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = Precision 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False}
(opts,journal) `gives` r = do
let (eitems, etotal) = r
(PeriodicReport _ aitems atotal) = multiBalanceReport nulldate opts journal
let opts' = opts{query_=And [queryFromFlags opts, query_ opts]}
(eitems, etotal) = r
(PeriodicReport _ aitems atotal) = multiBalanceReport opts' journal
showw (PeriodicReportRow a lAmt amt amt')
= (displayFull a, displayName a, displayDepth a, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt')
(map showw aitems) @?= (map showw eitems)

33
hledger-lib/Hledger/Reports/PostingsReport.hs
View File

@ -65,20 +65,20 @@ type SummaryPosting = (Posting, Day)
-- | 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 -> Query -> Journal -> PostingsReport
postingsReport ropts@ReportOpts{..} q j =
postingsReport :: ReportOpts -> Journal -> PostingsReport
postingsReport ropts@ReportOpts{..} j =
(totallabel, items)
where
reportspan = adjustReportDates ropts q j
reportspan = adjustReportDates ropts j
whichdate = whichDateFromOpts ropts
mdepth = queryDepth q
mdepth = queryDepth query_
styles = journalCommodityStyles j
priceoracle = journalPriceOracle infer_value_ j
multiperiod = interval_ /= NoInterval
today = fromMaybe (error' "postingsReport: could not pick a valuation date, ReportOpts today_ is unset") today_ -- PARTIAL:
-- postings to be included in the report, and similarly-matched postings before the report start date
(precedingps, reportps) = matchedPostingsBeforeAndDuring ropts q j reportspan
(precedingps, reportps) = matchedPostingsBeforeAndDuring ropts j reportspan
-- Postings, or summary postings with their subperiod's end date, to be displayed.
displayps :: [(Posting, Maybe Day)]
@ -140,11 +140,11 @@ totallabel = "Total"
-- 1. If the start date is unspecified, use the earliest date in the journal (if any)
-- 2. If the end date is unspecified, use the latest date in the journal (if any)
-- 3. If a report interval is specified, enlarge the dates to enclose whole intervals
adjustReportDates :: ReportOpts -> Query -> Journal -> DateSpan
adjustReportDates opts q j = reportspan
adjustReportDates :: ReportOpts -> Journal -> DateSpan
adjustReportDates opts j = reportspan
where
-- see also multiBalanceReport
requestedspan = dbg3 "requestedspan" $ queryDateSpan' q -- span specified by -b/-e/-p options and query args
requestedspan = dbg3 "requestedspan" $ queryDateSpan' $ query_ opts -- span specified by -b/-e/-p options and query args
journalspan = dbg3 "journalspan" $ dates `spanUnion` date2s -- earliest and latest dates (or date2s) in the journal
where
dates = journalDateSpan False j
@ -159,10 +159,11 @@ adjustReportDates opts q j = reportspan
-- and also any similarly-matched postings before that date span.
-- Date restrictions and depth restrictions in the query are ignored.
-- A helper for the postings report.
matchedPostingsBeforeAndDuring :: ReportOpts -> Query -> Journal -> DateSpan -> ([Posting],[Posting])
matchedPostingsBeforeAndDuring opts q j (DateSpan mstart mend) =
matchedPostingsBeforeAndDuring :: ReportOpts -> Journal -> DateSpan -> ([Posting],[Posting])
matchedPostingsBeforeAndDuring opts j (DateSpan mstart mend) =
dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps
where
q = query_ opts
beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing mstart
beforeandduringps =
dbg5 "ps5" $ sortOn sortdate $ -- sort postings by date or date2
@ -179,7 +180,7 @@ matchedPostingsBeforeAndDuring opts q j (DateSpan mstart mend) =
dateless = filterQuery (not . queryIsDateOrDate2)
beforeendq = dateqtype $ DateSpan Nothing mend
sortdate = if date2_ opts then postingDate2 else postingDate
symq = dbg4 "symq" $ filterQuery queryIsSym q
symq = dbg4 "symq" . filterQuery queryIsSym $ query_ opts
dateqtype
| queryIsDate2 dateq || (queryIsDate dateq && date2_ opts) = Date2
| otherwise = Date
@ -270,7 +271,7 @@ negatePostingAmount p = p { pamount = negate $ pamount p }
tests_PostingsReport = tests "PostingsReport" [
test "postingsReport" $ do
let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts query journal) @?= n
let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts{query_=query} journal) @?= n
-- with the query specified explicitly
(Any, nulljournal) `gives` 0
(Any, samplejournal) `gives` 13
@ -279,10 +280,10 @@ tests_PostingsReport = tests "PostingsReport" [
(And [Depth 1, StatusQ Cleared, Acct (toRegex' "expenses")], samplejournal) `gives` 2
(And [And [Depth 1, StatusQ Cleared], Acct (toRegex' "expenses")], samplejournal) `gives` 2
-- with query and/or command-line options
(length $ snd $ postingsReport defreportopts Any samplejournal) @?= 13
(length $ snd $ postingsReport defreportopts{interval_=Months 1} Any samplejournal) @?= 11
(length $ snd $ postingsReport defreportopts{interval_=Months 1, empty_=True} Any samplejournal) @?= 20
(length $ snd $ postingsReport defreportopts (Acct (toRegex' "assets:bank:checking")) samplejournal) @?= 5
(length $ snd $ postingsReport defreportopts samplejournal) @?= 13
(length $ snd $ postingsReport defreportopts{interval_=Months 1} samplejournal) @?= 11
(length $ snd $ postingsReport defreportopts{interval_=Months 1, empty_=True} samplejournal) @?= 20
(length $ snd $ postingsReport defreportopts{query_=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5
-- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0
-- [(Just (fromGregorian 2008 01 01,"income"),assets:bank:checking $1,$1)

147
hledger-lib/Hledger/Reports/ReportOptions.hs
View File

@ -23,9 +23,7 @@ module Hledger.Reports.ReportOptions (
journalSelectingAmountFromOpts,
intervalFromRawOpts,
forecastPeriodFromRawOpts,
queryFromOpts,
queryFromOptsOnly,
queryOptsFromOpts,
queryFromFlags,
transactionDateFn,
postingDateFn,
reportSpan,
@ -40,8 +38,6 @@ module Hledger.Reports.ReportOptions (
reportPeriodOrJournalLastDay,
valuationTypeIsCost,
valuationTypeIsDefaultValue,
tests_ReportOptions
)
where
@ -49,7 +45,7 @@ import Control.Applicative ((<|>))
import Data.List.Extra (nubSort)
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Text as T
import Data.Time.Calendar (Day, addDays, fromGregorian)
import Data.Time.Calendar (Day, addDays)
import Data.Default (Default(..))
import Safe (lastDef, lastMay)
@ -99,8 +95,8 @@ data ReportOpts = ReportOpts {
,no_elide_ :: Bool
,real_ :: Bool
,format_ :: StringFormat
,query_ :: String -- ^ All query arguments space sepeareted
-- and quoted if needed (see 'quoteIfNeeded')
,query_ :: Query
,queryopts_ :: [QueryOpt]
--
,average_ :: Bool
-- for posting reports (register)
@ -167,52 +163,62 @@ defreportopts = ReportOpts
def
def
def
def
rawOptsToReportOpts :: RawOpts -> IO ReportOpts
rawOptsToReportOpts rawopts = do
d <- getCurrentDay
no_color <- isJust <$> lookupEnv "NO_COLOR"
supports_color <- hSupportsANSIColor stdout
let colorflag = stringopt "color" rawopts
format <- case parseStringFormat <$> maybestringopt "format" rawopts of
Nothing -> return defaultBalanceLineFormat
Just (Right x) -> return x
Just (Left err) -> usageError $ "could not parse format option: " ++ err
let colorflag = stringopt "color" rawopts
formatstring = maybestringopt "format" rawopts
querystring = T.pack . unwords . map quoteIfNeeded $
listofstringopt "args" rawopts -- doesn't handle an arg like "" right
return defreportopts{
today_ = Just d
,period_ = periodFromRawOpts d rawopts
,interval_ = intervalFromRawOpts rawopts
,statuses_ = statusesFromRawOpts rawopts
,value_ = valuationTypeFromRawOpts rawopts
,infer_value_ = boolopt "infer-value" rawopts
,depth_ = maybeposintopt "depth" rawopts
,date2_ = boolopt "date2" rawopts
,empty_ = boolopt "empty" rawopts
,no_elide_ = boolopt "no-elide" rawopts
,real_ = boolopt "real" rawopts
,format_ = format
,query_ = unwords . map quoteIfNeeded $ listofstringopt "args" rawopts -- doesn't handle an arg like "" right
,average_ = boolopt "average" rawopts
,related_ = boolopt "related" rawopts
,txn_dates_ = boolopt "txn-dates" rawopts
,balancetype_ = balancetypeopt rawopts
,accountlistmode_ = accountlistmodeopt rawopts
,drop_ = posintopt "drop" rawopts
,row_total_ = boolopt "row-total" rawopts
,no_total_ = boolopt "no-total" rawopts
,sort_amount_ = boolopt "sort-amount" rawopts
,percent_ = boolopt "percent" rawopts
,invert_ = boolopt "invert" rawopts
,pretty_tables_ = boolopt "pretty-tables" rawopts
,color_ = and [not no_color
,not $ colorflag `elem` ["never","no"]
,colorflag `elem` ["always","yes"] || supports_color
]
,forecast_ = forecastPeriodFromRawOpts d rawopts
,transpose_ = boolopt "transpose" rawopts
}
format <- case parseStringFormat <$> formatstring of
Nothing -> return defaultBalanceLineFormat
Just (Right x) -> return x
Just (Left err) -> fail $ "could not parse format option: " ++ err
(argsquery, queryopts) <- either fail return $ parseQuery d querystring
let reportopts = defreportopts
{today_ = Just d
,period_ = periodFromRawOpts d rawopts
,interval_ = intervalFromRawOpts rawopts
,statuses_ = statusesFromRawOpts rawopts
,value_ = valuationTypeFromRawOpts rawopts
,infer_value_ = boolopt "infer-value" rawopts
,depth_ = maybeposintopt "depth" rawopts
,date2_ = boolopt "date2" rawopts
,empty_ = boolopt "empty" rawopts
,no_elide_ = boolopt "no-elide" rawopts
,real_ = boolopt "real" rawopts
,format_ = format
,query_ = simplifyQuery $ And [queryFromFlags reportopts, argsquery]
,queryopts_ = queryopts
,average_ = boolopt "average" rawopts
,related_ = boolopt "related" rawopts
,txn_dates_ = boolopt "txn-dates" rawopts
,balancetype_ = balancetypeopt rawopts
,accountlistmode_ = accountlistmodeopt rawopts
,drop_ = posintopt "drop" rawopts
,row_total_ = boolopt "row-total" rawopts
,no_total_ = boolopt "no-total" rawopts
,sort_amount_ = boolopt "sort-amount" rawopts
,percent_ = boolopt "percent" rawopts
,invert_ = boolopt "invert" rawopts
,pretty_tables_ = boolopt "pretty-tables" rawopts
,color_ = and [not no_color
,not $ colorflag `elem` ["never","no"]
,colorflag `elem` ["always","yes"] || supports_color
]
,forecast_ = forecastPeriodFromRawOpts d rawopts
,transpose_ = boolopt "transpose" rawopts
}
return reportopts
accountlistmodeopt :: RawOpts -> AccountListMode
accountlistmodeopt =
@ -423,17 +429,9 @@ journalSelectingAmountFromOpts opts =
Just (AtCost _) -> journalToCost
_ -> id
-- | Convert report options and arguments to a query.
-- If there is a parsing problem, this function calls error.
queryFromOpts :: Day -> ReportOpts -> Query
queryFromOpts d ropts = simplifyQuery . And $ [flagsq, argsq]
where
flagsq = queryFromOptsOnly d ropts
argsq = fst $ either error' id $ parseQuery d (T.pack $ query_ ropts) -- PARTIAL:
-- | Convert report options to a query, ignoring any non-flag command line arguments.
queryFromOptsOnly :: Day -> ReportOpts -> Query
queryFromOptsOnly _d ReportOpts{..} = simplifyQuery $ And flagsq
queryFromFlags :: ReportOpts -> Query
queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq
where
flagsq = consIf Real real_
. consIf Empty empty_
@ -444,11 +442,6 @@ queryFromOptsOnly _d ReportOpts{..} = simplifyQuery $ And flagsq
consIf f b = if b then (f True:) else id
consJust f = maybe id ((:) . f)
-- | Convert report options and arguments to query options.
-- If there is a parsing problem, this function calls error.
queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt]
queryOptsFromOpts d = snd . either error' id . parseQuery d . T.pack . query_ -- PARTIAL:
-- Report dates.
-- | The effective report span is the start and end dates specified by
@ -477,9 +470,8 @@ reportEndDate j ropts = spanEnd <$> reportSpan j ropts
-- Needs IO to parse smart dates in options/queries.
specifiedStartEndDates :: ReportOpts -> IO (Maybe Day, Maybe Day)
specifiedStartEndDates ropts = do
today <- getCurrentDay
let
q = queryFromOpts today ropts
q = query_ ropts
mspecifiedstartdate = queryStartDate False q
mspecifiedenddate = queryEndDate False q
return (mspecifiedstartdate, mspecifiedenddate)
@ -498,9 +490,7 @@ specifiedEndDate ropts = snd <$> specifiedStartEndDates ropts
-- since we need that to get the report period robustly
-- (unlike reportStartDate, which looks up the date with IO.)
reportPeriodStart :: ReportOpts -> Maybe Day
reportPeriodStart ropts@ReportOpts{..} = do
t <- today_
queryStartDate False $ queryFromOpts t ropts
reportPeriodStart = queryStartDate False . query_
-- Get the report's start date, or if no report period is specified,
-- the journal's start date (the earliest posting date). If there's no
@ -517,11 +507,7 @@ reportPeriodOrJournalStart ropts j =
-- since we need that to get the report period robustly
-- (unlike reportEndDate, which looks up the date with IO.)
reportPeriodLastDay :: ReportOpts -> Maybe Day
reportPeriodLastDay ropts@ReportOpts{..} = do
t <- today_
let q = queryFromOpts t ropts
qend <- queryEndDate False q
return $ addDays (-1) qend
reportPeriodLastDay = fmap (addDays (-1)) . queryEndDate False . query_
-- Get the last day of the overall report period, or if no report
-- period is specified, the last day of the journal (ie the latest
@ -530,22 +516,3 @@ reportPeriodLastDay ropts@ReportOpts{..} = do
reportPeriodOrJournalLastDay :: ReportOpts -> Journal -> Maybe Day
reportPeriodOrJournalLastDay ropts j =
reportPeriodLastDay ropts <|> journalEndDate False j
-- tests
tests_ReportOptions = tests "ReportOptions" [
test "queryFromOpts" $ do
queryFromOpts nulldate defreportopts @?= Any
queryFromOpts nulldate defreportopts{query_="a"} @?= Acct (toRegexCI' "a")
queryFromOpts nulldate defreportopts{query_="desc:'a a'"} @?= Desc (toRegexCI' "a a")
queryFromOpts nulldate defreportopts{period_=PeriodFrom (fromGregorian 2012 01 01),query_="date:'to 2013'" }
@?= (Date $ DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01))
queryFromOpts nulldate defreportopts{query_="date2:'in 2012'"} @?= (Date2 $ DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01))
queryFromOpts nulldate defreportopts{query_="'a a' 'b"} @?= Or [Acct $ toRegexCI' "a a", Acct $ toRegexCI' "'b"]
,test "queryOptsFromOpts" $ do
queryOptsFromOpts nulldate defreportopts @?= []
queryOptsFromOpts nulldate defreportopts{query_="a"} @?= []
queryOptsFromOpts nulldate defreportopts{period_=PeriodFrom (fromGregorian 2012 01 01)
,query_="date:'to 2013'"} @?= []
]

3
hledger/Hledger/Cli/CliOptions.hs
View File

@ -518,8 +518,7 @@ getHledgerCliOpts' mode' args' = do
putStrLn $ "running: " ++ progname'
putStrLn $ "raw args: " ++ show args'
putStrLn $ "processed opts:\n" ++ show opts
d <- getCurrentDay
putStrLn $ "search query: " ++ show (queryFromOpts d $ reportopts_ opts)
putStrLn $ "search query: " ++ show (query_ $ reportopts_ opts)
getHledgerCliOpts :: Mode RawOpts -> IO CliOpts
getHledgerCliOpts mode' = do

2
hledger/Hledger/Cli/Commands.hs
View File

@ -277,7 +277,7 @@ testmode = hledgerCommandMode
--
testcmd :: CliOpts -> Journal -> IO ()
testcmd opts _undefined = do
withArgs (words' $ query_ $ reportopts_ opts) $
withArgs (listofstringopt "args" $ rawopts_ opts) $
Test.Tasty.defaultMain $ tests "hledger" [
tests_Hledger
,tests_Hledger_Cli

3
hledger/Hledger/Cli/Commands/Accounts.hs
View File

@ -51,11 +51,10 @@ accounts :: CliOpts -> Journal -> IO ()
accounts CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
-- 1. identify the accounts we'll show
d <- getCurrentDay
let tree = tree_ ropts
declared = boolopt "declared" rawopts
used = boolopt "used" rawopts
q = queryFromOpts d ropts
q = query_ ropts
-- a depth limit will clip and exclude account names later, but we don't want to exclude accounts at this stage
nodepthq = dbg1 "nodepthq" $ filterQuery (not . queryIsDepth) q
-- just the acct: part of the query will be reapplied later, after clipping

30
hledger/Hledger/Cli/Commands/Activity.hs
View File

@ -30,23 +30,21 @@ barchar = '*'
-- | Print a bar chart of number of postings per report interval.
activity :: CliOpts -> Journal -> IO ()
activity CliOpts{reportopts_=ropts} j = do
d <- getCurrentDay
putStr $ showHistogram ropts (queryFromOpts d ropts) j
activity CliOpts{reportopts_=ropts} j = putStr $ showHistogram ropts j
showHistogram :: ReportOpts -> Query -> Journal -> String
showHistogram opts q j = concatMap (printDayWith countBar) spanps
where
i = interval_ opts
interval | i == NoInterval = Days 1
| otherwise = i
span' = queryDateSpan (date2_ opts) q `spanDefaultsFrom` journalDateSpan (date2_ opts) 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 = sortOn postingDate $ filter (q `matchesPosting`) $ journalPostings j
showHistogram :: ReportOpts -> Journal -> String
showHistogram ReportOpts{query_=q,interval_=i,date2_=date2} j =
concatMap (printDayWith countBar) spanps
where
interval | i == NoInterval = Days 1
| otherwise = i
span' = queryDateSpan date2 q `spanDefaultsFrom` journalDateSpan date2 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 = sortOn postingDate $ filter (q `matchesPosting`) $ journalPostings j
printDayWith f (DateSpan b _, ps) = printf "%s %s\n" (show $ fromJust b) (f ps)

5
hledger/Hledger/Cli/Commands/Add.hs
View File

@ -255,7 +255,7 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
-- Identify the closest recent match for this description in past transactions.
similarTransaction :: EntryState -> Text -> Maybe Transaction
similarTransaction EntryState{..} desc =
let q = queryFromOptsOnly esToday $ reportopts_ esOpts
let q = queryFromFlags $ reportopts_ esOpts
historymatches = transactionsSimilarTo esJournal q desc
bestmatch | null historymatches = Nothing
| otherwise = Just $ snd $ head historymatches
@ -461,9 +461,8 @@ ensureOneNewlineTerminated = (++"\n") . reverse . dropWhile (=='\n') . reverse
-- | Convert a string of journal data into a register report.
registerFromString :: String -> IO String
registerFromString s = do
d <- getCurrentDay
j <- readJournal' $ T.pack s
return $ postingsReportAsText opts $ postingsReport ropts (queryFromOpts d ropts) j
return . postingsReportAsText opts $ postingsReport ropts j
where
ropts = defreportopts{empty_=True}
opts = defcliopts{reportopts_=ropts}

12
hledger/Hledger/Cli/Commands/Aregister.hs
View File

@ -19,7 +19,6 @@ module Hledger.Cli.Commands.Aregister (
,tests_Aregister
) where
import Control.Monad (when)
import Data.Aeson (toJSON)
import Data.Aeson.Text (encodeToLazyText)
import Data.List
@ -75,10 +74,11 @@ aregister :: CliOpts -> Journal -> IO ()
aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
d <- getCurrentDay
-- the first argument specifies the account, any remaining arguments are a filter query
let args' = listofstringopt "args" rawopts
when (null args') $ error' "aregister needs an account, please provide an account name or pattern" -- PARTIAL:
(apat,querystring) <- case listofstringopt "args" rawopts of
[] -> fail "aregister needs an account, please provide an account name or pattern"
(a:as) -> return (a, T.pack . unwords $ map quoteIfNeeded as)
argsquery <- either fail (return . fst) $ parseQuery d querystring
let
(apat:queryargs) = args'
acct = headDef (error' $ show apat++" did not match any account") -- PARTIAL:
. filterAccts $ journalAccountNames j
filterAccts = case toRegexCI apat of
@ -88,13 +88,13 @@ aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
inclusive = True -- tree_ ropts
thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) acct
ropts' = ropts{
query_=unwords $ map quoteIfNeeded $ queryargs
query_=simplifyQuery $ And [queryFromFlags ropts, argsquery]
-- remove a depth limit for reportq, as in RegisterScreen, I forget why XXX
,depth_=Nothing
-- always show historical balance
,balancetype_= HistoricalBalance
}
reportq = And [queryFromOpts d ropts', excludeforecastq (isJust $ forecast_ ropts)]
reportq = And [query_ ropts', excludeforecastq (isJust $ forecast_ ropts)]
where
-- As in RegisterScreen, why ? XXX
-- Except in forecast mode, exclude future/forecast transactions.

9
hledger/Hledger/Cli/Commands/Balance.hs
View File

@ -305,14 +305,13 @@ balancemode = hledgerCommandMode
-- | The balance command, prints a balance report.
balance :: CliOpts -> Journal -> IO ()
balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
d <- getCurrentDay
let budget = boolopt "budget" rawopts
multiperiod = interval_ /= NoInterval
fmt = outputFormatFromOpts opts
if budget then do -- single or multi period budget report
reportspan <- reportSpan j ropts
let budgetreport = dbg4 "budgetreport" $ budgetReport ropts assrt reportspan d j
let budgetreport = dbg4 "budgetreport" $ budgetReport ropts assrt reportspan j
where
assrt = not $ ignore_assertions_ $ inputopts_ opts
render = case fmt of
@ -323,7 +322,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
else
if multiperiod then do -- multi period balance report
let report = multiBalanceReport d ropts j
let report = multiBalanceReport ropts j
render = case fmt of
"txt" -> multiBalanceReportAsText ropts
"csv" -> (++"\n") . printCSV . multiBalanceReportAsCsv ropts
@ -333,7 +332,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
writeOutput opts $ render report
else do -- single period simple balance report
let report = balanceReport ropts (queryFromOpts d ropts) j -- simple Ledger-style balance report
let report = balanceReport ropts j -- simple Ledger-style balance report
render = case fmt of
"txt" -> balanceReportAsText
"csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r
@ -622,7 +621,7 @@ tests_Balance = tests "Balance" [
test "unicode in balance layout" $ do
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts = defreportopts
balanceReportAsText opts (balanceReport opts (queryFromOpts (fromGregorian 2008 11 26) opts) j)
balanceReportAsText opts (balanceReport opts{today_=Just $ fromGregorian 2008 11 26} j)
@?=
unlines
[" -100 актив:наличные"

4
hledger/Hledger/Cli/Commands/Checkdates.hs
View File

@ -22,10 +22,8 @@ checkdatesmode = hledgerCommandMode
checkdates :: CliOpts -> Journal -> IO ()
checkdates CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
d <- getCurrentDay
let ropts_ = ropts{accountlistmode_=ALFlat}
let q = queryFromOpts d ropts_
let ts = filter (q `matchesTransaction`) $
let ts = filter (query_ ropts_ `matchesTransaction`) $
jtxns $ journalSelectingAmountFromOpts ropts j
let strict = boolopt "strict" rawopts
let date = transactionDateFn ropts

4
hledger/Hledger/Cli/Commands/Close.hs
View File

@ -73,7 +73,7 @@ close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
-- dates of the closing and opening transactions
ropts_ = ropts{balancetype_=HistoricalBalance, accountlistmode_=ALFlat}
q = queryFromOpts today ropts_
q = query_ ropts_
openingdate = fromMaybe today $ queryEndDate False q
closingdate = addDays (-1) openingdate
@ -86,7 +86,7 @@ close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
False -> normaliseMixedAmount . mixedAmountStripPrices
-- the balances to close
(acctbals,_) = balanceReport ropts_ q j
(acctbals,_) = balanceReport ropts_ j
totalamt = sum $ map (\(_,_,_,b) -> normalise b) acctbals
-- since balance assertion amounts are required to be exact, the

5
hledger/Hledger/Cli/Commands/Codes.hs
View File

@ -33,10 +33,7 @@ codesmode = hledgerCommandMode
-- | The codes command.
codes :: CliOpts -> Journal -> IO ()
codes CliOpts{reportopts_=ropts@ReportOpts{empty_}} j = do
d <- getCurrentDay
let q = queryFromOpts d ropts
ts = entriesReport ropts q j
let ts = entriesReport ropts j
codes = (if empty_ then id else filter (not . T.null)) $
map tcode ts
mapM_ T.putStrLn codes

4
hledger/Hledger/Cli/Commands/Descriptions.hs
View File

@ -32,9 +32,7 @@ descriptionsmode = hledgerCommandMode
-- | The descriptions command.
descriptions :: CliOpts -> Journal -> IO ()
descriptions CliOpts{reportopts_=ropts} j = do
d <- getCurrentDay
let q = queryFromOpts d ropts
ts = entriesReport ropts q j
let ts = entriesReport ropts j
descriptions = nubSort $ map tdescription ts
mapM_ T.putStrLn descriptions

4
hledger/Hledger/Cli/Commands/Diff.hs
View File

@ -102,11 +102,11 @@ unmatchedtxns s pp m =
-- | The diff command.
diff :: CliOpts -> Journal -> IO ()
diff CliOpts{file_=[f1, f2], reportopts_=ReportOpts{query_=acctName}} _ = do
diff CliOpts{file_=[f1, f2], reportopts_=ReportOpts{query_=Acct acctRe}} _ = do
j1 <- readJournalFile' f1
j2 <- readJournalFile' f2
let acct = T.pack acctName
let acct = T.pack $ reString acctRe
let pp1 = matchingPostings acct j1
let pp2 = matchingPostings acct j2

5
hledger/Hledger/Cli/Commands/Notes.hs
View File

@ -33,9 +33,6 @@ notesmode = hledgerCommandMode
-- | The notes command.
notes :: CliOpts -> Journal -> IO ()
notes CliOpts{reportopts_=ropts} j = do
d <- getCurrentDay
let q = queryFromOpts d ropts
ts = entriesReport ropts q j
let ts = entriesReport ropts j
notes = nubSort $ map transactionNote ts
mapM_ T.putStrLn notes

5
hledger/Hledger/Cli/Commands/Payees.hs
View File

@ -33,9 +33,6 @@ payeesmode = hledgerCommandMode
-- | The payees command.
payees :: CliOpts -> Journal -> IO ()
payees CliOpts{reportopts_=ropts} j = do
d <- getCurrentDay
let q = queryFromOpts d ropts
ts = entriesReport ropts q j
let ts = entriesReport ropts j
payees = nubSort $ map transactionPayee ts
mapM_ T.putStrLn payees

3
hledger/Hledger/Cli/Commands/Prices.hs
View File

@ -25,10 +25,9 @@ pricesmode = hledgerCommandMode
-- XXX the original hledger-prices script always ignored assertions
prices opts j = do
d <- getCurrentDay
let
styles = journalCommodityStyles j
q = queryFromOpts d (reportopts_ opts)
q = query_ $ reportopts_ opts
ps = filter (matchesPosting q) $ allPostings j
mprices = jpricedirectives j
cprices = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts ps

14
hledger/Hledger/Cli/Commands/Print.hs
View File

@ -54,16 +54,14 @@ print' opts j = do
printEntries :: CliOpts -> Journal -> IO ()
printEntries opts@CliOpts{reportopts_=ropts} j = do
d <- getCurrentDay
let q = queryFromOpts d ropts
fmt = outputFormatFromOpts opts
let fmt = outputFormatFromOpts opts
render = case fmt of
"txt" -> entriesReportAsText opts
"csv" -> (++"\n") . printCSV . entriesReportAsCsv
"json" -> (++"\n") . TL.unpack . toJsonText
"sql" -> entriesReportAsSql
_ -> const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL:
writeOutput opts $ render $ entriesReport ropts q j
writeOutput opts $ render $ entriesReport ropts j
entriesReportAsText :: CliOpts -> EntriesReport -> String
entriesReportAsText opts = concatMap (showTransaction . whichtxn)
@ -185,11 +183,9 @@ postingToCSV p =
-- (and the query, if any).
printMatch :: CliOpts -> Journal -> Text -> IO ()
printMatch CliOpts{reportopts_=ropts} j desc = do
d <- getCurrentDay
let q = queryFromOpts d ropts
case similarTransaction' j q desc of
Nothing -> putStrLn "no matches found."
Just t -> putStr $ showTransaction t
case similarTransaction' j (query_ ropts) desc of
Nothing -> putStrLn "no matches found."
Just t -> putStr $ showTransaction t
where
-- Identify the closest recent match for this description in past transactions.

6
hledger/Hledger/Cli/Commands/Register.hs
View File

@ -23,7 +23,6 @@ import Data.Maybe
-- import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Time (fromGregorian)
import System.Console.CmdArgs.Explicit
import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)
@ -60,13 +59,12 @@ registermode = hledgerCommandMode
-- | Print a (posting) register report.
register :: CliOpts -> Journal -> IO ()
register opts@CliOpts{reportopts_=ropts} j = do
d <- getCurrentDay
let fmt = outputFormatFromOpts opts
render | fmt=="txt" = postingsReportAsText
| fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv)
| fmt=="json" = const ((++"\n") . TL.unpack . toJsonText)
| otherwise = const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL:
writeOutput opts $ render opts $ postingsReport ropts (queryFromOpts d ropts) j
writeOutput opts . render opts $ postingsReport ropts j
postingsReportAsCsv :: PostingsReport -> CSV
postingsReportAsCsv (_,is) =
@ -201,7 +199,7 @@ tests_Register = tests "Register" [
test "unicode in register layout" $ do
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts = defreportopts
(postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (fromGregorian 2008 11 26) opts) j)
(postingsReportAsText defcliopts $ postingsReport opts j)
@?=
unlines
["2009-01-01 медвежья шкура расходы:покупки 100 100"

9
hledger/Hledger/Cli/Commands/Registermatch.hs
View File

@ -22,13 +22,10 @@ registermatchmode = hledgerCommandMode
([], Just $ argsFlag "DESC")
registermatch :: CliOpts -> Journal -> IO ()
registermatch opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
let args' = listofstringopt "args" rawopts
case args' of
registermatch opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j =
case listofstringopt "args" rawopts of
[desc] -> do
d <- getCurrentDay
let q = queryFromOptsOnly d ropts
(_,pris) = postingsReport ropts q j
let (_,pris) = postingsReport ropts j
ps = [p | (_,_,_,p,_) <- pris]
case similarPosting ps desc of
Nothing -> putStrLn "no matches found."

10
hledger/Hledger/Cli/Commands/Rewrite.hs
View File

@ -9,7 +9,7 @@ module Hledger.Cli.Commands.Rewrite (
where
#if !(MIN_VERSION_base(4,11,0))
import Control.Monad.Writer
import Control.Monad.Writer hiding (Any)
#endif
import Data.Functor.Identity
import Data.List (sortOn, foldl')
@ -42,15 +42,15 @@ rewrite opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j@Journal{jtxns=ts} = d
let modifiers = transactionModifierFromOpts opts : jtxnmodifiers j
let j' = j{jtxns=either error' id $ modifyTransactions d modifiers ts} -- PARTIAL:
-- run the print command, showing all transactions, or show diffs
printOrDiff rawopts opts{reportopts_=ropts{query_=""}} j j'
printOrDiff rawopts opts{reportopts_=ropts{query_=Any}} j j'
-- | Build a 'TransactionModifier' from any query arguments and --add-posting flags
-- provided on the command line, or throw a parse error.
transactionModifierFromOpts :: CliOpts -> TransactionModifier
transactionModifierFromOpts CliOpts{rawopts_=rawopts,reportopts_=ropts} =
TransactionModifier{tmquerytxt=q, tmpostingrules=ps}
transactionModifierFromOpts CliOpts{rawopts_=rawopts} =
TransactionModifier{tmquerytxt=q, tmpostingrules=ps}
where
q = T.pack $ query_ ropts
q = T.pack . unwords . map quoteIfNeeded $ listofstringopt "args" rawopts
ps = map (parseposting . T.pack) $ listofstringopt "add-posting" rawopts
parseposting t = either (error' . errorBundlePretty) id ep -- PARTIAL:
where

14
hledger/Hledger/Cli/Commands/Roi.hs
View File

@ -19,6 +19,7 @@ import Data.Function (on)
import Data.List
import Numeric.RootFinding
import Data.Decimal
import qualified Data.Text as T
import System.Console.CmdArgs.Explicit as CmdArgs
import Text.Tabular as Tbl
@ -54,11 +55,16 @@ roi :: CliOpts -> Journal -> IO ()
roi CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
d <- getCurrentDay
let
investmentsQuery = queryFromOpts d $ ropts{query_ = stringopt "investment" rawopts,period_=PeriodAll}
pnlQuery = queryFromOpts d $ ropts{query_ = stringopt "pnl" rawopts,period_=PeriodAll}
showCashFlow = boolopt "cashflow" rawopts
prettyTables = pretty_tables_ ropts
showCashFlow = boolopt "cashflow" rawopts
prettyTables = pretty_tables_ ropts
makeQuery flag = do
q <- either usageError (return . fst) . parseQuery d . T.pack $ stringopt flag rawopts
return . simplifyQuery $ And [queryFromFlags ropts{period_=PeriodAll}, q]
investmentsQuery <- makeQuery "investment"
pnlQuery <- makeQuery "pnl"
let
trans = dbg3 "investments" $ jtxns $ filterJournalTransactions investmentsQuery j
journalSpan =

7
hledger/Hledger/Cli/Commands/Stats.hs
View File

@ -42,12 +42,11 @@ statsmode = hledgerCommandMode
-- like Register.summarisePostings
-- | Print various statistics for the journal.
stats :: CliOpts -> Journal -> IO ()
stats opts@CliOpts{reportopts_=reportopts_} j = do
stats opts@CliOpts{reportopts_=ReportOpts{query_=q, interval_=interval}} j = do
d <- getCurrentDay
let q = queryFromOpts d reportopts_
l = ledgerFromJournal q j
let l = ledgerFromJournal q j
reportspan = (ledgerDateSpan l) `spanDefaultsFrom` (queryDateSpan False q)
intervalspans = splitSpan (interval_ reportopts_) reportspan
intervalspans = splitSpan interval reportspan
showstats = showLedgerStats l d
s = intercalate "\n" $ map showstats intervalspans
writeOutput opts s

16
hledger/Hledger/Cli/Commands/Tags.hs
View File

@ -28,15 +28,17 @@ tagsmode = hledgerCommandMode
tags :: CliOpts -> Journal -> IO ()
tags CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
d <- getCurrentDay
let
args = listofstringopt "args" rawopts
let args = listofstringopt "args" rawopts
mtagpat <- mapM (either Fail.fail pure . toRegexCI) $ headMay args
let
queryargs = drop 1 args
values = boolopt "values" rawopts
parsed = boolopt "parsed" rawopts
empty = empty_ ropts
q = queryFromOpts d $ ropts{query_ = unwords $ map quoteIfNeeded queryargs}
querystring = T.pack . unwords . map quoteIfNeeded $ drop 1 args
values = boolopt "values" rawopts
parsed = boolopt "parsed" rawopts
empty = empty_ ropts
argsquery <- either usageError (return . fst) $ parseQuery d querystring
let
q = simplifyQuery $ And [queryFromFlags ropts, argsquery]
txns = filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts ropts j
tagsorvalues =
(if parsed then id else nubSort)

5
hledger/Hledger/Cli/CompoundBalanceCommand.hs
View File

@ -89,7 +89,6 @@ compoundBalanceCommandMode CompoundBalanceCommandSpec{..} =
-- | Generate a runnable command from a compound balance command specification.
compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ())
compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=ropts@ReportOpts{..}, rawopts_=rawopts} j = do
today <- getCurrentDay
let
-- use the default balance type for this report, unless the user overrides
mBalanceTypeOverride =
@ -121,7 +120,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
_ -> showDateSpan requestedspan
where
enddates = map (addDays (-1)) . mapMaybe spanEnd $ cbrDates cbr -- these spans will always have a definite end date
requestedspan = queryDateSpan date2_ (queryFromOpts today ropts')
requestedspan = queryDateSpan date2_ query_
`spanDefaultsFrom` journalDateSpan date2_ j
-- when user overrides, add an indication to the report title
@ -143,7 +142,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
where multiperiod = interval_ /= NoInterval
-- make a CompoundBalanceReport.
cbr' = compoundBalanceReport today ropts' j cbcqueries
cbr' = compoundBalanceReport ropts' j cbcqueries
cbr = cbr'{cbrTitle=title}
-- render appropriately

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

@ -151,10 +151,9 @@ main = do
dbgIO "isInternalCommand" isInternalCommand
dbgIO "isExternalCommand" isExternalCommand
dbgIO "isBadCommand" isBadCommand
d <- getCurrentDay
dbgIO "period from opts" (period_ $ reportopts_ opts)
dbgIO "interval from opts" (interval_ $ reportopts_ opts)
dbgIO "query from opts & args" (queryFromOpts d $ reportopts_ opts)
dbgIO "query from opts & args" (query_ $ reportopts_ opts)
let
journallesserror = error "journal-less command tried to use the journal"
runHledgerCommand