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