2016-12-10 18:04:48 +03:00
{- # LANGUAGE FlexibleContexts # -}
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
- }
2017-01-20 18:33:24 +03:00
{- # LANGUAGE OverloadedStrings, LambdaCase # -}
lib: textification begins! account names
The first of several conversions from String to (strict) Text, hopefully
reducing space and time usage.
This one shows a small improvement, with GHC 7.10.3 and text-1.2.2.1:
hledger -f data/100x100x10.journal stats
string: <<ghc: 39471064 bytes, 77 GCs, 198421/275048 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.001 elapsed), 0.015 MUT (0.020 elapsed), 0.010 GC (0.014 elapsed) :ghc>>
text: <<ghc: 39268024 bytes, 77 GCs, 197018/270840 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.002 elapsed), 0.016 MUT (0.022 elapsed), 0.009 GC (0.011 elapsed) :ghc>>
hledger -f data/1000x100x10.journal stats
string: <<ghc: 318555920 bytes, 617 GCs, 2178997/7134472 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.001 elapsed), 0.129 MUT (0.136 elapsed), 0.067 GC (0.077 elapsed) :ghc>>
text: <<ghc: 314248496 bytes, 612 GCs, 2074045/6617960 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.003 elapsed), 0.137 MUT (0.145 elapsed), 0.067 GC (0.079 elapsed) :ghc>>
hledger -f data/10000x100x10.journal stats
string: <<ghc: 3114763608 bytes, 6026 GCs, 18858950/75552024 avg/max bytes residency (11 samples), 201M in use, 0.000 INIT (0.000 elapsed), 1.331 MUT (1.372 elapsed), 0.699 GC (0.812 elapsed) :ghc>>
text: <<ghc: 3071468920 bytes, 5968 GCs, 14120344/62951360 avg/max bytes residency (9 samples), 124M in use, 0.000 INIT (0.003 elapsed), 1.272 MUT (1.349 elapsed), 0.513 GC (0.578 elapsed) :ghc>>
hledger -f data/100000x100x10.journal stats
string: <<ghc: 31186579432 bytes, 60278 GCs, 135332581/740228992 avg/max bytes residency (13 samples), 1697M in use, 0.000 INIT (0.008 elapsed), 14.677 MUT (15.508 elapsed), 7.081 GC (8.074 elapsed) :ghc>>
text: <<ghc: 30753427672 bytes, 59763 GCs, 117595958/666457240 avg/max bytes residency (14 samples), 1588M in use, 0.000 INIT (0.008 elapsed), 13.713 MUT (13.966 elapsed), 6.220 GC (7.108 elapsed) :ghc>>
2016-05-24 04:16:21 +03: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 ,
lib: textification begins! account names
The first of several conversions from String to (strict) Text, hopefully
reducing space and time usage.
This one shows a small improvement, with GHC 7.10.3 and text-1.2.2.1:
hledger -f data/100x100x10.journal stats
string: <<ghc: 39471064 bytes, 77 GCs, 198421/275048 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.001 elapsed), 0.015 MUT (0.020 elapsed), 0.010 GC (0.014 elapsed) :ghc>>
text: <<ghc: 39268024 bytes, 77 GCs, 197018/270840 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.002 elapsed), 0.016 MUT (0.022 elapsed), 0.009 GC (0.011 elapsed) :ghc>>
hledger -f data/1000x100x10.journal stats
string: <<ghc: 318555920 bytes, 617 GCs, 2178997/7134472 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.001 elapsed), 0.129 MUT (0.136 elapsed), 0.067 GC (0.077 elapsed) :ghc>>
text: <<ghc: 314248496 bytes, 612 GCs, 2074045/6617960 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.003 elapsed), 0.137 MUT (0.145 elapsed), 0.067 GC (0.079 elapsed) :ghc>>
hledger -f data/10000x100x10.journal stats
string: <<ghc: 3114763608 bytes, 6026 GCs, 18858950/75552024 avg/max bytes residency (11 samples), 201M in use, 0.000 INIT (0.000 elapsed), 1.331 MUT (1.372 elapsed), 0.699 GC (0.812 elapsed) :ghc>>
text: <<ghc: 3071468920 bytes, 5968 GCs, 14120344/62951360 avg/max bytes residency (9 samples), 124M in use, 0.000 INIT (0.003 elapsed), 1.272 MUT (1.349 elapsed), 0.513 GC (0.578 elapsed) :ghc>>
hledger -f data/100000x100x10.journal stats
string: <<ghc: 31186579432 bytes, 60278 GCs, 135332581/740228992 avg/max bytes residency (13 samples), 1697M in use, 0.000 INIT (0.008 elapsed), 14.677 MUT (15.508 elapsed), 7.081 GC (8.074 elapsed) :ghc>>
text: <<ghc: 30753427672 bytes, 59763 GCs, 117595958/666457240 avg/max bytes residency (14 samples), 1588M in use, 0.000 INIT (0.008 elapsed), 13.713 MUT (13.966 elapsed), 6.220 GC (7.108 elapsed) :ghc>>
2016-05-24 04:16:21 +03:00
txnUntieKnot ,
2012-05-07 18:36:40 +04:00
-- * operations
showAccountName ,
hasRealPostings ,
realPostings ,
2016-12-10 18:04:48 +03:00
assignmentPostings ,
2012-05-07 18:36:40 +04:00
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 ,
2016-12-10 18:04:48 +03:00
balanceTransactionUpdate ,
2012-05-07 18:36:40 +04:00
-- * rendering
showTransaction ,
showTransactionUnelided ,
2015-10-30 04:05:02 +03:00
showTransactionUnelidedOneLineAmounts ,
2016-02-10 18:39:03 +03:00
showPostingLine ,
2017-01-20 18:33:24 +03:00
showPostingLines ,
-- * GenericSourcePos
sourceFilePath ,
sourceFirstLine ,
showGenericSourcePos ,
2012-05-07 18:36:40 +04:00
-- * 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
2016-12-10 18:04:48 +03:00
import Control.Monad.Except
import Control.Monad.Identity
2011-05-28 08:11:44 +04:00
import Data.Maybe
lib: textification: comments and tags
No change.
hledger -f data/100x100x10.journal stats
<<ghc: 42859576 bytes, 84 GCs, 193781/269984 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.001 elapsed), 0.016 MUT (0.020 elapsed), 0.009 GC (0.011 elapsed) :ghc>>
<<ghc: 42859576 bytes, 84 GCs, 193781/269984 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.001 elapsed), 0.015 MUT (0.018 elapsed), 0.009 GC (0.013 elapsed) :ghc>>
hledger -f data/1000x1000x10.journal stats
<<ghc: 349576344 bytes, 681 GCs, 1407388/4091680 avg/max bytes residency (7 samples), 11M in use, 0.000 INIT (0.000 elapsed), 0.124 MUT (0.130 elapsed), 0.047 GC (0.055 elapsed) :ghc>>
<<ghc: 349576280 bytes, 681 GCs, 1407388/4091680 avg/max bytes residency (7 samples), 11M in use, 0.000 INIT (0.000 elapsed), 0.126 MUT (0.132 elapsed), 0.049 GC (0.058 elapsed) :ghc>>
hledger -f data/10000x1000x10.journal stats
<<ghc: 3424030664 bytes, 6658 GCs, 11403359/41071624 avg/max bytes residency (11 samples), 111M in use, 0.000 INIT (0.000 elapsed), 1.207 MUT (1.228 elapsed), 0.473 GC (0.528 elapsed) :ghc>>
<<ghc: 3424030760 bytes, 6658 GCs, 11403874/41077288 avg/max bytes residency (11 samples), 111M in use, 0.000 INIT (0.002 elapsed), 1.234 MUT (1.256 elapsed), 0.470 GC (0.520 elapsed) :ghc>>
hledger -f data/100000x1000x10.journal stats
<<ghc: 34306547448 bytes, 66727 GCs, 76805504/414629288 avg/max bytes residency (14 samples), 1009M in use, 0.000 INIT (0.003 elapsed), 12.615 MUT (12.813 elapsed), 4.656 GC (5.291 elapsed) :ghc>>
<<ghc: 34306547320 bytes, 66727 GCs, 76805504/414629288 avg/max bytes residency (14 samples), 1009M in use, 0.000 INIT (0.009 elapsed), 12.802 MUT (13.065 elapsed), 4.774 GC (5.441 elapsed) :ghc>>
2016-05-25 03:09:20 +03:00
import Data.Text ( Text )
lib: textification begins! account names
The first of several conversions from String to (strict) Text, hopefully
reducing space and time usage.
This one shows a small improvement, with GHC 7.10.3 and text-1.2.2.1:
hledger -f data/100x100x10.journal stats
string: <<ghc: 39471064 bytes, 77 GCs, 198421/275048 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.001 elapsed), 0.015 MUT (0.020 elapsed), 0.010 GC (0.014 elapsed) :ghc>>
text: <<ghc: 39268024 bytes, 77 GCs, 197018/270840 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.002 elapsed), 0.016 MUT (0.022 elapsed), 0.009 GC (0.011 elapsed) :ghc>>
hledger -f data/1000x100x10.journal stats
string: <<ghc: 318555920 bytes, 617 GCs, 2178997/7134472 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.001 elapsed), 0.129 MUT (0.136 elapsed), 0.067 GC (0.077 elapsed) :ghc>>
text: <<ghc: 314248496 bytes, 612 GCs, 2074045/6617960 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.003 elapsed), 0.137 MUT (0.145 elapsed), 0.067 GC (0.079 elapsed) :ghc>>
hledger -f data/10000x100x10.journal stats
string: <<ghc: 3114763608 bytes, 6026 GCs, 18858950/75552024 avg/max bytes residency (11 samples), 201M in use, 0.000 INIT (0.000 elapsed), 1.331 MUT (1.372 elapsed), 0.699 GC (0.812 elapsed) :ghc>>
text: <<ghc: 3071468920 bytes, 5968 GCs, 14120344/62951360 avg/max bytes residency (9 samples), 124M in use, 0.000 INIT (0.003 elapsed), 1.272 MUT (1.349 elapsed), 0.513 GC (0.578 elapsed) :ghc>>
hledger -f data/100000x100x10.journal stats
string: <<ghc: 31186579432 bytes, 60278 GCs, 135332581/740228992 avg/max bytes residency (13 samples), 1697M in use, 0.000 INIT (0.008 elapsed), 14.677 MUT (15.508 elapsed), 7.081 GC (8.074 elapsed) :ghc>>
text: <<ghc: 30753427672 bytes, 59763 GCs, 117595958/666457240 avg/max bytes residency (14 samples), 1588M in use, 0.000 INIT (0.008 elapsed), 13.713 MUT (13.966 elapsed), 6.220 GC (7.108 elapsed) :ghc>>
2016-05-24 04:16:21 +03:00
import qualified Data.Text as T
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
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
lib: textification: descriptions & codes
Slightly higher (with small files) and lower (with large files) maximum
residency, and slightly quicker for all.
hledger -f data/100x100x10.journal stats
<<ghc: 42858472 bytes, 84 GCs, 193712/269608 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.015 elapsed), 0.016 MUT (0.042 elapsed), 0.011 GC (0.119 elapsed) :ghc>>
<<ghc: 42891776 bytes, 84 GCs, 190816/260920 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.004 elapsed), 0.017 MUT (0.025 elapsed), 0.010 GC (0.015 elapsed) :ghc>>
hledger -f data/1000x1000x10.journal stats
<<ghc: 349575240 bytes, 681 GCs, 1396425/4091680 avg/max bytes residency (7 samples), 11M in use, 0.000 INIT (0.000 elapsed), 0.137 MUT (0.146 elapsed), 0.050 GC (0.057 elapsed) :ghc>>
<<ghc: 349927568 bytes, 681 GCs, 1397825/4097248 avg/max bytes residency (7 samples), 11M in use, 0.000 INIT (0.000 elapsed), 0.126 MUT (0.133 elapsed), 0.050 GC (0.057 elapsed) :ghc>>
hledger -f data/10000x1000x10.journal stats
<<ghc: 3424029496 bytes, 6658 GCs, 11403141/41077288 avg/max bytes residency (11 samples), 111M in use, 0.000 INIT (0.000 elapsed), 1.278 MUT (1.310 elapsed), 0.493 GC (0.546 elapsed) :ghc>>
<<ghc: 3427418064 bytes, 6665 GCs, 11127869/37790168 avg/max bytes residency (11 samples), 109M in use, 0.000 INIT (0.001 elapsed), 1.212 MUT (1.229 elapsed), 0.466 GC (0.519 elapsed) :ghc>>
hledger -f data/100000x1000x10.journal stats
<<ghc: 34306546248 bytes, 66727 GCs, 77030638/414617944 avg/max bytes residency (14 samples), 1012M in use, 0.000 INIT (0.000 elapsed), 12.965 MUT (13.164 elapsed), 4.771 GC (5.447 elapsed) :ghc>>
<<ghc: 34340246056 bytes, 66779 GCs, 76983178/416011480 avg/max bytes residency (14 samples), 1011M in use, 0.000 INIT (0.008 elapsed), 12.666 MUT (12.836 elapsed), 4.595 GC (5.175 elapsed) :ghc>>
2016-05-25 04:51:52 +03:00
show t = " = " ++ T . unpack ( 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
lib: textification: descriptions & codes
Slightly higher (with small files) and lower (with large files) maximum
residency, and slightly quicker for all.
hledger -f data/100x100x10.journal stats
<<ghc: 42858472 bytes, 84 GCs, 193712/269608 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.015 elapsed), 0.016 MUT (0.042 elapsed), 0.011 GC (0.119 elapsed) :ghc>>
<<ghc: 42891776 bytes, 84 GCs, 190816/260920 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.004 elapsed), 0.017 MUT (0.025 elapsed), 0.010 GC (0.015 elapsed) :ghc>>
hledger -f data/1000x1000x10.journal stats
<<ghc: 349575240 bytes, 681 GCs, 1396425/4091680 avg/max bytes residency (7 samples), 11M in use, 0.000 INIT (0.000 elapsed), 0.137 MUT (0.146 elapsed), 0.050 GC (0.057 elapsed) :ghc>>
<<ghc: 349927568 bytes, 681 GCs, 1397825/4097248 avg/max bytes residency (7 samples), 11M in use, 0.000 INIT (0.000 elapsed), 0.126 MUT (0.133 elapsed), 0.050 GC (0.057 elapsed) :ghc>>
hledger -f data/10000x1000x10.journal stats
<<ghc: 3424029496 bytes, 6658 GCs, 11403141/41077288 avg/max bytes residency (11 samples), 111M in use, 0.000 INIT (0.000 elapsed), 1.278 MUT (1.310 elapsed), 0.493 GC (0.546 elapsed) :ghc>>
<<ghc: 3427418064 bytes, 6665 GCs, 11127869/37790168 avg/max bytes residency (11 samples), 109M in use, 0.000 INIT (0.001 elapsed), 1.212 MUT (1.229 elapsed), 0.466 GC (0.519 elapsed) :ghc>>
hledger -f data/100000x1000x10.journal stats
<<ghc: 34306546248 bytes, 66727 GCs, 77030638/414617944 avg/max bytes residency (14 samples), 1012M in use, 0.000 INIT (0.000 elapsed), 12.965 MUT (13.164 elapsed), 4.771 GC (5.447 elapsed) :ghc>>
<<ghc: 34340246056 bytes, 66779 GCs, 76983178/416011480 avg/max bytes residency (14 samples), 1011M in use, 0.000 INIT (0.008 elapsed), 12.666 MUT (12.836 elapsed), 4.595 GC (5.175 elapsed) :ghc>>
2016-05-25 04:51:52 +03:00
show t = " ~ " ++ T . unpack ( ptperiodicexpr t ) ++ " \ n " ++ unlines ( map show ( ptpostings t ) )
2009-04-03 14:58:05 +04:00
2017-01-20 18:33:24 +03:00
sourceFilePath :: GenericSourcePos -> FilePath
sourceFilePath = \ case
GenericSourcePos fp _ _ -> fp
JournalSourcePos fp _ -> fp
sourceFirstLine :: GenericSourcePos -> Int
sourceFirstLine = \ case
GenericSourcePos _ line _ -> line
JournalSourcePos _ ( line , _ ) -> line
showGenericSourcePos :: GenericSourcePos -> String
showGenericSourcePos = \ case
GenericSourcePos fp line column -> show fp ++ " (line " ++ show line ++ " , column " ++ show column ++ " ) "
JournalSourcePos fp ( line , line' ) -> show fp ++ " (lines " ++ show line ++ " - " ++ show line' ++ " ) "
2015-06-29 02:20:28 +03:00
nullsourcepos :: GenericSourcePos
nullsourcepos = GenericSourcePos " " 1 1
2014-08-01 04:32:42 +04:00
2009-12-19 08:57:54 +03:00
nulltransaction :: Transaction
nulltransaction = Transaction {
2015-10-30 06:12:46 +03:00
tindex = 0 ,
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
2015-10-30 04:05:02 +03:00
showTransaction = showTransactionHelper True False
2009-04-03 14:58:05 +04:00
2009-12-16 11:07:26 +03:00
showTransactionUnelided :: Transaction -> String
2015-10-30 04:05:02 +03:00
showTransactionUnelided = showTransactionHelper False 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 " ,
2017-01-11 07:44:10 +03:00
" * a $1.00 " ,
" ; pcomment2 " ,
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
" "
]
]
2015-10-30 04:05:02 +03:00
showTransactionUnelidedOneLineAmounts :: Transaction -> String
showTransactionUnelidedOneLineAmounts = showTransactionHelper False True
2014-05-07 08:35:38 +04:00
-- cf showPosting
2015-10-30 04:05:02 +03:00
showTransactionHelper :: Bool -> Bool -> Transaction -> String
showTransactionHelper elide onelineamounts t =
2012-05-15 05:49:05 +04:00
unlines $ [ descriptionline ]
2013-09-10 21:32:49 +04:00
++ newlinecomments
2015-10-30 04:05:02 +03:00
++ ( postingsAsLines elide onelineamounts t ( tpostings t ) )
2012-05-15 05:49:05 +04:00
++ [ " " ]
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 ]
2015-10-10 21:53:28 +03:00
date = showDate ( tdate t ) ++ maybe " " ( ( " = " ++ ) . showDate ) ( tdate2 t )
2015-05-16 21:51:35 +03:00
status | tstatus t == Cleared = " * "
| tstatus t == Pending = " ! "
| otherwise = " "
lib: textification: descriptions & codes
Slightly higher (with small files) and lower (with large files) maximum
residency, and slightly quicker for all.
hledger -f data/100x100x10.journal stats
<<ghc: 42858472 bytes, 84 GCs, 193712/269608 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.015 elapsed), 0.016 MUT (0.042 elapsed), 0.011 GC (0.119 elapsed) :ghc>>
<<ghc: 42891776 bytes, 84 GCs, 190816/260920 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.004 elapsed), 0.017 MUT (0.025 elapsed), 0.010 GC (0.015 elapsed) :ghc>>
hledger -f data/1000x1000x10.journal stats
<<ghc: 349575240 bytes, 681 GCs, 1396425/4091680 avg/max bytes residency (7 samples), 11M in use, 0.000 INIT (0.000 elapsed), 0.137 MUT (0.146 elapsed), 0.050 GC (0.057 elapsed) :ghc>>
<<ghc: 349927568 bytes, 681 GCs, 1397825/4097248 avg/max bytes residency (7 samples), 11M in use, 0.000 INIT (0.000 elapsed), 0.126 MUT (0.133 elapsed), 0.050 GC (0.057 elapsed) :ghc>>
hledger -f data/10000x1000x10.journal stats
<<ghc: 3424029496 bytes, 6658 GCs, 11403141/41077288 avg/max bytes residency (11 samples), 111M in use, 0.000 INIT (0.000 elapsed), 1.278 MUT (1.310 elapsed), 0.493 GC (0.546 elapsed) :ghc>>
<<ghc: 3427418064 bytes, 6665 GCs, 11127869/37790168 avg/max bytes residency (11 samples), 109M in use, 0.000 INIT (0.001 elapsed), 1.212 MUT (1.229 elapsed), 0.466 GC (0.519 elapsed) :ghc>>
hledger -f data/100000x1000x10.journal stats
<<ghc: 34306546248 bytes, 66727 GCs, 77030638/414617944 avg/max bytes residency (14 samples), 1012M in use, 0.000 INIT (0.000 elapsed), 12.965 MUT (13.164 elapsed), 4.771 GC (5.447 elapsed) :ghc>>
<<ghc: 34340246056 bytes, 66779 GCs, 76983178/416011480 avg/max bytes residency (14 samples), 1011M in use, 0.000 INIT (0.008 elapsed), 12.666 MUT (12.836 elapsed), 4.595 GC (5.175 elapsed) :ghc>>
2016-05-25 04:51:52 +03:00
code = if T . length ( tcode t ) > 0 then printf " (%s) " $ T . unpack $ tcode t else " "
desc = if null d then " " else " " ++ d where d = T . unpack $ 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.
lib: textification: comments and tags
No change.
hledger -f data/100x100x10.journal stats
<<ghc: 42859576 bytes, 84 GCs, 193781/269984 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.001 elapsed), 0.016 MUT (0.020 elapsed), 0.009 GC (0.011 elapsed) :ghc>>
<<ghc: 42859576 bytes, 84 GCs, 193781/269984 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.001 elapsed), 0.015 MUT (0.018 elapsed), 0.009 GC (0.013 elapsed) :ghc>>
hledger -f data/1000x1000x10.journal stats
<<ghc: 349576344 bytes, 681 GCs, 1407388/4091680 avg/max bytes residency (7 samples), 11M in use, 0.000 INIT (0.000 elapsed), 0.124 MUT (0.130 elapsed), 0.047 GC (0.055 elapsed) :ghc>>
<<ghc: 349576280 bytes, 681 GCs, 1407388/4091680 avg/max bytes residency (7 samples), 11M in use, 0.000 INIT (0.000 elapsed), 0.126 MUT (0.132 elapsed), 0.049 GC (0.058 elapsed) :ghc>>
hledger -f data/10000x1000x10.journal stats
<<ghc: 3424030664 bytes, 6658 GCs, 11403359/41071624 avg/max bytes residency (11 samples), 111M in use, 0.000 INIT (0.000 elapsed), 1.207 MUT (1.228 elapsed), 0.473 GC (0.528 elapsed) :ghc>>
<<ghc: 3424030760 bytes, 6658 GCs, 11403874/41077288 avg/max bytes residency (11 samples), 111M in use, 0.000 INIT (0.002 elapsed), 1.234 MUT (1.256 elapsed), 0.470 GC (0.520 elapsed) :ghc>>
hledger -f data/100000x1000x10.journal stats
<<ghc: 34306547448 bytes, 66727 GCs, 76805504/414629288 avg/max bytes residency (14 samples), 1009M in use, 0.000 INIT (0.003 elapsed), 12.615 MUT (12.813 elapsed), 4.656 GC (5.291 elapsed) :ghc>>
<<ghc: 34306547320 bytes, 66727 GCs, 76805504/414629288 avg/max bytes residency (14 samples), 1009M in use, 0.000 INIT (0.009 elapsed), 12.802 MUT (13.065 elapsed), 4.774 GC (5.441 elapsed) :ghc>>
2016-05-25 03:09:20 +03:00
renderCommentLines :: Text -> [ String ]
renderCommentLines t = case lines $ T . unpack t 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
2015-10-30 04:05:02 +03:00
postingsAsLines :: Bool -> Bool -> Transaction -> [ Posting ] -> [ String ]
postingsAsLines elide onelineamounts t ps
2012-05-15 05:49:05 +04:00
| elide && length ps > 1 && isTransactionBalanced Nothing t -- imprecise balanced check
2015-10-30 04:05:02 +03:00
= ( concatMap ( postingAsLines False onelineamounts ps ) $ init ps ) ++ postingAsLines True onelineamounts ps ( last ps )
| otherwise = concatMap ( postingAsLines False onelineamounts ps ) ps
2012-05-15 05:49:05 +04:00
2015-10-30 04:05:02 +03:00
postingAsLines :: Bool -> Bool -> [ Posting ] -> Posting -> [ String ]
2017-01-11 07:44:10 +03:00
postingAsLines elideamount onelineamounts ps p = concat [
postingblock
2013-09-10 21:32:49 +04:00
++ newlinecomments
2017-01-11 07:44:10 +03:00
| postingblock <- postingblocks ]
2012-05-15 05:49:05 +04:00
where
2017-06-05 03:41:42 +03:00
postingblocks = [ map rstrip $ lines $ concatTopPadded [ statusandaccount , " " , amount , assertion , samelinecomment ] | amount <- shownAmounts ]
2017-01-14 21:29:33 +03:00
assertion = maybe " " ( ( " = " ++ ) . showAmountWithZeroCommodity ) $ pbalanceassertion p
2017-06-05 03:41:42 +03:00
statusandaccount = indent $ fitString ( Just $ minwidth ) Nothing False True $ pstatusandacct p
2012-05-15 05:49:05 +04:00
where
2017-06-05 07:26:18 +03:00
-- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned
minwidth = maximum $ map ( ( 2 + ) . textWidth . T . pack . pacctstr ) ps
2017-06-05 03:41:42 +03:00
pstatusandacct p' = pstatusprefix p' ++ pacctstr p'
pstatusprefix p' | null s = " "
| otherwise = s ++ " "
where s = show $ pstatus p'
pacctstr p' = showAccountName Nothing ( ptype p' ) ( paccount p' )
2015-10-11 01:09:42 +03:00
-- currently prices are considered part of the amount string when right-aligning amounts
2017-01-11 07:44:10 +03:00
shownAmounts
| elideamount = [ " " ]
| onelineamounts = [ fitString ( Just amtwidth ) Nothing False False $ showMixedAmountOneLine $ pamount p ]
| otherwise = map ( fitStringMulti ( Just amtwidth ) Nothing False False . showAmount ) . amounts $ pamount p
2015-10-11 01:09:42 +03:00
where
amtwidth = maximum $ 12 : map ( strWidth . showMixedAmount . pamount ) ps -- min. 12 for backwards compatibility
( samelinecomment , newlinecomments ) =
case renderCommentLines ( pcomment p ) of [] -> ( " " , [] )
c : cs -> ( c , cs )
2012-05-15 05:49:05 +04:00
2016-02-10 18:39:03 +03:00
-- used in balance assertion error
showPostingLine p =
indent $
if pstatus p == Cleared then " * " else " " ++
showAccountName Nothing ( ptype p ) ( paccount p ) ++
" " ++
showMixedAmountOneLine ( pamount p )
2017-01-20 18:33:24 +03:00
-- | Produce posting line with all comment lines associated with it
showPostingLines :: Posting -> [ String ]
showPostingLines p = postingAsLines False False ps p where
ps | Just t <- ptransaction p = tpostings t
| otherwise = [ p ]
2012-05-15 05:49:05 +04:00
tests_postingAsLines = [
" postingAsLines " ~: do
2017-01-11 07:44:10 +03:00
let p ` gives ` ls = assertEqual ( show p ) ls ( postingAsLines False False [ p ] p )
posting ` gives ` []
2012-12-06 04:28:23 +04:00
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 ` [
2017-01-11 07:44:10 +03:00
" * a $1.00 ; pcomment1 " ,
" ; pcomment2 " ,
" ; tag3: val3 " ,
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
]
2017-01-11 23:09:07 +03:00
tests_inference = [
" inferBalancingAmount " ~: do
let p ` gives ` p' = assertEqual ( show p ) ( Right p' ) $ inferTransaction p
inferTransaction :: Transaction -> Either String Transaction
inferTransaction = runIdentity . runExceptT . inferBalancingAmount ( \ _ _ -> return () )
nulltransaction ` gives ` nulltransaction
nulltransaction {
tpostings = [
" a " ` post ` usd ( - 5 ) ,
" b " ` post ` missingamt
] }
` gives `
nulltransaction {
tpostings = [
" a " ` post ` usd ( - 5 ) ,
" b " ` post ` usd 5
] }
nulltransaction {
tpostings = [
" a " ` post ` usd ( - 5 ) ,
" b " ` post ` ( eur 3 @@ usd 4 ) ,
" c " ` post ` missingamt
] }
` gives `
nulltransaction {
tpostings = [
" a " ` post ` usd ( - 5 ) ,
" b " ` post ` ( eur 3 @@ usd 4 ) ,
" c " ` post ` usd 1
] }
]
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
lib: textification begins! account names
The first of several conversions from String to (strict) Text, hopefully
reducing space and time usage.
This one shows a small improvement, with GHC 7.10.3 and text-1.2.2.1:
hledger -f data/100x100x10.journal stats
string: <<ghc: 39471064 bytes, 77 GCs, 198421/275048 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.001 elapsed), 0.015 MUT (0.020 elapsed), 0.010 GC (0.014 elapsed) :ghc>>
text: <<ghc: 39268024 bytes, 77 GCs, 197018/270840 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.002 elapsed), 0.016 MUT (0.022 elapsed), 0.009 GC (0.011 elapsed) :ghc>>
hledger -f data/1000x100x10.journal stats
string: <<ghc: 318555920 bytes, 617 GCs, 2178997/7134472 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.001 elapsed), 0.129 MUT (0.136 elapsed), 0.067 GC (0.077 elapsed) :ghc>>
text: <<ghc: 314248496 bytes, 612 GCs, 2074045/6617960 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.003 elapsed), 0.137 MUT (0.145 elapsed), 0.067 GC (0.079 elapsed) :ghc>>
hledger -f data/10000x100x10.journal stats
string: <<ghc: 3114763608 bytes, 6026 GCs, 18858950/75552024 avg/max bytes residency (11 samples), 201M in use, 0.000 INIT (0.000 elapsed), 1.331 MUT (1.372 elapsed), 0.699 GC (0.812 elapsed) :ghc>>
text: <<ghc: 3071468920 bytes, 5968 GCs, 14120344/62951360 avg/max bytes residency (9 samples), 124M in use, 0.000 INIT (0.003 elapsed), 1.272 MUT (1.349 elapsed), 0.513 GC (0.578 elapsed) :ghc>>
hledger -f data/100000x100x10.journal stats
string: <<ghc: 31186579432 bytes, 60278 GCs, 135332581/740228992 avg/max bytes residency (13 samples), 1697M in use, 0.000 INIT (0.008 elapsed), 14.677 MUT (15.508 elapsed), 7.081 GC (8.074 elapsed) :ghc>>
text: <<ghc: 30753427672 bytes, 59763 GCs, 117595958/666457240 avg/max bytes residency (14 samples), 1588M in use, 0.000 INIT (0.008 elapsed), 13.713 MUT (13.966 elapsed), 6.220 GC (7.108 elapsed) :ghc>>
2016-05-24 04:16:21 +03:00
fmt RegularPosting = take w' . T . unpack
fmt VirtualPosting = parenthesise . reverse . take ( w' - 2 ) . reverse . T . unpack
fmt BalancedVirtualPosting = bracket . reverse . take ( w' - 2 ) . reverse . T . unpack
2009-05-24 10:22:44 +04:00
w' = fromMaybe 999999 w
lib: textification begins! account names
The first of several conversions from String to (strict) Text, hopefully
reducing space and time usage.
This one shows a small improvement, with GHC 7.10.3 and text-1.2.2.1:
hledger -f data/100x100x10.journal stats
string: <<ghc: 39471064 bytes, 77 GCs, 198421/275048 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.001 elapsed), 0.015 MUT (0.020 elapsed), 0.010 GC (0.014 elapsed) :ghc>>
text: <<ghc: 39268024 bytes, 77 GCs, 197018/270840 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.002 elapsed), 0.016 MUT (0.022 elapsed), 0.009 GC (0.011 elapsed) :ghc>>
hledger -f data/1000x100x10.journal stats
string: <<ghc: 318555920 bytes, 617 GCs, 2178997/7134472 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.001 elapsed), 0.129 MUT (0.136 elapsed), 0.067 GC (0.077 elapsed) :ghc>>
text: <<ghc: 314248496 bytes, 612 GCs, 2074045/6617960 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.003 elapsed), 0.137 MUT (0.145 elapsed), 0.067 GC (0.079 elapsed) :ghc>>
hledger -f data/10000x100x10.journal stats
string: <<ghc: 3114763608 bytes, 6026 GCs, 18858950/75552024 avg/max bytes residency (11 samples), 201M in use, 0.000 INIT (0.000 elapsed), 1.331 MUT (1.372 elapsed), 0.699 GC (0.812 elapsed) :ghc>>
text: <<ghc: 3071468920 bytes, 5968 GCs, 14120344/62951360 avg/max bytes residency (9 samples), 124M in use, 0.000 INIT (0.003 elapsed), 1.272 MUT (1.349 elapsed), 0.513 GC (0.578 elapsed) :ghc>>
hledger -f data/100000x100x10.journal stats
string: <<ghc: 31186579432 bytes, 60278 GCs, 135332581/740228992 avg/max bytes residency (13 samples), 1697M in use, 0.000 INIT (0.008 elapsed), 14.677 MUT (15.508 elapsed), 7.081 GC (8.074 elapsed) :ghc>>
text: <<ghc: 30753427672 bytes, 59763 GCs, 117595958/666457240 avg/max bytes residency (14 samples), 1588M in use, 0.000 INIT (0.008 elapsed), 13.713 MUT (13.966 elapsed), 6.220 GC (7.108 elapsed) :ghc>>
2016-05-24 04:16:21 +03:00
parenthesise :: String -> String
parenthesise s = " ( " ++ s ++ " ) "
bracket :: String -> String
bracket s = " [ " ++ s ++ " ] "
2009-05-24 10:22:44 +04:00
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
2016-12-10 18:04:48 +03:00
assignmentPostings :: Transaction -> [ Posting ]
assignmentPostings = filter isAssignment . tpostings
2010-02-27 21:06:29 +03:00
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.
2016-05-08 02:18:04 +03:00
isTransactionBalanced :: Maybe ( Map . Map CommoditySymbol AmountStyle ) -> Transaction -> Bool
2012-11-20 01:20:10 +04:00
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
2011-01-20 03:18:54 +03:00
-- | Ensure this transaction is balanced, possibly inferring a missing
2015-06-29 00:13:11 +03:00
-- amount or conversion price(s), or return an error message.
-- Balancing is affected by commodity display precisions, so those can
-- (optionally) be provided.
2016-12-10 18:04:48 +03:00
--
-- this fails for example, if there are several missing amounts
-- (possibly with balance assignments)
balanceTransaction :: Maybe ( Map . Map CommoditySymbol AmountStyle )
-> Transaction -> Either String Transaction
balanceTransaction stylemap = runIdentity . runExceptT
. balanceTransactionUpdate ( \ _ _ -> return () ) stylemap
-- | More general version of 'balanceTransaction' that takes an update
-- function
balanceTransactionUpdate :: MonadError String m
=> ( AccountName -> MixedAmount -> m () )
-- ^ update function
-> Maybe ( Map . Map CommoditySymbol AmountStyle )
-> Transaction -> m Transaction
balanceTransactionUpdate update styles t =
finalize =<< inferBalancingAmount update t
where
finalize t' = let t'' = inferBalancingPrices t'
in if isTransactionBalanced styles t''
then return $ txnTieKnot t''
else throwError $ printerr $ nonzerobalanceerror t''
printerr s = intercalate " \ n " [ s , showTransactionUnelided t ]
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 = " "
| otherwise = " real postings are off by "
++ showMixedAmount ( costOfMixedAmount rsum )
bvmsg | isReallyZeroMixedAmountCost bvsum = " "
| otherwise = " balanced virtual postings are off by "
++ showMixedAmount ( costOfMixedAmount bvsum )
sep = if not ( null rmsg ) && not ( null bvmsg ) then " ; " else " " :: String
2015-06-29 00:13:11 +03:00
-- | Infer up to one missing amount for this transactions's real postings, and
-- likewise for its balanced virtual postings, if needed; or return an error
2015-06-28 22:02:33 +03:00
-- message if we can't.
2015-06-29 00:13:11 +03:00
--
-- We can infer a missing amount when there are multiple postings and exactly
-- one of them is amountless. If the amounts had price(s) the inferred amount
-- have the same price(s), and will be converted to the price commodity.
2016-12-10 18:04:48 +03:00
inferBalancingAmount :: MonadError String m
=> ( AccountName -> MixedAmount -> m () )
-- ^ update function
-> Transaction -> m Transaction
inferBalancingAmount update t @ Transaction { tpostings = ps }
2015-06-28 22:02:33 +03:00
| length amountlessrealps > 1
2016-12-10 18:04:48 +03:00
= throwError $ printerr " could not balance this transaction - can't have more than one real posting with no amount (remember to put 2 or more spaces before amounts) "
2015-06-28 22:02:33 +03:00
| length amountlessbvps > 1
2016-12-10 18:04:48 +03:00
= throwError $ printerr " could not balance this transaction - can't have more than one balanced virtual posting with no amount (remember to put 2 or more spaces before amounts) "
2015-06-28 22:02:33 +03:00
| otherwise
2016-12-10 18:04:48 +03:00
= do postings <- mapM inferamount ps
return t { tpostings = postings }
2015-06-28 22:02:33 +03:00
where
printerr s = intercalate " \ n " [ s , showTransactionUnelided t ]
2017-01-13 03:24:53 +03:00
( amountfulrealps , amountlessrealps ) = partition hasAmount ( realPostings t )
realsum = sumStrict $ map pamount amountfulrealps
( amountfulbvps , amountlessbvps ) = partition hasAmount ( balancedVirtualPostings t )
bvsum = sumStrict $ map pamount amountfulbvps
2016-12-10 18:04:48 +03:00
inferamount p @ Posting { ptype = RegularPosting }
| not ( hasAmount p ) = updateAmount p realsum
inferamount p @ Posting { ptype = BalancedVirtualPosting }
| not ( hasAmount p ) = updateAmount p bvsum
inferamount p = return p
2017-01-13 18:25:44 +03:00
updateAmount p amt = update ( paccount p ) amt' >> return p { pamount = amt' , porigin = Just $ originalPosting p }
2017-01-11 23:09:07 +03:00
where amt' = normaliseMixedAmount $ costOfMixedAmount ( - amt )
2009-04-10 12:05:56 +04:00
2015-06-29 00:13:11 +03:00
-- | Infer prices for this transaction's posting amounts, if needed to make
2015-07-03 03:36:09 +03:00
-- the postings balance, and if possible. This is done once for the real
-- postings and again (separately) for the balanced virtual postings. When
-- it's not possible, the transaction is left unchanged.
2016-12-10 18:04:48 +03:00
--
2015-06-29 00:13:11 +03:00
-- The simplest example is a transaction with two postings, each in a
-- different commodity, with no prices specified. In this case we'll add a
-- price to the first posting such that it can be converted to the commodity
-- of the second posting (with -B), and such that the postings balance.
2016-12-10 18:04:48 +03:00
--
2015-06-29 00:13:11 +03:00
-- In general, we can infer a conversion price when the sum of posting amounts
2015-07-03 04:06:03 +03:00
-- contains exactly two different commodities and no explicit prices. Also
-- all postings are expected to contain an explicit amount (no missing
-- amounts) in a single commodity. Otherwise no price inferring is attempted.
2016-12-10 18:04:48 +03:00
--
2015-07-03 04:06:03 +03:00
-- The transaction itself could contain more than two commodities, and/or
-- prices, if they cancel out; what matters is that the sum of posting amounts
-- contains exactly two commodities and zero prices.
2016-12-10 18:04:48 +03:00
--
2015-06-29 00:13:11 +03:00
-- There can also be more than two postings in either of the commodities.
2016-12-10 18:04:48 +03:00
--
2015-06-29 00:13:11 +03:00
-- We want to avoid excessive display of digits when the calculated price is
2015-07-03 03:36:09 +03:00
-- an irrational number, while hopefully also ensuring the displayed numbers
-- make sense if the user does a manual calculation. This is (mostly) achieved
-- in two ways:
2016-12-10 18:04:48 +03:00
--
2015-06-29 00:13:11 +03:00
-- - when there is only one posting in the "from" commodity, a total price
-- (@@) is used, and all available decimal digits are shown
2016-12-10 18:04:48 +03:00
--
2015-06-29 00:13:11 +03:00
-- - otherwise, a suitable averaged unit price (@) is applied to the relevant
2015-07-03 03:36:09 +03:00
-- postings, with display precision equal to the summed display precisions
-- of the two commodities being converted between, or 2, whichever is larger.
2016-12-10 18:04:48 +03:00
--
2015-07-03 03:36:09 +03:00
-- (We don't always calculate a good-looking display precision for unit prices
-- when the commodity display precisions are low, eg when a journal doesn't
-- use any decimal places. The minimum of 2 helps make the prices shown by the
-- print command a bit less surprising in this case. Could do better.)
2016-12-10 18:04:48 +03:00
--
2015-06-29 00:13:11 +03:00
inferBalancingPrices :: Transaction -> Transaction
inferBalancingPrices t @ Transaction { tpostings = ps } = t { tpostings = ps' }
where
ps' = map ( priceInferrerFor t BalancedVirtualPosting ) $
map ( priceInferrerFor t RegularPosting ) $
ps
-- | Generate a posting update function which assigns a suitable balancing
-- price to the posting, if and as appropriate for the given transaction and
-- posting type (real or balanced virtual).
priceInferrerFor :: Transaction -> PostingType -> ( Posting -> Posting )
priceInferrerFor t pt = inferprice
where
postings = filter ( ( == pt ) . ptype ) $ tpostings t
pmixedamounts = map pamount postings
pamounts = concatMap amounts pmixedamounts
pcommodities = map acommodity pamounts
2017-01-13 03:24:53 +03:00
sumamounts = amounts $ sumStrict pmixedamounts -- sum normalises to one amount per commodity & price
2015-06-29 00:13:11 +03:00
sumcommodities = map acommodity sumamounts
sumprices = filter ( /= NoPrice ) $ map aprice sumamounts
caninferprices = length sumcommodities == 2 && null sumprices
inferprice p @ Posting { pamount = Mixed [ a ] }
| caninferprices && ptype p == pt && acommodity a == fromcommodity
2017-01-13 18:25:44 +03:00
= p { pamount = Mixed [ a { aprice = conversionprice } ] , porigin = Just $ originalPosting p }
2015-06-29 00:13:11 +03:00
where
fromcommodity = head $ filter ( ` elem ` sumcommodities ) pcommodities -- these heads are ugly but should be safe
conversionprice
| fromcount == 1 = TotalPrice $ abs toamount ` withPrecision ` maxprecision
2015-07-03 03:36:09 +03:00
| otherwise = UnitPrice $ abs unitprice ` withPrecision ` unitprecision
2015-06-29 00:13:11 +03:00
where
2015-07-03 03:36:09 +03:00
fromcount = length $ filter ( ( == fromcommodity ) . acommodity ) pamounts
fromamount = head $ filter ( ( == fromcommodity ) . acommodity ) sumamounts
tocommodity = head $ filter ( /= fromcommodity ) sumcommodities
toamount = head $ filter ( ( == tocommodity ) . acommodity ) sumamounts
unitprice = toamount ` divideAmount ` ( aquantity fromamount )
unitprecision = max 2 ( ( asprecision $ astyle $ toamount ) + ( asprecision $ astyle $ fromamount ) )
2015-06-29 00:13:11 +03:00
inferprice p = p
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
2015-06-28 22:02:33 +03:00
-- | Ensure a transaction's postings refer back to it, so that eg
-- relatedPostings works right.
2009-12-19 06:44:52 +03:00
txnTieKnot :: Transaction -> Transaction
2017-01-16 18:42:41 +03:00
txnTieKnot t @ Transaction { tpostings = ps } = t' where
t' = t { tpostings = map ( postingSetTransaction t' ) ps }
2009-12-19 06:44:52 +03:00
lib: textification begins! account names
The first of several conversions from String to (strict) Text, hopefully
reducing space and time usage.
This one shows a small improvement, with GHC 7.10.3 and text-1.2.2.1:
hledger -f data/100x100x10.journal stats
string: <<ghc: 39471064 bytes, 77 GCs, 198421/275048 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.001 elapsed), 0.015 MUT (0.020 elapsed), 0.010 GC (0.014 elapsed) :ghc>>
text: <<ghc: 39268024 bytes, 77 GCs, 197018/270840 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.002 elapsed), 0.016 MUT (0.022 elapsed), 0.009 GC (0.011 elapsed) :ghc>>
hledger -f data/1000x100x10.journal stats
string: <<ghc: 318555920 bytes, 617 GCs, 2178997/7134472 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.001 elapsed), 0.129 MUT (0.136 elapsed), 0.067 GC (0.077 elapsed) :ghc>>
text: <<ghc: 314248496 bytes, 612 GCs, 2074045/6617960 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.003 elapsed), 0.137 MUT (0.145 elapsed), 0.067 GC (0.079 elapsed) :ghc>>
hledger -f data/10000x100x10.journal stats
string: <<ghc: 3114763608 bytes, 6026 GCs, 18858950/75552024 avg/max bytes residency (11 samples), 201M in use, 0.000 INIT (0.000 elapsed), 1.331 MUT (1.372 elapsed), 0.699 GC (0.812 elapsed) :ghc>>
text: <<ghc: 3071468920 bytes, 5968 GCs, 14120344/62951360 avg/max bytes residency (9 samples), 124M in use, 0.000 INIT (0.003 elapsed), 1.272 MUT (1.349 elapsed), 0.513 GC (0.578 elapsed) :ghc>>
hledger -f data/100000x100x10.journal stats
string: <<ghc: 31186579432 bytes, 60278 GCs, 135332581/740228992 avg/max bytes residency (13 samples), 1697M in use, 0.000 INIT (0.008 elapsed), 14.677 MUT (15.508 elapsed), 7.081 GC (8.074 elapsed) :ghc>>
text: <<ghc: 30753427672 bytes, 59763 GCs, 117595958/666457240 avg/max bytes residency (14 samples), 1588M in use, 0.000 INIT (0.008 elapsed), 13.713 MUT (13.966 elapsed), 6.220 GC (7.108 elapsed) :ghc>>
2016-05-24 04:16:21 +03:00
-- | Ensure a transaction's postings do not refer back to it, so that eg
-- recursiveSize and GHCI's :sprint work right.
txnUntieKnot :: Transaction -> Transaction
txnUntieKnot t @ Transaction { tpostings = ps } = t { tpostings = map ( \ p -> p { ptransaction = Nothing } ) ps }
2009-12-19 06:44:52 +03:00
-- | Set a posting's parent transaction.
2016-08-14 22:44:19 +03:00
postingSetTransaction :: Transaction -> Posting -> Posting
postingSetTransaction 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 ,
2017-01-11 23:09:07 +03:00
tests_inference ,
2012-05-15 05:49:05 +04:00
[
2010-03-09 06:52:17 +03:00
" showTransaction " ~: do
assertEqual " show a balanced transaction, eliding last amount "
( unlines
[ " 2007/01/28 coopportunity "
2017-06-06 19:43:05 +03:00
, " expenses:food:groceries $47.18 "
2010-03-09 06:52:17 +03:00
, " assets:checking "
, " "
] )
2015-10-30 06:12:46 +03:00
( let t = Transaction 0 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 "
2017-06-06 19:43:05 +03:00
, " expenses:food:groceries $47.18 "
, " assets:checking $-47.18 "
2010-03-09 06:52:17 +03:00
, " "
] )
2015-10-30 06:12:46 +03:00
( let t = Transaction 0 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 "
2017-06-06 19:43:05 +03:00
, " expenses:food:groceries $47.18 "
, " assets:checking $-47.19 "
2010-03-09 06:52:17 +03:00
, " "
] )
( showTransaction
2015-10-30 06:12:46 +03:00
( txnTieKnot $ Transaction 0 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 "
2017-06-06 19:43:05 +03:00
, " expenses:food:groceries $47.18 "
2010-03-09 06:52:17 +03:00
, " "
] )
( showTransaction
2015-10-30 06:12:46 +03:00
( txnTieKnot $ Transaction 0 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-10-30 06:12:46 +03:00
( txnTieKnot $ Transaction 0 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 "
2017-06-06 19:43:05 +03:00
, " a 1 @ $2 "
2012-05-15 05:49:05 +04:00
, " b "
2010-03-09 06:52:17 +03:00
, " "
] )
( showTransaction
2015-10-30 06:12:46 +03:00
( txnTieKnot $ Transaction 0 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-10-30 06:12:46 +03:00
( Transaction 0 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-10-30 06:12:46 +03:00
( Transaction 0 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-10-30 06:12:46 +03:00
let e = balanceTransaction Nothing ( Transaction 0 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-10-30 06:12:46 +03:00
let e = balanceTransaction Nothing ( Transaction 0 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-10-30 06:12:46 +03:00
balanceTransaction Nothing ( Transaction 0 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-10-30 06:12:46 +03:00
balanceTransaction Nothing ( Transaction 0 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-10-30 06:12:46 +03:00
let t = Transaction 0 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-10-30 06:12:46 +03:00
let t = Transaction 0 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-10-30 06:12:46 +03:00
let t = Transaction 0 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-10-30 06:12:46 +03:00
let t = Transaction 0 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-10-30 06:12:46 +03:00
let t = Transaction 0 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-10-30 06:12:46 +03:00
let t = Transaction 0 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-10-30 06:12:46 +03:00
let t = Transaction 0 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
] ]