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 where
import Control.Applicative ((<|>), many, optional) import Control.Applicative ((<|>), many, optional)
import Data.Default (Default(..))
import Data.Either (partitionEithers) import Data.Either (partitionEithers)
import Data.List (partition) import Data.List (partition)
import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Maybe (fromMaybe, isJust, mapMaybe)
@ -105,6 +106,8 @@ data Query = Any -- ^ always match
-- matching the regexp if provided, exists -- matching the regexp if provided, exists
deriving (Eq,Show) deriving (Eq,Show)
instance Default Query where def = Any
-- | Construct a payee tag -- | Construct a payee tag
payeeTag :: Maybe String -> Either RegexError Query payeeTag :: Maybe String -> Either RegexError Query
payeeTag = fmap (Tag (toRegexCI' "payee")) . maybe (pure Nothing) (fmap Just . toRegexCI) 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_EntriesReport
,tests_MultiBalanceReport ,tests_MultiBalanceReport
,tests_PostingsReport ,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. -- their balances (change of balance) during the specified period.
-- If the normalbalance_ option is set, it adjusts the sorting and sign of -- If the normalbalance_ option is set, it adjusts the sorting and sign of
-- amounts (see ReportOpts and CompoundBalanceCommand). -- amounts (see ReportOpts and CompoundBalanceCommand).
balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport balanceReport :: ReportOpts -> Journal -> BalanceReport
balanceReport ropts q j = (rows, total) balanceReport ropts j = (rows, total)
where where
report = multiBalanceReportWith ropts q j (journalPriceOracle (infer_value_ ropts) j) report = multiBalanceReportWith ropts j (journalPriceOracle (infer_value_ ropts) j)
rows = [( prrFullName row rows = [( prrFullName row
, prrDisplayName row , prrDisplayName row
, prrDepth row - 1 -- BalanceReport uses 0-based account depths , prrDepth row - 1 -- BalanceReport uses 0-based account depths
@ -102,8 +102,9 @@ tests_BalanceReport = tests "BalanceReport" [
let let
(opts,journal) `gives` r = do (opts,journal) `gives` r = do
let (eitems, etotal) = r let opts' = opts{query_=And [queryFromFlags opts, query_ opts]}
(aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal (eitems, etotal) = r
(aitems, atotal) = balanceReport opts' journal
showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt) showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt)
(map showw aitems) @?= (map showw eitems) (map showw aitems) @?= (map showw eitems)
(showMixedAmountDebug atotal) @?= (showMixedAmountDebug etotal) (showMixedAmountDebug atotal) @?= (showMixedAmountDebug etotal)
@ -152,7 +153,7 @@ tests_BalanceReport = tests "BalanceReport" [
Mixed [usd 0]) Mixed [usd 0])
,test "with depth:N" $ ,test "with depth:N" $
(defreportopts{query_="depth:1"}, samplejournal) `gives` (defreportopts{query_=Depth 1}, samplejournal) `gives`
([ ([
("expenses", "expenses", 0, mamountp' "$2.00") ("expenses", "expenses", 0, mamountp' "$2.00")
,("income", "income", 0, mamountp' "$-2.00") ,("income", "income", 0, mamountp' "$-2.00")
@ -160,11 +161,11 @@ tests_BalanceReport = tests "BalanceReport" [
Mixed [usd 0]) Mixed [usd 0])
,test "with date:" $ ,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) ([], 0)
,test "with date2:" $ ,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") ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
,("income:salary","income:salary",0,mamountp' "$-1.00") ,("income:salary","income:salary",0,mamountp' "$-1.00")
@ -172,7 +173,7 @@ tests_BalanceReport = tests "BalanceReport" [
Mixed [usd 0]) Mixed [usd 0])
,test "with desc:" $ ,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") ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
,("income:salary","income:salary",0, mamountp' "$-1.00") ,("income:salary","income:salary",0, mamountp' "$-1.00")
@ -180,7 +181,7 @@ tests_BalanceReport = tests "BalanceReport" [
Mixed [usd 0]) Mixed [usd 0])
,test "with not:desc:" $ ,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:bank:saving","assets:bank:saving",0, mamountp' "$1.00")
,("assets:cash","assets:cash",0, mamountp' "$-2.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)) #if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>)) import Data.Monoid ((<>))
#endif #endif
import Data.Time.Calendar
import Safe import Safe
--import Data.List --import Data.List
--import Data.Maybe --import Data.Maybe
@ -66,8 +65,8 @@ type BudgetReport = PeriodicReport DisplayName BudgetCell
-- actual balance changes from the regular transactions, -- actual balance changes from the regular transactions,
-- and compare these to get a 'BudgetReport'. -- and compare these to get a 'BudgetReport'.
-- Unbudgeted accounts may be hidden or renamed (see budgetRollup). -- Unbudgeted accounts may be hidden or renamed (see budgetRollup).
budgetReport :: ReportOpts -> Bool -> DateSpan -> Day -> Journal -> BudgetReport budgetReport :: ReportOpts -> Bool -> DateSpan -> Journal -> BudgetReport
budgetReport ropts' assrt reportspan d j = dbg1 "sortedbudgetreport" budgetreport budgetReport ropts' assrt reportspan j = dbg1 "sortedbudgetreport" budgetreport
where where
-- Budget report demands ALTree mode to ensure subaccounts and subaccount budgets are properly handled -- 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 -- 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 actualj = dbg1With (("actualj"++).show.jtxns) $ budgetRollUp budgetedaccts showunbudgeted j
budgetj = dbg1With (("budgetj"++).show.jtxns) $ budgetJournal assrt ropts reportspan j budgetj = dbg1With (("budgetj"++).show.jtxns) $ budgetJournal assrt ropts reportspan j
actualreport@(PeriodicReport actualspans _ _) = actualreport@(PeriodicReport actualspans _ _) =
dbg1 "actualreport" $ multiBalanceReport d ropts{empty_=True} actualj dbg1 "actualreport" $ multiBalanceReport ropts{empty_=True} actualj
budgetgoalreport@(PeriodicReport _ budgetgoalitems budgetgoaltotals) = budgetgoalreport@(PeriodicReport _ budgetgoalitems budgetgoaltotals) =
dbg1 "budgetgoalreport" $ multiBalanceReport d ropts{empty_=True} budgetj dbg1 "budgetgoalreport" $ multiBalanceReport ropts{empty_=True} budgetj
budgetgoalreport' budgetgoalreport'
-- If no interval is specified: -- If no interval is specified:
-- budgetgoalreport's span might be shorter actualreport's due to periodic txns; -- 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 type EntriesReportItem = Transaction
-- | Select transactions for an entries report. -- | Select transactions for an entries report.
entriesReport :: ReportOpts -> Query -> Journal -> EntriesReport entriesReport :: ReportOpts -> Journal -> EntriesReport
entriesReport ropts@ReportOpts{..} q j@Journal{..} = entriesReport ropts@ReportOpts{..} j@Journal{..} =
sortBy (comparing getdate) $ filter (q `matchesTransaction`) $ map tvalue jtxns sortBy (comparing getdate) $ filter (query_ `matchesTransaction`) $ map tvalue jtxns
where where
getdate = transactionDateFn ropts getdate = transactionDateFn ropts
-- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports". -- 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 = tests "EntriesReport" [
tests "entriesReport" [ tests "entriesReport" [
test "not acct" $ (length $ entriesReport defreportopts (Not . Acct $ toRegex' "bank") samplejournal) @?= 1 test "not acct" $ (length $ entriesReport defreportopts{query_=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 "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 -- CompoundBalanceCommand). hledger's most powerful and useful report, used
-- by the balance command (in multiperiod mode) and (via compoundBalanceReport) -- by the balance command (in multiperiod mode) and (via compoundBalanceReport)
-- by the bs/cf/is commands. -- by the bs/cf/is commands.
multiBalanceReport :: Day -> ReportOpts -> Journal -> MultiBalanceReport multiBalanceReport :: ReportOpts -> Journal -> MultiBalanceReport
multiBalanceReport today ropts j = multiBalanceReport ropts j = multiBalanceReportWith ropts j (journalPriceOracle infer j)
multiBalanceReportWith ropts q j (journalPriceOracle infer j) where infer = infer_value_ ropts
where
q = queryFromOpts today ropts
infer = infer_value_ ropts
-- | A helper for multiBalanceReport. This one takes an explicit Query -- | A helper for multiBalanceReport. This one takes an extra argument,
-- instead of deriving one from ReportOpts, and an extra argument, a -- a PriceOracle to be used for looking up market prices. Commands which
-- PriceOracle to be used for looking up market prices. Commands which
-- run multiple reports (bs etc.) can generate the price oracle just -- run multiple reports (bs etc.) can generate the price oracle just
-- once for efficiency, passing it to each report by calling this -- once for efficiency, passing it to each report by calling this
-- function directly. -- function directly.
multiBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle -> MultiBalanceReport multiBalanceReportWith :: ReportOpts -> Journal -> PriceOracle -> MultiBalanceReport
multiBalanceReportWith ropts q j priceoracle = report multiBalanceReportWith ropts' j priceoracle = report
where where
-- Queries, report/column dates. -- Queries, report/column dates.
reportspan = dbg "reportspan" $ calculateReportSpan ropts q j reportspan = dbg "reportspan" $ calculateReportSpan ropts' j
reportq = dbg "reportq" $ makeReportQuery ropts reportspan q ropts = dbg "reportopts" $ makeReportQuery ropts' reportspan
-- Group postings into their columns. -- 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 colspans = dbg "colspans" $ M.keys colps
-- The matched accounts with a starting balance. All of these should appear -- 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. -- 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 -- Generate and postprocess the report, negating balances and taking percentages if needed
report = dbg' "report" $ 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 -- | Generate a compound balance report from a list of CBCSubreportSpec. This
-- shares postings between the subreports. -- shares postings between the subreports.
compoundBalanceReport :: Day -> ReportOpts -> Journal -> [CBCSubreportSpec] compoundBalanceReport :: ReportOpts -> Journal -> [CBCSubreportSpec]
-> CompoundBalanceReport -> CompoundBalanceReport
compoundBalanceReport today ropts j = compoundBalanceReport ropts j = compoundBalanceReportWith ropts j (journalPriceOracle infer j)
compoundBalanceReportWith ropts q j (journalPriceOracle infer j) where infer = infer_value_ ropts
where
q = queryFromOpts today ropts
infer = infer_value_ ropts
-- | A helper for compoundBalanceReport, similar to multiBalanceReportWith. -- | A helper for compoundBalanceReport, similar to multiBalanceReportWith.
compoundBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle compoundBalanceReportWith :: ReportOpts -> Journal -> PriceOracle
-> [CBCSubreportSpec] -> CompoundBalanceReport -> [CBCSubreportSpec] -> CompoundBalanceReport
compoundBalanceReportWith ropts q j priceoracle subreportspecs = cbr compoundBalanceReportWith ropts' j priceoracle subreportspecs = cbr
where where
-- Queries, report/column dates. -- Queries, report/column dates.
reportspan = dbg "reportspan" $ calculateReportSpan ropts q j reportspan = dbg "reportspan" $ calculateReportSpan ropts' j
reportq = dbg "reportq" $ makeReportQuery ropts reportspan q ropts = dbg "reportopts" $ makeReportQuery ropts' reportspan
-- Group postings into their columns. -- 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 colspans = dbg "colspans" $ M.keys colps
-- The matched accounts with a starting balance. All of these should appear -- 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. -- 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 subreports = map generateSubreport subreportspecs
where where
@ -156,7 +149,7 @@ compoundBalanceReportWith ropts q j priceoracle subreportspecs = cbr
( cbcsubreporttitle ( cbcsubreporttitle
-- Postprocess the report, negating balances and taking percentages if needed -- Postprocess the report, negating balances and taking percentages if needed
, prNormaliseSign cbcsubreportnormalsign $ , prNormaliseSign cbcsubreportnormalsign $
generateMultiBalanceReport ropts' reportq j priceoracle colspans colps' startbals' generateMultiBalanceReport ropts' j priceoracle colspans colps' startbals'
, cbcsubreportincreasestotal , cbcsubreportincreasestotal
) )
where where
@ -186,21 +179,19 @@ compoundBalanceReportWith ropts q j priceoracle subreportspecs = cbr
-- TODO: Do we want to check whether to bother calculating these? isHistorical -- TODO: Do we want to check whether to bother calculating these? isHistorical
-- and startDate is not nothing, otherwise mempty? This currently gives a -- and startDate is not nothing, otherwise mempty? This currently gives a
-- failure with some totals which are supposed to be 0 being blank. -- failure with some totals which are supposed to be 0 being blank.
startingBalances :: ReportOpts -> Query -> Journal -> DateSpan -> HashMap AccountName Account startingBalances :: ReportOpts -> Journal -> DateSpan -> HashMap AccountName Account
startingBalances ropts q j reportspan = acctchanges startingBalances ropts j reportspan =
acctChangesFromPostings ropts' . map fst $ getPostings ropts' j
where where
acctchanges = acctChangesFromPostings ropts' startbalq . map fst $ ropts' = case accountlistmode_ ropts of
getPostings ropts' startbalq j ALTree -> ropts{query_=startbalq, period_=precedingperiod, no_elide_=True}
ALFlat -> ropts{query_=startbalq, period_=precedingperiod}
-- q projected back before the report start date. -- 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), -- 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. -- we use emptydatespan to make sure they aren't counted as starting balance.
startbalq = dbg'' "startbalq" $ And [datelessq, precedingspanq] startbalq = dbg'' "startbalq" $ And [datelessq, precedingspanq]
datelessq = dbg "datelessq" $ filterQuery (not . queryIsDateOrDate2) q datelessq = dbg "datelessq" . filterQuery (not . queryIsDateOrDate2) $ query_ ropts
ropts' = case accountlistmode_ ropts of
ALTree -> ropts{no_elide_=True, period_=precedingperiod}
ALFlat -> ropts{period_=precedingperiod}
precedingperiod = dateSpanAsPeriod . spanIntersect precedingspan . precedingperiod = dateSpanAsPeriod . spanIntersect precedingspan .
periodAsDateSpan $ period_ ropts periodAsDateSpan $ period_ ropts
@ -210,11 +201,11 @@ startingBalances ropts q j reportspan = acctchanges
a -> a a -> a
-- | Calculate the span of the report to be generated. -- | Calculate the span of the report to be generated.
calculateReportSpan :: ReportOpts -> Query -> Journal -> DateSpan calculateReportSpan :: ReportOpts -> Journal -> DateSpan
calculateReportSpan ropts q j = reportspan calculateReportSpan ropts j = reportspan
where where
-- The date span specified by -b/-e/-p options and query args if any. -- 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. -- 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. -- This can still be the null (open) span if the journal is empty.
requestedspan' = dbg "requestedspan'" $ requestedspan' = dbg "requestedspan'" $
@ -233,21 +224,22 @@ calculateReportSpan ropts q j = reportspan
-- The user's query expanded to the report span -- The user's query expanded to the report span
-- if there is one (otherwise any date queries are left as-is, which -- if there is one (otherwise any date queries are left as-is, which
-- handles the hledger-ui+future txns case above). -- handles the hledger-ui+future txns case above).
makeReportQuery :: ReportOpts -> DateSpan -> Query -> Query makeReportQuery :: ReportOpts -> DateSpan -> ReportOpts
makeReportQuery ropts reportspan q makeReportQuery ropts reportspan
| reportspan == nulldatespan = q | reportspan == nulldatespan = ropts
| otherwise = And [dateless q, reportspandatesq] | otherwise = ropts{query_=query}
where where
query = simplifyQuery $ And [dateless $ query_ ropts, reportspandatesq]
reportspandatesq = dbg "reportspandatesq" $ dateqcons reportspan reportspandatesq = dbg "reportspandatesq" $ dateqcons reportspan
dateless = dbg "dateless" . filterQuery (not . queryIsDateOrDate2) dateless = dbg "dateless" . filterQuery (not . queryIsDateOrDate2)
dateqcons = if date2_ ropts then Date2 else Date dateqcons = if date2_ ropts then Date2 else Date
-- | Group postings, grouped by their column -- | Group postings, grouped by their column
getPostingsByColumn :: ReportOpts -> Query -> Journal -> DateSpan -> Map DateSpan [Posting] getPostingsByColumn :: ReportOpts -> Journal -> DateSpan -> Map DateSpan [Posting]
getPostingsByColumn ropts q j reportspan = columns getPostingsByColumn ropts j reportspan = columns
where where
-- Postings matching the query within the report period. -- 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 days = map snd ps
-- The date spans to be included as report columns. -- The date spans to be included as report columns.
@ -259,13 +251,14 @@ getPostingsByColumn ropts q j reportspan = columns
columns = foldr addPosting emptyMap ps columns = foldr addPosting emptyMap ps
-- | Gather postings matching the query within the report period. -- | Gather postings matching the query within the report period.
getPostings :: ReportOpts -> Query -> Journal -> [(Posting, Day)] getPostings :: ReportOpts -> Journal -> [(Posting, Day)]
getPostings ropts q = getPostings ropts =
map (\p -> (p, date p)) . map (\p -> (p, date p)) .
journalPostings . journalPostings .
filterJournalAmounts symq . -- remove amount parts excluded by cur: filterJournalAmounts symq . -- remove amount parts excluded by cur:
filterJournalPostings reportq -- remove postings not matched by (adjusted) query filterJournalPostings reportq -- remove postings not matched by (adjusted) query
where where
q = query_ ropts
symq = dbg "symq" . filterQuery queryIsSym $ dbg "requested q" q symq = dbg "symq" . filterQuery queryIsSym $ dbg "requested q" q
-- The user's query with no depth limit, and expanded to the report span -- 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 -- 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 -- | Gather the account balance changes into a regular matrix
-- including the accounts from all columns. -- including the accounts from all columns.
calculateAccountChanges :: ReportOpts -> Query -> [DateSpan] calculateAccountChanges :: ReportOpts -> [DateSpan] -> Map DateSpan [Posting]
-> Map DateSpan [Posting]
-> HashMap ClippedAccountName (Map DateSpan Account) -> HashMap ClippedAccountName (Map DateSpan Account)
calculateAccountChanges ropts q colspans colps calculateAccountChanges ropts colspans colps
| queryDepth q == Just 0 = acctchanges <> elided | queryDepth (query_ ropts) == Just 0 = acctchanges <> elided
| otherwise = acctchanges | otherwise = acctchanges
where where
-- Transpose to get each account's balance changes across all columns. -- Transpose to get each account's balance changes across all columns.
acctchanges = transposeMap colacctchanges acctchanges = transposeMap colacctchanges
colacctchanges :: Map DateSpan (HashMap ClippedAccountName Account) = 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] 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 -- the accounts that have postings and calculate the change amount for
-- each. Accounts and amounts will be depth-clipped appropriately if -- each. Accounts and amounts will be depth-clipped appropriately if
-- a depth limit is in effect. -- a depth limit is in effect.
acctChangesFromPostings :: ReportOpts -> Query -> [Posting] -> HashMap ClippedAccountName Account acctChangesFromPostings :: ReportOpts -> [Posting] -> HashMap ClippedAccountName Account
acctChangesFromPostings ropts q ps = HM.fromList [(aname a, a) | a <- as] acctChangesFromPostings ropts ps = HM.fromList [(aname a, a) | a <- as]
where where
as = filterAccounts . drop 1 $ accountsFromPostings ps as = filterAccounts . drop 1 $ accountsFromPostings ps
filterAccounts = case accountlistmode_ ropts of filterAccounts = case accountlistmode_ ropts of
ALTree -> filter ((depthq `matchesAccount`) . aname) -- exclude deeper balances ALTree -> filter ((depthq `matchesAccount`) . aname) -- exclude deeper balances
ALFlat -> clipAccountsAndAggregate (queryDepth depthq) . -- aggregate deeper balances at the depth limit. ALFlat -> clipAccountsAndAggregate (queryDepth depthq) . -- aggregate deeper balances at the depth limit.
filter ((0<) . anumpostings) 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. -- | 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 -- | 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 -- given by AccountName and columns by DateSpan, then generate a MultiBalanceReport
-- from the columns. -- from the columns.
generateMultiBalanceReport :: ReportOpts -> Query -> Journal -> PriceOracle generateMultiBalanceReport :: ReportOpts -> Journal -> PriceOracle -> [DateSpan]
-> [DateSpan] -> Map DateSpan [Posting] -> HashMap AccountName Account
-> Map DateSpan [Posting]
-> HashMap AccountName Account
-> MultiBalanceReport -> MultiBalanceReport
generateMultiBalanceReport ropts q j priceoracle colspans colps startbals = report generateMultiBalanceReport ropts j priceoracle colspans colps startbals = report
where where
-- Each account's balance changes across all columns. -- 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 -- Process changes into normal, cumulative, or historical amounts, plus value them
accumvalued = accumValueAmounts ropts j priceoracle colspans startbals acctchanges accumvalued = accumValueAmounts ropts j priceoracle colspans startbals acctchanges
-- All account names that will be displayed, possibly depth-clipped. -- 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. -- All the rows of the report.
rows = dbg'' "rows" $ buildReportRows ropts displaynames accumvalued 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 -- | Calculate accounts which are to be displayed in the report, as well as
-- their name and depth -- their name and depth
displayedAccounts :: ReportOpts -> Query displayedAccounts :: ReportOpts -> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName DisplayName -> HashMap AccountName DisplayName
displayedAccounts ropts q valuedaccts displayedAccounts ropts valuedaccts
| depth == 0 = HM.singleton "..." $ DisplayName "..." "..." 1 | depth == 0 = HM.singleton "..." $ DisplayName "..." "..." 1
| otherwise = HM.mapWithKey (\a _ -> displayedName a) displayedAccts | otherwise = HM.mapWithKey (\a _ -> displayedName a) displayedAccts
where where
@ -467,7 +456,7 @@ displayedAccounts ropts q valuedaccts
minSubs = if no_elide_ ropts then 1 else 2 minSubs = if no_elide_ ropts then 1 else 2
isZeroRow balance = all (mixedAmountLooksZero . balance) isZeroRow balance = all (mixedAmountLooksZero . balance)
depth = fromMaybe maxBound $ queryDepth q depth = fromMaybe maxBound . queryDepth $ query_ ropts
numSubs = subaccountTallies . HM.keys $ HM.filterWithKey isInteresting valuedaccts numSubs = subaccountTallies . HM.keys $ HM.filterWithKey isInteresting valuedaccts
-- | Sort the rows by amount or by account declaration order. -- | Sort the rows by amount or by account declaration order.
@ -612,8 +601,9 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
let let
amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = Precision 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False} 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 (opts,journal) `gives` r = do
let (eitems, etotal) = r let opts' = opts{query_=And [queryFromFlags opts, query_ opts]}
(PeriodicReport _ aitems atotal) = multiBalanceReport nulldate opts journal (eitems, etotal) = r
(PeriodicReport _ aitems atotal) = multiBalanceReport opts' journal
showw (PeriodicReportRow a lAmt amt amt') showw (PeriodicReportRow a lAmt amt amt')
= (displayFull a, displayName a, displayDepth a, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt') = (displayFull a, displayName a, displayDepth a, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt')
(map showw aitems) @?= (map showw eitems) (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 -- | Select postings from the journal and add running balance and other
-- information to make a postings report. Used by eg hledger's register command. -- information to make a postings report. Used by eg hledger's register command.
postingsReport :: ReportOpts -> Query -> Journal -> PostingsReport postingsReport :: ReportOpts -> Journal -> PostingsReport
postingsReport ropts@ReportOpts{..} q j = postingsReport ropts@ReportOpts{..} j =
(totallabel, items) (totallabel, items)
where where
reportspan = adjustReportDates ropts q j reportspan = adjustReportDates ropts j
whichdate = whichDateFromOpts ropts whichdate = whichDateFromOpts ropts
mdepth = queryDepth q mdepth = queryDepth query_
styles = journalCommodityStyles j styles = journalCommodityStyles j
priceoracle = journalPriceOracle infer_value_ j priceoracle = journalPriceOracle infer_value_ j
multiperiod = interval_ /= NoInterval multiperiod = interval_ /= NoInterval
today = fromMaybe (error' "postingsReport: could not pick a valuation date, ReportOpts today_ is unset") today_ -- PARTIAL: 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 -- 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. -- Postings, or summary postings with their subperiod's end date, to be displayed.
displayps :: [(Posting, Maybe Day)] 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) -- 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) -- 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 -- 3. If a report interval is specified, enlarge the dates to enclose whole intervals
adjustReportDates :: ReportOpts -> Query -> Journal -> DateSpan adjustReportDates :: ReportOpts -> Journal -> DateSpan
adjustReportDates opts q j = reportspan adjustReportDates opts j = reportspan
where where
-- see also multiBalanceReport -- 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 journalspan = dbg3 "journalspan" $ dates `spanUnion` date2s -- earliest and latest dates (or date2s) in the journal
where where
dates = journalDateSpan False j dates = journalDateSpan False j
@ -159,10 +159,11 @@ adjustReportDates opts q j = reportspan
-- and also any similarly-matched postings before that date span. -- and also any similarly-matched postings before that date span.
-- Date restrictions and depth restrictions in the query are ignored. -- Date restrictions and depth restrictions in the query are ignored.
-- A helper for the postings report. -- A helper for the postings report.
matchedPostingsBeforeAndDuring :: ReportOpts -> Query -> Journal -> DateSpan -> ([Posting],[Posting]) matchedPostingsBeforeAndDuring :: ReportOpts -> Journal -> DateSpan -> ([Posting],[Posting])
matchedPostingsBeforeAndDuring opts q j (DateSpan mstart mend) = matchedPostingsBeforeAndDuring opts j (DateSpan mstart mend) =
dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps
where where
q = query_ opts
beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing mstart beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing mstart
beforeandduringps = beforeandduringps =
dbg5 "ps5" $ sortOn sortdate $ -- sort postings by date or date2 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) dateless = filterQuery (not . queryIsDateOrDate2)
beforeendq = dateqtype $ DateSpan Nothing mend beforeendq = dateqtype $ DateSpan Nothing mend
sortdate = if date2_ opts then postingDate2 else postingDate sortdate = if date2_ opts then postingDate2 else postingDate
symq = dbg4 "symq" $ filterQuery queryIsSym q symq = dbg4 "symq" . filterQuery queryIsSym $ query_ opts
dateqtype dateqtype
| queryIsDate2 dateq || (queryIsDate dateq && date2_ opts) = Date2 | queryIsDate2 dateq || (queryIsDate dateq && date2_ opts) = Date2
| otherwise = Date | otherwise = Date
@ -270,7 +271,7 @@ negatePostingAmount p = p { pamount = negate $ pamount p }
tests_PostingsReport = tests "PostingsReport" [ tests_PostingsReport = tests "PostingsReport" [
test "postingsReport" $ do 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 -- with the query specified explicitly
(Any, nulljournal) `gives` 0 (Any, nulljournal) `gives` 0
(Any, samplejournal) `gives` 13 (Any, samplejournal) `gives` 13
@ -279,10 +280,10 @@ tests_PostingsReport = tests "PostingsReport" [
(And [Depth 1, StatusQ Cleared, Acct (toRegex' "expenses")], samplejournal) `gives` 2 (And [Depth 1, StatusQ Cleared, Acct (toRegex' "expenses")], samplejournal) `gives` 2
(And [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 -- with query and/or command-line options
(length $ snd $ postingsReport defreportopts Any samplejournal) @?= 13 (length $ snd $ postingsReport defreportopts samplejournal) @?= 13
(length $ snd $ postingsReport defreportopts{interval_=Months 1} Any samplejournal) @?= 11 (length $ snd $ postingsReport defreportopts{interval_=Months 1} samplejournal) @?= 11
(length $ snd $ postingsReport defreportopts{interval_=Months 1, empty_=True} Any samplejournal) @?= 20 (length $ snd $ postingsReport defreportopts{interval_=Months 1, empty_=True} samplejournal) @?= 20
(length $ snd $ postingsReport defreportopts (Acct (toRegex' "assets:bank:checking")) samplejournal) @?= 5 (length $ snd $ postingsReport defreportopts{query_=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5
-- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0 -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0
-- [(Just (fromGregorian 2008 01 01,"income"),assets:bank:checking $1,$1) -- [(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, journalSelectingAmountFromOpts,
intervalFromRawOpts, intervalFromRawOpts,
forecastPeriodFromRawOpts, forecastPeriodFromRawOpts,
queryFromOpts, queryFromFlags,
queryFromOptsOnly,
queryOptsFromOpts,
transactionDateFn, transactionDateFn,
postingDateFn, postingDateFn,
reportSpan, reportSpan,
@ -40,8 +38,6 @@ module Hledger.Reports.ReportOptions (
reportPeriodOrJournalLastDay, reportPeriodOrJournalLastDay,
valuationTypeIsCost, valuationTypeIsCost,
valuationTypeIsDefaultValue, valuationTypeIsDefaultValue,
tests_ReportOptions
) )
where where
@ -49,7 +45,7 @@ import Control.Applicative ((<|>))
import Data.List.Extra (nubSort) import Data.List.Extra (nubSort)
import Data.Maybe (fromMaybe, isJust) import Data.Maybe (fromMaybe, isJust)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar (Day, addDays, fromGregorian) import Data.Time.Calendar (Day, addDays)
import Data.Default (Default(..)) import Data.Default (Default(..))
import Safe (lastDef, lastMay) import Safe (lastDef, lastMay)
@ -99,8 +95,8 @@ data ReportOpts = ReportOpts {
,no_elide_ :: Bool ,no_elide_ :: Bool
,real_ :: Bool ,real_ :: Bool
,format_ :: StringFormat ,format_ :: StringFormat
,query_ :: String -- ^ All query arguments space sepeareted ,query_ :: Query
-- and quoted if needed (see 'quoteIfNeeded') ,queryopts_ :: [QueryOpt]
-- --
,average_ :: Bool ,average_ :: Bool
-- for posting reports (register) -- for posting reports (register)
@ -167,52 +163,62 @@ defreportopts = ReportOpts
def def
def def
def def
def
rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts :: RawOpts -> IO ReportOpts
rawOptsToReportOpts rawopts = do rawOptsToReportOpts rawopts = do
d <- getCurrentDay d <- getCurrentDay
no_color <- isJust <$> lookupEnv "NO_COLOR" no_color <- isJust <$> lookupEnv "NO_COLOR"
supports_color <- hSupportsANSIColor stdout supports_color <- hSupportsANSIColor stdout
let colorflag = stringopt "color" rawopts
format <- case parseStringFormat <$> maybestringopt "format" rawopts of let colorflag = stringopt "color" rawopts
Nothing -> return defaultBalanceLineFormat formatstring = maybestringopt "format" rawopts
Just (Right x) -> return x querystring = T.pack . unwords . map quoteIfNeeded $
Just (Left err) -> usageError $ "could not parse format option: " ++ err listofstringopt "args" rawopts -- doesn't handle an arg like "" right
return defreportopts{ format <- case parseStringFormat <$> formatstring of
today_ = Just d Nothing -> return defaultBalanceLineFormat
,period_ = periodFromRawOpts d rawopts Just (Right x) -> return x
,interval_ = intervalFromRawOpts rawopts Just (Left err) -> fail $ "could not parse format option: " ++ err
,statuses_ = statusesFromRawOpts rawopts
,value_ = valuationTypeFromRawOpts rawopts (argsquery, queryopts) <- either fail return $ parseQuery d querystring
,infer_value_ = boolopt "infer-value" rawopts
,depth_ = maybeposintopt "depth" rawopts let reportopts = defreportopts
,date2_ = boolopt "date2" rawopts {today_ = Just d
,empty_ = boolopt "empty" rawopts ,period_ = periodFromRawOpts d rawopts
,no_elide_ = boolopt "no-elide" rawopts ,interval_ = intervalFromRawOpts rawopts
,real_ = boolopt "real" rawopts ,statuses_ = statusesFromRawOpts rawopts
,format_ = format ,value_ = valuationTypeFromRawOpts rawopts
,query_ = unwords . map quoteIfNeeded $ listofstringopt "args" rawopts -- doesn't handle an arg like "" right ,infer_value_ = boolopt "infer-value" rawopts
,average_ = boolopt "average" rawopts ,depth_ = maybeposintopt "depth" rawopts
,related_ = boolopt "related" rawopts ,date2_ = boolopt "date2" rawopts
,txn_dates_ = boolopt "txn-dates" rawopts ,empty_ = boolopt "empty" rawopts
,balancetype_ = balancetypeopt rawopts ,no_elide_ = boolopt "no-elide" rawopts
,accountlistmode_ = accountlistmodeopt rawopts ,real_ = boolopt "real" rawopts
,drop_ = posintopt "drop" rawopts ,format_ = format
,row_total_ = boolopt "row-total" rawopts ,query_ = simplifyQuery $ And [queryFromFlags reportopts, argsquery]
,no_total_ = boolopt "no-total" rawopts ,queryopts_ = queryopts
,sort_amount_ = boolopt "sort-amount" rawopts ,average_ = boolopt "average" rawopts
,percent_ = boolopt "percent" rawopts ,related_ = boolopt "related" rawopts
,invert_ = boolopt "invert" rawopts ,txn_dates_ = boolopt "txn-dates" rawopts
,pretty_tables_ = boolopt "pretty-tables" rawopts ,balancetype_ = balancetypeopt rawopts
,color_ = and [not no_color ,accountlistmode_ = accountlistmodeopt rawopts
,not $ colorflag `elem` ["never","no"] ,drop_ = posintopt "drop" rawopts
,colorflag `elem` ["always","yes"] || supports_color ,row_total_ = boolopt "row-total" rawopts
] ,no_total_ = boolopt "no-total" rawopts
,forecast_ = forecastPeriodFromRawOpts d rawopts ,sort_amount_ = boolopt "sort-amount" rawopts
,transpose_ = boolopt "transpose" 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 :: RawOpts -> AccountListMode
accountlistmodeopt = accountlistmodeopt =
@ -423,17 +429,9 @@ journalSelectingAmountFromOpts opts =
Just (AtCost _) -> journalToCost Just (AtCost _) -> journalToCost
_ -> id _ -> 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. -- | Convert report options to a query, ignoring any non-flag command line arguments.
queryFromOptsOnly :: Day -> ReportOpts -> Query queryFromFlags :: ReportOpts -> Query
queryFromOptsOnly _d ReportOpts{..} = simplifyQuery $ And flagsq queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq
where where
flagsq = consIf Real real_ flagsq = consIf Real real_
. consIf Empty empty_ . consIf Empty empty_
@ -444,11 +442,6 @@ queryFromOptsOnly _d ReportOpts{..} = simplifyQuery $ And flagsq
consIf f b = if b then (f True:) else id consIf f b = if b then (f True:) else id
consJust f = maybe id ((:) . f) 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. -- Report dates.
-- | The effective report span is the start and end dates specified by -- | 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. -- Needs IO to parse smart dates in options/queries.
specifiedStartEndDates :: ReportOpts -> IO (Maybe Day, Maybe Day) specifiedStartEndDates :: ReportOpts -> IO (Maybe Day, Maybe Day)
specifiedStartEndDates ropts = do specifiedStartEndDates ropts = do
today <- getCurrentDay
let let
q = queryFromOpts today ropts q = query_ ropts
mspecifiedstartdate = queryStartDate False q mspecifiedstartdate = queryStartDate False q
mspecifiedenddate = queryEndDate False q mspecifiedenddate = queryEndDate False q
return (mspecifiedstartdate, mspecifiedenddate) return (mspecifiedstartdate, mspecifiedenddate)
@ -498,9 +490,7 @@ specifiedEndDate ropts = snd <$> specifiedStartEndDates ropts
-- since we need that to get the report period robustly -- since we need that to get the report period robustly
-- (unlike reportStartDate, which looks up the date with IO.) -- (unlike reportStartDate, which looks up the date with IO.)
reportPeriodStart :: ReportOpts -> Maybe Day reportPeriodStart :: ReportOpts -> Maybe Day
reportPeriodStart ropts@ReportOpts{..} = do reportPeriodStart = queryStartDate False . query_
t <- today_
queryStartDate False $ queryFromOpts t ropts
-- Get the report's start date, or if no report period is specified, -- 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 -- 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 -- since we need that to get the report period robustly
-- (unlike reportEndDate, which looks up the date with IO.) -- (unlike reportEndDate, which looks up the date with IO.)
reportPeriodLastDay :: ReportOpts -> Maybe Day reportPeriodLastDay :: ReportOpts -> Maybe Day
reportPeriodLastDay ropts@ReportOpts{..} = do reportPeriodLastDay = fmap (addDays (-1)) . queryEndDate False . query_
t <- today_
let q = queryFromOpts t ropts
qend <- queryEndDate False q
return $ addDays (-1) qend
-- Get the last day of the overall report period, or if no report -- 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 -- 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 :: ReportOpts -> Journal -> Maybe Day
reportPeriodOrJournalLastDay ropts j = reportPeriodOrJournalLastDay ropts j =
reportPeriodLastDay ropts <|> journalEndDate False 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 $ "running: " ++ progname'
putStrLn $ "raw args: " ++ show args' putStrLn $ "raw args: " ++ show args'
putStrLn $ "processed opts:\n" ++ show opts putStrLn $ "processed opts:\n" ++ show opts
d <- getCurrentDay putStrLn $ "search query: " ++ show (query_ $ reportopts_ opts)
putStrLn $ "search query: " ++ show (queryFromOpts d $ reportopts_ opts)
getHledgerCliOpts :: Mode RawOpts -> IO CliOpts getHledgerCliOpts :: Mode RawOpts -> IO CliOpts
getHledgerCliOpts mode' = do getHledgerCliOpts mode' = do

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

@ -277,7 +277,7 @@ testmode = hledgerCommandMode
-- --
testcmd :: CliOpts -> Journal -> IO () testcmd :: CliOpts -> Journal -> IO ()
testcmd opts _undefined = do testcmd opts _undefined = do
withArgs (words' $ query_ $ reportopts_ opts) $ withArgs (listofstringopt "args" $ rawopts_ opts) $
Test.Tasty.defaultMain $ tests "hledger" [ Test.Tasty.defaultMain $ tests "hledger" [
tests_Hledger tests_Hledger
,tests_Hledger_Cli ,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 accounts CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
-- 1. identify the accounts we'll show -- 1. identify the accounts we'll show
d <- getCurrentDay
let tree = tree_ ropts let tree = tree_ ropts
declared = boolopt "declared" rawopts declared = boolopt "declared" rawopts
used = boolopt "used" 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 -- 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 nodepthq = dbg1 "nodepthq" $ filterQuery (not . queryIsDepth) q
-- just the acct: part of the query will be reapplied later, after clipping -- 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. -- | Print a bar chart of number of postings per report interval.
activity :: CliOpts -> Journal -> IO () activity :: CliOpts -> Journal -> IO ()
activity CliOpts{reportopts_=ropts} j = do activity CliOpts{reportopts_=ropts} j = putStr $ showHistogram ropts j
d <- getCurrentDay
putStr $ showHistogram ropts (queryFromOpts d ropts) j
showHistogram :: ReportOpts -> Query -> Journal -> String showHistogram :: ReportOpts -> Journal -> String
showHistogram opts q j = concatMap (printDayWith countBar) spanps showHistogram ReportOpts{query_=q,interval_=i,date2_=date2} j =
where concatMap (printDayWith countBar) spanps
i = interval_ opts where
interval | i == NoInterval = Days 1 interval | i == NoInterval = Days 1
| otherwise = i | otherwise = i
span' = queryDateSpan (date2_ opts) q `spanDefaultsFrom` journalDateSpan (date2_ opts) j span' = queryDateSpan date2 q `spanDefaultsFrom` journalDateSpan date2 j
spans = filter (DateSpan Nothing Nothing /=) $ splitSpan interval span' spans = filter (DateSpan Nothing Nothing /=) $ splitSpan interval span'
spanps = [(s, filter (isPostingInDateSpan s) ps) | s <- spans] spanps = [(s, filter (isPostingInDateSpan s) ps) | s <- spans]
-- same as Register -- same as Register
-- should count transactions, not postings ? -- 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 = sortOn postingDate $ filter (q `matchesPosting`) $ journalPostings j ps = sortOn postingDate $ filter (q `matchesPosting`) $ journalPostings j
printDayWith f (DateSpan b _, ps) = printf "%s %s\n" (show $ fromJust b) (f ps) 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. -- Identify the closest recent match for this description in past transactions.
similarTransaction :: EntryState -> Text -> Maybe Transaction similarTransaction :: EntryState -> Text -> Maybe Transaction
similarTransaction EntryState{..} desc = similarTransaction EntryState{..} desc =
let q = queryFromOptsOnly esToday $ reportopts_ esOpts let q = queryFromFlags $ reportopts_ esOpts
historymatches = transactionsSimilarTo esJournal q desc historymatches = transactionsSimilarTo esJournal q desc
bestmatch | null historymatches = Nothing bestmatch | null historymatches = Nothing
| otherwise = Just $ snd $ head historymatches | 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. -- | Convert a string of journal data into a register report.
registerFromString :: String -> IO String registerFromString :: String -> IO String
registerFromString s = do registerFromString s = do
d <- getCurrentDay
j <- readJournal' $ T.pack s j <- readJournal' $ T.pack s
return $ postingsReportAsText opts $ postingsReport ropts (queryFromOpts d ropts) j return . postingsReportAsText opts $ postingsReport ropts j
where where
ropts = defreportopts{empty_=True} ropts = defreportopts{empty_=True}
opts = defcliopts{reportopts_=ropts} opts = defcliopts{reportopts_=ropts}

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

@ -19,7 +19,6 @@ module Hledger.Cli.Commands.Aregister (
,tests_Aregister ,tests_Aregister
) where ) where
import Control.Monad (when)
import Data.Aeson (toJSON) import Data.Aeson (toJSON)
import Data.Aeson.Text (encodeToLazyText) import Data.Aeson.Text (encodeToLazyText)
import Data.List import Data.List
@ -75,10 +74,11 @@ aregister :: CliOpts -> Journal -> IO ()
aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
d <- getCurrentDay d <- getCurrentDay
-- the first argument specifies the account, any remaining arguments are a filter query -- the first argument specifies the account, any remaining arguments are a filter query
let args' = listofstringopt "args" rawopts (apat,querystring) <- case listofstringopt "args" rawopts of
when (null args') $ error' "aregister needs an account, please provide an account name or pattern" -- PARTIAL: [] -> 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 let
(apat:queryargs) = args'
acct = headDef (error' $ show apat++" did not match any account") -- PARTIAL: acct = headDef (error' $ show apat++" did not match any account") -- PARTIAL:
. filterAccts $ journalAccountNames j . filterAccts $ journalAccountNames j
filterAccts = case toRegexCI apat of filterAccts = case toRegexCI apat of
@ -88,13 +88,13 @@ aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
inclusive = True -- tree_ ropts inclusive = True -- tree_ ropts
thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) acct thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) acct
ropts' = ropts{ 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 -- remove a depth limit for reportq, as in RegisterScreen, I forget why XXX
,depth_=Nothing ,depth_=Nothing
-- always show historical balance -- always show historical balance
,balancetype_= HistoricalBalance ,balancetype_= HistoricalBalance
} }
reportq = And [queryFromOpts d ropts', excludeforecastq (isJust $ forecast_ ropts)] reportq = And [query_ ropts', excludeforecastq (isJust $ forecast_ ropts)]
where where
-- As in RegisterScreen, why ? XXX -- As in RegisterScreen, why ? XXX
-- Except in forecast mode, exclude future/forecast transactions. -- 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. -- | The balance command, prints a balance report.
balance :: CliOpts -> Journal -> IO () balance :: CliOpts -> Journal -> IO ()
balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
d <- getCurrentDay
let budget = boolopt "budget" rawopts let budget = boolopt "budget" rawopts
multiperiod = interval_ /= NoInterval multiperiod = interval_ /= NoInterval
fmt = outputFormatFromOpts opts fmt = outputFormatFromOpts opts
if budget then do -- single or multi period budget report if budget then do -- single or multi period budget report
reportspan <- reportSpan j ropts reportspan <- reportSpan j ropts
let budgetreport = dbg4 "budgetreport" $ budgetReport ropts assrt reportspan d j let budgetreport = dbg4 "budgetreport" $ budgetReport ropts assrt reportspan j
where where
assrt = not $ ignore_assertions_ $ inputopts_ opts assrt = not $ ignore_assertions_ $ inputopts_ opts
render = case fmt of render = case fmt of
@ -323,7 +322,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
else else
if multiperiod then do -- multi period balance report if multiperiod then do -- multi period balance report
let report = multiBalanceReport d ropts j let report = multiBalanceReport ropts j
render = case fmt of render = case fmt of
"txt" -> multiBalanceReportAsText ropts "txt" -> multiBalanceReportAsText ropts
"csv" -> (++"\n") . printCSV . multiBalanceReportAsCsv ropts "csv" -> (++"\n") . printCSV . multiBalanceReportAsCsv ropts
@ -333,7 +332,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
writeOutput opts $ render report writeOutput opts $ render report
else do -- single period simple balance 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 render = case fmt of
"txt" -> balanceReportAsText "txt" -> balanceReportAsText
"csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r "csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r
@ -622,7 +621,7 @@ tests_Balance = tests "Balance" [
test "unicode in balance layout" $ do test "unicode in balance layout" $ do
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts = defreportopts 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 unlines
[" -100 актив:наличные" [" -100 актив:наличные"

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

@ -22,10 +22,8 @@ checkdatesmode = hledgerCommandMode
checkdates :: CliOpts -> Journal -> IO () checkdates :: CliOpts -> Journal -> IO ()
checkdates CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do checkdates CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
d <- getCurrentDay
let ropts_ = ropts{accountlistmode_=ALFlat} let ropts_ = ropts{accountlistmode_=ALFlat}
let q = queryFromOpts d ropts_ let ts = filter (query_ ropts_ `matchesTransaction`) $
let ts = filter (q `matchesTransaction`) $
jtxns $ journalSelectingAmountFromOpts ropts j jtxns $ journalSelectingAmountFromOpts ropts j
let strict = boolopt "strict" rawopts let strict = boolopt "strict" rawopts
let date = transactionDateFn ropts 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 -- dates of the closing and opening transactions
ropts_ = ropts{balancetype_=HistoricalBalance, accountlistmode_=ALFlat} ropts_ = ropts{balancetype_=HistoricalBalance, accountlistmode_=ALFlat}
q = queryFromOpts today ropts_ q = query_ ropts_
openingdate = fromMaybe today $ queryEndDate False q openingdate = fromMaybe today $ queryEndDate False q
closingdate = addDays (-1) openingdate closingdate = addDays (-1) openingdate
@ -86,7 +86,7 @@ close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
False -> normaliseMixedAmount . mixedAmountStripPrices False -> normaliseMixedAmount . mixedAmountStripPrices
-- the balances to close -- the balances to close
(acctbals,_) = balanceReport ropts_ q j (acctbals,_) = balanceReport ropts_ j
totalamt = sum $ map (\(_,_,_,b) -> normalise b) acctbals totalamt = sum $ map (\(_,_,_,b) -> normalise b) acctbals
-- since balance assertion amounts are required to be exact, the -- 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. -- | The codes command.
codes :: CliOpts -> Journal -> IO () codes :: CliOpts -> Journal -> IO ()
codes CliOpts{reportopts_=ropts@ReportOpts{empty_}} j = do codes CliOpts{reportopts_=ropts@ReportOpts{empty_}} j = do
d <- getCurrentDay let ts = entriesReport ropts j
let q = queryFromOpts d ropts
ts = entriesReport ropts q j
codes = (if empty_ then id else filter (not . T.null)) $ codes = (if empty_ then id else filter (not . T.null)) $
map tcode ts map tcode ts
mapM_ T.putStrLn codes mapM_ T.putStrLn codes

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

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

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

@ -102,11 +102,11 @@ unmatchedtxns s pp m =
-- | The diff command. -- | The diff command.
diff :: CliOpts -> Journal -> IO () 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 j1 <- readJournalFile' f1
j2 <- readJournalFile' f2 j2 <- readJournalFile' f2
let acct = T.pack acctName let acct = T.pack $ reString acctRe
let pp1 = matchingPostings acct j1 let pp1 = matchingPostings acct j1
let pp2 = matchingPostings acct j2 let pp2 = matchingPostings acct j2

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

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

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

@ -33,9 +33,6 @@ payeesmode = hledgerCommandMode
-- | The payees command. -- | The payees command.
payees :: CliOpts -> Journal -> IO () payees :: CliOpts -> Journal -> IO ()
payees CliOpts{reportopts_=ropts} j = do payees CliOpts{reportopts_=ropts} j = do
d <- getCurrentDay let ts = entriesReport ropts j
let q = queryFromOpts d ropts
ts = entriesReport ropts q j
payees = nubSort $ map transactionPayee ts payees = nubSort $ map transactionPayee ts
mapM_ T.putStrLn payees 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 -- XXX the original hledger-prices script always ignored assertions
prices opts j = do prices opts j = do
d <- getCurrentDay
let let
styles = journalCommodityStyles j styles = journalCommodityStyles j
q = queryFromOpts d (reportopts_ opts) q = query_ $ reportopts_ opts
ps = filter (matchesPosting q) $ allPostings j ps = filter (matchesPosting q) $ allPostings j
mprices = jpricedirectives j mprices = jpricedirectives j
cprices = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts ps 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 :: CliOpts -> Journal -> IO ()
printEntries opts@CliOpts{reportopts_=ropts} j = do printEntries opts@CliOpts{reportopts_=ropts} j = do
d <- getCurrentDay let fmt = outputFormatFromOpts opts
let q = queryFromOpts d ropts
fmt = outputFormatFromOpts opts
render = case fmt of render = case fmt of
"txt" -> entriesReportAsText opts "txt" -> entriesReportAsText opts
"csv" -> (++"\n") . printCSV . entriesReportAsCsv "csv" -> (++"\n") . printCSV . entriesReportAsCsv
"json" -> (++"\n") . TL.unpack . toJsonText "json" -> (++"\n") . TL.unpack . toJsonText
"sql" -> entriesReportAsSql "sql" -> entriesReportAsSql
_ -> const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL: _ -> const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL:
writeOutput opts $ render $ entriesReport ropts q j writeOutput opts $ render $ entriesReport ropts j
entriesReportAsText :: CliOpts -> EntriesReport -> String entriesReportAsText :: CliOpts -> EntriesReport -> String
entriesReportAsText opts = concatMap (showTransaction . whichtxn) entriesReportAsText opts = concatMap (showTransaction . whichtxn)
@ -185,11 +183,9 @@ postingToCSV p =
-- (and the query, if any). -- (and the query, if any).
printMatch :: CliOpts -> Journal -> Text -> IO () printMatch :: CliOpts -> Journal -> Text -> IO ()
printMatch CliOpts{reportopts_=ropts} j desc = do printMatch CliOpts{reportopts_=ropts} j desc = do
d <- getCurrentDay case similarTransaction' j (query_ ropts) desc of
let q = queryFromOpts d ropts Nothing -> putStrLn "no matches found."
case similarTransaction' j q desc of Just t -> putStr $ showTransaction t
Nothing -> putStrLn "no matches found."
Just t -> putStr $ showTransaction t
where where
-- Identify the closest recent match for this description in past transactions. -- 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 Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import Data.Time (fromGregorian)
import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Explicit
import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV) import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)
@ -60,13 +59,12 @@ registermode = hledgerCommandMode
-- | Print a (posting) register report. -- | Print a (posting) register report.
register :: CliOpts -> Journal -> IO () register :: CliOpts -> Journal -> IO ()
register opts@CliOpts{reportopts_=ropts} j = do register opts@CliOpts{reportopts_=ropts} j = do
d <- getCurrentDay
let fmt = outputFormatFromOpts opts let fmt = outputFormatFromOpts opts
render | fmt=="txt" = postingsReportAsText render | fmt=="txt" = postingsReportAsText
| fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv) | fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv)
| fmt=="json" = const ((++"\n") . TL.unpack . toJsonText) | fmt=="json" = const ((++"\n") . TL.unpack . toJsonText)
| otherwise = const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL: | 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 :: PostingsReport -> CSV
postingsReportAsCsv (_,is) = postingsReportAsCsv (_,is) =
@ -201,7 +199,7 @@ tests_Register = tests "Register" [
test "unicode in register layout" $ do test "unicode in register layout" $ do
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts = defreportopts let opts = defreportopts
(postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (fromGregorian 2008 11 26) opts) j) (postingsReportAsText defcliopts $ postingsReport opts j)
@?= @?=
unlines unlines
["2009-01-01 медвежья шкура расходы:покупки 100 100" ["2009-01-01 медвежья шкура расходы:покупки 100 100"

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

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

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

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

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

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

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

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

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

@ -28,15 +28,17 @@ tagsmode = hledgerCommandMode
tags :: CliOpts -> Journal -> IO () tags :: CliOpts -> Journal -> IO ()
tags CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do tags CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
d <- getCurrentDay d <- getCurrentDay
let let args = listofstringopt "args" rawopts
args = listofstringopt "args" rawopts
mtagpat <- mapM (either Fail.fail pure . toRegexCI) $ headMay args mtagpat <- mapM (either Fail.fail pure . toRegexCI) $ headMay args
let let
queryargs = drop 1 args querystring = T.pack . unwords . map quoteIfNeeded $ drop 1 args
values = boolopt "values" rawopts values = boolopt "values" rawopts
parsed = boolopt "parsed" rawopts parsed = boolopt "parsed" rawopts
empty = empty_ ropts empty = empty_ ropts
q = queryFromOpts d $ ropts{query_ = unwords $ map quoteIfNeeded queryargs}
argsquery <- either usageError (return . fst) $ parseQuery d querystring
let
q = simplifyQuery $ And [queryFromFlags ropts, argsquery]
txns = filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts ropts j txns = filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts ropts j
tagsorvalues = tagsorvalues =
(if parsed then id else nubSort) (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. -- | Generate a runnable command from a compound balance command specification.
compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ()) compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ())
compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=ropts@ReportOpts{..}, rawopts_=rawopts} j = do compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=ropts@ReportOpts{..}, rawopts_=rawopts} j = do
today <- getCurrentDay
let let
-- use the default balance type for this report, unless the user overrides -- use the default balance type for this report, unless the user overrides
mBalanceTypeOverride = mBalanceTypeOverride =
@ -121,7 +120,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
_ -> showDateSpan requestedspan _ -> showDateSpan requestedspan
where where
enddates = map (addDays (-1)) . mapMaybe spanEnd $ cbrDates cbr -- these spans will always have a definite end date 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 `spanDefaultsFrom` journalDateSpan date2_ j
-- when user overrides, add an indication to the report title -- when user overrides, add an indication to the report title
@ -143,7 +142,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
where multiperiod = interval_ /= NoInterval where multiperiod = interval_ /= NoInterval
-- make a CompoundBalanceReport. -- make a CompoundBalanceReport.
cbr' = compoundBalanceReport today ropts' j cbcqueries cbr' = compoundBalanceReport ropts' j cbcqueries
cbr = cbr'{cbrTitle=title} cbr = cbr'{cbrTitle=title}
-- render appropriately -- render appropriately

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

@ -151,10 +151,9 @@ main = do
dbgIO "isInternalCommand" isInternalCommand dbgIO "isInternalCommand" isInternalCommand
dbgIO "isExternalCommand" isExternalCommand dbgIO "isExternalCommand" isExternalCommand
dbgIO "isBadCommand" isBadCommand dbgIO "isBadCommand" isBadCommand
d <- getCurrentDay
dbgIO "period from opts" (period_ $ reportopts_ opts) dbgIO "period from opts" (period_ $ reportopts_ opts)
dbgIO "interval from opts" (interval_ $ 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 let
journallesserror = error "journal-less command tried to use the journal" journallesserror = error "journal-less command tried to use the journal"
runHledgerCommand runHledgerCommand