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:
Simon Michael 2012-12-06 02:41:37 +00:00
parent ccbc071289
commit 20e68f23a8
8 changed files with 54 additions and 50 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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