support effective dates on postings as well
We now preserve all dates while reporting, instead of overwriting one with the other.
This commit is contained in:
parent
ccbc071289
commit
20e68f23a8
@ -411,13 +411,13 @@ NAME=EXACTVALUE` on the command line.
|
|||||||
### Posting dates
|
### Posting dates
|
||||||
|
|
||||||
You can give individual postings a different date from their parent
|
You can give individual postings a different date from their parent
|
||||||
transaction, by adding posting tag `date:ACTUALDATE`. If present, this
|
transaction, by adding posting tag `date:ACTUALDATE`. The effective date
|
||||||
date will be used by the register and balance reports.
|
can be set similarly: `date2:EFFECTIVEDATE`. If present, these dates will
|
||||||
|
take precedence in register and balance reports.
|
||||||
|
|
||||||
For compatibility, ledger's posting date syntax is also supported
|
For compatibility, ledger's posting date syntax is also supported
|
||||||
(`[ACTUALDATE]`, `[ACTUALDATE=EFFECTIVEDATE]` or `[=EFFECTIVEDATE]` in a
|
(`[ACTUALDATE]`, `[ACTUALDATE=EFFECTIVEDATE]` or `[=EFFECTIVEDATE]` in a
|
||||||
posting comment) and treated as an alterate spelling of the date: tag.
|
posting comment) and treated as an alterate spelling of the date tags.
|
||||||
Note effective dates are not csurrently here are ignored, currently.
|
|
||||||
|
|
||||||
### Including other files
|
### Including other files
|
||||||
|
|
||||||
|
|||||||
@ -18,7 +18,6 @@ module Hledger.Data.Journal (
|
|||||||
journalCanonicaliseAmounts,
|
journalCanonicaliseAmounts,
|
||||||
journalConvertAmountsToCost,
|
journalConvertAmountsToCost,
|
||||||
journalFinalise,
|
journalFinalise,
|
||||||
journalSelectingDate,
|
|
||||||
-- * Filtering
|
-- * Filtering
|
||||||
filterJournalPostings,
|
filterJournalPostings,
|
||||||
filterJournalTransactions,
|
filterJournalTransactions,
|
||||||
@ -342,13 +341,6 @@ filterJournalTransactionsByAccount apats j@Journal{jtxns=ts} = j{jtxns=filter tm
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
-- | Convert this journal's transactions' primary date to either the
|
|
||||||
-- actual or effective date.
|
|
||||||
journalSelectingDate :: WhichDate -> Journal -> Journal
|
|
||||||
journalSelectingDate ActualDate j = j
|
|
||||||
journalSelectingDate EffectiveDate j =
|
|
||||||
j{jtxns=map (journalTransactionWithDate EffectiveDate) $ jtxns j}
|
|
||||||
|
|
||||||
-- | Apply additional account aliases (eg from the command-line) to all postings in a journal.
|
-- | Apply additional account aliases (eg from the command-line) to all postings in a journal.
|
||||||
journalApplyAliases :: [(AccountName,AccountName)] -> Journal -> Journal
|
journalApplyAliases :: [(AccountName,AccountName)] -> Journal -> Journal
|
||||||
journalApplyAliases aliases j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
|
journalApplyAliases aliases j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
|
||||||
|
|||||||
@ -64,6 +64,7 @@ instance Show Posting where show = showPosting
|
|||||||
nullposting, posting :: Posting
|
nullposting, posting :: Posting
|
||||||
nullposting = Posting
|
nullposting = Posting
|
||||||
{pdate=Nothing
|
{pdate=Nothing
|
||||||
|
,pdate2=Nothing
|
||||||
,pstatus=False
|
,pstatus=False
|
||||||
,paccount=""
|
,paccount=""
|
||||||
,pamount=nullmixedamt
|
,pamount=nullmixedamt
|
||||||
@ -126,21 +127,25 @@ accountNamesFromPostings = nub . map paccount
|
|||||||
sumPostings :: [Posting] -> MixedAmount
|
sumPostings :: [Posting] -> MixedAmount
|
||||||
sumPostings = sum . map pamount
|
sumPostings = sum . map pamount
|
||||||
|
|
||||||
-- | Get a posting's (primary) date - it's own date if specified,
|
-- | Get a posting's (primary) date - it's own primary date if specified,
|
||||||
-- otherwise the parent transaction's primary date (otherwise the null
|
-- otherwise the parent transaction's primary date, or the null date if
|
||||||
-- date).
|
-- there is no parent transaction.
|
||||||
postingDate :: Posting -> Day
|
postingDate :: Posting -> Day
|
||||||
postingDate p = fromMaybe txndate $ pdate p
|
postingDate p = fromMaybe txndate $ pdate p
|
||||||
where
|
where
|
||||||
txndate = maybe nulldate tdate $ ptransaction p
|
txndate = maybe nulldate tdate $ ptransaction p
|
||||||
|
|
||||||
-- | Get a posting's secondary (effective) date - it's own primary date if
|
-- | Get a posting's secondary (effective) date, which is the first of:
|
||||||
-- specified (can't access posting secondary dates yet), otherwise the
|
-- posting's secondary date, transaction's secondary date, posting's
|
||||||
-- parent transaction's effective date, otherwise the null date.
|
-- primary date, transaction's primary date, or the null date if there is
|
||||||
|
-- no parent transaction.
|
||||||
postingEffectiveDate :: Posting -> Day
|
postingEffectiveDate :: Posting -> Day
|
||||||
postingEffectiveDate p = maybe nulldate transactionEffectiveDate $ ptransaction p
|
postingEffectiveDate p = headDef nulldate $ catMaybes dates
|
||||||
where
|
where dates = [pdate2 p
|
||||||
transactionEffectiveDate t = fromMaybe (tdate t) $ teffectivedate t
|
,maybe Nothing teffectivedate $ ptransaction p
|
||||||
|
,pdate p
|
||||||
|
,maybe Nothing (Just . tdate) $ ptransaction p
|
||||||
|
]
|
||||||
|
|
||||||
-- |Is this posting cleared? If this posting was individually marked
|
-- |Is this posting cleared? If this posting was individually marked
|
||||||
-- as cleared, returns True. Otherwise, return the parent
|
-- as cleared, returns True. Otherwise, return the parent
|
||||||
|
|||||||
@ -24,7 +24,7 @@ module Hledger.Data.Transaction (
|
|||||||
-- * date operations
|
-- * date operations
|
||||||
transactionActualDate,
|
transactionActualDate,
|
||||||
transactionEffectiveDate,
|
transactionEffectiveDate,
|
||||||
journalTransactionWithDate,
|
transactionWithDate,
|
||||||
-- * arithmetic
|
-- * arithmetic
|
||||||
transactionPostingBalances,
|
transactionPostingBalances,
|
||||||
balanceTransaction,
|
balanceTransaction,
|
||||||
@ -352,9 +352,14 @@ transactionEffectiveDate t = fromMaybe (tdate t) $ teffectivedate t
|
|||||||
|
|
||||||
-- | Once we no longer need both, set the main transaction date to either
|
-- | Once we no longer need both, set the main transaction date to either
|
||||||
-- the actual or effective date. A bit hacky.
|
-- the actual or effective date. A bit hacky.
|
||||||
journalTransactionWithDate :: WhichDate -> Transaction -> Transaction
|
transactionWithDate :: WhichDate -> Transaction -> Transaction
|
||||||
journalTransactionWithDate ActualDate t = t
|
transactionWithDate ActualDate t = t
|
||||||
journalTransactionWithDate EffectiveDate t = txnTieKnot t{tdate=transactionEffectiveDate t}
|
transactionWithDate EffectiveDate t =
|
||||||
|
txnTieKnot t{tdate=transactionEffectiveDate t, tpostings=map (postingWithDate EffectiveDate) $ tpostings t}
|
||||||
|
|
||||||
|
postingWithDate :: WhichDate -> Posting -> Posting
|
||||||
|
postingWithDate ActualDate p = p
|
||||||
|
postingWithDate EffectiveDate p = p{pdate=pdate2 p}
|
||||||
|
|
||||||
-- | Ensure a transaction's postings refer back to it.
|
-- | Ensure a transaction's postings refer back to it.
|
||||||
txnTieKnot :: Transaction -> Transaction
|
txnTieKnot :: Transaction -> Transaction
|
||||||
|
|||||||
@ -77,6 +77,7 @@ type Tag = (String, String)
|
|||||||
|
|
||||||
data Posting = Posting {
|
data Posting = Posting {
|
||||||
pdate :: Maybe Day, -- ^ this posting's date, if different from the transaction's
|
pdate :: Maybe Day, -- ^ this posting's date, if different from the transaction's
|
||||||
|
pdate2 :: Maybe Day, -- ^ this posting's secondary (effective) date, if different from the transaction's
|
||||||
pstatus :: Bool,
|
pstatus :: Bool,
|
||||||
paccount :: AccountName,
|
paccount :: AccountName,
|
||||||
pamount :: MixedAmount,
|
pamount :: MixedAmount,
|
||||||
@ -90,7 +91,7 @@ data Posting = Posting {
|
|||||||
-- The equality test for postings ignores the parent transaction's
|
-- The equality test for postings ignores the parent transaction's
|
||||||
-- identity, to avoid infinite loops.
|
-- identity, to avoid infinite loops.
|
||||||
instance Eq Posting where
|
instance Eq Posting where
|
||||||
(==) (Posting a1 b1 c1 d1 e1 f1 g1 _) (Posting a2 b2 c2 d2 e2 f2 g2 _) = a1==a2 && b1==b2 && c1==c2 && d1==d2 && e1==e2 && f1==f2 && g1==g2
|
(==) (Posting a1 b1 c1 d1 e1 f1 g1 h1 _) (Posting a2 b2 c2 d2 e2 f2 g2 h2 _) = a1==a2 && b1==b2 && c1==c2 && d1==d2 && e1==e2 && f1==f2 && g1==g2 && h1==h2
|
||||||
|
|
||||||
data Transaction = Transaction {
|
data Transaction = Transaction {
|
||||||
tdate :: Day,
|
tdate :: Day,
|
||||||
|
|||||||
@ -514,7 +514,8 @@ postingp = do
|
|||||||
comment <- try followingcomment <|> (newline >> return "")
|
comment <- try followingcomment <|> (newline >> return "")
|
||||||
let tags = tagsInComment comment
|
let tags = tagsInComment comment
|
||||||
date = dateFromTags tags
|
date = dateFromTags tags
|
||||||
return posting{pdate=date, pstatus=status, paccount=account', pamount=amount, pcomment=comment, ptype=ptype, ptags=tags}
|
date2 = date2FromTags tags
|
||||||
|
return posting{pdate=date, pdate2=date2, pstatus=status, paccount=account', pamount=amount, pcomment=comment, ptype=ptype, ptags=tags}
|
||||||
|
|
||||||
#ifdef TESTS
|
#ifdef TESTS
|
||||||
test_postingp = do
|
test_postingp = do
|
||||||
@ -888,6 +889,9 @@ test_ledgerDateSyntaxToTags = do
|
|||||||
dateFromTags :: [Tag] -> Maybe Day
|
dateFromTags :: [Tag] -> Maybe Day
|
||||||
dateFromTags = maybe Nothing parsedateM . fmap snd . find ((=="date").fst)
|
dateFromTags = maybe Nothing parsedateM . fmap snd . find ((=="date").fst)
|
||||||
|
|
||||||
|
date2FromTags :: [Tag] -> Maybe Day
|
||||||
|
date2FromTags = maybe Nothing parsedateM . fmap snd . find ((=="date2").fst)
|
||||||
|
|
||||||
|
|
||||||
{- old hunit tests
|
{- old hunit tests
|
||||||
|
|
||||||
|
|||||||
@ -18,7 +18,6 @@ module Hledger.Reports (
|
|||||||
intervalFromOpts,
|
intervalFromOpts,
|
||||||
clearedValueFromOpts,
|
clearedValueFromOpts,
|
||||||
whichDateFromOpts,
|
whichDateFromOpts,
|
||||||
journalSelectingDateFromOpts,
|
|
||||||
journalSelectingAmountFromOpts,
|
journalSelectingAmountFromOpts,
|
||||||
queryFromOpts,
|
queryFromOpts,
|
||||||
queryOptsFromOpts,
|
queryOptsFromOpts,
|
||||||
@ -163,11 +162,6 @@ whichDateFromOpts ReportOpts{..} = if effective_ then EffectiveDate else ActualD
|
|||||||
transactionDateFn :: ReportOpts -> (Transaction -> Day)
|
transactionDateFn :: ReportOpts -> (Transaction -> Day)
|
||||||
transactionDateFn ReportOpts{..} = if effective_ then transactionEffectiveDate else transactionActualDate
|
transactionDateFn ReportOpts{..} = if effective_ then transactionEffectiveDate else transactionActualDate
|
||||||
|
|
||||||
-- | Convert this journal's transactions' primary date to either the
|
|
||||||
-- actual or effective date, as per options.
|
|
||||||
journalSelectingDateFromOpts :: ReportOpts -> Journal -> Journal
|
|
||||||
journalSelectingDateFromOpts opts = journalSelectingDate (whichDateFromOpts opts)
|
|
||||||
|
|
||||||
-- | Convert this journal's postings' amounts to the cost basis amounts if
|
-- | Convert this journal's postings' amounts to the cost basis amounts if
|
||||||
-- specified by options.
|
-- specified by options.
|
||||||
journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
|
journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
|
||||||
@ -180,7 +174,7 @@ queryFromOpts :: Day -> ReportOpts -> Query
|
|||||||
queryFromOpts d opts@ReportOpts{..} = simplifyQuery $ And $ [flagsq, argsq]
|
queryFromOpts d opts@ReportOpts{..} = simplifyQuery $ And $ [flagsq, argsq]
|
||||||
where
|
where
|
||||||
flagsq = And $
|
flagsq = And $
|
||||||
[Date $ dateSpanFromOpts d opts]
|
[(if effective_ then EDate else Date) $ dateSpanFromOpts d opts]
|
||||||
++ (if real_ then [Real True] else [])
|
++ (if real_ then [Real True] else [])
|
||||||
++ (if empty_ then [Empty True] else []) -- ?
|
++ (if empty_ then [Empty True] else []) -- ?
|
||||||
++ (maybe [] ((:[]) . Status) (clearedValueFromOpts opts))
|
++ (maybe [] ((:[]) . Status) (clearedValueFromOpts opts))
|
||||||
@ -257,19 +251,20 @@ type PostingsReportItem = (Maybe (Day, String) -- posting date and description i
|
|||||||
-- 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 -> Query -> Journal -> PostingsReport
|
||||||
postingsReport opts q j = -- trace ("q: "++show q++"\nq': "++show q') $
|
postingsReport opts q j = -- trace ("q: "++show q++"\nq': "++show q') $
|
||||||
(totallabel, postingsReportItems ps nullposting depth startbal (+))
|
(totallabel, postingsReportItems ps nullposting wd depth startbal (+))
|
||||||
where
|
where
|
||||||
ps | interval == NoInterval = displayableps
|
ps | interval == NoInterval = displayableps
|
||||||
| otherwise = summarisePostingsByInterval interval depth empty reportspan displayableps
|
| otherwise = summarisePostingsByInterval interval depth empty reportspan displayableps
|
||||||
j' = journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
|
j' = journalSelectingAmountFromOpts opts j
|
||||||
-- don't do depth filtering until the end
|
wd = whichDateFromOpts opts
|
||||||
|
-- delay depth filtering until the end
|
||||||
(depth, q') = (queryDepth q, filterQuery (not . queryIsDepth) q)
|
(depth, q') = (queryDepth q, filterQuery (not . queryIsDepth) q)
|
||||||
(precedingps, displayableps, _) = dbg "ps3" $ postingsMatchingDisplayExpr (display_ opts)
|
(precedingps, displayableps, _) = dbg "ps3" $ postingsMatchingDisplayExpr (display_ opts)
|
||||||
$ dbg "ps2" $ filter (q' `matchesPosting`)
|
$ dbg "ps2" $ filter (q' `matchesPosting`)
|
||||||
$ dbg "ps1" $ journalPostings j'
|
$ dbg "ps1" $ journalPostings j'
|
||||||
dbg :: Show a => String -> a -> a
|
dbg :: Show a => String -> a -> a
|
||||||
-- dbg = ltrace
|
|
||||||
dbg = flip const
|
dbg = flip const
|
||||||
|
-- dbg = lstrace
|
||||||
|
|
||||||
empty = queryEmpty q
|
empty = queryEmpty q
|
||||||
displayexpr = display_ opts -- XXX
|
displayexpr = display_ opts -- XXX
|
||||||
@ -292,11 +287,11 @@ totallabel = "Total"
|
|||||||
balancelabel = "Balance"
|
balancelabel = "Balance"
|
||||||
|
|
||||||
-- | Generate postings report line items.
|
-- | Generate postings report line items.
|
||||||
postingsReportItems :: [Posting] -> Posting -> Int -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [PostingsReportItem]
|
postingsReportItems :: [Posting] -> Posting -> WhichDate -> Int -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [PostingsReportItem]
|
||||||
postingsReportItems [] _ _ _ _ = []
|
postingsReportItems [] _ _ _ _ _ = []
|
||||||
postingsReportItems (p:ps) pprev d b sumfn = i:(postingsReportItems ps p d b' sumfn)
|
postingsReportItems (p:ps) pprev wd d b sumfn = i:(postingsReportItems ps p wd d b' sumfn)
|
||||||
where
|
where
|
||||||
i = mkpostingsReportItem isfirstintxn p' b'
|
i = mkpostingsReportItem isfirstintxn wd p' b'
|
||||||
p' = p{paccount=clipAccountName d $ paccount p}
|
p' = p{paccount=clipAccountName d $ paccount p}
|
||||||
isfirstintxn = ptransaction p /= ptransaction pprev
|
isfirstintxn = ptransaction p /= ptransaction pprev
|
||||||
b' = b `sumfn` pamount p
|
b' = b `sumfn` pamount p
|
||||||
@ -304,15 +299,17 @@ postingsReportItems (p:ps) pprev d b sumfn = i:(postingsReportItems ps p d b' su
|
|||||||
-- | Generate one postings report line item, given a flag indicating
|
-- | Generate one postings report line item, given a flag indicating
|
||||||
-- whether to include transaction info, the posting, and the current
|
-- whether to include transaction info, the posting, and the current
|
||||||
-- running balance.
|
-- running balance.
|
||||||
mkpostingsReportItem :: Bool -> Posting -> MixedAmount -> PostingsReportItem
|
mkpostingsReportItem :: Bool -> WhichDate -> Posting -> MixedAmount -> PostingsReportItem
|
||||||
mkpostingsReportItem False p b = (Nothing, p, b)
|
mkpostingsReportItem False _ p b = (Nothing, p, b)
|
||||||
mkpostingsReportItem True p b = (Just (date,desc), p, b)
|
mkpostingsReportItem True wd p b = (Just (date,desc), p, b)
|
||||||
where
|
where
|
||||||
date = postingDate p
|
date = case wd of ActualDate -> postingDate p
|
||||||
|
EffectiveDate -> postingEffectiveDate p
|
||||||
desc = maybe "" tdescription $ ptransaction p
|
desc = maybe "" tdescription $ ptransaction p
|
||||||
|
|
||||||
-- | Date-sort and split a list of postings into three spans - postings matched
|
-- | Date-sort and split a list of postings into three spans - postings matched
|
||||||
-- by the given display expression, and the preceding and following postings.
|
-- by the given display expression, and the preceding and following postings.
|
||||||
|
-- XXX always sorts by primary date, should sort by effective date if expression is about that
|
||||||
postingsMatchingDisplayExpr :: Maybe String -> [Posting] -> ([Posting],[Posting],[Posting])
|
postingsMatchingDisplayExpr :: Maybe String -> [Posting] -> ([Posting],[Posting],[Posting])
|
||||||
postingsMatchingDisplayExpr d ps = (before, matched, after)
|
postingsMatchingDisplayExpr d ps = (before, matched, after)
|
||||||
where
|
where
|
||||||
@ -462,7 +459,7 @@ accountTransactionsReport opts j m thisacctquery = (label, items)
|
|||||||
where
|
where
|
||||||
-- transactions affecting this account, in date order
|
-- transactions affecting this account, in date order
|
||||||
ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctquery) $ jtxns $
|
ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctquery) $ jtxns $
|
||||||
journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
|
journalSelectingAmountFromOpts opts j
|
||||||
-- starting balance: if we are filtering by a start date and nothing else,
|
-- starting balance: if we are filtering by a start date and nothing else,
|
||||||
-- the sum of postings to this account before that date; otherwise zero.
|
-- the sum of postings to this account before that date; otherwise zero.
|
||||||
(startbal,label) | queryIsNull m = (nullmixedamt, balancelabel)
|
(startbal,label) | queryIsNull m = (nullmixedamt, balancelabel)
|
||||||
@ -542,7 +539,7 @@ type AccountsReportItem = (AccountName -- full account name
|
|||||||
accountsReport :: ReportOpts -> Query -> Journal -> AccountsReport
|
accountsReport :: ReportOpts -> Query -> Journal -> AccountsReport
|
||||||
accountsReport opts q j = (items, total)
|
accountsReport opts q j = (items, total)
|
||||||
where
|
where
|
||||||
l = ledgerFromJournal q $ journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
|
l = ledgerFromJournal q $ journalSelectingAmountFromOpts opts j
|
||||||
accts = clipAccounts (queryDepth q) $ ledgerRootAccount l
|
accts = clipAccounts (queryDepth q) $ ledgerRootAccount l
|
||||||
accts'
|
accts'
|
||||||
| flat_ opts = filterzeros $ tail $ flattenAccounts accts
|
| flat_ opts = filterzeros $ tail $ flattenAccounts accts
|
||||||
|
|||||||
@ -7,7 +7,7 @@ A ledger-compatible @register@ command.
|
|||||||
module Hledger.Cli.Register (
|
module Hledger.Cli.Register (
|
||||||
register
|
register
|
||||||
,postingsReportAsText
|
,postingsReportAsText
|
||||||
,showPostingWithBalanceForVty
|
-- ,showPostingWithBalanceForVty
|
||||||
,tests_Hledger_Cli_Register
|
,tests_Hledger_Cli_Register
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@ -66,7 +66,7 @@ postingsReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", ba
|
|||||||
bal = padleft 12 (showMixedAmountWithoutPrice b)
|
bal = padleft 12 (showMixedAmountWithoutPrice b)
|
||||||
|
|
||||||
-- XXX
|
-- XXX
|
||||||
showPostingWithBalanceForVty showtxninfo p b = postingsReportItemAsText defreportopts $ mkpostingsReportItem showtxninfo p b
|
-- showPostingWithBalanceForVty showtxninfo p b = postingsReportItemAsText defreportopts $ mkpostingsReportItem showtxninfo p b
|
||||||
|
|
||||||
tests_Hledger_Cli_Register :: Test
|
tests_Hledger_Cli_Register :: Test
|
||||||
tests_Hledger_Cli_Register = TestList
|
tests_Hledger_Cli_Register = TestList
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user