2009-04-03 14:58:05 +04:00
{- |
2012-05-14 22:52:22 +04:00
A 'Transaction' represents a movement of some commodity ( ies ) between two
or more accounts . It consists of multiple account 'Posting's which balance
2012-05-28 02:59:06 +04:00
to zero , a date , and optional extras like description , cleared status , and
tags .
2009-04-03 14:58:05 +04:00
- }
2012-05-07 18:36:40 +04:00
module Hledger.Data.Transaction (
-- * Transaction
2014-08-01 04:32:42 +04:00
nullsourcepos ,
2012-05-07 18:36:40 +04:00
nulltransaction ,
txnTieKnot ,
-- settxn,
-- * operations
showAccountName ,
hasRealPostings ,
realPostings ,
virtualPostings ,
balancedVirtualPostings ,
transactionsPostings ,
isTransactionBalanced ,
-- nonzerobalanceerror,
-- * date operations
2012-12-06 08:43:41 +04:00
transactionDate2 ,
2012-05-07 18:36:40 +04:00
-- * arithmetic
transactionPostingBalances ,
balanceTransaction ,
-- * rendering
showTransaction ,
showTransactionUnelided ,
-- * misc.
tests_Hledger_Data_Transaction
)
2009-04-03 14:58:05 +04:00
where
2011-05-28 08:11:44 +04:00
import Data.List
import Data.Maybe
2011-09-23 18:50:20 +04:00
import Data.Time.Calendar
2011-05-28 08:11:44 +04:00
import Test.HUnit
import Text.Printf
2010-11-15 01:44:37 +03:00
import qualified Data.Map as Map
2014-08-01 04:32:42 +04:00
import Text.Parsec.Pos
2010-11-15 01:44:37 +03:00
2011-05-28 08:11:44 +04:00
import Hledger.Utils
2010-05-20 03:08:53 +04:00
import Hledger.Data.Types
import Hledger.Data.Dates
import Hledger.Data.Posting
import Hledger.Data.Amount
2009-04-03 14:58:05 +04:00
2009-12-16 11:07:26 +03:00
instance Show Transaction where show = showTransactionUnelided
2009-04-03 14:58:05 +04:00
2014-09-11 00:07:53 +04:00
instance Show ModifierTransaction where
2009-09-22 20:51:27 +04:00
show t = " = " ++ mtvalueexpr t ++ " \ n " ++ unlines ( map show ( mtpostings t ) )
2009-04-03 14:58:05 +04:00
2014-09-11 00:07:53 +04:00
instance Show PeriodicTransaction where
2009-09-22 20:51:27 +04:00
show t = " ~ " ++ ptperiodicexpr t ++ " \ n " ++ unlines ( map show ( ptpostings t ) )
2009-04-03 14:58:05 +04:00
2014-08-01 04:32:42 +04:00
nullsourcepos :: SourcePos
nullsourcepos = initialPos " "
2009-12-19 08:57:54 +03:00
nulltransaction :: Transaction
nulltransaction = Transaction {
2014-08-01 04:32:42 +04:00
tsourcepos = nullsourcepos ,
2009-12-19 08:57:54 +03:00
tdate = nulldate ,
2012-12-06 08:43:41 +04:00
tdate2 = Nothing ,
2015-05-16 21:51:35 +03:00
tstatus = Uncleared ,
2014-09-11 00:07:53 +04:00
tcode = " " ,
tdescription = " " ,
2009-12-19 08:57:54 +03:00
tcomment = " " ,
2012-05-28 02:59:06 +04:00
ttags = [] ,
2009-12-19 08:57:54 +03:00
tpostings = [] ,
tpreceding_comment_lines = " "
}
2009-04-03 14:58:05 +04:00
{- |
2010-07-13 10:30:06 +04:00
Show a journal transaction , formatted for the print command . ledger 2 . x's
2009-04-03 14:58:05 +04:00
standard format looks like this :
@
yyyy / mm / dd [ * ] [ CODE ] description ......... [ ; comment ............... ]
account name 1 ..................... ...$ amount1 [ ; comment ............... ]
account name 2 ..................... ..$- amount1 [ ; comment ............... ]
pcodewidth = no limit -- 10 -- mimicking ledger layout.
pdescwidth = no limit -- 20 -- I don't remember what these mean,
pacctwidth = 35 minimum , no maximum -- they were important at the time.
pamtwidth = 11
pcommentwidth = no limit -- 22
@
- }
2009-12-16 11:07:26 +03:00
showTransaction :: Transaction -> String
2011-09-23 18:27:26 +04:00
showTransaction = showTransaction' True
2009-04-03 14:58:05 +04:00
2009-12-16 11:07:26 +03:00
showTransactionUnelided :: Transaction -> String
2011-09-23 18:27:26 +04:00
showTransactionUnelided = showTransaction' False
2009-04-03 14:58:05 +04:00
2012-05-15 05:49:05 +04:00
tests_showTransactionUnelided = [
" showTransactionUnelided " ~: do
let t ` gives ` s = assertEqual " " s ( showTransactionUnelided t )
nulltransaction ` gives ` " 0000/01/01 \ n \ n "
nulltransaction {
tdate = parsedate " 2012/05/14 " ,
2012-12-06 08:43:41 +04:00
tdate2 = Just $ parsedate " 2012/05/15 " ,
2015-05-16 21:51:35 +03:00
tstatus = Uncleared ,
2012-05-15 05:49:05 +04:00
tcode = " code " ,
tdescription = " desc " ,
tcomment = " tcomment1 \ n tcomment2 \ n " ,
2012-05-28 02:59:06 +04:00
ttags = [ ( " ttag1 " , " val1 " ) ] ,
2012-05-15 05:49:05 +04:00
tpostings = [
nullposting {
2015-05-16 21:51:35 +03:00
pstatus = Cleared ,
2012-05-15 05:49:05 +04:00
paccount = " a " ,
2012-11-20 01:20:10 +04:00
pamount = Mixed [ usd 1 , hrs 2 ] ,
2013-09-10 21:32:49 +04:00
pcomment = " \ n pcomment2 \ n " ,
2012-05-15 05:49:05 +04:00
ptype = RegularPosting ,
2012-05-28 02:59:06 +04:00
ptags = [ ( " ptag1 " , " val1 " ) , ( " ptag2 " , " val2 " ) ]
2012-05-15 05:49:05 +04:00
}
]
}
` gives ` unlines [
2013-09-10 21:32:49 +04:00
" 2012/05/14=2012/05/15 (code) desc ; tcomment1 " ,
" ; tcomment2 " ,
2012-05-15 05:49:05 +04:00
" $1.00 " ,
2015-02-27 16:27:24 +03:00
" * a 2.00h " ,
2013-09-10 21:32:49 +04:00
" ; pcomment2 " ,
2012-05-15 05:49:05 +04:00
" "
]
]
2014-05-07 08:35:38 +04:00
-- cf showPosting
2011-09-23 18:27:26 +04:00
showTransaction' :: Bool -> Transaction -> String
showTransaction' elide t =
2012-05-15 05:49:05 +04:00
unlines $ [ descriptionline ]
2013-09-10 21:32:49 +04:00
++ newlinecomments
2012-05-15 05:49:05 +04:00
++ ( postingsAsLines elide t ( tpostings t ) )
++ [ " " ]
2009-04-03 14:58:05 +04:00
where
2013-09-10 21:32:49 +04:00
descriptionline = rstrip $ concat [ date , status , code , desc , samelinecomment ]
2012-12-06 08:43:41 +04:00
date = showdate ( tdate t ) ++ maybe " " showedate ( tdate2 t )
2011-09-23 18:27:26 +04:00
showdate = printf " %-10s " . showDate
showedate = printf " =%s " . showdate
2015-05-16 21:51:35 +03:00
status | tstatus t == Cleared = " * "
| tstatus t == Pending = " ! "
| otherwise = " "
2009-12-16 20:58:51 +03:00
code = if length ( tcode t ) > 0 then printf " (%s) " $ tcode t else " "
2011-01-19 21:55:16 +03:00
desc = if null d then " " else " " ++ d where d = tdescription t
2013-09-10 21:32:49 +04:00
( samelinecomment , newlinecomments ) =
case renderCommentLines ( tcomment t ) of [] -> ( " " , [] )
c : cs -> ( c , cs )
-- Render a transaction or posting's comment as indented, semicolon-prefixed comment lines.
renderCommentLines :: String -> [ String ]
renderCommentLines s = case lines s of ( " " : ls ) -> " " : map commentprefix ls
ls -> map commentprefix ls
2012-12-06 04:28:23 +04:00
where
2013-09-10 21:32:49 +04:00
commentprefix = indent . ( " ; " ++ )
-- -- Render a transaction or posting's comment as semicolon-prefixed comment lines -
-- -- an inline (same-line) comment if it's a single line, otherwise multiple indented lines.
-- commentLines' :: String -> (String, [String])
-- commentLines' s
-- | null s = ("", [])
-- | length ls == 1 = (prefix $ head ls, [])
-- | otherwise = ("", (prefix $ head ls):(map prefix $ tail ls))
-- where
-- ls = lines s
-- prefix = indent . (";"++)
2012-05-15 05:49:05 +04:00
postingsAsLines :: Bool -> Transaction -> [ Posting ] -> [ String ]
postingsAsLines elide t ps
| elide && length ps > 1 && isTransactionBalanced Nothing t -- imprecise balanced check
= ( concatMap ( postingAsLines False ps ) $ init ps ) ++ postingAsLines True ps ( last ps )
| otherwise = concatMap ( postingAsLines False ps ) ps
postingAsLines :: Bool -> [ Posting ] -> Posting -> [ String ]
postingAsLines elideamount ps p =
postinglines
2013-09-10 21:32:49 +04:00
++ newlinecomments
2012-05-15 05:49:05 +04:00
where
2013-09-10 21:32:49 +04:00
postinglines = map rstrip $ lines $ concatTopPadded [ showacct p , " " , amount , samelinecomment ]
2012-05-15 05:49:05 +04:00
amount = if elideamount then " " else showamt ( pamount p )
2013-09-10 21:32:49 +04:00
( samelinecomment , newlinecomments ) =
case renderCommentLines ( pcomment p ) of [] -> ( " " , [] )
c : cs -> ( c , cs )
2012-05-15 05:49:05 +04:00
showacct p =
indent $ showstatus p ++ printf ( printf " %%-%ds " w ) ( showAccountName Nothing ( ptype p ) ( paccount p ) )
where
2015-05-16 21:51:35 +03:00
showstatus p = if pstatus p == Cleared then " * " else " "
2012-05-15 05:49:05 +04:00
w = maximum $ map ( length . paccount ) ps
showamt =
padleft 12 . showMixedAmount
tests_postingAsLines = [
" postingAsLines " ~: do
let p ` gives ` ls = assertEqual " " ls ( postingAsLines False [ p ] p )
2012-12-06 04:28:23 +04:00
posting ` gives ` [ " 0 " ]
posting {
2015-05-16 21:51:35 +03:00
pstatus = Cleared ,
2012-05-15 05:49:05 +04:00
paccount = " a " ,
2012-11-20 01:20:10 +04:00
pamount = Mixed [ usd 1 , hrs 2 ] ,
2012-12-06 04:28:23 +04:00
pcomment = " pcomment1 \ n pcomment2 \ n tag3: val3 \ n " ,
2012-05-15 05:49:05 +04:00
ptype = RegularPosting ,
2012-05-28 02:59:06 +04:00
ptags = [ ( " ptag1 " , " val1 " ) , ( " ptag2 " , " val2 " ) ]
2012-05-15 05:49:05 +04:00
}
` gives ` [
" $1.00 " ,
2015-02-27 16:27:24 +03:00
" * a 2.00h ; pcomment1 " ,
2013-09-10 21:32:49 +04:00
" ; pcomment2 " ,
" ; tag3: val3 "
2012-12-06 04:28:23 +04:00
]
2012-05-15 05:49:05 +04:00
]
indent :: String -> String
indent = ( " " ++ )
2009-04-03 14:58:05 +04:00
2009-05-24 10:22:44 +04:00
-- | Show an account name, clipped to the given width if any, and
-- appropriately bracketed/parenthesised for the given posting type.
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 ++ " ] "
2011-06-29 04:31:37 +04:00
hasRealPostings :: Transaction -> Bool
hasRealPostings = not . null . realPostings
2010-02-27 21:06:29 +03:00
realPostings :: Transaction -> [ Posting ]
realPostings = filter isReal . tpostings
virtualPostings :: Transaction -> [ Posting ]
virtualPostings = filter isVirtual . tpostings
balancedVirtualPostings :: Transaction -> [ Posting ]
balancedVirtualPostings = filter isBalancedVirtual . tpostings
2011-06-11 20:11:38 +04:00
transactionsPostings :: [ Transaction ] -> [ Posting ]
transactionsPostings = concat . map tpostings
2010-02-27 21:06:29 +03:00
-- | Get the sums of a transaction's real, virtual, and balanced virtual postings.
transactionPostingBalances :: Transaction -> ( MixedAmount , MixedAmount , MixedAmount )
transactionPostingBalances t = ( sumPostings $ realPostings t
, sumPostings $ virtualPostings t
, sumPostings $ balancedVirtualPostings t )
-- | Is this transaction balanced ? A balanced transaction's real
-- (non-virtual) postings sum to 0, and any balanced virtual postings
-- also sum to 0.
2012-11-20 01:20:10 +04:00
isTransactionBalanced :: Maybe ( Map . Map Commodity AmountStyle ) -> Transaction -> Bool
isTransactionBalanced styles t =
2010-11-15 01:44:37 +03:00
-- isReallyZeroMixedAmountCost rsum && isReallyZeroMixedAmountCost bvsum
isZeroMixedAmount rsum' && isZeroMixedAmount bvsum'
where
( rsum , _ , bvsum ) = transactionPostingBalances t
2012-11-20 01:20:10 +04:00
rsum' = canonicalise $ costOfMixedAmount rsum
bvsum' = canonicalise $ costOfMixedAmount bvsum
canonicalise = maybe id canonicaliseMixedAmount styles
2010-11-15 01:44:37 +03:00
2015-05-28 00:21:19 +03:00
-- XXX refactor
2011-01-20 03:18:54 +03:00
-- | Ensure this transaction is balanced, possibly inferring a missing
2012-01-03 12:15:48 +04:00
-- amount or conversion price, or return an error message.
2011-01-20 03:18:54 +03:00
--
2012-01-03 12:15:48 +04:00
-- Balancing is affected by commodity display precisions, so those may
-- be provided.
2011-01-20 03:18:54 +03:00
--
2012-01-03 12:15:48 +04:00
-- We can infer a missing real amount when there are multiple real
-- postings and exactly one of them is amountless (likewise for
-- balanced virtual postings). Inferred amounts are converted to cost
-- basis when possible.
2011-01-20 03:18:54 +03:00
--
2012-01-03 12:15:48 +04:00
-- We can infer a conversion price when all real amounts are specified
-- and the sum of real postings' amounts is exactly two
-- non-explicitly-priced amounts in different commodities (likewise
-- for balanced virtual postings).
2012-11-20 01:20:10 +04:00
balanceTransaction :: Maybe ( Map . Map Commodity AmountStyle ) -> Transaction -> Either String Transaction
balanceTransaction styles t @ Transaction { tpostings = ps }
2010-04-14 20:59:02 +04:00
| length rwithoutamounts > 1 || length bvwithoutamounts > 1
2014-01-25 03:27:55 +04:00
= Left $ printerr " could not balance this transaction (can't have more than one missing amount; remember to put 2 or more spaces before amounts) "
2012-11-20 01:20:10 +04:00
| not $ isTransactionBalanced styles t''' = Left $ printerr $ nonzerobalanceerror t'''
2012-12-22 04:24:38 +04:00
| otherwise = Right t''''
2009-04-03 14:58:05 +04:00
where
2011-01-20 03:18:54 +03:00
-- maybe infer missing amounts
( rwithamounts , rwithoutamounts ) = partition hasAmount $ realPostings t
( bvwithamounts , bvwithoutamounts ) = partition hasAmount $ balancedVirtualPostings t
ramounts = map pamount rwithamounts
bvamounts = map pamount bvwithamounts
t' = t { tpostings = map inferamount ps }
2014-09-11 00:07:53 +04:00
where
2012-01-03 12:15:48 +04:00
inferamount p | not ( hasAmount p ) && isReal p = p { pamount = costOfMixedAmount ( - sum ramounts ) }
| not ( hasAmount p ) && isBalancedVirtual p = p { pamount = costOfMixedAmount ( - sum bvamounts ) }
2011-01-20 03:18:54 +03:00
| otherwise = p
-- maybe infer conversion prices, for real postings
rmixedamountsinorder = map pamount $ realPostings t'
ramountsinorder = concatMap amounts rmixedamountsinorder
2012-11-20 01:20:10 +04:00
rcommoditiesinorder = map acommodity ramountsinorder
2011-01-20 03:18:54 +03:00
rsumamounts = amounts $ sum rmixedamountsinorder
2015-05-28 00:21:19 +03:00
-- as it says above, we can infer a conversion price when
t'' = if t' == t -- all real amounts were explicit (we didn't have to infer any)
&& length rsumamounts == 2 -- and the sum of real amounts has exactly two commodities (assumption: summing mixed amounts normalises to one simple amount per commodity)
&& all ( ( == NoPrice ) . aprice ) rsumamounts -- and none of the amounts had explicit prices
2011-01-20 03:18:54 +03:00
then t' { tpostings = map inferprice ps }
else t'
where
2015-05-28 00:21:19 +03:00
inferprice p @ Posting { pamount = Mixed [ a @ Amount { acommodity = c , aprice = NoPrice } ] , ptype = RegularPosting } -- assumption: a posting's mixed amount contains one simple amount
2012-11-20 01:20:10 +04:00
= p { pamount = Mixed [ a { aprice = conversionprice c } ] }
2011-01-20 03:18:54 +03:00
where
conversionprice c | c == unpricedcommodity
2015-05-28 00:21:19 +03:00
-- calculate a price that makes the postings balance, and give it "just enough"
-- display precision that a manual calculation with the displayed numbers
-- shows the transaction balancing.
2011-01-20 03:18:54 +03:00
= if length ramountsinunpricedcommodity == 1
2015-05-28 00:21:19 +03:00
-- when there is only one posting in the target commodity,
-- show a total price (@@) for more exact output. In this
-- case show all available decimal digits, it shouldn't be too many.
2012-11-20 03:24:04 +04:00
then TotalPrice $ abs targetcommodityamount ` withPrecision ` maxprecision
2015-05-28 00:21:19 +03:00
-- otherwise, calculate the average unit conversion price across all postings.
-- Set the precision to the sum of the precisions of the commodities involved,
-- which should be enough to make calculation look right while also preventing
-- irrational numbers from printing excessive digits.
else UnitPrice $ abs unitprice ` withPrecision ` sumofprecisions
2012-11-20 02:39:08 +04:00
| otherwise = NoPrice
2011-01-20 03:18:54 +03:00
where
2012-11-20 01:20:10 +04:00
unpricedcommodity = head $ filter ( ` elem ` ( map acommodity rsumamounts ) ) rcommoditiesinorder
unpricedamount = head $ filter ( ( == unpricedcommodity ) . acommodity ) rsumamounts
targetcommodityamount = head $ filter ( ( /= unpricedcommodity ) . acommodity ) rsumamounts
ramountsinunpricedcommodity = filter ( ( == unpricedcommodity ) . acommodity ) ramountsinorder
2015-05-28 00:21:19 +03:00
unitprice = targetcommodityamount ` divideAmount ` ( aquantity unpricedamount )
sumofprecisions = ( asprecision $ astyle $ targetcommodityamount ) + ( asprecision $ astyle $ unpricedamount )
2011-01-20 03:18:54 +03:00
inferprice p = p
2015-05-28 00:21:19 +03:00
-- maybe infer prices for balanced virtual postings. Duplicates the above. XXX
2011-01-20 03:18:54 +03:00
bvmixedamountsinorder = map pamount $ balancedVirtualPostings t''
bvamountsinorder = concatMap amounts bvmixedamountsinorder
2012-11-20 01:20:10 +04:00
bvcommoditiesinorder = map acommodity bvamountsinorder
2011-01-20 03:18:54 +03:00
bvsumamounts = amounts $ sum bvmixedamountsinorder
2012-11-20 02:39:08 +04:00
t''' = if length bvsumamounts == 2 && all ( ( == NoPrice ) . aprice ) bvsumamounts && t' == t -- XXX could check specifically for bv amount inferring
2011-01-20 03:18:54 +03:00
then t'' { tpostings = map inferprice ps }
else t''
where
2012-11-20 02:39:08 +04:00
inferprice p @ Posting { pamount = Mixed [ a @ Amount { acommodity = c , aprice = NoPrice } ] , ptype = BalancedVirtualPosting }
2012-11-20 01:20:10 +04:00
= p { pamount = Mixed [ a { aprice = conversionprice c } ] }
2011-01-20 03:18:54 +03:00
where
conversionprice c | c == unpricedcommodity
= if length bvamountsinunpricedcommodity == 1
2012-11-20 03:24:04 +04:00
then TotalPrice $ abs targetcommodityamount ` withPrecision ` maxprecision
2015-05-28 00:21:19 +03:00
else UnitPrice $ abs unitprice ` withPrecision ` sumofprecisions
2012-11-20 02:39:08 +04:00
| otherwise = NoPrice
2011-01-20 03:18:54 +03:00
where
2012-11-20 01:20:10 +04:00
unpricedcommodity = head $ filter ( ` elem ` ( map acommodity bvsumamounts ) ) bvcommoditiesinorder
unpricedamount = head $ filter ( ( == unpricedcommodity ) . acommodity ) bvsumamounts
targetcommodityamount = head $ filter ( ( /= unpricedcommodity ) . acommodity ) bvsumamounts
bvamountsinunpricedcommodity = filter ( ( == unpricedcommodity ) . acommodity ) bvamountsinorder
2015-05-28 00:21:19 +03:00
unitprice = targetcommodityamount ` divideAmount ` ( aquantity unpricedamount )
sumofprecisions = ( asprecision $ astyle $ targetcommodityamount ) + ( asprecision $ astyle $ unpricedamount )
2011-01-20 03:18:54 +03:00
inferprice p = p
2012-12-22 04:24:38 +04:00
-- tie the knot so eg relatedPostings works right
t'''' = txnTieKnot t'''
2010-03-10 02:06:27 +03:00
printerr s = intercalate " \ n " [ s , showTransactionUnelided t ]
2009-04-10 12:05:56 +04:00
2010-02-27 21:06:29 +03:00
nonzerobalanceerror :: Transaction -> String
nonzerobalanceerror t = printf " could not balance this transaction (%s%s%s) " rmsg sep bvmsg
where
( rsum , _ , bvsum ) = transactionPostingBalances t
rmsg | isReallyZeroMixedAmountCost rsum = " "
2012-05-27 22:14:20 +04:00
| otherwise = " real postings are off by " ++ showMixedAmount ( costOfMixedAmount rsum )
2010-02-27 21:06:29 +03:00
bvmsg | isReallyZeroMixedAmountCost bvsum = " "
2012-05-27 22:14:20 +04:00
| otherwise = " balanced virtual postings are off by " ++ showMixedAmount ( costOfMixedAmount bvsum )
2012-11-14 21:25:02 +04:00
sep = if not ( null rmsg ) && not ( null bvmsg ) then " ; " else " " :: String
2009-07-09 23:22:27 +04:00
2012-12-06 08:43:41 +04:00
-- Get a transaction's secondary date, defaulting to the primary date.
transactionDate2 :: Transaction -> Day
transactionDate2 t = fromMaybe ( tdate t ) $ tdate2 t
2011-09-23 18:50:20 +04:00
2009-12-21 08:23:07 +03:00
-- | Ensure a transaction's postings refer back to it.
2009-12-19 06:44:52 +03:00
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 }
2009-12-21 08:23:07 +03:00
2012-05-15 05:49:05 +04:00
tests_Hledger_Data_Transaction = TestList $ concat [
tests_postingAsLines ,
tests_showTransactionUnelided ,
[
2010-03-09 06:52:17 +03:00
" showTransaction " ~: do
assertEqual " show a balanced transaction, eliding last amount "
( unlines
[ " 2007/01/28 coopportunity "
, " expenses:food:groceries $47.18 "
, " assets:checking "
, " "
] )
2015-05-16 21:51:35 +03:00
( let t = Transaction nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Uncleared " " " coopportunity " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " expenses:food:groceries " , pamount = Mixed [ usd 47.18 ] , ptransaction = Just t }
, posting { paccount = " assets:checking " , pamount = Mixed [ usd ( - 47.18 ) ] , ptransaction = Just t }
2010-03-09 06:52:17 +03:00
] " "
in showTransaction t )
, " showTransaction " ~: do
assertEqual " show a balanced transaction, no eliding "
( unlines
[ " 2007/01/28 coopportunity "
, " expenses:food:groceries $47.18 "
, " assets:checking $-47.18 "
, " "
] )
2015-05-16 21:51:35 +03:00
( let t = Transaction nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Uncleared " " " coopportunity " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " expenses:food:groceries " , pamount = Mixed [ usd 47.18 ] , ptransaction = Just t }
, posting { paccount = " assets:checking " , pamount = Mixed [ usd ( - 47.18 ) ] , ptransaction = Just t }
2010-03-09 06:52:17 +03:00
] " "
in showTransactionUnelided t )
-- document some cases that arise in debug/testing:
, " showTransaction " ~: do
assertEqual " show an unbalanced transaction, should not elide "
( unlines
[ " 2007/01/28 coopportunity "
, " expenses:food:groceries $47.18 "
, " assets:checking $-47.19 "
, " "
] )
( showTransaction
2015-05-16 21:51:35 +03:00
( txnTieKnot $ Transaction nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Uncleared " " " coopportunity " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " expenses:food:groceries " , pamount = Mixed [ usd 47.18 ] }
, posting { paccount = " assets:checking " , pamount = Mixed [ usd ( - 47.19 ) ] }
2010-03-09 06:52:17 +03:00
] " " ) )
, " showTransaction " ~: do
assertEqual " show an unbalanced transaction with one posting, should not elide "
( unlines
[ " 2007/01/28 coopportunity "
, " expenses:food:groceries $47.18 "
, " "
] )
( showTransaction
2015-05-16 21:51:35 +03:00
( txnTieKnot $ Transaction nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Uncleared " " " coopportunity " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " expenses:food:groceries " , pamount = Mixed [ usd 47.18 ] }
2010-03-09 06:52:17 +03:00
] " " ) )
, " showTransaction " ~: do
assertEqual " show a transaction with one posting and a missing amount "
( unlines
[ " 2007/01/28 coopportunity "
2012-05-15 05:49:05 +04:00
, " expenses:food:groceries "
2010-03-09 06:52:17 +03:00
, " "
] )
( showTransaction
2015-05-16 21:51:35 +03:00
( txnTieKnot $ Transaction nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Uncleared " " " coopportunity " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " expenses:food:groceries " , pamount = missingmixedamt }
2010-03-09 06:52:17 +03:00
] " " ) )
, " showTransaction " ~: do
assertEqual " show a transaction with a priced commodityless amount "
( unlines
[ " 2010/01/01 x "
, " a 1 @ $2 "
2012-05-15 05:49:05 +04:00
, " b "
2010-03-09 06:52:17 +03:00
, " "
] )
( showTransaction
2015-05-16 21:51:35 +03:00
( txnTieKnot $ Transaction nullsourcepos ( parsedate " 2010/01/01 " ) Nothing Uncleared " " " x " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " a " , pamount = Mixed [ num 1 ` at ` ( usd 2 ` withPrecision ` 0 ) ] }
, posting { paccount = " b " , pamount = missingmixedamt }
2010-03-09 06:52:17 +03:00
] " " ) )
2010-12-27 23:26:22 +03:00
, " balanceTransaction " ~: do
assertBool " detect unbalanced entry, sign error "
( isLeft $ balanceTransaction Nothing
2015-05-16 21:51:35 +03:00
( Transaction nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Uncleared " " " test " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " a " , pamount = Mixed [ usd 1 ] }
, posting { paccount = " b " , pamount = Mixed [ usd 1 ] }
2010-12-27 23:26:22 +03:00
] " " ) )
2012-11-12 20:31:43 +04:00
2010-12-27 23:26:22 +03:00
assertBool " detect unbalanced entry, multiple missing amounts "
( isLeft $ balanceTransaction Nothing
2015-05-16 21:51:35 +03:00
( Transaction nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Uncleared " " " test " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " a " , pamount = missingmixedamt }
, posting { paccount = " b " , pamount = missingmixedamt }
2010-12-27 23:26:22 +03:00
] " " ) )
2012-11-12 20:31:43 +04:00
2015-05-16 21:51:35 +03:00
let e = balanceTransaction Nothing ( Transaction nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Uncleared " " " " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " a " , pamount = Mixed [ usd 1 ] }
, posting { paccount = " b " , pamount = missingmixedamt }
2010-12-27 23:26:22 +03:00
] " " )
2011-01-20 03:18:54 +03:00
assertBool " balanceTransaction allows one missing amount " ( isRight e )
assertEqual " balancing amount is inferred "
2012-11-20 01:20:10 +04:00
( Mixed [ usd ( - 1 ) ] )
2010-12-27 23:26:22 +03:00
( case e of
Right e' -> ( pamount $ last $ tpostings e' )
Left _ -> error ' " s h o u l d n o t h a p p e n " )
2012-11-12 20:31:43 +04:00
2015-05-16 21:51:35 +03:00
let e = balanceTransaction Nothing ( Transaction nullsourcepos ( parsedate " 2011/01/01 " ) Nothing Uncleared " " " " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " a " , pamount = Mixed [ usd 1.35 ] }
, posting { paccount = " b " , pamount = Mixed [ eur ( - 1 ) ] }
2011-01-20 03:18:54 +03:00
] " " )
assertBool " balanceTransaction can infer conversion price " ( isRight e )
assertEqual " balancing conversion price is inferred "
2012-11-20 03:24:04 +04:00
( Mixed [ usd 1.35 @@ ( eur 1 ` withPrecision ` maxprecision ) ] )
2011-01-20 03:18:54 +03:00
( case e of
Right e' -> ( pamount $ head $ tpostings e' )
Left _ -> error ' " s h o u l d n o t h a p p e n " )
2010-12-27 23:26:22 +03:00
2012-11-12 20:31:43 +04:00
assertBool " balanceTransaction balances based on cost if there are unit prices " ( isRight $
2015-05-16 21:51:35 +03:00
balanceTransaction Nothing ( Transaction nullsourcepos ( parsedate " 2011/01/01 " ) Nothing Uncleared " " " " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " a " , pamount = Mixed [ usd 1 ` at ` eur 2 ] }
, posting { paccount = " a " , pamount = Mixed [ usd ( - 2 ) ` at ` eur 1 ] }
2012-11-12 20:31:43 +04:00
] " " ) )
assertBool " balanceTransaction balances based on cost if there are total prices " ( isRight $
2015-05-16 21:51:35 +03:00
balanceTransaction Nothing ( Transaction nullsourcepos ( parsedate " 2011/01/01 " ) Nothing Uncleared " " " " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " a " , pamount = Mixed [ usd 1 @@ eur 1 ] }
, posting { paccount = " a " , pamount = Mixed [ usd ( - 2 ) @@ eur 1 ] }
2012-11-12 20:31:43 +04:00
] " " ) )
2010-12-27 23:26:22 +03:00
, " isTransactionBalanced " ~: do
2015-05-16 21:51:35 +03:00
let t = Transaction nullsourcepos ( parsedate " 2009/01/01 " ) Nothing Uncleared " " " a " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " b " , pamount = Mixed [ usd 1.00 ] , ptransaction = Just t }
, posting { paccount = " c " , pamount = Mixed [ usd ( - 1.00 ) ] , ptransaction = Just t }
2010-12-27 23:26:22 +03:00
] " "
assertBool " detect balanced " ( isTransactionBalanced Nothing t )
2015-05-16 21:51:35 +03:00
let t = Transaction nullsourcepos ( parsedate " 2009/01/01 " ) Nothing Uncleared " " " a " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " b " , pamount = Mixed [ usd 1.00 ] , ptransaction = Just t }
, posting { paccount = " c " , pamount = Mixed [ usd ( - 1.01 ) ] , ptransaction = Just t }
2010-12-27 23:26:22 +03:00
] " "
assertBool " detect unbalanced " ( not $ isTransactionBalanced Nothing t )
2015-05-16 21:51:35 +03:00
let t = Transaction nullsourcepos ( parsedate " 2009/01/01 " ) Nothing Uncleared " " " a " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " b " , pamount = Mixed [ usd 1.00 ] , ptransaction = Just t }
2010-12-27 23:26:22 +03:00
] " "
assertBool " detect unbalanced, one posting " ( not $ isTransactionBalanced Nothing t )
2015-05-16 21:51:35 +03:00
let t = Transaction nullsourcepos ( parsedate " 2009/01/01 " ) Nothing Uncleared " " " a " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " b " , pamount = Mixed [ usd 0 ] , ptransaction = Just t }
2010-12-27 23:26:22 +03:00
] " "
assertBool " one zero posting is considered balanced for now " ( isTransactionBalanced Nothing t )
2015-05-16 21:51:35 +03:00
let t = Transaction nullsourcepos ( parsedate " 2009/01/01 " ) Nothing Uncleared " " " a " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " b " , pamount = Mixed [ usd 1.00 ] , ptransaction = Just t }
, posting { paccount = " c " , pamount = Mixed [ usd ( - 1.00 ) ] , ptransaction = Just t }
, posting { paccount = " d " , pamount = Mixed [ usd 100 ] , ptype = VirtualPosting , ptransaction = Just t }
2010-12-27 23:26:22 +03:00
] " "
assertBool " virtual postings don't need to balance " ( isTransactionBalanced Nothing t )
2015-05-16 21:51:35 +03:00
let t = Transaction nullsourcepos ( parsedate " 2009/01/01 " ) Nothing Uncleared " " " a " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " b " , pamount = Mixed [ usd 1.00 ] , ptransaction = Just t }
, posting { paccount = " c " , pamount = Mixed [ usd ( - 1.00 ) ] , ptransaction = Just t }
, posting { paccount = " d " , pamount = Mixed [ usd 100 ] , ptype = BalancedVirtualPosting , ptransaction = Just t }
2010-12-27 23:26:22 +03:00
] " "
assertBool " balanced virtual postings need to balance among themselves " ( not $ isTransactionBalanced Nothing t )
2015-05-16 21:51:35 +03:00
let t = Transaction nullsourcepos ( parsedate " 2009/01/01 " ) Nothing Uncleared " " " a " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " b " , pamount = Mixed [ usd 1.00 ] , ptransaction = Just t }
, posting { paccount = " c " , pamount = Mixed [ usd ( - 1.00 ) ] , ptransaction = Just t }
, posting { paccount = " d " , pamount = Mixed [ usd 100 ] , ptype = BalancedVirtualPosting , ptransaction = Just t }
, posting { paccount = " 3 " , pamount = Mixed [ usd ( - 100 ) ] , ptype = BalancedVirtualPosting , ptransaction = Just t }
2010-12-27 23:26:22 +03:00
] " "
assertBool " balanced virtual postings need to balance among themselves (2) " ( isTransactionBalanced Nothing t )
2012-05-15 05:49:05 +04:00
] ]