module Ledger.Transaction
where
import Ledger.Utils
import Ledger.Types
import Ledger.Dates
import Ledger.Posting
import Ledger.Amount
instance Show Transaction where show = showTransactionUnelided
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))
nulltransaction :: Transaction
nulltransaction = Transaction {
tdate=nulldate,
teffectivedate=Nothing,
tstatus=False,
tcode="",
tdescription="",
tcomment="",
tpostings=[],
tpreceding_comment_lines=""
}
showTransaction :: Transaction -> String
showTransaction = showTransaction' True False
showTransactionUnelided :: Transaction -> String
showTransactionUnelided = showTransaction' False False
showTransactionForPrint :: Bool -> Transaction -> String
showTransactionForPrint effective = showTransaction' False effective
showTransaction' :: Bool -> Bool -> Transaction -> String
showTransaction' elide effective t =
unlines $ [description] ++ showpostings (tpostings t) ++ [""]
where
description = concat [date, status, code, desc, comment]
date | effective = showdate $ fromMaybe (tdate t) $ teffectivedate t
| otherwise = showdate (tdate t) ++ maybe "" showedate (teffectivedate t)
status = if tstatus t then " *" else ""
code = if length (tcode t) > 0 then printf " (%s)" $ tcode t else ""
desc = ' ' : tdescription t
comment = if null com then "" else " ; " ++ com where com = tcomment t
showdate = printf "%-10s" . showDate
showedate = printf "=%s" . showdate
showpostings ps
| elide && length ps > 1 && isTransactionBalanced 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 ++ printf (printf "%%-%ds" w) (showAccountName Nothing (ptype p) (paccount p))
w = maximum $ map (length . paccount) ps
showamount = printf "%12s" . showMixedAmount
showcomment s = if null s then "" else " ; "++s
showstatus p = if pstatus p then "* " else ""
showAccountName :: Maybe Int -> PostingType -> AccountName -> String
showAccountName w = fmt
where
fmt RegularPosting = take w'
fmt VirtualPosting = parenthesise . reverse . take (w'2) . reverse
fmt BalancedVirtualPosting = bracket . reverse . take (w'2) . reverse
w' = fromMaybe 999999 w
parenthesise s = "("++s++")"
bracket s = "["++s++"]"
isTransactionBalanced :: Transaction -> Bool
isTransactionBalanced (Transaction {tpostings=ps}) =
all (isReallyZeroMixedAmount . costOfMixedAmount . sum . map pamount)
[filter isReal ps, filter isBalancedVirtual ps]
balanceTransaction :: Transaction -> Either String Transaction
balanceTransaction t@Transaction{tpostings=ps}
| length missingamounts' > 1 = Left $ printerr "could not balance this transaction, too many missing amounts"
| not $ isTransactionBalanced t' = Left $ printerr nonzerobalanceerror
| otherwise = Right t'
where
(withamounts, missingamounts) = partition hasAmount $ filter isReal ps
(_, missingamounts') = partition hasAmount ps
t' = t{tpostings=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 (showTransactionUnelided t)
nonzerobalanceerror = "could not balance this transaction, amounts do not add up to zero"
ledgerTransactionWithDate :: WhichDate -> Transaction -> Transaction
ledgerTransactionWithDate ActualDate t = t
ledgerTransactionWithDate EffectiveDate t = txnTieKnot t{tdate=fromMaybe (tdate t) (teffectivedate t)}
txnTieKnot :: Transaction -> Transaction
txnTieKnot t@Transaction{tpostings=ps} = t{tpostings=map (settxn t) ps}
settxn :: Transaction -> Posting -> Posting
settxn t p = p{ptransaction=Just t}