lib,cli: Store parsed Query in ReportOpts, rather than an unparsed
String.
This commit is contained in:
Stephen Morgan
Simon Michael
parent
103308e795
commit
c45663d41d
@ -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)
|
||||
|
||||
@ -41,5 +41,4 @@ tests_Reports = tests "Reports" [
|
||||
,tests_EntriesReport
|
||||
,tests_MultiBalanceReport
|
||||
,tests_PostingsReport
|
||||
,tests_ReportOptions
|
||||
]
|
||||
|
||||
@ -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")
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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'"} @?= []
|
||||
]
|
||||
|
||||
@ -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
|
||||
|
||||
@ -276,8 +276,8 @@ testmode = hledgerCommandMode
|
||||
-- not be used (and would raise an error).
|
||||
--
|
||||
testcmd :: CliOpts -> Journal -> IO ()
|
||||
testcmd opts _undefined = do
|
||||
withArgs (words' $ query_ $ reportopts_ opts) $
|
||||
testcmd opts _undefined = do
|
||||
withArgs (listofstringopt "args" $ rawopts_ opts) $
|
||||
Test.Tasty.defaultMain $ tests "hledger" [
|
||||
tests_Hledger
|
||||
,tests_Hledger_Cli
|
||||
|
||||
@ -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,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)
|
||||
|
||||
|
||||
@ -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}
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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 актив:наличные"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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."
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 =
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user