diff --git a/Commands/Convert.hs b/Commands/Convert.hs index d94f60ec9..f4f5e483f 100644 --- a/Commands/Convert.hs +++ b/Commands/Convert.hs @@ -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 diff --git a/Commands/Register.hs b/Commands/Register.hs index 120866ab5..37f732af3 100644 --- a/Commands/Register.hs +++ b/Commands/Register.hs @@ -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 diff --git a/Commands/Web.hs b/Commands/Web.hs index ff385b82a..576ccd651 100644 --- a/Commands/Web.hs +++ b/Commands/Web.hs @@ -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="" } diff --git a/Ledger/Journal.hs b/Ledger/Journal.hs index 48562d15e..d3f9b8e14 100644 --- a/Ledger/Journal.hs +++ b/Ledger/Journal.hs @@ -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) diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index eb189c8a9..b71bf1960 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -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 diff --git a/Ledger/Posting.hs b/Ledger/Posting.hs index 677f2e84b..082f051a4 100644 --- a/Ledger/Posting.hs +++ b/Ledger/Posting.hs @@ -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) diff --git a/Ledger/TimeLog.hs b/Ledger/TimeLog.hs index f81507c76..2a9bf46c2 100644 --- a/Ledger/TimeLog.hs +++ b/Ledger/TimeLog.hs @@ -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 ] diff --git a/Ledger/Transaction.hs b/Ledger/Transaction.hs index be669b5a9..24a0bcf0a 100644 --- a/Ledger/Transaction.hs +++ b/Ledger/Transaction.hs @@ -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} diff --git a/Ledger/Types.hs b/Ledger/Types.hs index de2777c25..b02f3b969 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -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 { diff --git a/Tests.hs b/Tests.hs index e1d34b5be..e546d5980 100644 --- a/Tests.hs +++ b/Tests.hs @@ -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}]}] [] [] ""