slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

support effective dates on postings as well

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
MANUAL.md
View File

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

8
hledger-lib/Hledger/Data/Journal.hs
View File

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

23
hledger-lib/Hledger/Data/Posting.hs
View File

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

13
hledger-lib/Hledger/Data/Transaction.hs
View File

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

3
hledger-lib/Hledger/Data/Types.hs
View File

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

6
hledger-lib/Hledger/Read/JournalReader.hs
View File

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

39
hledger-lib/Hledger/Reports.hs
View File

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

4
hledger/Hledger/Cli/Register.hs
View File

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