module Ledger.LedgerTransaction
where
import Ledger.Utils
import Ledger.Types
import Ledger.Dates
import Ledger.Posting
import Ledger.Amount
instance Show LedgerTransaction where show = showLedgerTransaction
instance Show ModifierTransaction where
show t = "= " ++ (mtvalueexpr t) ++ "\n" ++ unlines (map show (mtpostings t))
instance Show PeriodicTransaction where
show t = "~ " ++ (ptperiodicexpr t) ++ "\n" ++ unlines (map show (ptpostings t))
nullledgertxn :: LedgerTransaction
nullledgertxn = LedgerTransaction {
ltdate=parsedate "1900/1/1",
ltstatus=False,
ltcode="",
ltdescription="",
ltcomment="",
ltpostings=[],
ltpreceding_comment_lines=""
}
showLedgerTransaction :: LedgerTransaction -> String
showLedgerTransaction = showLedgerTransaction' True
showLedgerTransactionUnelided :: LedgerTransaction -> String
showLedgerTransactionUnelided = showLedgerTransaction' False
showLedgerTransaction' :: Bool -> LedgerTransaction -> String
showLedgerTransaction' elide t =
unlines $ [description] ++ (showpostings $ ltpostings t) ++ [""]
where
precedingcomment = ltpreceding_comment_lines t
description = concat [date, status, code, desc]
date = showdate $ ltdate t
status = if ltstatus t then " *" else ""
code = if (length $ ltcode t) > 0 then (printf " (%s)" $ ltcode t) else ""
desc = " " ++ ltdescription t
comment = if (length $ ltcomment t) > 0 then " ; "++(ltcomment t) else ""
showdate d = printf "%-10s" (showDate d)
showpostings ps
| elide && length ps > 1 && isLedgerTransactionBalanced t
= map showposting (init ps) ++ [showpostingnoamt (last ps)]
| otherwise = map showposting ps
where
showposting p = showacct p ++ " " ++ (showamount $ pamount p) ++ (showcomment $ pcomment p)
showpostingnoamt p = rstrip $ showacct p ++ " " ++ (showcomment $ pcomment p)
showacct p = " " ++ showstatus p ++ (showaccountname $ paccount p)
showamount = printf "%12s" . showMixedAmount
showaccountname s = printf "%-34s" s
showcomment s = if (length s) > 0 then " ; "++s else ""
showstatus p = if pstatus p then "* " else ""
isLedgerTransactionBalanced :: LedgerTransaction -> Bool
isLedgerTransactionBalanced (LedgerTransaction {ltpostings=ps}) =
all (isReallyZeroMixedAmount . costOfMixedAmount . sum . map pamount)
[filter isReal ps, filter isBalancedVirtual ps]
balanceLedgerTransaction :: LedgerTransaction -> Either String LedgerTransaction
balanceLedgerTransaction t@LedgerTransaction{ltpostings=ps}
| length missingamounts > 1 = Left $ printerr "could not balance this transaction, too many missing amounts"
| not $ isLedgerTransactionBalanced t' = Left $ printerr nonzerobalanceerror
| otherwise = Right t'
where
(withamounts, missingamounts) = partition hasAmount $ filter isReal ps
t' = t{ltpostings=ps'}
ps' | length missingamounts == 1 = map balance ps
| otherwise = ps
where
balance p | isReal p && not (hasAmount p) = p{pamount = costOfMixedAmount (otherstotal)}
| otherwise = p
where otherstotal = sum $ map pamount withamounts
printerr s = printf "%s:\n%s" s (showLedgerTransactionUnelided t)
nonzerobalanceerror = "could not balance this transaction, amounts do not add up to zero"