diff --git a/MANUAL.md b/MANUAL.md index f5776f1f3..a1d3d94b9 100644 --- a/MANUAL.md +++ b/MANUAL.md @@ -411,13 +411,13 @@ NAME=EXACTVALUE` on the command line. ### Posting dates You can give individual postings a different date from their parent -transaction, by adding posting tag `date:ACTUALDATE`. If present, this -date will be used by the register and balance reports. +transaction, by adding posting tag `date:ACTUALDATE`. The effective date +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 (`[ACTUALDATE]`, `[ACTUALDATE=EFFECTIVEDATE]` or `[=EFFECTIVEDATE]` in a -posting comment) and treated as an alterate spelling of the date: tag. -Note effective dates are not csurrently here are ignored, currently. +posting comment) and treated as an alterate spelling of the date tags. ### Including other files diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index af8b6bd11..6802242d4 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -18,7 +18,6 @@ module Hledger.Data.Journal ( journalCanonicaliseAmounts, journalConvertAmountsToCost, journalFinalise, - journalSelectingDate, -- * Filtering filterJournalPostings, 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. journalApplyAliases :: [(AccountName,AccountName)] -> Journal -> Journal journalApplyAliases aliases j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 93b791368..bc7ea75d9 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -64,6 +64,7 @@ instance Show Posting where show = showPosting nullposting, posting :: Posting nullposting = Posting {pdate=Nothing + ,pdate2=Nothing ,pstatus=False ,paccount="" ,pamount=nullmixedamt @@ -126,21 +127,25 @@ accountNamesFromPostings = nub . map paccount sumPostings :: [Posting] -> MixedAmount sumPostings = sum . map pamount --- | Get a posting's (primary) date - it's own date if specified, --- otherwise the parent transaction's primary date (otherwise the null --- date). +-- | Get a posting's (primary) date - it's own primary date if specified, +-- otherwise the parent transaction's primary date, or the null date if +-- there is no parent transaction. postingDate :: Posting -> Day postingDate p = fromMaybe txndate $ pdate p where txndate = maybe nulldate tdate $ ptransaction p --- | Get a posting's secondary (effective) date - it's own primary date if --- specified (can't access posting secondary dates yet), otherwise the --- parent transaction's effective date, otherwise the null date. +-- | Get a posting's secondary (effective) date, which is the first of: +-- posting's secondary date, transaction's secondary date, posting's +-- primary date, transaction's primary date, or the null date if there is +-- no parent transaction. postingEffectiveDate :: Posting -> Day -postingEffectiveDate p = maybe nulldate transactionEffectiveDate $ ptransaction p - where - transactionEffectiveDate t = fromMaybe (tdate t) $ teffectivedate t +postingEffectiveDate p = headDef nulldate $ catMaybes dates + where dates = [pdate2 p + ,maybe Nothing teffectivedate $ ptransaction p + ,pdate p + ,maybe Nothing (Just . tdate) $ ptransaction p + ] -- |Is this posting cleared? If this posting was individually marked -- as cleared, returns True. Otherwise, return the parent diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 136b3a2c0..d43b47be3 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -24,7 +24,7 @@ module Hledger.Data.Transaction ( -- * date operations transactionActualDate, transactionEffectiveDate, - journalTransactionWithDate, + transactionWithDate, -- * arithmetic transactionPostingBalances, 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 -- the actual or effective date. A bit hacky. -journalTransactionWithDate :: WhichDate -> Transaction -> Transaction -journalTransactionWithDate ActualDate t = t -journalTransactionWithDate EffectiveDate t = txnTieKnot t{tdate=transactionEffectiveDate t} +transactionWithDate :: WhichDate -> Transaction -> Transaction +transactionWithDate ActualDate t = 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. txnTieKnot :: Transaction -> Transaction diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 7e114f8e0..39bc73ec7 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -77,6 +77,7 @@ type Tag = (String, String) data Posting = Posting { 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, paccount :: AccountName, pamount :: MixedAmount, @@ -90,7 +91,7 @@ data Posting = Posting { -- The equality test for postings ignores the parent transaction's -- identity, to avoid infinite loops. 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 { tdate :: Day, diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 4cb935d36..eccb1cdce 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -514,7 +514,8 @@ postingp = do comment <- try followingcomment <|> (newline >> return "") let tags = tagsInComment comment 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 test_postingp = do @@ -888,6 +889,9 @@ test_ledgerDateSyntaxToTags = do dateFromTags :: [Tag] -> Maybe Day 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 diff --git a/hledger-lib/Hledger/Reports.hs b/hledger-lib/Hledger/Reports.hs index 036f07bbe..a2f1f5bb2 100644 --- a/hledger-lib/Hledger/Reports.hs +++ b/hledger-lib/Hledger/Reports.hs @@ -18,7 +18,6 @@ module Hledger.Reports ( intervalFromOpts, clearedValueFromOpts, whichDateFromOpts, - journalSelectingDateFromOpts, journalSelectingAmountFromOpts, queryFromOpts, queryOptsFromOpts, @@ -163,11 +162,6 @@ whichDateFromOpts ReportOpts{..} = if effective_ then EffectiveDate else ActualD transactionDateFn :: ReportOpts -> (Transaction -> Day) 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 -- specified by options. journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal @@ -180,7 +174,7 @@ queryFromOpts :: Day -> ReportOpts -> Query queryFromOpts d opts@ReportOpts{..} = simplifyQuery $ And $ [flagsq, argsq] where flagsq = And $ - [Date $ dateSpanFromOpts d opts] + [(if effective_ then EDate else Date) $ dateSpanFromOpts d opts] ++ (if real_ then [Real True] else []) ++ (if empty_ then [Empty True] else []) -- ? ++ (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. postingsReport :: ReportOpts -> Query -> Journal -> PostingsReport 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 ps | interval == NoInterval = displayableps | otherwise = summarisePostingsByInterval interval depth empty reportspan displayableps - j' = journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j - -- don't do depth filtering until the end + j' = journalSelectingAmountFromOpts opts j + wd = whichDateFromOpts opts + -- delay depth filtering until the end (depth, q') = (queryDepth q, filterQuery (not . queryIsDepth) q) (precedingps, displayableps, _) = dbg "ps3" $ postingsMatchingDisplayExpr (display_ opts) $ dbg "ps2" $ filter (q' `matchesPosting`) $ dbg "ps1" $ journalPostings j' dbg :: Show a => String -> a -> a - -- dbg = ltrace dbg = flip const + -- dbg = lstrace empty = queryEmpty q displayexpr = display_ opts -- XXX @@ -292,11 +287,11 @@ totallabel = "Total" balancelabel = "Balance" -- | Generate postings report line items. -postingsReportItems :: [Posting] -> Posting -> Int -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [PostingsReportItem] -postingsReportItems [] _ _ _ _ = [] -postingsReportItems (p:ps) pprev d b sumfn = i:(postingsReportItems ps p d b' sumfn) +postingsReportItems :: [Posting] -> Posting -> WhichDate -> Int -> MixedAmount -> (MixedAmount -> MixedAmount -> MixedAmount) -> [PostingsReportItem] +postingsReportItems [] _ _ _ _ _ = [] +postingsReportItems (p:ps) pprev wd d b sumfn = i:(postingsReportItems ps p wd d b' sumfn) where - i = mkpostingsReportItem isfirstintxn p' b' + i = mkpostingsReportItem isfirstintxn wd p' b' p' = p{paccount=clipAccountName d $ paccount p} isfirstintxn = ptransaction p /= ptransaction pprev 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 -- whether to include transaction info, the posting, and the current -- running balance. -mkpostingsReportItem :: Bool -> Posting -> MixedAmount -> PostingsReportItem -mkpostingsReportItem False p b = (Nothing, p, b) -mkpostingsReportItem True p b = (Just (date,desc), p, b) +mkpostingsReportItem :: Bool -> WhichDate -> Posting -> MixedAmount -> PostingsReportItem +mkpostingsReportItem False _ p b = (Nothing, p, b) +mkpostingsReportItem True wd p b = (Just (date,desc), p, b) where - date = postingDate p + date = case wd of ActualDate -> postingDate p + EffectiveDate -> postingEffectiveDate p desc = maybe "" tdescription $ ptransaction p -- | Date-sort and split a list of postings into three spans - postings matched -- 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 d ps = (before, matched, after) where @@ -462,7 +459,7 @@ accountTransactionsReport opts j m thisacctquery = (label, items) where -- transactions affecting this account, in date order 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, -- the sum of postings to this account before that date; otherwise zero. (startbal,label) | queryIsNull m = (nullmixedamt, balancelabel) @@ -542,7 +539,7 @@ type AccountsReportItem = (AccountName -- full account name accountsReport :: ReportOpts -> Query -> Journal -> AccountsReport accountsReport opts q j = (items, total) where - l = ledgerFromJournal q $ journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j + l = ledgerFromJournal q $ journalSelectingAmountFromOpts opts j accts = clipAccounts (queryDepth q) $ ledgerRootAccount l accts' | flat_ opts = filterzeros $ tail $ flattenAccounts accts diff --git a/hledger/Hledger/Cli/Register.hs b/hledger/Hledger/Cli/Register.hs index af2fe6382..3fde73dca 100644 --- a/hledger/Hledger/Cli/Register.hs +++ b/hledger/Hledger/Cli/Register.hs @@ -7,7 +7,7 @@ A ledger-compatible @register@ command. module Hledger.Cli.Register ( register ,postingsReportAsText - ,showPostingWithBalanceForVty + -- ,showPostingWithBalanceForVty ,tests_Hledger_Cli_Register ) where @@ -66,7 +66,7 @@ postingsReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", ba bal = padleft 12 (showMixedAmountWithoutPrice b) -- 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 = TestList