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

make Postings reference their parent Transaction

Browse Source 
With this change, Transactions and Postings reference each other
co-recursively.  This makes constructing them more tedious, but it
may also allow LedgerPostings to be dropped and code to be simplified.
Time and space performance of register and balance is as before.
This commit is contained in:
Simon Michael 2009-12-19 03:44:52 +00:00
parent 8405072ff6
commit ec95b0723c
10 changed files with 126 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
Commands/Convert.hs
View File

@ -256,8 +256,7 @@ transactionFromCsvRecord rules fields =
unknownacct | (readDef 0 amountstr' :: Double) < 0 = "income:unknown"
| otherwise = "expenses:unknown"
(acct,newdesc) = identify (accountRules rules) unknownacct desc
in
Transaction {
t = Transaction {
tdate=date,
teffectivedate=Nothing,
tstatus=status,
@ -271,17 +270,20 @@ transactionFromCsvRecord rules fields =
paccount=acct,
pamount=amount,
pcomment="",
ptype=RegularPosting
ptype=RegularPosting,
ptransaction=Just t
},
Posting {
pstatus=False,
paccount=baseAccount rules,
pamount=(-amount),
pcomment="",
ptype=RegularPosting
ptype=RegularPosting,
ptransaction=Just t
}
]
}
in t
-- | Convert some date string with unknown format to YYYY/MM/DD.
normaliseDate :: String -> String

2
Commands/Register.hs
View File

@ -114,7 +114,7 @@ showlp omitdesc lp b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n"
datewidth = 10
descwidth = datedescwidth - datewidth - 2
desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String
p = showPostingWithoutPrice $ Posting s a amt "" tt
p = showPostingWithoutPrice $ Posting s a amt "" tt Nothing
bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b)
LedgerPosting{lpstatus=s,lpdate=da,lpdescription=de,lpaccount=a,lpamount=amt,lptype=tt} = lp

4
Commands/Web.hs
View File

@ -310,8 +310,8 @@ handleAddform l = do
,tdescription=desc
,tcomment=""
,tpostings=[
Posting False acct1 amt1' "" RegularPosting
,Posting False acct2 amt2' "" RegularPosting
Posting False acct1 amt1' "" RegularPosting (Just t')
,Posting False acct2 amt2' "" RegularPosting (Just t')
]
,tpreceding_comment_lines=""
}

2
Ledger/Journal.hs
View File

@ -140,7 +140,7 @@ canonicaliseAmounts costbasis rl@(Journal ms ps ts tls hs f fp ft) = Journal ms
where
fixledgertransaction (Transaction d ed s c de co ts pr) = Transaction d ed s c de co (map fixrawposting ts) pr
where
fixrawposting (Posting s ac a c t) = Posting s ac (fixmixedamount a) c t
fixrawposting (Posting s ac a c t txn) = Posting s ac (fixmixedamount a) c t txn
fixmixedamount (Mixed as) = Mixed $ map fixamount as
fixamount = (if costbasis then costOfAmount else id) . fixprice . fixcommodity
fixcommodity a = a{commodity=c} where c = canonicalcommoditymap ! symbol (commodity a)

4
Ledger/Parse.hs
View File

@ -317,7 +317,7 @@ ledgerTransaction = do
comment <- ledgercomment <|> return ""
restofline
postings <- ledgerpostings
let t = Transaction date edate status code description comment postings ""
let t = txnTieKnot $ Transaction date edate status code description comment postings ""
case balanceTransaction t of
Right t' -> return t'
Left err -> fail err
@ -392,7 +392,7 @@ ledgerposting = do
many spacenonewline
comment <- ledgercomment <|> return ""
restofline
return (Posting status account' amount comment ptype)
return (Posting status account' amount comment ptype Nothing)
-- Qualify with the parent account from parsing context
transactionaccountname :: GenParser Char LedgerFileCtx AccountName

10
Ledger/Posting.hs
View File

@ -19,29 +19,29 @@ import Ledger.AccountName
instance Show Posting where show = showPosting
nullrawposting = Posting False "" nullmixedamt "" RegularPosting
nullrawposting = Posting False "" nullmixedamt "" RegularPosting Nothing
showPosting :: Posting -> String
showPosting (Posting _ a amt com lptype) =
showPosting (Posting{paccount=a,pamount=amt,pcomment=com,ptype=t}) =
concatTopPadded [showaccountname a ++ " ", showamount amt, comment]
where
ledger3ishlayout = False
acctnamewidth = if ledger3ishlayout then 25 else 22
showaccountname = printf ("%-"++(show acctnamewidth)++"s") . bracket . elideAccountName width
(bracket,width) = case lptype of
(bracket,width) = case t of
BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth-2)
VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2)
_ -> (id,acctnamewidth)
showamount = padleft 12 . showMixedAmountOrZero
comment = if null com then "" else " ; " ++ com
-- XXX refactor
showPostingWithoutPrice (Posting _ a amt com lptype) =
showPostingWithoutPrice (Posting{paccount=a,pamount=amt,pcomment=com,ptype=t}) =
concatTopPadded [showaccountname a ++ " ", showamount amt, comment]
where
ledger3ishlayout = False
acctnamewidth = if ledger3ishlayout then 25 else 22
showaccountname = printf ("%-"++(show acctnamewidth)++"s") . bracket . elideAccountName width
(bracket,width) = case lptype of
(bracket,width) = case t of
BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth-2)
VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2)
_ -> (id,acctnamewidth)

3
Ledger/TimeLog.hs
View File

@ -84,6 +84,7 @@ entryFromTimeLogInOut i o
idate = localDay itime
hrs = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc
amount = Mixed [hours hrs]
ps = [Posting False acctname amount "" RegularPosting
ps = [Posting{pstatus=False,paccount=acctname,pamount=amount,
pcomment="",ptype=RegularPosting,ptransaction=Just t}
--,Posting "assets:time" (-amount) "" RegularPosting
]

8
Ledger/Transaction.hs
View File

@ -131,3 +131,11 @@ ledgerTransactionWithDate :: WhichDate -> Transaction -> Transaction
ledgerTransactionWithDate ActualDate t = t
ledgerTransactionWithDate EffectiveDate t = t{tdate=fromMaybe (tdate t) (teffectivedate t)}
-- | Ensure a transaction's postings refer to it as their transaction.
txnTieKnot :: Transaction -> Transaction
txnTieKnot t@Transaction{tpostings=ps} = t{tpostings=map (settxn t) ps}
-- | Set a posting's parent transaction.
settxn :: Transaction -> Posting -> Posting
settxn t p = p{ptransaction=Just t}

4
Ledger/Types.hs
View File

@ -74,7 +74,9 @@ data Posting = Posting {
paccount :: AccountName,
pamount :: MixedAmount,
pcomment :: String,
ptype :: PostingType
ptype :: PostingType,
ptransaction :: Maybe Transaction -- ^ this posting's parent transaction (co-recursive types).
-- Tying this knot gets tedious, Maybe makes it easier/optional.
} deriving (Eq)
data ModifierTransaction = ModifierTransaction {

187
Tests.hs
View File

@ -310,18 +310,18 @@ tests = [
assertBool "detect unbalanced entry, sign error"
(isLeft $ balanceTransaction
(Transaction (parsedate "2007/01/28") Nothing False "" "test" ""
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting,
Posting False "b" (Mixed [dollars 1]) "" RegularPosting
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting Nothing,
Posting False "b" (Mixed [dollars 1]) "" RegularPosting Nothing
] ""))
assertBool "detect unbalanced entry, multiple missing amounts"
(isLeft $ balanceTransaction
(Transaction (parsedate "2007/01/28") Nothing False "" "test" ""
[Posting False "a" missingamt "" RegularPosting,
Posting False "b" missingamt "" RegularPosting
[Posting False "a" missingamt "" RegularPosting Nothing,
Posting False "b" missingamt "" RegularPosting Nothing
] ""))
let e = balanceTransaction (Transaction (parsedate "2007/01/28") Nothing False "" "test" ""
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting,
Posting False "b" missingamt "" RegularPosting
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting Nothing,
Posting False "b" missingamt "" RegularPosting Nothing
] "")
assertBool "one missing amount should be ok" (isRight e)
assertEqual "balancing amount is added"
@ -405,50 +405,43 @@ tests = [
"my assets" `isAccountNamePrefixOf` "assets:bank" `is` False
,"isTransactionBalanced" ~: do
assertBool "detect balanced"
(isTransactionBalanced
(Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting
] ""))
assertBool "detect unbalanced"
(not $ isTransactionBalanced
(Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
,Posting False "c" (Mixed [dollars (-1.01)]) "" RegularPosting
] ""))
assertBool "detect unbalanced, one posting"
(not $ isTransactionBalanced
(Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
] ""))
assertBool "one zero posting is considered balanced for now"
(isTransactionBalanced
(Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 0]) "" RegularPosting
] ""))
assertBool "virtual postings don't need to balance"
(isTransactionBalanced
(Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting
,Posting False "d" (Mixed [dollars 100]) "" VirtualPosting
] ""))
assertBool "balanced virtual postings need to balance among themselves"
(not $ isTransactionBalanced
(Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting
,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting
] ""))
assertBool "balanced virtual postings need to balance among themselves (2)"
(isTransactionBalanced
(Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting
,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting
,Posting False "e" (Mixed [dollars (-100)]) "" BalancedVirtualPosting
] ""))
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting (Just t)
] ""
assertBool "detect balanced" (isTransactionBalanced t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)
,Posting False "c" (Mixed [dollars (-1.01)]) "" RegularPosting (Just t)
] ""
assertBool "detect unbalanced" (not $ isTransactionBalanced t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)
] ""
assertBool "detect unbalanced, one posting" (not $ isTransactionBalanced t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 0]) "" RegularPosting (Just t)
] ""
assertBool "one zero posting is considered balanced for now" (isTransactionBalanced t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting (Just t)
,Posting False "d" (Mixed [dollars 100]) "" VirtualPosting (Just t)
] ""
assertBool "virtual postings don't need to balance" (isTransactionBalanced t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting (Just t)
,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting (Just t)
] ""
assertBool "balanced virtual postings need to balance among themselves" (not $ isTransactionBalanced t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting (Just t)
,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting (Just t)
,Posting False "e" (Mixed [dollars (-100)]) "" BalancedVirtualPosting (Just t)
] ""
assertBool "balanced virtual postings need to balance among themselves (2)" (isTransactionBalanced t)
,"isSubAccountNameOf" ~: do
"assets" `isSubAccountNameOf` "assets" `is` False
@ -678,11 +671,11 @@ tests = [
," assets:checking"
,""
])
(showTransaction
(Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting
,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting
] ""))
(let t = Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting (Just t)
,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting (Just t)
] ""
in showTransaction t)
assertEqual "show a balanced transaction, no eliding"
(unlines
["2007/01/28 coopportunity"
@ -690,11 +683,11 @@ tests = [
," assets:checking $-47.18"
,""
])
(showTransactionUnelided
(Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting
,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting
] ""))
(let t = Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting (Just t)
,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting (Just t)
] ""
in showTransactionUnelided t)
-- document some cases that arise in debug/testing:
assertEqual "show an unbalanced transaction, should not elide"
(unlines
@ -704,9 +697,9 @@ tests = [
,""
])
(showTransaction
(Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting
,Posting False "assets:checking" (Mixed [dollars (-47.19)]) "" RegularPosting
(txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting Nothing
,Posting False "assets:checking" (Mixed [dollars (-47.19)]) "" RegularPosting Nothing
] ""))
assertEqual "show an unbalanced transaction with one posting, should not elide"
(unlines
@ -715,8 +708,8 @@ tests = [
,""
])
(showTransaction
(Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting
(txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting Nothing
] ""))
assertEqual "show a transaction with one posting and a missing amount"
(unlines
@ -725,8 +718,8 @@ tests = [
,""
])
(showTransaction
(Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" missingamt "" RegularPosting
(txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" missingamt "" RegularPosting Nothing
] ""))
,"unicode in balance layout" ~: do
@ -906,19 +899,19 @@ write_sample_ledger = writeFile "sample.ledger" sample_ledger_str
rawposting1_str = " expenses:food:dining $10.00\n"
rawposting1 = Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting
rawposting1 = Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting Nothing
entry1_str = unlines
["2007/01/28 coopportunity"
," expenses:food:groceries $47.18"
," assets:checking"
," assets:checking $-47.18"
,""
]
entry1 =
Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting,
Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting] ""
txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting Nothing,
Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting Nothing] ""
entry2_str = unlines
@ -1064,7 +1057,7 @@ journal7 = Journal
[]
[]
[
Transaction {
txnTieKnot $ Transaction {
tdate=parsedate "2007/01/01",
teffectivedate=Nothing,
tstatus=False,
@ -1077,20 +1070,22 @@ journal7 = Journal
paccount="assets:cash",
pamount=(Mixed [dollars 4.82]),
pcomment="",
ptype=RegularPosting
ptype=RegularPosting,
ptransaction=Nothing
},
Posting {
pstatus=False,
paccount="equity:opening balances",
pamount=(Mixed [dollars (-4.82)]),
pcomment="",
ptype=RegularPosting
ptype=RegularPosting,
ptransaction=Nothing
}
],
tpreceding_comment_lines=""
}
,
Transaction {
txnTieKnot $ Transaction {
tdate=parsedate "2007/02/01",
teffectivedate=Nothing,
tstatus=False,
@ -1103,20 +1098,22 @@ journal7 = Journal
paccount="expenses:vacation",
pamount=(Mixed [dollars 179.92]),
pcomment="",
ptype=RegularPosting
ptype=RegularPosting,
ptransaction=Nothing
},
Posting {
pstatus=False,
paccount="assets:checking",
pamount=(Mixed [dollars (-179.92)]),
pcomment="",
ptype=RegularPosting
ptype=RegularPosting,
ptransaction=Nothing
}
],
tpreceding_comment_lines=""
}
,
Transaction {
txnTieKnot $ Transaction {
tdate=parsedate "2007/01/02",
teffectivedate=Nothing,
tstatus=False,
@ -1129,20 +1126,22 @@ journal7 = Journal
paccount="assets:saving",
pamount=(Mixed [dollars 200]),
pcomment="",
ptype=RegularPosting
ptype=RegularPosting,
ptransaction=Nothing
},
Posting {
pstatus=False,
paccount="assets:checking",
pamount=(Mixed [dollars (-200)]),
pcomment="",
ptype=RegularPosting
ptype=RegularPosting,
ptransaction=Nothing
}
],
tpreceding_comment_lines=""
}
,
Transaction {
txnTieKnot $ Transaction {
tdate=parsedate "2007/01/03",
teffectivedate=Nothing,
tstatus=False,
@ -1155,20 +1154,22 @@ journal7 = Journal
paccount="expenses:food:dining",
pamount=(Mixed [dollars 4.82]),
pcomment="",
ptype=RegularPosting
ptype=RegularPosting,
ptransaction=Nothing
},
Posting {
pstatus=False,
paccount="assets:cash",
pamount=(Mixed [dollars (-4.82)]),
pcomment="",
ptype=RegularPosting
ptype=RegularPosting,
ptransaction=Nothing
}
],
tpreceding_comment_lines=""
}
,
Transaction {
txnTieKnot $ Transaction {
tdate=parsedate "2007/01/03",
teffectivedate=Nothing,
tstatus=False,
@ -1181,20 +1182,22 @@ journal7 = Journal
paccount="expenses:phone",
pamount=(Mixed [dollars 95.11]),
pcomment="",
ptype=RegularPosting
ptype=RegularPosting,
ptransaction=Nothing
},
Posting {
pstatus=False,
paccount="assets:checking",
pamount=(Mixed [dollars (-95.11)]),
pcomment="",
ptype=RegularPosting
ptype=RegularPosting,
ptransaction=Nothing
}
],
tpreceding_comment_lines=""
}
,
Transaction {
txnTieKnot $ Transaction {
tdate=parsedate "2007/01/03",
teffectivedate=Nothing,
tstatus=False,
@ -1207,14 +1210,16 @@ journal7 = Journal
paccount="liabilities:credit cards:discover",
pamount=(Mixed [dollars 80]),
pcomment="",
ptype=RegularPosting
ptype=RegularPosting,
ptransaction=Nothing
},
Posting {
pstatus=False,
paccount="assets:checking",
pamount=(Mixed [dollars (-80)]),
pcomment="",
ptype=RegularPosting
ptype=RegularPosting,
ptransaction=Nothing
}
],
tpreceding_comment_lines=""
@ -1253,7 +1258,7 @@ journalWithAmounts as =
Journal
[]
[]
[nullledgertxn{tdescription=a,tpostings=[nullrawposting{pamount=parse a}]} | a <- as]
[t | a <- as, let t = nullledgertxn{tdescription=a,tpostings=[nullrawposting{pamount=parse a,ptransaction=Just t}]}]
[]
[]
""