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
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 ,
2018-09-04 21:31:31 +03:00
-- * tests
2018-09-06 23:08:26 +03:00
tests_Transaction
2012-05-07 18:36:40 +04:00
)
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 Text.Printf
2010-11-15 01:44:37 +03:00
import qualified Data.Map as Map
2018-09-04 23:52:36 +03: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
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
2018-10-25 10:05:29 +03:00
-- | Render source position in human-readable form.
-- Keep in sync with Hledger.UI.ErrorScreen.hledgerparseerrorpositionp (temporary). XXX
2017-01-20 18:33:24 +03:00
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' ++ " ) "
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 ,
2017-06-16 02:25:37 +03:00
tstatus = Unmarked ,
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
{- |
2018-10-22 16:46:31 +03:00
Render a journal transaction as text in the style of Ledger's print command .
Ledger 2 . x's standard format looks like this :
2009-04-03 14:58:05 +04:00
@
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
@
2018-10-22 16:46:31 +03:00
The output will be parseable journal syntax .
To facilitate this , postings with explicit multi - commodity amounts
are displayed as multiple similar postings , one per commodity .
( Normally does not happen with this function ) .
2018-10-22 17:23:40 +03:00
If there are multiple postings , all with explicit amounts ,
and the transaction appears obviously balanced
2018-10-22 16:46:31 +03:00
( postings sum to 0 , without needing to infer conversion prices ) ,
the last posting's amount will not be shown .
2009-04-03 14:58:05 +04:00
- }
2018-10-22 16:46:31 +03:00
-- XXX why that logic ?
-- XXX where is/should this be still used ?
2018-10-23 00:28:18 +03:00
-- XXX rename these, after amount expressions/mixed posting amounts lands
-- eg showTransactionSimpleAmountsElidingLast, showTransactionSimpleAmounts, showTransaction
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
2018-10-22 16:46:31 +03:00
-- | Like showTransaction, but does not change amounts' explicitness.
-- Explicit amounts are shown and implicit amounts are not.
-- The output will be parseable journal syntax.
-- To facilitate this, postings with explicit multi-commodity amounts
-- are displayed as multiple similar postings, one per commodity.
-- Most often, this is the one you want to use.
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
2018-10-22 16:46:31 +03:00
-- | Like showTransactionUnelided, but explicit multi-commodity amounts
-- are shown on one line, comma-separated. In this case the output will
-- not be parseable journal syntax.
2015-10-30 04:05:02 +03:00
showTransactionUnelidedOneLineAmounts :: Transaction -> String
showTransactionUnelidedOneLineAmounts = showTransactionHelper False True
2018-10-22 16:46:31 +03:00
-- | Helper for showTransaction*.
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 )
2018-10-22 16:46:31 +03:00
-- | 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 . ( " ; " ++ )
2018-10-22 16:46:31 +03:00
-- | Given a transaction and its postings, render the postings, suitable
2018-11-30 00:32:59 +03:00
-- for `print` output. Normally this output will be valid journal syntax which
-- hledger can reparse (though it may include no-longer-valid balance assertions).
2018-10-22 16:46:31 +03:00
--
2018-11-30 00:32:59 +03:00
-- Explicit amounts are shown, any implicit amounts are not.
2018-10-22 16:46:31 +03:00
--
2018-11-30 00:32:59 +03:00
-- Setting elide to true forces the last posting's amount to be implicit, if:
-- there are other postings, all with explicit amounts, and the transaction
-- appears balanced.
2018-10-22 16:46:31 +03:00
--
2018-11-30 00:32:59 +03:00
-- Postings with multicommodity explicit amounts are handled as follows:
-- if onelineamounts is true, these amounts are shown on one line,
-- comma-separated, and the output will not be valid journal syntax.
-- Otherwise, they are shown as several similar postings, one per commodity.
--
2018-11-30 00:44:38 +03:00
-- The output will appear to be a balanced transaction.
-- Amounts' display precisions, which may have been limited by commodity
-- directives, will be increased if necessary to ensure this.
--
2018-11-30 00:32:59 +03:00
-- Posting amounts will be aligned with each other, starting about 4 columns
-- beyond the widest account name (see postingAsLines for details).
2018-10-22 16:46:31 +03:00
--
2015-10-30 04:05:02 +03:00
postingsAsLines :: Bool -> Bool -> Transaction -> [ Posting ] -> [ String ]
postingsAsLines elide onelineamounts t ps
2018-10-22 17:23:40 +03:00
| elide && length ps > 1 && all hasAmount ps && 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
2018-10-22 16:46:31 +03:00
-- | Render one posting, on one or more lines, suitable for `print` output.
-- There will be an indented account name, plus one or more of status flag,
-- posting amount, balance assertion, same-line comment, next-line comments.
--
-- If the posting's amount is implicit or if elideamount is true, no amount is shown.
--
-- If the posting's amount is explicit and multi-commodity, multiple similar
-- postings are shown, one for each commodity, to help produce parseable journal syntax.
-- Or if onelineamounts is true, such amounts are shown on one line, comma-separated
-- (and the output will not be valid journal syntax).
--
-- By default, 4 spaces (2 if there's a status flag) are shown between
-- account name and start of amount area, which is typically 12 chars wide
-- and contains a right-aligned amount (so 10-12 visible spaces between
-- account name and amount is typical).
-- When given a list of postings to be aligned with, the whitespace will be
-- increased if needed to match the posting with the longest account name.
-- This is used to align the amounts of a transaction's postings.
--
2015-10-30 04:05:02 +03:00
postingAsLines :: Bool -> Bool -> [ Posting ] -> Posting -> [ String ]
2018-10-22 16:46:31 +03:00
postingAsLines elideamount onelineamounts pstoalignwith p = concat [
2017-01-11 07:44:10 +03:00
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 ]
2018-10-12 06:37:20 +03:00
assertion = maybe " " ( ( " = " ++ ) . showAmountWithZeroCommodity . baamount ) $ 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
2018-10-22 16:46:31 +03:00
minwidth = maximum $ map ( ( 2 + ) . textWidth . T . pack . pacctstr ) pstoalignwith
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 ]
2017-12-13 02:51:20 +03:00
| null ( amounts $ pamount p ) = [ " " ]
2017-01-11 07:44:10 +03:00
| otherwise = map ( fitStringMulti ( Just amtwidth ) Nothing False False . showAmount ) . amounts $ pamount p
2015-10-11 01:09:42 +03:00
where
2018-10-22 16:46:31 +03:00
amtwidth = maximum $ 12 : map ( strWidth . showMixedAmount . pamount ) pstoalignwith -- min. 12 for backwards compatibility
2015-10-11 01:09:42 +03:00
( samelinecomment , newlinecomments ) =
case renderCommentLines ( pcomment p ) of [] -> ( " " , [] )
c : cs -> ( c , cs )
2012-05-15 05:49:05 +04:00
2018-10-22 16:46:31 +03:00
-- | Show a posting's status, account name and amount on one line.
-- Used in balance assertion errors.
2016-02-10 18:39:03 +03:00
showPostingLine p =
indent $
if pstatus p == Cleared then " * " else " " ++
showAccountName Nothing ( ptype p ) ( paccount p ) ++
" " ++
showMixedAmountOneLine ( pamount p )
2018-10-22 16:46:31 +03:00
-- | Render a posting, at the appropriate width for aligning with
-- its siblings if any. Used by the rewrite command.
2017-01-20 18:33:24 +03:00
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
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 )
2018-11-30 00:14:49 +03:00
-- | Does this transaction appear balanced when rendered, optionally with the
-- given commodity display styles ? More precisely:
-- after converting amounts to cost using explicit transaction prices if any;
-- and summing the real postings, and summing the balanced virtual postings;
-- and applying the given display styles if any (maybe affecting decimal places);
-- do both totals appear to be zero when rendered ?
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
2018-04-20 22:18:28 +03:00
balanceTransactionUpdate update mstyles t =
2018-10-24 01:23:26 +03:00
( finalize =<< inferBalancingAmount update ( fromMaybe Map . empty mstyles ) t )
` catchError ` ( throwError . annotateErrorWithTxn t )
2016-12-10 18:04:48 +03:00
where
finalize t' = let t'' = inferBalancingPrices t'
2018-04-20 22:18:28 +03:00
in if isTransactionBalanced mstyles t''
2016-12-10 18:04:48 +03:00
then return $ txnTieKnot t''
2018-10-24 01:23:26 +03:00
else throwError $ nonzerobalanceerror t''
2016-12-10 18:04:48 +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 = " "
| 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
2018-10-24 01:23:26 +03:00
annotateErrorWithTxn t e = intercalate " \ n " [ showGenericSourcePos $ tsourcepos t , e , showTransactionUnelided t ]
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.
2018-04-20 22:18:28 +03:00
inferBalancingAmount :: MonadError String m =>
( AccountName -> MixedAmount -> m () ) -- ^ update function
-> Map . Map CommoditySymbol AmountStyle -- ^ standard amount styles
-> Transaction
-> m Transaction
inferBalancingAmount update styles t @ Transaction { tpostings = ps }
2015-06-28 22:02:33 +03:00
| length amountlessrealps > 1
2018-10-24 01:23:26 +03:00
= throwError " 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
2018-10-24 01:23:26 +03:00
= throwError " 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
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
2018-04-20 22:18:28 +03:00
updateAmount p amt =
update ( paccount p ) amt' >> return p { pamount = amt' , porigin = Just $ originalPosting p }
where
-- Inferred amounts are converted to cost.
-- Also, ensure the new amount has the standard style for its commodity
-- (the main amount styling pass happened before this balancing pass).
amt' = styleMixedAmount styles $ 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
2018-11-14 04:25:32 +03:00
unitprice = ( aquantity fromamount ) ` divideAmount ` toamount
2015-07-03 03:36:09 +03:00
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
2018-09-04 21:31:31 +03:00
-- tests
2018-09-06 23:08:26 +03:00
tests_Transaction = tests " Transaction " [
2018-09-04 21:31:31 +03:00
tests " showTransactionUnelided " [
2018-10-22 16:46:31 +03:00
showTransactionUnelided nulltransaction ` is ` " 0000/01/01 \ n \ n "
2018-09-04 21:31:31 +03:00
, showTransactionUnelided nulltransaction {
tdate = parsedate " 2012/05/14 " ,
tdate2 = Just $ parsedate " 2012/05/15 " ,
tstatus = Unmarked ,
tcode = " code " ,
tdescription = " desc " ,
tcomment = " tcomment1 \ n tcomment2 \ n " ,
ttags = [ ( " ttag1 " , " val1 " ) ] ,
tpostings = [
nullposting {
pstatus = Cleared ,
paccount = " a " ,
pamount = Mixed [ usd 1 , hrs 2 ] ,
pcomment = " \ n pcomment2 \ n " ,
ptype = RegularPosting ,
ptags = [ ( " ptag1 " , " val1 " ) , ( " ptag2 " , " val2 " ) ]
}
]
}
` is ` unlines [
" 2012/05/14=2012/05/15 (code) desc ; tcomment1 " ,
" ; tcomment2 " ,
" * a $1.00 " ,
" ; pcomment2 " ,
" * a 2.00h " ,
" ; pcomment2 " ,
" "
]
]
, tests " postingAsLines " [
postingAsLines False False [ posting ] posting ` is ` [ " " ]
, let p = posting {
pstatus = Cleared ,
paccount = " a " ,
pamount = Mixed [ usd 1 , hrs 2 ] ,
pcomment = " pcomment1 \ n pcomment2 \ n tag3: val3 \ n " ,
ptype = RegularPosting ,
ptags = [ ( " ptag1 " , " val1 " ) , ( " ptag2 " , " val2 " ) ]
}
in postingAsLines False False [ p ] p ` is `
[
" * a $1.00 ; pcomment1 " ,
" ; pcomment2 " ,
" ; tag3: val3 " ,
" * a 2.00h ; pcomment1 " ,
" ; pcomment2 " ,
" ; tag3: val3 "
]
]
2018-11-30 00:44:38 +03:00
-- postingsAsLines
2018-10-22 16:46:31 +03:00
, let
-- one implicit amount
timp = nulltransaction { tpostings = [
" a " ` post ` usd 1 ,
" b " ` post ` missingamt
] }
-- explicit amounts, balanced
texp = nulltransaction { tpostings = [
" a " ` post ` usd 1 ,
" b " ` post ` usd ( - 1 )
] }
-- explicit amount, only one posting
texp1 = nulltransaction { tpostings = [
" (a) " ` post ` usd 1
] }
-- explicit amounts, two commodities, explicit balancing price
texp2 = nulltransaction { tpostings = [
" a " ` post ` usd 1 ,
" b " ` post ` ( hrs ( - 1 ) ` at ` usd 1 )
] }
-- explicit amounts, two commodities, implicit balancing price
texp2b = nulltransaction { tpostings = [
" a " ` post ` usd 1 ,
" b " ` post ` hrs ( - 1 )
] }
2018-10-22 17:23:40 +03:00
-- one missing amount, not the last one
t3 = nulltransaction { tpostings = [
" a " ` post ` usd 1
, " b " ` post ` missingamt
, " c " ` post ` usd ( - 1 )
] }
2018-11-30 00:44:38 +03:00
-- unbalanced amounts when precision is limited (#931)
t4 = nulltransaction { tpostings = [
" a " ` post ` usd ( - 0.01 )
, " b " ` post ` usd ( 0.005 )
, " c " ` post ` usd ( 0.005 )
] }
2018-10-22 16:46:31 +03:00
in
tests " postingsAsLines " [
test " null-transaction " $
let t = nulltransaction
in postingsAsLines True False t ( tpostings t ) ` is ` []
, test " implicit-amount-elide-false " $
let t = timp in postingsAsLines False False t ( tpostings t ) ` is ` [
" a $1.00 "
, " b " -- implicit amount remains implicit
]
, test " implicit-amount-elide-true " $
let t = timp in postingsAsLines True False t ( tpostings t ) ` is ` [
" a $1.00 "
, " b " -- implicit amount remains implicit
]
, test " explicit-amounts-elide-false " $
let t = texp in postingsAsLines False False t ( tpostings t ) ` is ` [
" a $1.00 "
, " b $-1.00 " -- both amounts remain explicit
]
, test " explicit-amounts-elide-true " $
let t = texp in postingsAsLines True False t ( tpostings t ) ` is ` [
" a $1.00 "
, " b " -- explicit amount is made implicit
]
, test " one-explicit-amount-elide-true " $
let t = texp1 in postingsAsLines True False t ( tpostings t ) ` is ` [
" (a) $1.00 " -- explicit amount remains explicit since only one posting
]
, test " explicit-amounts-two-commodities-elide-true " $
let t = texp2 in postingsAsLines True False t ( tpostings t ) ` is ` [
" a $1.00 "
, " b " -- explicit amount is made implicit since txn is explicitly balanced
]
, test " explicit-amounts-not-explicitly-balanced-elide-true " $
let t = texp2b in postingsAsLines True False t ( tpostings t ) ` is ` [
" a $1.00 "
, " b -1.00h " -- explicit amount remains explicit since a conversion price would have be inferred to balance
]
2018-10-22 17:23:40 +03:00
, test " implicit-amount-not-last " $
let t = t3 in postingsAsLines True False t ( tpostings t ) ` is ` [
" a $1.00 "
, " b "
, " c $-1.00 "
]
2018-11-30 00:44:38 +03:00
, _test " ensure-visibly-balanced " $
let t = t4 in postingsAsLines False False t ( tpostings t ) ` is ` [
" a $-0.01 "
, " b $0.005 "
, " c $0.005 "
]
2018-10-22 16:46:31 +03:00
]
2018-09-04 21:31:31 +03:00
, do
let inferTransaction :: Transaction -> Either String Transaction
inferTransaction = runIdentity . runExceptT . inferBalancingAmount ( \ _ _ -> return () ) Map . empty
tests " inferBalancingAmount " [
inferTransaction nulltransaction ` is ` Right nulltransaction
, inferTransaction nulltransaction {
tpostings = [
" a " ` post ` usd ( - 5 ) ,
" b " ` post ` missingamt
] }
` is ` Right
nulltransaction {
tpostings = [
" a " ` post ` usd ( - 5 ) ,
" b " ` post ` usd 5
] }
, inferTransaction nulltransaction {
tpostings = [
" a " ` post ` usd ( - 5 ) ,
" b " ` post ` ( eur 3 @@ usd 4 ) ,
" c " ` post ` missingamt
] }
` is ` Right
nulltransaction {
tpostings = [
" a " ` post ` usd ( - 5 ) ,
" b " ` post ` ( eur 3 @@ usd 4 ) ,
" c " ` post ` usd 1
] }
]
, tests " showTransaction " [
test " show a balanced transaction, eliding last amount " $
let t = Transaction 0 nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Unmarked " " " 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
] " "
2018-09-04 21:31:31 +03:00
in
showTransaction t
` is `
unlines
[ " 2007/01/28 coopportunity "
, " expenses:food:groceries $47.18 "
, " assets:checking "
, " "
]
2018-10-12 06:37:20 +03:00
, test " show a balanced transaction, no eliding " $
2017-06-16 02:25:37 +03:00
( let t = Transaction 0 nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Unmarked " " " 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 )
2018-09-04 21:31:31 +03:00
` is `
2010-03-09 06:52:17 +03:00
( unlines
[ " 2007/01/28 coopportunity "
2017-06-06 19:43:05 +03:00
, " expenses:food:groceries $47.18 "
2018-09-04 21:31:31 +03:00
, " assets:checking $-47.18 "
2010-03-09 06:52:17 +03:00
, " "
] )
2018-09-04 21:31:31 +03:00
-- document some cases that arise in debug/testing:
, test " show an unbalanced transaction, should not elide " $
2010-03-09 06:52:17 +03:00
( showTransaction
2017-06-16 02:25:37 +03:00
( txnTieKnot $ Transaction 0 nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Unmarked " " " 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
] " " ) )
2018-09-04 21:31:31 +03:00
` is `
2010-03-09 06:52:17 +03:00
( unlines
[ " 2007/01/28 coopportunity "
2017-06-06 19:43:05 +03:00
, " expenses:food:groceries $47.18 "
2018-09-04 21:31:31 +03:00
, " assets:checking $-47.19 "
2010-03-09 06:52:17 +03:00
, " "
] )
2018-09-04 21:31:31 +03:00
, test " show an unbalanced transaction with one posting, should not elide " $
2010-03-09 06:52:17 +03:00
( showTransaction
2017-06-16 02:25:37 +03:00
( txnTieKnot $ Transaction 0 nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Unmarked " " " 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
] " " ) )
2018-09-04 21:31:31 +03:00
` is `
2010-03-09 06:52:17 +03:00
( unlines
[ " 2007/01/28 coopportunity "
2018-09-04 21:31:31 +03:00
, " expenses:food:groceries $47.18 "
2010-03-09 06:52:17 +03:00
, " "
] )
2018-09-04 21:31:31 +03:00
, test " show a transaction with one posting and a missing amount " $
2010-03-09 06:52:17 +03:00
( showTransaction
2017-06-16 02:25:37 +03:00
( txnTieKnot $ Transaction 0 nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Unmarked " " " coopportunity " " " []
2012-12-06 04:03:07 +04:00
[ posting { paccount = " expenses:food:groceries " , pamount = missingmixedamt }
2010-03-09 06:52:17 +03:00
] " " ) )
2018-09-04 21:31:31 +03:00
` is `
2010-03-09 06:52:17 +03:00
( unlines
2018-09-04 21:31:31 +03:00
[ " 2007/01/28 coopportunity "
, " expenses:food:groceries "
2010-03-09 06:52:17 +03:00
, " "
] )
2018-09-04 21:31:31 +03:00
, test " show a transaction with a priced commodityless amount " $
2010-03-09 06:52:17 +03:00
( showTransaction
2017-06-16 02:25:37 +03:00
( txnTieKnot $ Transaction 0 nullsourcepos ( parsedate " 2010/01/01 " ) Nothing Unmarked " " " 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
] " " ) )
2018-09-04 21:31:31 +03:00
` is `
( unlines
[ " 2010/01/01 x "
, " a 1 @ $2 "
, " b "
, " "
] )
]
2010-03-09 06:52:17 +03:00
2018-09-04 21:31:31 +03:00
, tests " balanceTransaction " [
test " detect unbalanced entry, sign error " $
( expectLeft $ balanceTransaction Nothing
2017-06-16 02:25:37 +03:00
( Transaction 0 nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Unmarked " " " 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
2018-09-04 21:31:31 +03:00
, test " detect unbalanced entry, multiple missing amounts " $
( expectLeft $ balanceTransaction Nothing
2017-06-16 02:25:37 +03:00
( Transaction 0 nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Unmarked " " " 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
2018-09-04 21:31:31 +03:00
, test " one missing amount is inferred " $
( pamount . last . tpostings <$> balanceTransaction
Nothing
( Transaction 0 nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Unmarked " " " " " " []
[ posting { paccount = " a " , pamount = Mixed [ usd 1 ] }
, posting { paccount = " b " , pamount = missingmixedamt }
] " " ) )
` is ` Right ( Mixed [ usd ( - 1 ) ] )
, test " conversion price is inferred " $
( pamount . head . tpostings <$> balanceTransaction
Nothing
( Transaction 0 nullsourcepos ( parsedate " 2007/01/28 " ) Nothing Unmarked " " " " " " []
[ posting { paccount = " a " , pamount = Mixed [ usd 1.35 ] }
, posting { paccount = " b " , pamount = Mixed [ eur ( - 1 ) ] }
] " " ) )
` is ` Right ( Mixed [ usd 1.35 @@ ( eur 1 ` withPrecision ` maxprecision ) ] )
, test " balanceTransaction balances based on cost if there are unit prices " $
expectRight $
2017-06-16 02:25:37 +03:00
balanceTransaction Nothing ( Transaction 0 nullsourcepos ( parsedate " 2011/01/01 " ) Nothing Unmarked " " " " " " []
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 ] }
2018-09-04 21:31:31 +03:00
] " " )
2012-11-12 20:31:43 +04:00
2018-09-04 21:31:31 +03:00
, test " balanceTransaction balances based on cost if there are total prices " $
expectRight $
2017-06-16 02:25:37 +03:00
balanceTransaction Nothing ( Transaction 0 nullsourcepos ( parsedate " 2011/01/01 " ) Nothing Unmarked " " " " " " []
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 ] }
2018-09-04 21:31:31 +03:00
] " " )
]
2012-11-12 20:31:43 +04:00
2018-09-04 21:31:31 +03:00
, tests " isTransactionBalanced " [
test " detect balanced " $ expect $
isTransactionBalanced Nothing $ Transaction 0 nullsourcepos ( parsedate " 2009/01/01 " ) Nothing Unmarked " " " a " " " []
[ posting { paccount = " b " , pamount = Mixed [ usd 1.00 ] }
, posting { paccount = " c " , pamount = Mixed [ usd ( - 1.00 ) ] }
2010-12-27 23:26:22 +03:00
] " "
2018-09-04 21:31:31 +03:00
, test " detect unbalanced " $ expect $
not $ isTransactionBalanced Nothing $ Transaction 0 nullsourcepos ( parsedate " 2009/01/01 " ) Nothing Unmarked " " " a " " " []
[ posting { paccount = " b " , pamount = Mixed [ usd 1.00 ] }
, posting { paccount = " c " , pamount = Mixed [ usd ( - 1.01 ) ] }
2010-12-27 23:26:22 +03:00
] " "
2018-09-04 21:31:31 +03:00
, test " detect unbalanced, one posting " $ expect $
not $ isTransactionBalanced Nothing $ Transaction 0 nullsourcepos ( parsedate " 2009/01/01 " ) Nothing Unmarked " " " a " " " []
[ posting { paccount = " b " , pamount = Mixed [ usd 1.00 ] }
2010-12-27 23:26:22 +03:00
] " "
2018-09-04 21:31:31 +03:00
, test " one zero posting is considered balanced for now " $ expect $
isTransactionBalanced Nothing $ Transaction 0 nullsourcepos ( parsedate " 2009/01/01 " ) Nothing Unmarked " " " a " " " []
[ posting { paccount = " b " , pamount = Mixed [ usd 0 ] }
2010-12-27 23:26:22 +03:00
] " "
2018-09-04 21:31:31 +03:00
, test " virtual postings don't need to balance " $ expect $
isTransactionBalanced Nothing $ Transaction 0 nullsourcepos ( parsedate " 2009/01/01 " ) Nothing Unmarked " " " a " " " []
[ posting { paccount = " b " , pamount = Mixed [ usd 1.00 ] }
, posting { paccount = " c " , pamount = Mixed [ usd ( - 1.00 ) ] }
, posting { paccount = " d " , pamount = Mixed [ usd 100 ] , ptype = VirtualPosting }
2010-12-27 23:26:22 +03:00
] " "
2018-09-04 21:31:31 +03:00
, test " balanced virtual postings need to balance among themselves " $ expect $
not $ isTransactionBalanced Nothing $ Transaction 0 nullsourcepos ( parsedate " 2009/01/01 " ) Nothing Unmarked " " " a " " " []
[ posting { paccount = " b " , pamount = Mixed [ usd 1.00 ] }
, posting { paccount = " c " , pamount = Mixed [ usd ( - 1.00 ) ] }
, posting { paccount = " d " , pamount = Mixed [ usd 100 ] , ptype = BalancedVirtualPosting }
2010-12-27 23:26:22 +03:00
] " "
2018-09-04 21:31:31 +03:00
, test " balanced virtual postings need to balance among themselves (2) " $ expect $
isTransactionBalanced Nothing $ Transaction 0 nullsourcepos ( parsedate " 2009/01/01 " ) Nothing Unmarked " " " a " " " []
[ posting { paccount = " b " , pamount = Mixed [ usd 1.00 ] }
, posting { paccount = " c " , pamount = Mixed [ usd ( - 1.00 ) ] }
, posting { paccount = " d " , pamount = Mixed [ usd 100 ] , ptype = BalancedVirtualPosting }
, posting { paccount = " 3 " , pamount = Mixed [ usd ( - 100 ) ] , ptype = BalancedVirtualPosting }
2010-12-27 23:26:22 +03:00
] " "
2018-09-04 21:31:31 +03:00
]
2010-12-27 23:26:22 +03:00
2018-09-04 21:31:31 +03:00
]