2021-05-09 03:20:42 +03:00
|
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE Rank2Types #-}
|
2019-02-18 23:11:07 +03:00
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
2018-03-12 12:29:24 +03:00
|
|
|
|
2008-10-03 06:04:15 +04:00
|
|
|
{-|
|
|
|
|
|
2012-04-14 02:24:55 +04:00
|
|
|
A 'Journal' is a set of transactions, plus optional related data. This is
|
|
|
|
hledger's primary data object. It is usually parsed from a journal file or
|
|
|
|
other data format (see "Hledger.Read").
|
2008-10-03 06:04:15 +04:00
|
|
|
|
|
|
|
-}
|
|
|
|
|
2012-04-14 02:24:55 +04:00
|
|
|
module Hledger.Data.Journal (
|
|
|
|
-- * Parsing helpers
|
2021-09-01 04:22:16 +03:00
|
|
|
JournalParser,
|
|
|
|
ErroringJournalParser,
|
2019-06-04 03:26:27 +03:00
|
|
|
addPriceDirective,
|
2018-07-30 21:29:45 +03:00
|
|
|
addTransactionModifier,
|
2012-04-14 02:24:55 +04:00
|
|
|
addPeriodicTransaction,
|
|
|
|
addTransaction,
|
2020-05-24 04:19:43 +03:00
|
|
|
journalInferMarketPricesFromTransactions,
|
2015-11-22 20:21:36 +03:00
|
|
|
journalApplyCommodityStyles,
|
|
|
|
commodityStylesFromAmounts,
|
2018-04-20 22:18:28 +03:00
|
|
|
journalCommodityStyles,
|
2019-10-20 05:58:27 +03:00
|
|
|
journalToCost,
|
2022-01-15 16:25:16 +03:00
|
|
|
journalAddInferredEquityPostings,
|
2018-10-12 17:01:39 +03:00
|
|
|
journalReverse,
|
2018-10-16 18:51:51 +03:00
|
|
|
journalSetLastReadTime,
|
2017-09-05 20:48:35 +03:00
|
|
|
journalPivot,
|
2012-04-14 02:24:55 +04:00
|
|
|
-- * Filtering
|
|
|
|
filterJournalTransactions,
|
2014-02-28 05:47:47 +04:00
|
|
|
filterJournalPostings,
|
2021-07-28 10:46:29 +03:00
|
|
|
filterJournalRelatedPostings,
|
2014-05-24 00:10:36 +04:00
|
|
|
filterJournalAmounts,
|
|
|
|
filterTransactionAmounts,
|
2016-06-01 22:09:16 +03:00
|
|
|
filterTransactionPostings,
|
2021-07-28 10:46:29 +03:00
|
|
|
filterTransactionRelatedPostings,
|
2014-02-28 05:47:47 +04:00
|
|
|
filterPostingAmount,
|
2019-05-05 20:35:49 +03:00
|
|
|
-- * Mapping
|
2021-02-04 18:57:26 +03:00
|
|
|
journalMapTransactions,
|
|
|
|
journalMapPostings,
|
2021-02-04 18:31:12 +03:00
|
|
|
journalMapPostingAmounts,
|
2012-04-14 02:24:55 +04:00
|
|
|
-- * Querying
|
|
|
|
journalAccountNamesUsed,
|
2017-12-29 23:18:04 +03:00
|
|
|
journalAccountNamesImplied,
|
|
|
|
journalAccountNamesDeclared,
|
|
|
|
journalAccountNamesDeclaredOrUsed,
|
|
|
|
journalAccountNamesDeclaredOrImplied,
|
|
|
|
journalAccountNames,
|
2012-11-20 01:20:10 +04:00
|
|
|
-- journalAmountAndPriceCommodities,
|
2020-02-11 20:21:24 +03:00
|
|
|
-- journalAmountStyles,
|
|
|
|
-- overJournalAmounts,
|
|
|
|
-- traverseJournalAmounts,
|
2012-11-20 01:20:10 +04:00
|
|
|
-- journalCanonicalCommodities,
|
2020-12-30 22:38:13 +03:00
|
|
|
journalPayeesDeclared,
|
2021-01-18 02:18:16 +03:00
|
|
|
journalPayeesUsed,
|
|
|
|
journalPayeesDeclaredOrUsed,
|
2020-11-28 04:54:55 +03:00
|
|
|
journalCommoditiesDeclared,
|
2021-03-01 14:35:21 +03:00
|
|
|
journalCommodities,
|
2012-04-14 02:24:55 +04:00
|
|
|
journalDateSpan,
|
2021-03-02 13:32:52 +03:00
|
|
|
journalDateSpanBothDates,
|
2019-04-23 23:58:32 +03:00
|
|
|
journalStartDate,
|
|
|
|
journalEndDate,
|
2021-07-11 23:52:50 +03:00
|
|
|
journalLastDay,
|
2014-02-28 05:47:47 +04:00
|
|
|
journalDescriptions,
|
2012-04-14 02:24:55 +04:00
|
|
|
journalFilePath,
|
|
|
|
journalFilePaths,
|
2015-10-30 06:12:46 +03:00
|
|
|
journalTransactionAt,
|
|
|
|
journalNextTransaction,
|
|
|
|
journalPrevTransaction,
|
2012-04-14 02:24:55 +04:00
|
|
|
journalPostings,
|
2021-02-20 23:40:47 +03:00
|
|
|
journalTransactionsSimilarTo,
|
2019-06-04 03:26:27 +03:00
|
|
|
-- journalPrices,
|
2012-04-14 05:12:42 +04:00
|
|
|
-- * Standard account types
|
2012-05-16 11:37:24 +04:00
|
|
|
journalBalanceSheetAccountQuery,
|
|
|
|
journalProfitAndLossAccountQuery,
|
2018-09-27 23:54:16 +03:00
|
|
|
journalRevenueAccountQuery,
|
2012-04-15 04:05:10 +04:00
|
|
|
journalExpenseAccountQuery,
|
|
|
|
journalAssetAccountQuery,
|
|
|
|
journalLiabilityAccountQuery,
|
|
|
|
journalEquityAccountQuery,
|
2012-04-17 21:32:56 +04:00
|
|
|
journalCashAccountQuery,
|
imp: cost: Generate totally balanced conversion postings for amounts with costs.
Introduce --infer-equity option which will generate conversion postings.
--cost will override --infer-equity.
This means there will no longer be unbalanced transactions, but will be
offsetting conversion postings to balance things out. For example.
2000-01-01
a 1 AAA @@ 2 BBB
b -2 BBB
When converting to cost, this is treated the same as before.
When used with --infer-equity, this is now treated as:
2000-01-01
a 1 AAA
equity:conversion:AAA-BBB:AAA -1 AAA
equity:conversion:AAA-BBB:BBB 2 BBB
b -2 BBB
There is a new account type, Conversion/V, which is a subtype of Equity/E.
The first account declared with this type, if any, is used as the base account
for inferred equity postings in conversion transactions, overriding the default
"equity:conversion".
API changes:
Costing has been changed to ConversionOp with three options:
NoConversionOp, ToCost, and InferEquity.
The first correspond to the previous NoCost and Cost options, while the
third corresponds to the --infer-equity flag. This converts transactions with costs
(one or more transaction prices) to transactions with equity:conversion postings.
It is in ConversionOp because converting to cost with -B/--cost and inferring conversion
equity postings with --infer-equity are mutually exclusive.
Correspondingly, the cost_ record of ReportOpts has been changed to
conversionop_.
This also removes show_costs_ option in ReportOpts, as its functionality
has been replaced by the richer cost_ option.
2021-05-04 04:15:55 +03:00
|
|
|
journalConversionAccount,
|
2012-04-14 02:24:55 +04:00
|
|
|
-- * Misc
|
2015-11-22 20:21:36 +03:00
|
|
|
canonicalStyleFrom,
|
2012-04-14 02:24:55 +04:00
|
|
|
nulljournal,
|
2021-08-24 05:34:32 +03:00
|
|
|
journalNumberTransactions,
|
2016-08-14 22:44:19 +03:00
|
|
|
journalNumberAndTieTransactions,
|
|
|
|
journalUntieTransactions,
|
2019-02-01 22:31:04 +03:00
|
|
|
journalModifyTransactions,
|
2020-11-24 20:17:01 +03:00
|
|
|
journalApplyAliases,
|
2012-04-14 02:24:55 +04:00
|
|
|
-- * Tests
|
2012-05-27 22:14:20 +04:00
|
|
|
samplejournal,
|
2021-08-24 05:34:32 +03:00
|
|
|
samplejournalMaybeExplicit,
|
|
|
|
tests_Journal
|
2021-11-23 00:08:33 +03:00
|
|
|
,journalLeafAccountNamesDeclared)
|
2007-07-02 23:15:39 +04:00
|
|
|
where
|
2020-12-25 08:38:26 +03:00
|
|
|
|
2021-01-03 14:33:01 +03:00
|
|
|
import Control.Applicative ((<|>))
|
2021-08-24 05:34:32 +03:00
|
|
|
import Control.Monad.Except (ExceptT(..))
|
2021-09-01 04:22:16 +03:00
|
|
|
import Control.Monad.State.Strict (StateT)
|
2021-02-21 00:42:40 +03:00
|
|
|
import Data.Char (toUpper, isDigit)
|
2020-02-29 12:54:24 +03:00
|
|
|
import Data.Default (Default(..))
|
2021-03-01 14:35:21 +03:00
|
|
|
import Data.Foldable (toList)
|
2021-08-24 05:34:32 +03:00
|
|
|
import Data.List ((\\), find, foldl', sortBy)
|
2021-01-03 14:33:01 +03:00
|
|
|
import Data.List.Extra (nubSort)
|
|
|
|
import qualified Data.Map.Strict as M
|
2021-08-24 05:34:32 +03:00
|
|
|
import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList)
|
2019-02-18 23:11:07 +03:00
|
|
|
import qualified Data.Set as S
|
lib: textification: saved journal source
Slightly worse on small files, better on large ones.
hledger -f data/100x100x10.journal stats
<<ghc: 39305392 bytes, 77 GCs, 196354/268584 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.007 elapsed), 0.014 MUT (0.027 elapsed), 0.011 GC (0.111 elapsed) :ghc>>
<<ghc: 39307728 bytes, 77 GCs, 196909/270248 avg/max bytes residency (3 samples), 2M in use, 0.001 INIT (0.010 elapsed), 0.015 MUT (0.028 elapsed), 0.012 GC (0.116 elapsed) :ghc>>
hledger -f data/1000x1000x10.journal stats
<<ghc: 314285912 bytes, 612 GCs, 2064811/6597608 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.002 elapsed), 0.126 MUT (0.134 elapsed), 0.059 GC (0.069 elapsed) :ghc>>
<<ghc: 314271368 bytes, 612 GCs, 2070227/6628024 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.000 elapsed), 0.137 MUT (0.143 elapsed), 0.059 GC (0.068 elapsed) :ghc>>
hledger -f data/10000x1000x10.journal stats
<<ghc: 3070033264 bytes, 5965 GCs, 12699294/62962464 avg/max bytes residency (10 samples), 124M in use, 0.000 INIT (0.000 elapsed), 1.245 MUT (1.300 elapsed), 0.498 GC (0.558 elapsed) :ghc>>
<<ghc: 3070006752 bytes, 5973 GCs, 12687314/62848920 avg/max bytes residency (10 samples), 124M in use, 0.000 INIT (0.003 elapsed), 1.257 MUT (1.281 elapsed), 0.496 GC (0.554 elapsed) :ghc>>
hledger -f data/100000x1000x10.journal stats
<<ghc: 30753465088 bytes, 59763 GCs, 117723618/666643528 avg/max bytes residency (14 samples), 1589M in use, 0.000 INIT (0.002 elapsed), 12.536 MUT (12.793 elapsed), 5.978 GC (7.155 elapsed) :ghc>>
<<ghc: 30753367256 bytes, 59811 GCs, 117723236/666627528 avg/max bytes residency (14 samples), 1590M in use, 0.001 INIT (0.012 elapsed), 12.923 MUT (13.169 elapsed), 5.981 GC (6.860 elapsed) :ghc>>
2016-05-24 05:24:39 +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
|
2021-03-02 13:32:52 +03:00
|
|
|
import Safe (headMay, headDef, maximumMay, minimumMay)
|
2020-12-25 08:38:26 +03:00
|
|
|
import Data.Time.Calendar (Day, addDays, fromGregorian)
|
2021-08-11 06:52:39 +03:00
|
|
|
import Data.Time.Clock.POSIX (POSIXTime)
|
2020-12-25 08:38:26 +03:00
|
|
|
import Data.Tree (Tree, flatten)
|
|
|
|
import Text.Printf (printf)
|
2021-09-01 04:22:16 +03:00
|
|
|
import Text.Megaparsec (ParsecT)
|
|
|
|
import Text.Megaparsec.Custom (FinalParseError)
|
2011-05-28 08:11:44 +04:00
|
|
|
|
2019-07-15 13:28:52 +03:00
|
|
|
import Hledger.Utils
|
2010-05-20 03:08:53 +04:00
|
|
|
import Hledger.Data.Types
|
|
|
|
import Hledger.Data.AccountName
|
|
|
|
import Hledger.Data.Amount
|
imp: cost: Generate totally balanced conversion postings for amounts with costs.
Introduce --infer-equity option which will generate conversion postings.
--cost will override --infer-equity.
This means there will no longer be unbalanced transactions, but will be
offsetting conversion postings to balance things out. For example.
2000-01-01
a 1 AAA @@ 2 BBB
b -2 BBB
When converting to cost, this is treated the same as before.
When used with --infer-equity, this is now treated as:
2000-01-01
a 1 AAA
equity:conversion:AAA-BBB:AAA -1 AAA
equity:conversion:AAA-BBB:BBB 2 BBB
b -2 BBB
There is a new account type, Conversion/V, which is a subtype of Equity/E.
The first account declared with this type, if any, is used as the base account
for inferred equity postings in conversion transactions, overriding the default
"equity:conversion".
API changes:
Costing has been changed to ConversionOp with three options:
NoConversionOp, ToCost, and InferEquity.
The first correspond to the previous NoCost and Cost options, while the
third corresponds to the --infer-equity flag. This converts transactions with costs
(one or more transaction prices) to transactions with equity:conversion postings.
It is in ConversionOp because converting to cost with -B/--cost and inferring conversion
equity postings with --infer-equity are mutually exclusive.
Correspondingly, the cost_ record of ReportOpts has been changed to
conversionop_.
This also removes show_costs_ option in ReportOpts, as its functionality
has been replaced by the richer cost_ option.
2021-05-04 04:15:55 +03:00
|
|
|
import Hledger.Data.Posting
|
2012-05-27 22:14:20 +04:00
|
|
|
import Hledger.Data.Transaction
|
2019-02-01 22:31:04 +03:00
|
|
|
import Hledger.Data.TransactionModifier
|
imp: cost: Generate totally balanced conversion postings for amounts with costs.
Introduce --infer-equity option which will generate conversion postings.
--cost will override --infer-equity.
This means there will no longer be unbalanced transactions, but will be
offsetting conversion postings to balance things out. For example.
2000-01-01
a 1 AAA @@ 2 BBB
b -2 BBB
When converting to cost, this is treated the same as before.
When used with --infer-equity, this is now treated as:
2000-01-01
a 1 AAA
equity:conversion:AAA-BBB:AAA -1 AAA
equity:conversion:AAA-BBB:BBB 2 BBB
b -2 BBB
There is a new account type, Conversion/V, which is a subtype of Equity/E.
The first account declared with this type, if any, is used as the base account
for inferred equity postings in conversion transactions, overriding the default
"equity:conversion".
API changes:
Costing has been changed to ConversionOp with three options:
NoConversionOp, ToCost, and InferEquity.
The first correspond to the previous NoCost and Cost options, while the
third corresponds to the --infer-equity flag. This converts transactions with costs
(one or more transaction prices) to transactions with equity:conversion postings.
It is in ConversionOp because converting to cost with -B/--cost and inferring conversion
equity postings with --infer-equity are mutually exclusive.
Correspondingly, the cost_ record of ReportOpts has been changed to
conversionop_.
This also removes show_costs_ option in ReportOpts, as its functionality
has been replaced by the richer cost_ option.
2021-05-04 04:15:55 +03:00
|
|
|
import Hledger.Data.Valuation
|
2012-05-16 11:57:10 +04:00
|
|
|
import Hledger.Query
|
2007-07-02 23:15:39 +04:00
|
|
|
|
|
|
|
|
2021-09-01 04:22:16 +03:00
|
|
|
-- | A parser of text that runs in some monad, keeping a Journal as state.
|
|
|
|
type JournalParser m a = StateT Journal (ParsecT CustomErr Text m) a
|
|
|
|
|
|
|
|
-- | A parser of text that runs in some monad, keeping a Journal as
|
|
|
|
-- state, that can throw an exception to end parsing, preventing
|
|
|
|
-- further parser backtracking.
|
|
|
|
type ErroringJournalParser m a =
|
|
|
|
StateT Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
|
|
|
|
|
2016-05-23 10:32:55 +03:00
|
|
|
-- deriving instance Show Journal
|
2009-12-16 10:00:43 +03:00
|
|
|
instance Show Journal where
|
2013-12-07 01:51:19 +04:00
|
|
|
show j
|
|
|
|
| debugLevel < 3 = printf "Journal %s with %d transactions, %d accounts"
|
|
|
|
(journalFilePath j)
|
2018-03-29 18:45:34 +03:00
|
|
|
(length $ jtxns j)
|
2013-12-07 01:51:19 +04:00
|
|
|
(length accounts)
|
|
|
|
| debugLevel < 6 = printf "Journal %s with %d transactions, %d accounts: %s"
|
|
|
|
(journalFilePath j)
|
2018-03-29 18:45:34 +03:00
|
|
|
(length $ jtxns j)
|
2013-12-07 01:51:19 +04:00
|
|
|
(length accounts)
|
|
|
|
(show accounts)
|
|
|
|
| otherwise = printf "Journal %s with %d transactions, %d accounts: %s, commodity styles: %s"
|
2010-09-24 05:56:11 +04:00
|
|
|
(journalFilePath j)
|
2018-03-29 18:45:34 +03:00
|
|
|
(length $ jtxns j)
|
2008-10-09 13:25:58 +04:00
|
|
|
(length accounts)
|
|
|
|
(show accounts)
|
2016-05-23 10:32:55 +03:00
|
|
|
(show $ jinferredcommodities j)
|
2009-12-16 10:00:43 +03:00
|
|
|
-- ++ (show $ journalTransactions l)
|
2015-06-29 00:14:56 +03:00
|
|
|
where accounts = filter (/= "root") $ flatten $ journalAccountNameTree j
|
2008-10-03 16:10:05 +04:00
|
|
|
|
2012-04-14 02:24:55 +04:00
|
|
|
-- showJournalDebug j = unlines [
|
|
|
|
-- show j
|
|
|
|
-- ,show (jtxns j)
|
2018-07-30 21:29:45 +03:00
|
|
|
-- ,show (jtxnmodifiers j)
|
2012-04-14 02:24:55 +04:00
|
|
|
-- ,show (jperiodictxns j)
|
2016-05-23 10:32:55 +03:00
|
|
|
-- ,show $ jparsetimeclockentries j
|
2019-06-04 03:26:27 +03:00
|
|
|
-- ,show $ jpricedirectives j
|
2016-05-23 10:32:55 +03:00
|
|
|
-- ,show $ jfinalcommentlines j
|
2016-05-19 06:57:34 +03:00
|
|
|
-- ,show $ jparsestate j
|
2016-05-23 10:32:55 +03:00
|
|
|
-- ,show $ map fst $ jfiles j
|
2012-04-14 02:24:55 +04:00
|
|
|
-- ]
|
2011-08-03 03:27:41 +04:00
|
|
|
|
2020-02-29 12:54:24 +03:00
|
|
|
-- The semigroup instance for Journal is useful for two situations.
|
2019-07-15 13:28:52 +03:00
|
|
|
--
|
2016-05-23 10:32:55 +03:00
|
|
|
-- 1. concatenating finalised journals, eg with multiple -f options:
|
|
|
|
-- FIRST <> SECOND. The second's list fields are appended to the
|
|
|
|
-- first's, map fields are combined, transaction counts are summed,
|
|
|
|
-- the parse state of the second is kept.
|
2019-07-15 13:28:52 +03:00
|
|
|
--
|
2016-05-23 10:32:55 +03:00
|
|
|
-- 2. merging a child parsed journal, eg with the include directive:
|
|
|
|
-- CHILD <> PARENT. A parsed journal's data is in reverse order, so
|
|
|
|
-- this gives what we want.
|
|
|
|
--
|
2020-02-29 12:54:24 +03:00
|
|
|
-- Note that (<>) is right-biased, so nulljournal is only a left identity.
|
|
|
|
-- In particular, this prevents Journal from being a monoid.
|
|
|
|
instance Semigroup Journal where
|
2018-03-12 12:29:24 +03:00
|
|
|
j1 <> j2 = Journal {
|
2016-05-23 10:32:55 +03:00
|
|
|
jparsedefaultyear = jparsedefaultyear j2
|
|
|
|
,jparsedefaultcommodity = jparsedefaultcommodity j2
|
2020-11-07 07:45:52 +03:00
|
|
|
,jparsedecimalmark = jparsedecimalmark j2
|
2016-05-23 10:32:55 +03:00
|
|
|
,jparseparentaccounts = jparseparentaccounts j2
|
|
|
|
,jparsealiases = jparsealiases j2
|
2016-08-14 22:44:19 +03:00
|
|
|
-- ,jparsetransactioncount = jparsetransactioncount j1 + jparsetransactioncount j2
|
2020-06-15 01:48:16 +03:00
|
|
|
,jparsetimeclockentries = jparsetimeclockentries j1 <> jparsetimeclockentries j2
|
|
|
|
,jincludefilestack = jincludefilestack j2
|
2020-12-30 22:38:13 +03:00
|
|
|
,jdeclaredpayees = jdeclaredpayees j1 <> jdeclaredpayees j2
|
journal: account directives can declare account types
Previously you had to use one of the standard english account names
(assets, liabilities..) for top-level accounts, if you wanted to use
the bs/bse/cf/is commands.
Now, account directives can specify which of the big five categories
an account belongs to - asset, liability, equity, revenue or expense -
by writing one of the letters A, L, E, R or X two or more spaces after
the account name (where the numeric account code used to be).
This might change. Some thoughts influencing the current syntax:
- easy to type and read
- does not require multiple lines
- does not depend on any particular account numbering scheme
- allows more types later if needed
- still anglocentric, but only a little
- could be treated as syntactic sugar for account tags later
- seems to be compatible with (ignored by) current Ledger
The current design permits unlimited account type declarations anywhere
in the account tree. So you could declare a liability account somewhere
under assets, and maybe a revenue account under that, and another asset
account even further down. In such cases you start to see oddities like
accounts appearing in multiple places in a tree-mode report. In theory
the reports will still behave reasonably, but this has not been tested
too hard. In any case this is clearly too much freedom. I have left it
this way, for now, in case it helps with:
- modelling contra accounts ?
- multiple files. I suspect the extra expressiveness may come in handy
when combining multiple files with account type declarations,
rewriting account names, apply parent accounts etc.
If we only allowed type declarations on top-level accounts, or
only allowed a single account of each type, complications seem likely.
2018-09-27 04:34:48 +03:00
|
|
|
,jdeclaredaccounts = jdeclaredaccounts j1 <> jdeclaredaccounts j2
|
|
|
|
,jdeclaredaccounttypes = jdeclaredaccounttypes j1 <> jdeclaredaccounttypes j2
|
2020-11-09 22:28:11 +03:00
|
|
|
,jglobalcommoditystyles = jglobalcommoditystyles j1 <> jglobalcommoditystyles j2
|
2016-05-23 10:32:55 +03:00
|
|
|
,jcommodities = jcommodities j1 <> jcommodities j2
|
|
|
|
,jinferredcommodities = jinferredcommodities j1 <> jinferredcommodities j2
|
2020-06-15 01:48:16 +03:00
|
|
|
,jpricedirectives = jpricedirectives j1 <> jpricedirectives j2
|
2020-06-19 03:09:59 +03:00
|
|
|
,jinferredmarketprices = jinferredmarketprices j1 <> jinferredmarketprices j2
|
2018-07-30 21:29:45 +03:00
|
|
|
,jtxnmodifiers = jtxnmodifiers j1 <> jtxnmodifiers j2
|
2016-05-23 10:32:55 +03:00
|
|
|
,jperiodictxns = jperiodictxns j1 <> jperiodictxns j2
|
|
|
|
,jtxns = jtxns j1 <> jtxns j2
|
2020-06-15 01:48:16 +03:00
|
|
|
,jfinalcommentlines = jfinalcommentlines j2 -- XXX discards j1's ?
|
2016-05-23 10:32:55 +03:00
|
|
|
,jfiles = jfiles j1 <> jfiles j2
|
|
|
|
,jlastreadtime = max (jlastreadtime j1) (jlastreadtime j2)
|
|
|
|
}
|
2016-05-19 01:08:50 +03:00
|
|
|
|
2020-02-29 12:54:24 +03:00
|
|
|
instance Default Journal where
|
|
|
|
def = nulljournal
|
2018-03-12 12:29:24 +03:00
|
|
|
|
2009-12-20 18:50:54 +03:00
|
|
|
nulljournal :: Journal
|
2016-05-23 10:32:55 +03:00
|
|
|
nulljournal = Journal {
|
|
|
|
jparsedefaultyear = Nothing
|
|
|
|
,jparsedefaultcommodity = Nothing
|
2020-11-07 07:45:52 +03:00
|
|
|
,jparsedecimalmark = Nothing
|
2016-05-23 10:32:55 +03:00
|
|
|
,jparseparentaccounts = []
|
|
|
|
,jparsealiases = []
|
2016-08-14 22:44:19 +03:00
|
|
|
-- ,jparsetransactioncount = 0
|
2018-09-30 05:33:17 +03:00
|
|
|
,jparsetimeclockentries = []
|
|
|
|
,jincludefilestack = []
|
2020-12-30 22:38:13 +03:00
|
|
|
,jdeclaredpayees = []
|
2018-09-30 05:33:17 +03:00
|
|
|
,jdeclaredaccounts = []
|
journal: account directives can declare account types
Previously you had to use one of the standard english account names
(assets, liabilities..) for top-level accounts, if you wanted to use
the bs/bse/cf/is commands.
Now, account directives can specify which of the big five categories
an account belongs to - asset, liability, equity, revenue or expense -
by writing one of the letters A, L, E, R or X two or more spaces after
the account name (where the numeric account code used to be).
This might change. Some thoughts influencing the current syntax:
- easy to type and read
- does not require multiple lines
- does not depend on any particular account numbering scheme
- allows more types later if needed
- still anglocentric, but only a little
- could be treated as syntactic sugar for account tags later
- seems to be compatible with (ignored by) current Ledger
The current design permits unlimited account type declarations anywhere
in the account tree. So you could declare a liability account somewhere
under assets, and maybe a revenue account under that, and another asset
account even further down. In such cases you start to see oddities like
accounts appearing in multiple places in a tree-mode report. In theory
the reports will still behave reasonably, but this has not been tested
too hard. In any case this is clearly too much freedom. I have left it
this way, for now, in case it helps with:
- modelling contra accounts ?
- multiple files. I suspect the extra expressiveness may come in handy
when combining multiple files with account type declarations,
rewriting account names, apply parent accounts etc.
If we only allowed type declarations on top-level accounts, or
only allowed a single account of each type, complications seem likely.
2018-09-27 04:34:48 +03:00
|
|
|
,jdeclaredaccounttypes = M.empty
|
2020-11-09 22:28:11 +03:00
|
|
|
,jglobalcommoditystyles = M.empty
|
journal: account directives can declare account types
Previously you had to use one of the standard english account names
(assets, liabilities..) for top-level accounts, if you wanted to use
the bs/bse/cf/is commands.
Now, account directives can specify which of the big five categories
an account belongs to - asset, liability, equity, revenue or expense -
by writing one of the letters A, L, E, R or X two or more spaces after
the account name (where the numeric account code used to be).
This might change. Some thoughts influencing the current syntax:
- easy to type and read
- does not require multiple lines
- does not depend on any particular account numbering scheme
- allows more types later if needed
- still anglocentric, but only a little
- could be treated as syntactic sugar for account tags later
- seems to be compatible with (ignored by) current Ledger
The current design permits unlimited account type declarations anywhere
in the account tree. So you could declare a liability account somewhere
under assets, and maybe a revenue account under that, and another asset
account even further down. In such cases you start to see oddities like
accounts appearing in multiple places in a tree-mode report. In theory
the reports will still behave reasonably, but this has not been tested
too hard. In any case this is clearly too much freedom. I have left it
this way, for now, in case it helps with:
- modelling contra accounts ?
- multiple files. I suspect the extra expressiveness may come in handy
when combining multiple files with account type declarations,
rewriting account names, apply parent accounts etc.
If we only allowed type declarations on top-level accounts, or
only allowed a single account of each type, complications seem likely.
2018-09-27 04:34:48 +03:00
|
|
|
,jcommodities = M.empty
|
|
|
|
,jinferredcommodities = M.empty
|
2020-06-15 01:48:16 +03:00
|
|
|
,jpricedirectives = []
|
2020-06-19 03:09:59 +03:00
|
|
|
,jinferredmarketprices = []
|
2018-07-30 21:29:45 +03:00
|
|
|
,jtxnmodifiers = []
|
2016-05-23 10:32:55 +03:00
|
|
|
,jperiodictxns = []
|
|
|
|
,jtxns = []
|
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
|
|
|
,jfinalcommentlines = ""
|
2016-05-23 10:32:55 +03:00
|
|
|
,jfiles = []
|
2021-08-11 06:52:39 +03:00
|
|
|
,jlastreadtime = 0
|
2016-05-23 10:32:55 +03:00
|
|
|
}
|
2010-11-13 18:03:40 +03:00
|
|
|
|
2010-09-24 05:56:11 +04:00
|
|
|
journalFilePath :: Journal -> FilePath
|
|
|
|
journalFilePath = fst . mainfile
|
|
|
|
|
|
|
|
journalFilePaths :: Journal -> [FilePath]
|
2016-05-23 10:32:55 +03:00
|
|
|
journalFilePaths = map fst . jfiles
|
2010-09-24 05:56:11 +04:00
|
|
|
|
lib: textification: saved journal source
Slightly worse on small files, better on large ones.
hledger -f data/100x100x10.journal stats
<<ghc: 39305392 bytes, 77 GCs, 196354/268584 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.007 elapsed), 0.014 MUT (0.027 elapsed), 0.011 GC (0.111 elapsed) :ghc>>
<<ghc: 39307728 bytes, 77 GCs, 196909/270248 avg/max bytes residency (3 samples), 2M in use, 0.001 INIT (0.010 elapsed), 0.015 MUT (0.028 elapsed), 0.012 GC (0.116 elapsed) :ghc>>
hledger -f data/1000x1000x10.journal stats
<<ghc: 314285912 bytes, 612 GCs, 2064811/6597608 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.002 elapsed), 0.126 MUT (0.134 elapsed), 0.059 GC (0.069 elapsed) :ghc>>
<<ghc: 314271368 bytes, 612 GCs, 2070227/6628024 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.000 elapsed), 0.137 MUT (0.143 elapsed), 0.059 GC (0.068 elapsed) :ghc>>
hledger -f data/10000x1000x10.journal stats
<<ghc: 3070033264 bytes, 5965 GCs, 12699294/62962464 avg/max bytes residency (10 samples), 124M in use, 0.000 INIT (0.000 elapsed), 1.245 MUT (1.300 elapsed), 0.498 GC (0.558 elapsed) :ghc>>
<<ghc: 3070006752 bytes, 5973 GCs, 12687314/62848920 avg/max bytes residency (10 samples), 124M in use, 0.000 INIT (0.003 elapsed), 1.257 MUT (1.281 elapsed), 0.496 GC (0.554 elapsed) :ghc>>
hledger -f data/100000x1000x10.journal stats
<<ghc: 30753465088 bytes, 59763 GCs, 117723618/666643528 avg/max bytes residency (14 samples), 1589M in use, 0.000 INIT (0.002 elapsed), 12.536 MUT (12.793 elapsed), 5.978 GC (7.155 elapsed) :ghc>>
<<ghc: 30753367256 bytes, 59811 GCs, 117723236/666627528 avg/max bytes residency (14 samples), 1590M in use, 0.001 INIT (0.012 elapsed), 12.923 MUT (13.169 elapsed), 5.981 GC (6.860 elapsed) :ghc>>
2016-05-24 05:24:39 +03:00
|
|
|
mainfile :: Journal -> (FilePath, Text)
|
2016-05-23 10:32:55 +03:00
|
|
|
mainfile = headDef ("", "") . jfiles
|
2010-09-24 05:56:11 +04:00
|
|
|
|
2009-12-16 11:07:26 +03:00
|
|
|
addTransaction :: Transaction -> Journal -> Journal
|
2014-11-03 09:00:02 +03:00
|
|
|
addTransaction t j = j { jtxns = t : jtxns j }
|
2008-12-08 04:48:03 +03:00
|
|
|
|
2018-07-30 21:29:45 +03:00
|
|
|
addTransactionModifier :: TransactionModifier -> Journal -> Journal
|
|
|
|
addTransactionModifier mt j = j { jtxnmodifiers = mt : jtxnmodifiers j }
|
2008-12-08 04:48:03 +03:00
|
|
|
|
2009-12-16 10:00:43 +03:00
|
|
|
addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal
|
2014-11-03 09:00:02 +03:00
|
|
|
addPeriodicTransaction pt j = j { jperiodictxns = pt : jperiodictxns j }
|
2008-12-08 04:48:03 +03:00
|
|
|
|
2019-06-04 03:26:27 +03:00
|
|
|
addPriceDirective :: PriceDirective -> Journal -> Journal
|
|
|
|
addPriceDirective h j = j { jpricedirectives = h : jpricedirectives j } -- XXX #999 keep sorted
|
2008-12-16 13:54:20 +03:00
|
|
|
|
2015-10-30 06:12:46 +03:00
|
|
|
-- | Get the transaction with this index (its 1-based position in the input stream), if any.
|
|
|
|
journalTransactionAt :: Journal -> Integer -> Maybe Transaction
|
|
|
|
journalTransactionAt Journal{jtxns=ts} i =
|
|
|
|
-- it's probably ts !! (i+1), but we won't assume
|
|
|
|
headMay [t | t <- ts, tindex t == i]
|
|
|
|
|
|
|
|
-- | Get the transaction that appeared immediately after this one in the input stream, if any.
|
|
|
|
journalNextTransaction :: Journal -> Transaction -> Maybe Transaction
|
|
|
|
journalNextTransaction j t = journalTransactionAt j (tindex t + 1)
|
2016-02-21 13:37:59 +03:00
|
|
|
|
2015-10-30 06:12:46 +03:00
|
|
|
-- | Get the transaction that appeared immediately before this one in the input stream, if any.
|
|
|
|
journalPrevTransaction :: Journal -> Transaction -> Maybe Transaction
|
|
|
|
journalPrevTransaction j t = journalTransactionAt j (tindex t - 1)
|
2016-02-21 13:37:59 +03:00
|
|
|
|
2014-02-28 05:47:47 +04:00
|
|
|
-- | All postings from this journal's transactions, in order.
|
2009-12-19 08:57:54 +03:00
|
|
|
journalPostings :: Journal -> [Posting]
|
|
|
|
journalPostings = concatMap tpostings . jtxns
|
2008-10-03 16:10:05 +04:00
|
|
|
|
2020-11-28 04:54:55 +03:00
|
|
|
-- | Sorted unique commodity symbols declared by commodity directives in this journal.
|
2021-03-01 14:35:21 +03:00
|
|
|
journalCommoditiesDeclared :: Journal -> [CommoditySymbol]
|
|
|
|
journalCommoditiesDeclared = M.keys . jcommodities
|
|
|
|
|
|
|
|
-- | Sorted unique commodity symbols declared or inferred from this journal.
|
|
|
|
journalCommodities :: Journal -> S.Set CommoditySymbol
|
|
|
|
journalCommodities j = M.keysSet (jcommodities j) <> M.keysSet (jinferredcommodities j)
|
2020-11-28 04:54:55 +03:00
|
|
|
|
2021-01-18 02:18:16 +03:00
|
|
|
-- | Unique transaction descriptions used in this journal.
|
|
|
|
journalDescriptions :: Journal -> [Text]
|
|
|
|
journalDescriptions = nubSort . map tdescription . jtxns
|
|
|
|
|
2020-12-30 22:38:13 +03:00
|
|
|
-- | Sorted unique payees declared by payee directives in this journal.
|
|
|
|
journalPayeesDeclared :: Journal -> [Payee]
|
|
|
|
journalPayeesDeclared = nubSort . map fst . jdeclaredpayees
|
|
|
|
|
2021-01-18 02:18:16 +03:00
|
|
|
-- | Sorted unique payees used by transactions in this journal.
|
|
|
|
journalPayeesUsed :: Journal -> [Payee]
|
|
|
|
journalPayeesUsed = nubSort . map transactionPayee . jtxns
|
|
|
|
|
|
|
|
-- | Sorted unique payees used in transactions or declared by payee directives in this journal.
|
|
|
|
journalPayeesDeclaredOrUsed :: Journal -> [Payee]
|
2021-03-01 14:35:21 +03:00
|
|
|
journalPayeesDeclaredOrUsed j = toList $ foldMap S.fromList
|
|
|
|
[journalPayeesDeclared j, journalPayeesUsed j]
|
2021-01-18 02:18:16 +03:00
|
|
|
|
2017-12-29 23:18:04 +03:00
|
|
|
-- | Sorted unique account names posted to by this journal's transactions.
|
2009-12-16 10:00:43 +03:00
|
|
|
journalAccountNamesUsed :: Journal -> [AccountName]
|
2017-12-29 23:18:04 +03:00
|
|
|
journalAccountNamesUsed = accountNamesFromPostings . journalPostings
|
|
|
|
|
2019-07-15 13:28:52 +03:00
|
|
|
-- | Sorted unique account names implied by this journal's transactions -
|
2017-12-29 23:18:04 +03:00
|
|
|
-- accounts posted to and all their implied parent accounts.
|
|
|
|
journalAccountNamesImplied :: Journal -> [AccountName]
|
|
|
|
journalAccountNamesImplied = expandAccountNames . journalAccountNamesUsed
|
|
|
|
|
|
|
|
-- | Sorted unique account names declared by account directives in this journal.
|
|
|
|
journalAccountNamesDeclared :: Journal -> [AccountName]
|
2020-01-04 09:09:01 +03:00
|
|
|
journalAccountNamesDeclared = nubSort . map fst . jdeclaredaccounts
|
2017-12-29 23:18:04 +03:00
|
|
|
|
2021-11-23 00:08:33 +03:00
|
|
|
-- | Sorted unique account names declared by account directives in this journal,
|
|
|
|
-- which have no children.
|
|
|
|
journalLeafAccountNamesDeclared :: Journal -> [AccountName]
|
|
|
|
journalLeafAccountNamesDeclared = treeLeaves . accountNameTreeFrom . journalAccountNamesDeclared
|
|
|
|
|
2017-12-29 23:18:04 +03:00
|
|
|
-- | Sorted unique account names declared by account directives or posted to
|
|
|
|
-- by transactions in this journal.
|
|
|
|
journalAccountNamesDeclaredOrUsed :: Journal -> [AccountName]
|
2021-03-01 14:35:21 +03:00
|
|
|
journalAccountNamesDeclaredOrUsed j = toList $ foldMap S.fromList
|
|
|
|
[journalAccountNamesDeclared j, journalAccountNamesUsed j]
|
2017-12-29 23:18:04 +03:00
|
|
|
|
|
|
|
-- | Sorted unique account names declared by account directives, or posted to
|
|
|
|
-- or implied as parents by transactions in this journal.
|
|
|
|
journalAccountNamesDeclaredOrImplied :: Journal -> [AccountName]
|
2021-03-01 14:35:21 +03:00
|
|
|
journalAccountNamesDeclaredOrImplied j = toList $ foldMap S.fromList
|
|
|
|
[journalAccountNamesDeclared j, expandAccountNames $ journalAccountNamesUsed j]
|
2008-10-03 16:10:05 +04:00
|
|
|
|
2017-12-29 23:34:51 +03:00
|
|
|
-- | Convenience/compatibility alias for journalAccountNamesDeclaredOrImplied.
|
2009-12-16 10:00:43 +03:00
|
|
|
journalAccountNames :: Journal -> [AccountName]
|
2019-07-15 13:28:52 +03:00
|
|
|
journalAccountNames = journalAccountNamesDeclaredOrImplied
|
2008-10-03 16:10:05 +04:00
|
|
|
|
2009-12-16 10:00:43 +03:00
|
|
|
journalAccountNameTree :: Journal -> Tree AccountName
|
2021-03-01 14:35:21 +03:00
|
|
|
journalAccountNameTree = accountNameTreeFrom . journalAccountNamesDeclaredOrImplied
|
2008-10-10 08:23:25 +04:00
|
|
|
|
2021-02-20 23:40:47 +03:00
|
|
|
-- | Find up to N most similar and most recent transactions matching
|
|
|
|
-- the given transaction description and query. Transactions are
|
|
|
|
-- listed with their description's similarity score (see
|
|
|
|
-- compareDescriptions), sorted by highest score and then by date.
|
2021-02-21 00:42:40 +03:00
|
|
|
-- Only transactions with a similarity score greater than a minimum
|
2021-02-20 23:40:47 +03:00
|
|
|
-- threshold (currently 0) are returned.
|
|
|
|
journalTransactionsSimilarTo :: Journal -> Query -> Text -> Int -> [(Double,Transaction)]
|
2021-02-21 00:42:40 +03:00
|
|
|
journalTransactionsSimilarTo Journal{jtxns} q desc n =
|
2021-02-20 23:40:47 +03:00
|
|
|
take n $
|
|
|
|
sortBy (\(s1,t1) (s2,t2) -> compare (s2,tdate t2) (s1,tdate t1)) $
|
|
|
|
filter ((> threshold).fst)
|
2021-02-21 00:42:40 +03:00
|
|
|
[(compareDescriptions desc $ tdescription t, t) | t <- jtxns, q `matchesTransaction` t]
|
2021-02-20 23:40:47 +03:00
|
|
|
where
|
|
|
|
threshold = 0
|
|
|
|
|
2021-02-21 00:42:40 +03:00
|
|
|
-- | Return a similarity score from 0 to 1.5 for two transaction descriptions.
|
|
|
|
-- This is based on compareStrings, with the following modifications:
|
|
|
|
--
|
|
|
|
-- - numbers are stripped out before measuring similarity
|
|
|
|
--
|
|
|
|
-- - if the (unstripped) first description appears in its entirety within the second,
|
|
|
|
-- the score is boosted by 0.5.
|
|
|
|
--
|
2021-02-20 23:40:47 +03:00
|
|
|
compareDescriptions :: Text -> Text -> Double
|
2021-02-21 00:42:40 +03:00
|
|
|
compareDescriptions a b =
|
|
|
|
(if a `T.isInfixOf` b then (0.5+) else id) $
|
|
|
|
compareStrings (simplify a) (simplify b)
|
|
|
|
where
|
|
|
|
simplify = T.unpack . T.filter (not.isDigit)
|
2021-02-20 23:40:47 +03:00
|
|
|
|
2021-02-21 00:42:40 +03:00
|
|
|
-- | Return a similarity score from 0 to 1 for two strings. This
|
2021-02-20 23:40:47 +03:00
|
|
|
-- was based on Simon White's string similarity algorithm
|
|
|
|
-- (http://www.catalysoft.com/articles/StrikeAMatch.html), later found
|
|
|
|
-- to be https://en.wikipedia.org/wiki/S%C3%B8rensen%E2%80%93Dice_coefficient,
|
2021-02-21 00:42:40 +03:00
|
|
|
-- and modified to handle short strings better.
|
2021-02-20 23:40:47 +03:00
|
|
|
-- Todo: check out http://nlp.fi.muni.cz/raslan/2008/raslan08.pdf#page=14 .
|
|
|
|
compareStrings :: String -> String -> Double
|
|
|
|
compareStrings "" "" = 1
|
|
|
|
compareStrings [_] "" = 0
|
|
|
|
compareStrings "" [_] = 0
|
|
|
|
compareStrings [a] [b] = if toUpper a == toUpper b then 1 else 0
|
|
|
|
compareStrings s1 s2 = 2 * commonpairs / totalpairs
|
2021-02-21 00:42:40 +03:00
|
|
|
where
|
|
|
|
pairs1 = S.fromList $ wordLetterPairs $ uppercase s1
|
|
|
|
pairs2 = S.fromList $ wordLetterPairs $ uppercase s2
|
|
|
|
commonpairs = fromIntegral $ S.size $ S.intersection pairs1 pairs2
|
|
|
|
totalpairs = fromIntegral $ S.size pairs1 + S.size pairs2
|
2021-02-20 23:40:47 +03:00
|
|
|
|
2021-02-21 00:42:40 +03:00
|
|
|
wordLetterPairs :: String -> [String]
|
2021-02-20 23:40:47 +03:00
|
|
|
wordLetterPairs = concatMap letterPairs . words
|
|
|
|
|
2021-02-21 00:42:40 +03:00
|
|
|
letterPairs :: String -> [String]
|
2021-02-20 23:40:47 +03:00
|
|
|
letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest)
|
|
|
|
letterPairs _ = []
|
|
|
|
|
2018-09-27 23:54:16 +03:00
|
|
|
-- queries for standard account types
|
|
|
|
|
2021-02-14 01:54:04 +03:00
|
|
|
-- | Get a query for accounts of the specified types in this journal.
|
imp: cost: Generate totally balanced conversion postings for amounts with costs.
Introduce --infer-equity option which will generate conversion postings.
--cost will override --infer-equity.
This means there will no longer be unbalanced transactions, but will be
offsetting conversion postings to balance things out. For example.
2000-01-01
a 1 AAA @@ 2 BBB
b -2 BBB
When converting to cost, this is treated the same as before.
When used with --infer-equity, this is now treated as:
2000-01-01
a 1 AAA
equity:conversion:AAA-BBB:AAA -1 AAA
equity:conversion:AAA-BBB:BBB 2 BBB
b -2 BBB
There is a new account type, Conversion/V, which is a subtype of Equity/E.
The first account declared with this type, if any, is used as the base account
for inferred equity postings in conversion transactions, overriding the default
"equity:conversion".
API changes:
Costing has been changed to ConversionOp with three options:
NoConversionOp, ToCost, and InferEquity.
The first correspond to the previous NoCost and Cost options, while the
third corresponds to the --infer-equity flag. This converts transactions with costs
(one or more transaction prices) to transactions with equity:conversion postings.
It is in ConversionOp because converting to cost with -B/--cost and inferring conversion
equity postings with --infer-equity are mutually exclusive.
Correspondingly, the cost_ record of ReportOpts has been changed to
conversionop_.
This also removes show_costs_ option in ReportOpts, as its functionality
has been replaced by the richer cost_ option.
2021-05-04 04:15:55 +03:00
|
|
|
-- Account types include:
|
|
|
|
-- Asset, Liability, Equity, Revenue, Expense, Cash, Conversion.
|
2021-02-14 01:54:04 +03:00
|
|
|
-- For each type, if no accounts were declared with this type, the query
|
|
|
|
-- will instead match accounts with names matched by the case-insensitive
|
|
|
|
-- regular expression provided as a fallback.
|
|
|
|
-- The query will match all accounts which were declared as one of
|
|
|
|
-- these types (by account directives with the type: tag), plus all their
|
|
|
|
-- subaccounts which have not been declared as some other type.
|
|
|
|
journalAccountTypeQuery :: [AccountType] -> Regexp -> Journal -> Query
|
|
|
|
journalAccountTypeQuery atypes fallbackregex Journal{jdeclaredaccounttypes} =
|
|
|
|
let
|
|
|
|
declaredacctsoftype :: [AccountName] =
|
|
|
|
concat $ mapMaybe (`M.lookup` jdeclaredaccounttypes) atypes
|
|
|
|
in case declaredacctsoftype of
|
|
|
|
[] -> Acct fallbackregex
|
2021-08-16 08:38:25 +03:00
|
|
|
as -> And $ Or acctnameRegexes : if null differentlyTypedRegexes then [] else [ Not $ Or differentlyTypedRegexes ]
|
2021-02-14 01:54:04 +03:00
|
|
|
where
|
|
|
|
-- XXX Query isn't able to match account type since that requires extra info from the journal.
|
|
|
|
-- So we do a hacky search by name instead.
|
|
|
|
acctnameRegexes = map (Acct . accountNameToAccountRegex) as
|
|
|
|
differentlyTypedRegexes = map (Acct . accountNameToAccountRegex) differentlytypedsubs
|
|
|
|
|
|
|
|
differentlytypedsubs = concat
|
|
|
|
[subs | (t,bs) <- M.toList jdeclaredaccounttypes
|
2021-08-16 07:09:17 +03:00
|
|
|
, t `notElem` atypes
|
2021-02-14 01:54:04 +03:00
|
|
|
, let subs = [b | b <- bs, any (`isAccountNamePrefixOf` b) as]
|
|
|
|
]
|
|
|
|
|
2018-09-27 23:54:16 +03:00
|
|
|
-- | A query for accounts in this journal which have been
|
2020-07-17 18:51:07 +03:00
|
|
|
-- declared as Asset (or Cash, a subtype of Asset) by account directives,
|
|
|
|
-- or otherwise for accounts with names matched by the case-insensitive
|
|
|
|
-- regular expression @^assets?(:|$)@.
|
2018-09-27 23:54:16 +03:00
|
|
|
journalAssetAccountQuery :: Journal -> Query
|
2021-02-13 19:09:45 +03:00
|
|
|
journalAssetAccountQuery j =
|
|
|
|
Or [
|
|
|
|
journalAccountTypeQuery [Asset] (toRegexCI' "^assets?(:|$)") j
|
2021-02-14 01:54:04 +03:00
|
|
|
,journalCashAccountOnlyQuery j
|
2021-02-13 19:09:45 +03:00
|
|
|
]
|
2020-07-17 18:51:07 +03:00
|
|
|
|
2021-02-14 01:54:04 +03:00
|
|
|
-- | A query for accounts in this journal which have been
|
|
|
|
-- declared as Asset (and not Cash) by account directives,
|
|
|
|
-- or otherwise for accounts with names matched by the case-insensitive
|
|
|
|
-- regular expression @^assets?(:|$)@.
|
|
|
|
journalAssetNonCashAccountQuery :: Journal -> Query
|
2021-08-16 08:32:12 +03:00
|
|
|
journalAssetNonCashAccountQuery = journalAccountTypeQuery [Asset] (toRegexCI' "^assets?(:|$)")
|
2021-02-14 01:54:04 +03:00
|
|
|
|
|
|
|
-- | A query for Cash (liquid asset) accounts in this journal, ie accounts
|
|
|
|
-- declared as Cash by account directives, or otherwise Asset accounts whose
|
|
|
|
-- names do not include the case-insensitive regular expression
|
|
|
|
-- @(investment|receivable|:A/R|:fixed)@.
|
2020-07-17 18:51:07 +03:00
|
|
|
journalCashAccountQuery :: Journal -> Query
|
|
|
|
journalCashAccountQuery j =
|
|
|
|
case M.lookup Cash (jdeclaredaccounttypes j) of
|
2021-02-14 01:54:04 +03:00
|
|
|
Just _ -> journalCashAccountOnlyQuery j
|
|
|
|
Nothing ->
|
|
|
|
-- no Cash accounts are declared; query for Asset accounts and exclude some of them
|
|
|
|
And [ journalAssetNonCashAccountQuery j, Not . Acct $ toRegexCI' "(investment|receivable|:A/R|:fixed)" ]
|
|
|
|
|
|
|
|
-- | A query for accounts in this journal specifically declared as Cash by
|
|
|
|
-- account directives, or otherwise the None query.
|
|
|
|
journalCashAccountOnlyQuery :: Journal -> Query
|
|
|
|
journalCashAccountOnlyQuery j =
|
|
|
|
case M.lookup Cash (jdeclaredaccounttypes j) of
|
|
|
|
Just _ ->
|
|
|
|
-- Cash accounts are declared; get a query for them (the fallback regex won't be used)
|
|
|
|
journalAccountTypeQuery [Cash] notused j
|
|
|
|
where notused = error' "journalCashAccountOnlyQuery: this should not have happened!" -- PARTIAL:
|
|
|
|
Nothing -> None
|
2018-09-27 23:54:16 +03:00
|
|
|
|
|
|
|
-- | A query for accounts in this journal which have been
|
|
|
|
-- declared as Liability by account directives, or otherwise for
|
2019-07-15 13:28:52 +03:00
|
|
|
-- accounts with names matched by the case-insensitive regular expression
|
2018-09-27 23:54:16 +03:00
|
|
|
-- @^(debts?|liabilit(y|ies))(:|$)@.
|
|
|
|
journalLiabilityAccountQuery :: Journal -> Query
|
2020-09-03 19:48:50 +03:00
|
|
|
journalLiabilityAccountQuery = journalAccountTypeQuery [Liability] (toRegexCI' "^(debts?|liabilit(y|ies))(:|$)")
|
2018-09-27 23:54:16 +03:00
|
|
|
|
|
|
|
-- | A query for accounts in this journal which have been
|
|
|
|
-- declared as Equity by account directives, or otherwise for
|
2019-07-15 13:28:52 +03:00
|
|
|
-- accounts with names matched by the case-insensitive regular expression
|
2018-09-27 23:54:16 +03:00
|
|
|
-- @^equity(:|$)@.
|
|
|
|
journalEquityAccountQuery :: Journal -> Query
|
2020-09-03 19:48:50 +03:00
|
|
|
journalEquityAccountQuery = journalAccountTypeQuery [Equity] (toRegexCI' "^equity(:|$)")
|
2018-09-27 23:54:16 +03:00
|
|
|
|
|
|
|
-- | A query for accounts in this journal which have been
|
|
|
|
-- declared as Revenue by account directives, or otherwise for
|
2019-07-15 13:28:52 +03:00
|
|
|
-- accounts with names matched by the case-insensitive regular expression
|
2018-09-27 23:54:16 +03:00
|
|
|
-- @^(income|revenue)s?(:|$)@.
|
|
|
|
journalRevenueAccountQuery :: Journal -> Query
|
2020-09-03 19:48:50 +03:00
|
|
|
journalRevenueAccountQuery = journalAccountTypeQuery [Revenue] (toRegexCI' "^(income|revenue)s?(:|$)")
|
2018-09-27 23:54:16 +03:00
|
|
|
|
|
|
|
-- | A query for accounts in this journal which have been
|
|
|
|
-- declared as Expense by account directives, or otherwise for
|
2019-07-15 13:28:52 +03:00
|
|
|
-- accounts with names matched by the case-insensitive regular expression
|
2020-03-23 02:34:12 +03:00
|
|
|
-- @^expenses?(:|$)@.
|
2012-05-16 11:12:49 +04:00
|
|
|
journalExpenseAccountQuery :: Journal -> Query
|
2020-09-03 19:48:50 +03:00
|
|
|
journalExpenseAccountQuery = journalAccountTypeQuery [Expense] (toRegexCI' "^expenses?(:|$)")
|
2012-04-14 05:12:42 +04:00
|
|
|
|
2012-05-16 11:37:24 +04:00
|
|
|
-- | A query for Asset, Liability & Equity accounts in this journal.
|
2012-04-14 05:12:42 +04:00
|
|
|
-- Cf <http://en.wikipedia.org/wiki/Chart_of_accounts#Balance_Sheet_Accounts>.
|
2020-08-15 12:14:27 +03:00
|
|
|
journalBalanceSheetAccountQuery :: Journal -> Query
|
2012-05-16 11:12:49 +04:00
|
|
|
journalBalanceSheetAccountQuery j = Or [journalAssetAccountQuery j
|
2018-09-27 05:14:54 +03:00
|
|
|
,journalLiabilityAccountQuery j
|
|
|
|
,journalEquityAccountQuery j
|
|
|
|
]
|
2012-04-15 04:05:10 +04:00
|
|
|
|
2018-09-27 23:54:16 +03:00
|
|
|
-- | A query for Profit & Loss accounts in this journal.
|
|
|
|
-- Cf <http://en.wikipedia.org/wiki/Chart_of_accounts#Profit_.26_Loss_accounts>.
|
|
|
|
journalProfitAndLossAccountQuery :: Journal -> Query
|
|
|
|
journalProfitAndLossAccountQuery j = Or [journalRevenueAccountQuery j
|
|
|
|
,journalExpenseAccountQuery j
|
|
|
|
]
|
2012-04-14 05:12:42 +04:00
|
|
|
|
imp: cost: Generate totally balanced conversion postings for amounts with costs.
Introduce --infer-equity option which will generate conversion postings.
--cost will override --infer-equity.
This means there will no longer be unbalanced transactions, but will be
offsetting conversion postings to balance things out. For example.
2000-01-01
a 1 AAA @@ 2 BBB
b -2 BBB
When converting to cost, this is treated the same as before.
When used with --infer-equity, this is now treated as:
2000-01-01
a 1 AAA
equity:conversion:AAA-BBB:AAA -1 AAA
equity:conversion:AAA-BBB:BBB 2 BBB
b -2 BBB
There is a new account type, Conversion/V, which is a subtype of Equity/E.
The first account declared with this type, if any, is used as the base account
for inferred equity postings in conversion transactions, overriding the default
"equity:conversion".
API changes:
Costing has been changed to ConversionOp with three options:
NoConversionOp, ToCost, and InferEquity.
The first correspond to the previous NoCost and Cost options, while the
third corresponds to the --infer-equity flag. This converts transactions with costs
(one or more transaction prices) to transactions with equity:conversion postings.
It is in ConversionOp because converting to cost with -B/--cost and inferring conversion
equity postings with --infer-equity are mutually exclusive.
Correspondingly, the cost_ record of ReportOpts has been changed to
conversionop_.
This also removes show_costs_ option in ReportOpts, as its functionality
has been replaced by the richer cost_ option.
2021-05-04 04:15:55 +03:00
|
|
|
-- | The 'AccountName' to use for automatically generated conversion postings.
|
|
|
|
journalConversionAccount :: Journal -> AccountName
|
|
|
|
journalConversionAccount =
|
|
|
|
headDef (T.pack "equity:conversion")
|
|
|
|
. M.findWithDefault [] Conversion
|
|
|
|
. jdeclaredaccounttypes
|
|
|
|
|
2009-12-21 08:23:07 +03:00
|
|
|
-- Various kinds of filtering on journals. We do it differently depending
|
|
|
|
-- on the command.
|
|
|
|
|
2011-06-04 03:14:26 +04:00
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
-- filtering V2
|
|
|
|
|
2014-05-24 00:10:36 +04:00
|
|
|
-- | Keep only transactions matching the query expression.
|
|
|
|
filterJournalTransactions :: Query -> Journal -> Journal
|
|
|
|
filterJournalTransactions q j@Journal{jtxns=ts} = j{jtxns=filter (q `matchesTransaction`) ts}
|
|
|
|
|
2011-06-04 03:14:26 +04:00
|
|
|
-- | Keep only postings matching the query expression.
|
|
|
|
-- This can leave unbalanced transactions.
|
2012-05-27 22:14:20 +04:00
|
|
|
filterJournalPostings :: Query -> Journal -> Journal
|
2016-06-02 06:47:27 +03:00
|
|
|
filterJournalPostings q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionPostings q) ts}
|
2011-06-05 22:36:32 +04:00
|
|
|
|
2021-07-28 10:46:29 +03:00
|
|
|
-- | Keep only postings which do not match the query expression, but for which a related posting does.
|
|
|
|
-- This can leave unbalanced transactions.
|
|
|
|
filterJournalRelatedPostings :: Query -> Journal -> Journal
|
|
|
|
filterJournalRelatedPostings q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionRelatedPostings q) ts}
|
|
|
|
|
2021-09-23 09:02:09 +03:00
|
|
|
-- | Within each posting's amount, keep only the parts matching the query, and
|
|
|
|
-- remove any postings with all amounts removed.
|
2014-02-28 05:47:47 +04:00
|
|
|
-- This can leave unbalanced transactions.
|
2014-05-24 00:10:36 +04:00
|
|
|
filterJournalAmounts :: Query -> Journal -> Journal
|
|
|
|
filterJournalAmounts q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionAmounts q) ts}
|
|
|
|
|
2021-09-23 09:02:09 +03:00
|
|
|
-- | Filter out all parts of this transaction's amounts which do not match the
|
|
|
|
-- query, and remove any postings with all amounts removed.
|
2014-05-24 00:10:36 +04:00
|
|
|
-- This can leave the transaction unbalanced.
|
|
|
|
filterTransactionAmounts :: Query -> Transaction -> Transaction
|
2021-09-23 09:02:09 +03:00
|
|
|
filterTransactionAmounts q t@Transaction{tpostings=ps} = t{tpostings=mapMaybe (filterPostingAmount q) ps}
|
|
|
|
|
|
|
|
-- | Filter out all parts of this posting's amount which do not match the query, and remove the posting
|
|
|
|
-- if this removes all amounts.
|
|
|
|
filterPostingAmount :: Query -> Posting -> Maybe Posting
|
|
|
|
filterPostingAmount q p@Posting{pamount=as}
|
|
|
|
| null newamt = Nothing
|
|
|
|
| otherwise = Just p{pamount=Mixed newamt}
|
|
|
|
where
|
|
|
|
Mixed newamt = filterMixedAmount (q `matchesAmount`) as
|
2014-02-28 05:47:47 +04:00
|
|
|
|
2016-06-01 22:09:16 +03:00
|
|
|
filterTransactionPostings :: Query -> Transaction -> Transaction
|
2016-06-02 06:47:27 +03:00
|
|
|
filterTransactionPostings q t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps}
|
2016-06-01 22:09:16 +03:00
|
|
|
|
2021-07-28 10:46:29 +03:00
|
|
|
filterTransactionRelatedPostings :: Query -> Transaction -> Transaction
|
|
|
|
filterTransactionRelatedPostings q t@Transaction{tpostings=ps} =
|
|
|
|
t{tpostings=if null matches then [] else ps \\ matches}
|
|
|
|
where matches = filter (matchesPosting q) ps
|
|
|
|
|
2019-05-05 20:35:49 +03:00
|
|
|
-- | Apply a transformation to a journal's transactions.
|
2021-02-04 18:57:26 +03:00
|
|
|
journalMapTransactions :: (Transaction -> Transaction) -> Journal -> Journal
|
|
|
|
journalMapTransactions f j@Journal{jtxns=ts} = j{jtxns=map f ts}
|
2019-05-05 20:35:49 +03:00
|
|
|
|
|
|
|
-- | Apply a transformation to a journal's postings.
|
2021-02-04 18:57:26 +03:00
|
|
|
journalMapPostings :: (Posting -> Posting) -> Journal -> Journal
|
|
|
|
journalMapPostings f j@Journal{jtxns=ts} = j{jtxns=map (transactionMapPostings f) ts}
|
2016-06-01 22:09:16 +03:00
|
|
|
|
2021-02-04 18:31:12 +03:00
|
|
|
-- | Apply a transformation to a journal's posting amounts.
|
lib: Change internal representation of MixedAmount to use a strict Map
instead of a list of Amounts. No longer export Mixed constructor, to
keep API clean (if you really need it, you can import it directly from
Hledger.Data.Types). We also ensure the JSON representation of
MixedAmount doesn't change: it is stored as a normalised list of
Amounts.
This commit improves performance. Here are some indicative results.
hledger reg -f examples/10000x1000x10.journal
- Maximum residency decreases from 65MB to 60MB (8% decrease)
- Total memory in use decreases from 178MiB to 157MiB (12% decrease)
hledger reg -f examples/10000x10000x10.journal
- Maximum residency decreases from 69MB to 60MB (13% decrease)
- Total memory in use decreases from 198MiB to 153MiB (23% decrease)
hledger bal -f examples/10000x1000x10.journal
- Total heap usage decreases from 6.4GB to 6.0GB (6% decrease)
- Total memory in use decreases from 178MiB to 153MiB (14% decrease)
hledger bal -f examples/10000x10000x10.journal
- Total heap usage decreases from 7.3GB to 6.9GB (5% decrease)
- Total memory in use decreases from 196MiB to 185MiB (5% decrease)
hledger bal -M -f examples/10000x1000x10.journal
- Total heap usage decreases from 16.8GB to 10.6GB (47% decrease)
- Total time decreases from 14.3s to 12.0s (16% decrease)
hledger bal -M -f examples/10000x10000x10.journal
- Total heap usage decreases from 108GB to 48GB (56% decrease)
- Total time decreases from 62s to 41s (33% decrease)
If you never directly use the constructor Mixed or pattern match against
it then you don't need to make any changes. If you do, then do the
following:
- If you really care about the individual Amounts and never normalise
your MixedAmount (for example, just storing `Mixed amts` and then
extracting `amts` as a pattern match, then use should switch to using
[Amount]. This should just involve removing the `Mixed` constructor.
- If you ever call `mixed`, `normaliseMixedAmount`, or do any sort of
amount arithmetic (+), (-), then you should replace the constructor
`Mixed` with the function `mixed`. To extract the list of Amounts, use
the function `amounts`.
- If you ever call `normaliseMixedAmountSquashPricesForDisplay`, you can
replace that with `mixedAmountStripPrices`. (N.B. this does something
slightly different from `normaliseMixedAmountSquashPricesForDisplay`,
but I don't think there's any use case for squashing prices and then
keeping the first of the squashed prices around. If you disagree let
me know.)
- Any remaining calls to `normaliseMixedAmount` can be removed, as that
is now the identity function.
2021-01-29 08:07:11 +03:00
|
|
|
journalMapPostingAmounts :: (MixedAmount -> MixedAmount) -> Journal -> Journal
|
|
|
|
journalMapPostingAmounts f = journalMapPostings (postingTransformAmount f)
|
2021-02-04 18:31:12 +03:00
|
|
|
|
2012-05-27 22:14:20 +04:00
|
|
|
{-
|
2011-06-04 03:14:26 +04:00
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
-- filtering V1
|
|
|
|
|
2011-06-03 06:14:36 +04:00
|
|
|
-- | Keep only transactions we are interested in, as described by the
|
|
|
|
-- filter specification.
|
2009-12-21 08:23:07 +03:00
|
|
|
filterJournalTransactions :: FilterSpec -> Journal -> Journal
|
|
|
|
filterJournalTransactions FilterSpec{datespan=datespan
|
|
|
|
,cleared=cleared
|
|
|
|
-- ,real=real
|
|
|
|
-- ,empty=empty
|
|
|
|
,acctpats=apats
|
|
|
|
,descpats=dpats
|
|
|
|
,depth=depth
|
2012-05-09 19:34:05 +04:00
|
|
|
,fMetadata=md
|
2009-12-21 08:23:07 +03:00
|
|
|
} =
|
2017-06-16 02:54:34 +03:00
|
|
|
filterJournalTransactionsByStatus cleared .
|
2009-12-21 08:23:07 +03:00
|
|
|
filterJournalPostingsByDepth depth .
|
|
|
|
filterJournalTransactionsByAccount apats .
|
2012-04-09 00:43:48 +04:00
|
|
|
filterJournalTransactionsByMetadata md .
|
2009-12-21 08:23:07 +03:00
|
|
|
filterJournalTransactionsByDescription dpats .
|
2011-06-03 06:14:36 +04:00
|
|
|
filterJournalTransactionsByDate datespan
|
2009-12-21 08:23:07 +03:00
|
|
|
|
2011-06-03 06:14:36 +04:00
|
|
|
-- | Keep only postings we are interested in, as described by the filter
|
|
|
|
-- specification. This can leave unbalanced transactions.
|
2009-12-21 08:23:07 +03:00
|
|
|
filterJournalPostings :: FilterSpec -> Journal -> Journal
|
|
|
|
filterJournalPostings FilterSpec{datespan=datespan
|
|
|
|
,cleared=cleared
|
|
|
|
,real=real
|
|
|
|
,empty=empty
|
|
|
|
,acctpats=apats
|
|
|
|
,descpats=dpats
|
|
|
|
,depth=depth
|
2012-05-09 19:34:05 +04:00
|
|
|
,fMetadata=md
|
2009-12-21 08:23:07 +03:00
|
|
|
} =
|
|
|
|
filterJournalPostingsByRealness real .
|
2017-06-16 02:54:34 +03:00
|
|
|
filterJournalPostingsByStatus cleared .
|
2009-12-21 08:23:07 +03:00
|
|
|
filterJournalPostingsByEmpty empty .
|
|
|
|
filterJournalPostingsByDepth depth .
|
|
|
|
filterJournalPostingsByAccount apats .
|
2012-04-09 00:43:48 +04:00
|
|
|
filterJournalTransactionsByMetadata md .
|
2009-12-21 08:23:07 +03:00
|
|
|
filterJournalTransactionsByDescription dpats .
|
2011-06-03 06:14:36 +04:00
|
|
|
filterJournalTransactionsByDate datespan
|
2009-04-03 14:58:05 +04:00
|
|
|
|
2012-04-09 00:43:48 +04:00
|
|
|
-- | Keep only transactions whose metadata matches all metadata specifications.
|
|
|
|
filterJournalTransactionsByMetadata :: [(String,String)] -> Journal -> Journal
|
|
|
|
filterJournalTransactionsByMetadata pats j@Journal{jtxns=ts} = j{jtxns=filter matchmd ts}
|
|
|
|
where matchmd t = all (`elem` tmetadata t) pats
|
|
|
|
|
2010-07-13 10:30:06 +04:00
|
|
|
-- | Keep only transactions whose description matches the description patterns.
|
2009-12-16 11:07:26 +03:00
|
|
|
filterJournalTransactionsByDescription :: [String] -> Journal -> Journal
|
2009-12-21 08:43:10 +03:00
|
|
|
filterJournalTransactionsByDescription pats j@Journal{jtxns=ts} = j{jtxns=filter matchdesc ts}
|
2009-12-16 20:58:51 +03:00
|
|
|
where matchdesc = matchpats pats . tdescription
|
2009-04-03 14:58:05 +04:00
|
|
|
|
2010-07-13 10:30:06 +04:00
|
|
|
-- | Keep only transactions which fall between begin and end dates.
|
2009-04-03 14:58:05 +04:00
|
|
|
-- We include transactions on the begin date and exclude transactions on the end
|
2008-10-10 08:23:25 +04:00
|
|
|
-- date, like ledger. An empty date string means no restriction.
|
2009-12-16 11:07:26 +03:00
|
|
|
filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal
|
2009-12-21 08:43:10 +03:00
|
|
|
filterJournalTransactionsByDate (DateSpan begin end) j@Journal{jtxns=ts} = j{jtxns=filter match ts}
|
|
|
|
where match t = maybe True (tdate t>=) begin && maybe True (tdate t<) end
|
2008-10-10 08:23:25 +04:00
|
|
|
|
2010-07-13 10:30:06 +04:00
|
|
|
-- | Keep only transactions which have the requested cleared/uncleared
|
|
|
|
-- status, if there is one.
|
2017-06-16 02:54:34 +03:00
|
|
|
filterJournalTransactionsByStatus :: Maybe Bool -> Journal -> Journal
|
|
|
|
filterJournalTransactionsByStatus Nothing j = j
|
|
|
|
filterJournalTransactionsByStatus (Just val) j@Journal{jtxns=ts} = j{jtxns=filter match ts}
|
2009-12-21 08:43:10 +03:00
|
|
|
where match = (==val).tstatus
|
2009-12-21 08:23:07 +03:00
|
|
|
|
|
|
|
-- | Keep only postings which have the requested cleared/uncleared status,
|
|
|
|
-- if there is one.
|
2017-06-16 02:54:34 +03:00
|
|
|
filterJournalPostingsByStatus :: Maybe Bool -> Journal -> Journal
|
|
|
|
filterJournalPostingsByStatus Nothing j = j
|
|
|
|
filterJournalPostingsByStatus (Just c) j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
|
2009-12-21 08:23:07 +03:00
|
|
|
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter ((==c) . postingCleared) ps}
|
2008-10-15 04:34:02 +04:00
|
|
|
|
2009-04-03 14:58:05 +04:00
|
|
|
-- | Strip out any virtual postings, if the flag is true, otherwise do
|
2008-10-17 04:57:00 +04:00
|
|
|
-- no filtering.
|
2009-12-16 10:00:43 +03:00
|
|
|
filterJournalPostingsByRealness :: Bool -> Journal -> Journal
|
2012-04-16 20:43:58 +04:00
|
|
|
filterJournalPostingsByRealness False j = j
|
2009-12-21 08:43:10 +03:00
|
|
|
filterJournalPostingsByRealness True j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
|
2009-12-21 08:23:07 +03:00
|
|
|
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter isReal ps}
|
|
|
|
|
|
|
|
-- | Strip out any postings with zero amount, unless the flag is true.
|
|
|
|
filterJournalPostingsByEmpty :: Bool -> Journal -> Journal
|
2012-04-16 20:43:58 +04:00
|
|
|
filterJournalPostingsByEmpty True j = j
|
2009-12-21 08:43:10 +03:00
|
|
|
filterJournalPostingsByEmpty False j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
|
2009-12-21 08:23:07 +03:00
|
|
|
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (not . isEmptyPosting) ps}
|
|
|
|
|
2012-04-14 02:24:55 +04:00
|
|
|
-- -- | Keep only transactions which affect accounts deeper than the specified depth.
|
|
|
|
-- filterJournalTransactionsByDepth :: Maybe Int -> Journal -> Journal
|
|
|
|
-- filterJournalTransactionsByDepth Nothing j = j
|
|
|
|
-- filterJournalTransactionsByDepth (Just d) j@Journal{jtxns=ts} =
|
|
|
|
-- j{jtxns=(filter (any ((<= d+1) . accountNameLevel . paccount) . tpostings) ts)}
|
2009-04-03 14:58:05 +04:00
|
|
|
|
|
|
|
-- | Strip out any postings to accounts deeper than the specified depth
|
2010-07-13 10:30:06 +04:00
|
|
|
-- (and any transactions which have no postings as a result).
|
2009-12-21 08:23:07 +03:00
|
|
|
filterJournalPostingsByDepth :: Maybe Int -> Journal -> Journal
|
|
|
|
filterJournalPostingsByDepth Nothing j = j
|
2009-12-21 08:43:10 +03:00
|
|
|
filterJournalPostingsByDepth (Just d) j@Journal{jtxns=ts} =
|
|
|
|
j{jtxns=filter (not . null . tpostings) $ map filtertxns ts}
|
2009-12-16 20:58:51 +03:00
|
|
|
where filtertxns t@Transaction{tpostings=ps} =
|
2009-12-21 08:23:07 +03:00
|
|
|
t{tpostings=filter ((<= d) . accountNameLevel . paccount) ps}
|
2009-04-03 14:58:05 +04:00
|
|
|
|
2012-05-27 22:14:20 +04:00
|
|
|
-- | Keep only postings which affect accounts matched by the account patterns.
|
|
|
|
-- This can leave transactions unbalanced.
|
|
|
|
filterJournalPostingsByAccount :: [String] -> Journal -> Journal
|
|
|
|
filterJournalPostingsByAccount apats j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
|
|
|
|
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (matchpats apats . paccount) ps}
|
|
|
|
|
2009-12-21 08:23:07 +03:00
|
|
|
-- | Keep only transactions which affect accounts matched by the account patterns.
|
2010-04-16 03:08:27 +04:00
|
|
|
-- More precisely: each positive account pattern excludes transactions
|
|
|
|
-- which do not contain a posting to a matched account, and each negative
|
|
|
|
-- account pattern excludes transactions containing a posting to a matched
|
|
|
|
-- account.
|
2009-12-21 08:23:07 +03:00
|
|
|
filterJournalTransactionsByAccount :: [String] -> Journal -> Journal
|
2010-04-16 03:08:27 +04:00
|
|
|
filterJournalTransactionsByAccount apats j@Journal{jtxns=ts} = j{jtxns=filter tmatch ts}
|
|
|
|
where
|
|
|
|
tmatch t = (null positives || any positivepmatch ps) && (null negatives || not (any negativepmatch ps)) where ps = tpostings t
|
|
|
|
positivepmatch p = any (`amatch` a) positives where a = paccount p
|
|
|
|
negativepmatch p = any (`amatch` a) negatives where a = paccount p
|
2011-06-09 01:52:10 +04:00
|
|
|
amatch pat a = regexMatchesCI (abspat pat) a
|
2010-04-16 03:08:27 +04:00
|
|
|
(negatives,positives) = partition isnegativepat apats
|
2008-11-22 09:35:10 +03:00
|
|
|
|
2012-05-27 22:14:20 +04:00
|
|
|
-}
|
2009-12-21 08:23:07 +03:00
|
|
|
|
2019-04-20 23:12:53 +03:00
|
|
|
-- | Reverse all lists of parsed items, which during parsing were
|
|
|
|
-- prepended to, so that the items are in parse order. Part of
|
|
|
|
-- post-parse finalisation.
|
2018-10-12 17:01:39 +03:00
|
|
|
journalReverse :: Journal -> Journal
|
|
|
|
journalReverse j =
|
|
|
|
j {jfiles = reverse $ jfiles j
|
|
|
|
,jdeclaredaccounts = reverse $ jdeclaredaccounts j
|
|
|
|
,jtxns = reverse $ jtxns j
|
|
|
|
,jtxnmodifiers = reverse $ jtxnmodifiers j
|
|
|
|
,jperiodictxns = reverse $ jperiodictxns j
|
2020-11-10 19:01:31 +03:00
|
|
|
,jpricedirectives = reverse $ jpricedirectives j
|
2018-10-12 17:01:39 +03:00
|
|
|
}
|
|
|
|
|
2018-10-16 18:51:51 +03:00
|
|
|
-- | Set this journal's last read time, ie when its files were last read.
|
2021-08-11 06:52:39 +03:00
|
|
|
journalSetLastReadTime :: POSIXTime -> Journal -> Journal
|
2018-10-16 18:51:51 +03:00
|
|
|
journalSetLastReadTime t j = j{ jlastreadtime = t }
|
2018-10-11 19:35:18 +03:00
|
|
|
|
2013-05-29 03:25:00 +04:00
|
|
|
|
2016-08-14 22:44:19 +03:00
|
|
|
journalNumberAndTieTransactions = journalTieTransactions . journalNumberTransactions
|
|
|
|
|
|
|
|
-- | Number (set the tindex field) this journal's transactions, counting upward from 1.
|
|
|
|
journalNumberTransactions :: Journal -> Journal
|
2021-08-16 06:43:28 +03:00
|
|
|
journalNumberTransactions j@Journal{jtxns=ts} = j{jtxns=zipWith (\i t -> t{tindex=i}) [1..] ts}
|
2016-08-14 22:44:19 +03:00
|
|
|
|
|
|
|
-- | Tie the knot in all of this journal's transactions, ensuring their postings
|
|
|
|
-- refer to them. This should be done last, after any other transaction-modifying operations.
|
|
|
|
journalTieTransactions :: Journal -> Journal
|
|
|
|
journalTieTransactions j@Journal{jtxns=ts} = j{jtxns=map txnTieKnot ts}
|
|
|
|
|
|
|
|
-- | Untie all transaction-posting knots in this journal, so that eg
|
|
|
|
-- recursiveSize and GHCI's :sprint can work on it.
|
|
|
|
journalUntieTransactions :: Transaction -> Transaction
|
|
|
|
journalUntieTransactions t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ptransaction=Nothing}) ps}
|
|
|
|
|
2020-08-05 23:41:13 +03:00
|
|
|
-- | Apply any transaction modifier rules in the journal (adding automated
|
|
|
|
-- postings to transactions, eg). Or if a modifier rule fails to parse,
|
|
|
|
-- return the error message. A reference date is provided to help interpret
|
|
|
|
-- relative dates in transaction modifier queries.
|
|
|
|
journalModifyTransactions :: Day -> Journal -> Either String Journal
|
|
|
|
journalModifyTransactions d j =
|
2021-07-26 17:37:08 +03:00
|
|
|
case modifyTransactions (journalCommodityStyles j) d (jtxnmodifiers j) (jtxns j) of
|
|
|
|
Right ts -> Right j{jtxns=ts}
|
|
|
|
Left err -> Left err
|
2019-02-01 22:31:04 +03:00
|
|
|
|
2019-02-18 23:11:07 +03:00
|
|
|
--
|
|
|
|
|
2020-02-11 21:23:52 +03:00
|
|
|
-- | Choose and apply a consistent display style to the posting
|
2020-11-09 22:28:11 +03:00
|
|
|
-- amounts in each commodity (see journalCommodityStyles).
|
|
|
|
-- Can return an error message eg if inconsistent number formats are found.
|
2019-09-28 04:09:39 +03:00
|
|
|
journalApplyCommodityStyles :: Journal -> Either String Journal
|
2021-07-26 17:37:08 +03:00
|
|
|
journalApplyCommodityStyles = fmap fixjournal . journalInferCommodityStyles
|
|
|
|
where
|
|
|
|
fixjournal j@Journal{jpricedirectives=pds} =
|
|
|
|
journalMapPostings (postingApplyCommodityStyles styles) j{jpricedirectives=map fixpricedirective pds}
|
2019-09-28 04:09:39 +03:00
|
|
|
where
|
2021-07-26 17:37:08 +03:00
|
|
|
styles = journalCommodityStyles j
|
2019-10-20 17:09:34 +03:00
|
|
|
fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmountExceptPrecision styles a}
|
2018-04-20 22:18:28 +03:00
|
|
|
|
2020-11-09 22:28:11 +03:00
|
|
|
-- | Get the canonical amount styles for this journal, whether (in order of precedence):
|
|
|
|
-- set globally in InputOpts,
|
|
|
|
-- declared by commodity directives,
|
|
|
|
-- declared by a default commodity (D) directive,
|
|
|
|
-- or inferred from posting amounts,
|
|
|
|
-- as a map from symbol to style.
|
|
|
|
-- Styles from directives are assumed to specify the decimal mark.
|
2018-04-20 22:18:28 +03:00
|
|
|
journalCommodityStyles :: Journal -> M.Map CommoditySymbol AmountStyle
|
2020-02-11 20:47:26 +03:00
|
|
|
journalCommodityStyles j =
|
|
|
|
-- XXX could be some redundancy here, cf journalStyleInfluencingAmounts
|
2020-11-09 22:28:11 +03:00
|
|
|
globalstyles <> declaredstyles <> defaultcommoditystyle <> inferredstyles
|
2018-04-20 22:18:28 +03:00
|
|
|
where
|
2020-11-09 22:28:11 +03:00
|
|
|
globalstyles = jglobalcommoditystyles j
|
|
|
|
declaredstyles = M.mapMaybe cformat $ jcommodities j
|
2020-02-11 20:47:26 +03:00
|
|
|
defaultcommoditystyle = M.fromList $ catMaybes [jparsedefaultcommodity j]
|
|
|
|
inferredstyles = jinferredcommodities j
|
2016-05-08 04:25:28 +03:00
|
|
|
|
2018-04-21 07:56:06 +03:00
|
|
|
-- | Collect and save inferred amount styles for each commodity based on
|
|
|
|
-- the posting amounts in that commodity (excluding price amounts), ie:
|
|
|
|
-- "the format of the first amount, adjusted to the highest precision of all amounts".
|
2019-09-28 04:09:39 +03:00
|
|
|
-- Can return an error message eg if inconsistent number formats are found.
|
|
|
|
journalInferCommodityStyles :: Journal -> Either String Journal
|
2021-03-01 14:35:21 +03:00
|
|
|
journalInferCommodityStyles j =
|
|
|
|
case commodityStylesFromAmounts $ journalStyleInfluencingAmounts j of
|
2019-09-28 04:09:39 +03:00
|
|
|
Left e -> Left e
|
2020-11-10 19:01:31 +03:00
|
|
|
Right cs -> Right j{jinferredcommodities = dbg7 "journalInferCommodityStyles" cs}
|
2019-09-28 04:09:39 +03:00
|
|
|
|
2020-02-11 20:21:24 +03:00
|
|
|
-- | Given a list of amounts, in parse order (roughly speaking; see journalStyleInfluencingAmounts),
|
|
|
|
-- build a map from their commodity names to standard commodity
|
|
|
|
-- display formats. Can return an error message eg if inconsistent
|
|
|
|
-- number formats are found.
|
2019-09-28 04:09:39 +03:00
|
|
|
--
|
|
|
|
-- Though, these amounts may have come from multiple files, so we
|
|
|
|
-- shouldn't assume they use consistent number formats.
|
2019-09-28 04:40:36 +03:00
|
|
|
-- Currently we don't enforce that even within a single file,
|
|
|
|
-- and this function never reports an error.
|
2019-09-28 04:09:39 +03:00
|
|
|
--
|
|
|
|
commodityStylesFromAmounts :: [Amount] -> Either String (M.Map CommoditySymbol AmountStyle)
|
2021-01-03 14:33:01 +03:00
|
|
|
commodityStylesFromAmounts =
|
|
|
|
Right . foldr (\a -> M.insertWith canonicalStyle (acommodity a) (astyle a)) mempty
|
look harder for decimal point & digit groups (fixes #196)
Amount display styles have been reworked a bit; they are now calculated
after journal parsing, not during it. This allows the fix for #196:
we now search through the amounts until a decimal point is detected,
instead of just looking at the first one; likewise for digit groups.
Digit groups are now implemented with a better type.
Digit group size detection has been improved a little:
1000,000 now gives group sizes [3,4,4,...], not [3,3,...], and
10,000 gives groups sizes [3,3,...] not [3,2,2,..].
(To get [3,2,2,...] you'd use eg 00,00,000.)
There are still some old (or new ?) issues; I don't think we handle
inconsistent decimal points & digit groups too well. But for now all
tests pass.
2014-07-03 10:26:16 +04:00
|
|
|
|
2019-09-28 04:40:36 +03:00
|
|
|
-- | Given a list of amount styles (assumed to be from parsed amounts
|
|
|
|
-- in a single commodity), in parse order, choose a canonical style.
|
2021-01-03 14:33:01 +03:00
|
|
|
canonicalStyleFrom :: [AmountStyle] -> AmountStyle
|
2021-08-16 08:32:12 +03:00
|
|
|
canonicalStyleFrom = foldl' canonicalStyle amountstyle
|
2021-01-03 14:33:01 +03:00
|
|
|
|
|
|
|
-- TODO: should probably detect and report inconsistencies here.
|
|
|
|
-- Though, we don't have the info for a good error message, so maybe elsewhere.
|
|
|
|
-- | Given a pair of AmountStyles, choose a canonical style.
|
2020-11-10 20:29:04 +03:00
|
|
|
-- This is:
|
2021-01-03 14:33:01 +03:00
|
|
|
-- the general style of the first amount,
|
2020-11-10 20:29:04 +03:00
|
|
|
-- with the first digit group style seen,
|
|
|
|
-- with the maximum precision of all.
|
2021-01-03 14:33:01 +03:00
|
|
|
canonicalStyle :: AmountStyle -> AmountStyle -> AmountStyle
|
|
|
|
canonicalStyle a b = a{asprecision=prec, asdecimalpoint=decmark, asdigitgroups=mgrps}
|
look harder for decimal point & digit groups (fixes #196)
Amount display styles have been reworked a bit; they are now calculated
after journal parsing, not during it. This allows the fix for #196:
we now search through the amounts until a decimal point is detected,
instead of just looking at the first one; likewise for digit groups.
Digit groups are now implemented with a better type.
Digit group size detection has been improved a little:
1000,000 now gives group sizes [3,4,4,...], not [3,3,...], and
10,000 gives groups sizes [3,3,...] not [3,2,2,..].
(To get [3,2,2,...] you'd use eg 00,00,000.)
There are still some old (or new ?) issues; I don't think we handle
inconsistent decimal points & digit groups too well. But for now all
tests pass.
2014-07-03 10:26:16 +04:00
|
|
|
where
|
2015-11-22 20:21:36 +03:00
|
|
|
-- precision is maximum of all precisions
|
2021-01-03 14:33:01 +03:00
|
|
|
prec = max (asprecision a) (asprecision b)
|
2019-09-28 04:40:36 +03:00
|
|
|
-- identify the digit group mark (& group sizes)
|
2021-01-03 14:33:01 +03:00
|
|
|
mgrps = asdigitgroups a <|> asdigitgroups b
|
2019-09-28 04:40:36 +03:00
|
|
|
-- if a digit group mark was identified above, we can rely on that;
|
|
|
|
-- make sure the decimal mark is different. If not, default to period.
|
2021-01-03 14:33:01 +03:00
|
|
|
defdecmark = case mgrps of
|
2019-09-28 04:40:36 +03:00
|
|
|
Just (DigitGroups '.' _) -> ','
|
|
|
|
_ -> '.'
|
|
|
|
-- identify the decimal mark: the first one used, or the above default,
|
|
|
|
-- but never the same character as the digit group mark.
|
|
|
|
-- urgh.. refactor..
|
|
|
|
decmark = case mgrps of
|
2021-01-03 14:33:01 +03:00
|
|
|
Just _ -> Just defdecmark
|
|
|
|
Nothing -> asdecimalpoint a <|> asdecimalpoint b <|> Just defdecmark
|
2010-05-22 23:00:20 +04:00
|
|
|
|
2012-04-14 02:24:55 +04:00
|
|
|
-- -- | Apply this journal's historical price records to unpriced amounts where possible.
|
2019-06-04 03:26:27 +03:00
|
|
|
-- journalApplyPriceDirectives :: Journal -> Journal
|
|
|
|
-- journalApplyPriceDirectives j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
|
2012-04-14 02:24:55 +04:00
|
|
|
-- where
|
|
|
|
-- fixtransaction t@Transaction{tdate=d, tpostings=ps} = t{tpostings=map fixposting ps}
|
|
|
|
-- where
|
|
|
|
-- fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
|
2021-01-31 07:23:46 +03:00
|
|
|
-- fixmixedamount = mapMixedAmount fixamount
|
2012-04-14 02:24:55 +04:00
|
|
|
-- fixamount = fixprice
|
|
|
|
-- fixprice a@Amount{price=Just _} = a
|
2019-06-04 03:26:27 +03:00
|
|
|
-- fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitPrice) $ journalPriceDirectiveFor j d c}
|
2012-04-14 02:24:55 +04:00
|
|
|
|
|
|
|
-- -- | Get the price for a commodity on the specified day from the price database, if known.
|
|
|
|
-- -- Does only one lookup step, ie will not look up the price of a price.
|
2019-06-04 03:26:27 +03:00
|
|
|
-- journalPriceDirectiveFor :: Journal -> Day -> CommoditySymbol -> Maybe MixedAmount
|
|
|
|
-- journalPriceDirectiveFor j d CommoditySymbol{symbol=s} = do
|
|
|
|
-- let ps = reverse $ filter ((<= d).pddate) $ filter ((s==).hsymbol) $ sortBy (comparing pddate) $ jpricedirectives j
|
|
|
|
-- case ps of (PriceDirective{pdamount=a}:_) -> Just a
|
2012-04-14 02:24:55 +04:00
|
|
|
-- _ -> Nothing
|
2010-05-23 00:23:36 +04:00
|
|
|
|
2020-05-24 04:19:43 +03:00
|
|
|
-- | Infer transaction-implied market prices from commodity-exchanging
|
|
|
|
-- transactions, if any. It's best to call this after transactions have
|
|
|
|
-- been balanced and posting amounts have appropriate prices attached.
|
|
|
|
journalInferMarketPricesFromTransactions :: Journal -> Journal
|
|
|
|
journalInferMarketPricesFromTransactions j =
|
2020-06-19 03:09:59 +03:00
|
|
|
j{jinferredmarketprices =
|
|
|
|
dbg4 "jinferredmarketprices" $
|
|
|
|
mapMaybe postingInferredmarketPrice $ journalPostings j
|
2020-05-24 04:19:43 +03:00
|
|
|
}
|
|
|
|
|
|
|
|
-- | Make a market price equivalent to this posting's amount's unit
|
|
|
|
-- price, if any. If the posting amount is multicommodity, only the
|
|
|
|
-- first commodity amount is considered.
|
2020-06-19 03:09:59 +03:00
|
|
|
postingInferredmarketPrice :: Posting -> Maybe MarketPrice
|
|
|
|
postingInferredmarketPrice p@Posting{pamount} =
|
lib: Change internal representation of MixedAmount to use a strict Map
instead of a list of Amounts. No longer export Mixed constructor, to
keep API clean (if you really need it, you can import it directly from
Hledger.Data.Types). We also ensure the JSON representation of
MixedAmount doesn't change: it is stored as a normalised list of
Amounts.
This commit improves performance. Here are some indicative results.
hledger reg -f examples/10000x1000x10.journal
- Maximum residency decreases from 65MB to 60MB (8% decrease)
- Total memory in use decreases from 178MiB to 157MiB (12% decrease)
hledger reg -f examples/10000x10000x10.journal
- Maximum residency decreases from 69MB to 60MB (13% decrease)
- Total memory in use decreases from 198MiB to 153MiB (23% decrease)
hledger bal -f examples/10000x1000x10.journal
- Total heap usage decreases from 6.4GB to 6.0GB (6% decrease)
- Total memory in use decreases from 178MiB to 153MiB (14% decrease)
hledger bal -f examples/10000x10000x10.journal
- Total heap usage decreases from 7.3GB to 6.9GB (5% decrease)
- Total memory in use decreases from 196MiB to 185MiB (5% decrease)
hledger bal -M -f examples/10000x1000x10.journal
- Total heap usage decreases from 16.8GB to 10.6GB (47% decrease)
- Total time decreases from 14.3s to 12.0s (16% decrease)
hledger bal -M -f examples/10000x10000x10.journal
- Total heap usage decreases from 108GB to 48GB (56% decrease)
- Total time decreases from 62s to 41s (33% decrease)
If you never directly use the constructor Mixed or pattern match against
it then you don't need to make any changes. If you do, then do the
following:
- If you really care about the individual Amounts and never normalise
your MixedAmount (for example, just storing `Mixed amts` and then
extracting `amts` as a pattern match, then use should switch to using
[Amount]. This should just involve removing the `Mixed` constructor.
- If you ever call `mixed`, `normaliseMixedAmount`, or do any sort of
amount arithmetic (+), (-), then you should replace the constructor
`Mixed` with the function `mixed`. To extract the list of Amounts, use
the function `amounts`.
- If you ever call `normaliseMixedAmountSquashPricesForDisplay`, you can
replace that with `mixedAmountStripPrices`. (N.B. this does something
slightly different from `normaliseMixedAmountSquashPricesForDisplay`,
but I don't think there's any use case for squashing prices and then
keeping the first of the squashed prices around. If you disagree let
me know.)
- Any remaining calls to `normaliseMixedAmount` can be removed, as that
is now the identity function.
2021-01-29 08:07:11 +03:00
|
|
|
-- convert any total prices to unit prices
|
|
|
|
case amountsRaw $ mixedAmountTotalPriceToUnitPrice pamount of
|
|
|
|
Amount{acommodity=fromcomm, aprice = Just (UnitPrice Amount{acommodity=tocomm, aquantity=rate})}:_ ->
|
|
|
|
Just MarketPrice {
|
|
|
|
mpdate = postingDate p
|
|
|
|
,mpfrom = fromcomm
|
|
|
|
,mpto = tocomm
|
|
|
|
,mprate = rate
|
|
|
|
}
|
|
|
|
_ -> Nothing
|
2020-05-24 04:19:43 +03:00
|
|
|
|
2019-05-23 10:36:16 +03:00
|
|
|
-- | Convert all this journal's amounts to cost using the transaction prices, if any.
|
|
|
|
-- The journal's commodity styles are applied to the resulting amounts.
|
imp: cost: Generate totally balanced conversion postings for amounts with costs.
Introduce --infer-equity option which will generate conversion postings.
--cost will override --infer-equity.
This means there will no longer be unbalanced transactions, but will be
offsetting conversion postings to balance things out. For example.
2000-01-01
a 1 AAA @@ 2 BBB
b -2 BBB
When converting to cost, this is treated the same as before.
When used with --infer-equity, this is now treated as:
2000-01-01
a 1 AAA
equity:conversion:AAA-BBB:AAA -1 AAA
equity:conversion:AAA-BBB:BBB 2 BBB
b -2 BBB
There is a new account type, Conversion/V, which is a subtype of Equity/E.
The first account declared with this type, if any, is used as the base account
for inferred equity postings in conversion transactions, overriding the default
"equity:conversion".
API changes:
Costing has been changed to ConversionOp with three options:
NoConversionOp, ToCost, and InferEquity.
The first correspond to the previous NoCost and Cost options, while the
third corresponds to the --infer-equity flag. This converts transactions with costs
(one or more transaction prices) to transactions with equity:conversion postings.
It is in ConversionOp because converting to cost with -B/--cost and inferring conversion
equity postings with --infer-equity are mutually exclusive.
Correspondingly, the cost_ record of ReportOpts has been changed to
conversionop_.
This also removes show_costs_ option in ReportOpts, as its functionality
has been replaced by the richer cost_ option.
2021-05-04 04:15:55 +03:00
|
|
|
journalToCost :: ConversionOp -> Journal -> Journal
|
2022-01-15 16:25:16 +03:00
|
|
|
journalToCost cost j@Journal{jtxns=ts} = j{jtxns=map (transactionToCost styles cost) ts}
|
imp: cost: Generate totally balanced conversion postings for amounts with costs.
Introduce --infer-equity option which will generate conversion postings.
--cost will override --infer-equity.
This means there will no longer be unbalanced transactions, but will be
offsetting conversion postings to balance things out. For example.
2000-01-01
a 1 AAA @@ 2 BBB
b -2 BBB
When converting to cost, this is treated the same as before.
When used with --infer-equity, this is now treated as:
2000-01-01
a 1 AAA
equity:conversion:AAA-BBB:AAA -1 AAA
equity:conversion:AAA-BBB:BBB 2 BBB
b -2 BBB
There is a new account type, Conversion/V, which is a subtype of Equity/E.
The first account declared with this type, if any, is used as the base account
for inferred equity postings in conversion transactions, overriding the default
"equity:conversion".
API changes:
Costing has been changed to ConversionOp with three options:
NoConversionOp, ToCost, and InferEquity.
The first correspond to the previous NoCost and Cost options, while the
third corresponds to the --infer-equity flag. This converts transactions with costs
(one or more transaction prices) to transactions with equity:conversion postings.
It is in ConversionOp because converting to cost with -B/--cost and inferring conversion
equity postings with --infer-equity are mutually exclusive.
Correspondingly, the cost_ record of ReportOpts has been changed to
conversionop_.
This also removes show_costs_ option in ReportOpts, as its functionality
has been replaced by the richer cost_ option.
2021-05-04 04:15:55 +03:00
|
|
|
where
|
|
|
|
styles = journalCommodityStyles j
|
2012-11-20 01:20:10 +04:00
|
|
|
|
2022-01-15 16:25:16 +03:00
|
|
|
-- | Add inferred equity postings to a 'Journal' using transaction prices.
|
|
|
|
journalAddInferredEquityPostings :: Journal -> Journal
|
|
|
|
journalAddInferredEquityPostings j = journalMapTransactions (transactionAddInferredEquityPostings equityAcct) j
|
|
|
|
where
|
|
|
|
equityAcct = journalConversionAccount j
|
|
|
|
|
2012-11-20 01:20:10 +04:00
|
|
|
-- -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol.
|
2016-05-08 02:18:04 +03:00
|
|
|
-- journalCanonicalCommodities :: Journal -> M.Map String CommoditySymbol
|
2012-11-20 01:20:10 +04:00
|
|
|
-- journalCanonicalCommodities j = canonicaliseCommodities $ journalAmountCommodities j
|
2010-05-23 00:23:36 +04:00
|
|
|
|
2012-11-20 01:20:10 +04:00
|
|
|
-- -- | Get all this journal's amounts' commodities, in the order parsed.
|
2016-05-08 02:18:04 +03:00
|
|
|
-- journalAmountCommodities :: Journal -> [CommoditySymbol]
|
2012-11-20 01:20:10 +04:00
|
|
|
-- journalAmountCommodities = map acommodity . concatMap amounts . journalAmounts
|
2010-05-23 00:23:36 +04:00
|
|
|
|
2012-11-20 01:20:10 +04:00
|
|
|
-- -- | Get all this journal's amount and price commodities, in the order parsed.
|
2016-05-08 02:18:04 +03:00
|
|
|
-- journalAmountAndPriceCommodities :: Journal -> [CommoditySymbol]
|
2012-11-20 01:20:10 +04:00
|
|
|
-- journalAmountAndPriceCommodities = concatMap amountCommodities . concatMap amounts . journalAmounts
|
2010-05-23 00:23:36 +04:00
|
|
|
|
2012-11-20 01:20:10 +04:00
|
|
|
-- -- | Get this amount's commodity and any commodities referenced in its price.
|
2016-05-08 02:18:04 +03:00
|
|
|
-- amountCommodities :: Amount -> [CommoditySymbol]
|
2012-11-20 01:20:10 +04:00
|
|
|
-- amountCommodities Amount{acommodity=c,aprice=p} =
|
|
|
|
-- case p of Nothing -> [c]
|
|
|
|
-- Just (UnitPrice ma) -> c:(concatMap amountCommodities $ amounts ma)
|
|
|
|
-- Just (TotalPrice ma) -> c:(concatMap amountCommodities $ amounts ma)
|
2010-05-23 00:23:36 +04:00
|
|
|
|
2020-02-11 20:21:24 +03:00
|
|
|
-- | Get an ordered list of amounts in this journal which can
|
|
|
|
-- influence canonical amount display styles. Those amounts are, in
|
|
|
|
-- the following order:
|
2015-10-12 02:07:31 +03:00
|
|
|
--
|
2020-02-11 20:21:24 +03:00
|
|
|
-- * amounts in market price (P) directives (in parse order)
|
|
|
|
-- * posting amounts in transactions (in parse order)
|
|
|
|
-- * the amount in the final default commodity (D) directive
|
|
|
|
--
|
|
|
|
-- Transaction price amounts (posting amounts' aprice field) are not included.
|
2015-10-12 02:07:31 +03:00
|
|
|
--
|
2020-02-11 20:21:24 +03:00
|
|
|
journalStyleInfluencingAmounts :: Journal -> [Amount]
|
lib: Change internal representation of MixedAmount to use a strict Map
instead of a list of Amounts. No longer export Mixed constructor, to
keep API clean (if you really need it, you can import it directly from
Hledger.Data.Types). We also ensure the JSON representation of
MixedAmount doesn't change: it is stored as a normalised list of
Amounts.
This commit improves performance. Here are some indicative results.
hledger reg -f examples/10000x1000x10.journal
- Maximum residency decreases from 65MB to 60MB (8% decrease)
- Total memory in use decreases from 178MiB to 157MiB (12% decrease)
hledger reg -f examples/10000x10000x10.journal
- Maximum residency decreases from 69MB to 60MB (13% decrease)
- Total memory in use decreases from 198MiB to 153MiB (23% decrease)
hledger bal -f examples/10000x1000x10.journal
- Total heap usage decreases from 6.4GB to 6.0GB (6% decrease)
- Total memory in use decreases from 178MiB to 153MiB (14% decrease)
hledger bal -f examples/10000x10000x10.journal
- Total heap usage decreases from 7.3GB to 6.9GB (5% decrease)
- Total memory in use decreases from 196MiB to 185MiB (5% decrease)
hledger bal -M -f examples/10000x1000x10.journal
- Total heap usage decreases from 16.8GB to 10.6GB (47% decrease)
- Total time decreases from 14.3s to 12.0s (16% decrease)
hledger bal -M -f examples/10000x10000x10.journal
- Total heap usage decreases from 108GB to 48GB (56% decrease)
- Total time decreases from 62s to 41s (33% decrease)
If you never directly use the constructor Mixed or pattern match against
it then you don't need to make any changes. If you do, then do the
following:
- If you really care about the individual Amounts and never normalise
your MixedAmount (for example, just storing `Mixed amts` and then
extracting `amts` as a pattern match, then use should switch to using
[Amount]. This should just involve removing the `Mixed` constructor.
- If you ever call `mixed`, `normaliseMixedAmount`, or do any sort of
amount arithmetic (+), (-), then you should replace the constructor
`Mixed` with the function `mixed`. To extract the list of Amounts, use
the function `amounts`.
- If you ever call `normaliseMixedAmountSquashPricesForDisplay`, you can
replace that with `mixedAmountStripPrices`. (N.B. this does something
slightly different from `normaliseMixedAmountSquashPricesForDisplay`,
but I don't think there's any use case for squashing prices and then
keeping the first of the squashed prices around. If you disagree let
me know.)
- Any remaining calls to `normaliseMixedAmount` can be removed, as that
is now the identity function.
2021-01-29 08:07:11 +03:00
|
|
|
journalStyleInfluencingAmounts j =
|
2020-11-10 19:01:31 +03:00
|
|
|
dbg7 "journalStyleInfluencingAmounts" $
|
|
|
|
catMaybes $ concat [
|
2020-02-11 20:21:24 +03:00
|
|
|
[mdefaultcommodityamt]
|
|
|
|
,map (Just . pdamount) $ jpricedirectives j
|
lib: Change internal representation of MixedAmount to use a strict Map
instead of a list of Amounts. No longer export Mixed constructor, to
keep API clean (if you really need it, you can import it directly from
Hledger.Data.Types). We also ensure the JSON representation of
MixedAmount doesn't change: it is stored as a normalised list of
Amounts.
This commit improves performance. Here are some indicative results.
hledger reg -f examples/10000x1000x10.journal
- Maximum residency decreases from 65MB to 60MB (8% decrease)
- Total memory in use decreases from 178MiB to 157MiB (12% decrease)
hledger reg -f examples/10000x10000x10.journal
- Maximum residency decreases from 69MB to 60MB (13% decrease)
- Total memory in use decreases from 198MiB to 153MiB (23% decrease)
hledger bal -f examples/10000x1000x10.journal
- Total heap usage decreases from 6.4GB to 6.0GB (6% decrease)
- Total memory in use decreases from 178MiB to 153MiB (14% decrease)
hledger bal -f examples/10000x10000x10.journal
- Total heap usage decreases from 7.3GB to 6.9GB (5% decrease)
- Total memory in use decreases from 196MiB to 185MiB (5% decrease)
hledger bal -M -f examples/10000x1000x10.journal
- Total heap usage decreases from 16.8GB to 10.6GB (47% decrease)
- Total time decreases from 14.3s to 12.0s (16% decrease)
hledger bal -M -f examples/10000x10000x10.journal
- Total heap usage decreases from 108GB to 48GB (56% decrease)
- Total time decreases from 62s to 41s (33% decrease)
If you never directly use the constructor Mixed or pattern match against
it then you don't need to make any changes. If you do, then do the
following:
- If you really care about the individual Amounts and never normalise
your MixedAmount (for example, just storing `Mixed amts` and then
extracting `amts` as a pattern match, then use should switch to using
[Amount]. This should just involve removing the `Mixed` constructor.
- If you ever call `mixed`, `normaliseMixedAmount`, or do any sort of
amount arithmetic (+), (-), then you should replace the constructor
`Mixed` with the function `mixed`. To extract the list of Amounts, use
the function `amounts`.
- If you ever call `normaliseMixedAmountSquashPricesForDisplay`, you can
replace that with `mixedAmountStripPrices`. (N.B. this does something
slightly different from `normaliseMixedAmountSquashPricesForDisplay`,
but I don't think there's any use case for squashing prices and then
keeping the first of the squashed prices around. If you disagree let
me know.)
- Any remaining calls to `normaliseMixedAmount` can be removed, as that
is now the identity function.
2021-01-29 08:07:11 +03:00
|
|
|
,map Just . concatMap (amountsRaw . pamount) $ journalPostings j
|
2020-02-11 20:21:24 +03:00
|
|
|
]
|
|
|
|
where
|
|
|
|
-- D's amount style isn't actually stored as an amount, make it into one
|
|
|
|
mdefaultcommodityamt =
|
|
|
|
case jparsedefaultcommodity j of
|
|
|
|
Just (symbol,style) -> Just nullamt{acommodity=symbol,astyle=style}
|
|
|
|
Nothing -> Nothing
|
2017-02-04 11:08:00 +03:00
|
|
|
|
2020-02-11 20:21:24 +03:00
|
|
|
-- overcomplicated/unused amount traversal stuff
|
|
|
|
--
|
|
|
|
-- | Get an ordered list of 'AmountStyle's from the amounts in this
|
|
|
|
-- journal which influence canonical amount display styles. See
|
|
|
|
-- traverseJournalAmounts.
|
|
|
|
-- journalAmounts :: Journal -> [Amount]
|
|
|
|
-- journalAmounts = getConst . traverseJournalAmounts (Const . (:[]))
|
|
|
|
--
|
2020-02-11 19:10:04 +03:00
|
|
|
-- | Apply a transformation to the journal amounts traversed by traverseJournalAmounts.
|
2020-02-11 20:21:24 +03:00
|
|
|
-- overJournalAmounts :: (Amount -> Amount) -> Journal -> Journal
|
|
|
|
-- overJournalAmounts f = runIdentity . traverseJournalAmounts (Identity . f)
|
|
|
|
--
|
2020-02-11 19:10:04 +03:00
|
|
|
-- | A helper that traverses over most amounts in the journal,
|
|
|
|
-- in particular the ones which influence canonical amount display styles,
|
|
|
|
-- processing them with the given applicative function.
|
|
|
|
--
|
|
|
|
-- These include, in the following order:
|
|
|
|
--
|
2020-02-11 20:21:24 +03:00
|
|
|
-- * the amount in the final default commodity (D) directive
|
|
|
|
-- * amounts in market price (P) directives (in parse order)
|
2020-02-11 19:10:04 +03:00
|
|
|
-- * posting amounts in transactions (in parse order)
|
|
|
|
--
|
|
|
|
-- Transaction price amounts, which may be embedded in posting amounts
|
|
|
|
-- (the aprice field), are left intact but not traversed/processed.
|
|
|
|
--
|
2020-02-11 20:21:24 +03:00
|
|
|
-- traverseJournalAmounts :: Applicative f => (Amount -> f Amount) -> Journal -> f Journal
|
|
|
|
-- traverseJournalAmounts f j =
|
|
|
|
-- recombine <$> (traverse . dcamt) f (jparsedefaultcommodity j)
|
|
|
|
-- <*> (traverse . pdamt) f (jpricedirectives j)
|
|
|
|
-- <*> (traverse . tps . traverse . pamt . amts . traverse) f (jtxns j)
|
|
|
|
-- where
|
|
|
|
-- recombine pds txns = j { jpricedirectives = pds, jtxns = txns }
|
|
|
|
-- -- a bunch of traversals
|
|
|
|
-- dcamt g pd = (\mdc -> case mdc of Nothing -> Nothing
|
|
|
|
-- Just ((c,stpd{pdamount =amt}
|
|
|
|
-- ) <$> g (pdamount pd)
|
|
|
|
-- pdamt g pd = (\amt -> pd{pdamount =amt}) <$> g (pdamount pd)
|
|
|
|
-- tps g t = (\ps -> t {tpostings=ps }) <$> g (tpostings t)
|
|
|
|
-- pamt g p = (\amt -> p {pamount =amt}) <$> g (pamount p)
|
|
|
|
-- amts g (Mixed as) = Mixed <$> g as
|
2008-11-22 23:35:17 +03:00
|
|
|
|
2014-04-25 01:44:30 +04:00
|
|
|
-- | The fully specified date span enclosing the dates (primary or secondary)
|
|
|
|
-- of all this journal's transactions and postings, or DateSpan Nothing Nothing
|
2014-04-25 01:28:20 +04:00
|
|
|
-- if there are none.
|
2014-04-25 01:44:30 +04:00
|
|
|
journalDateSpan :: Bool -> Journal -> DateSpan
|
2021-03-02 13:32:52 +03:00
|
|
|
journalDateSpan False = journalDateSpanHelper $ Just PrimaryDate
|
|
|
|
journalDateSpan True = journalDateSpanHelper $ Just SecondaryDate
|
|
|
|
|
|
|
|
-- | The fully specified date span enclosing the dates (primary and secondary)
|
|
|
|
-- of all this journal's transactions and postings, or DateSpan Nothing Nothing
|
|
|
|
-- if there are none.
|
|
|
|
journalDateSpanBothDates :: Journal -> DateSpan
|
|
|
|
journalDateSpanBothDates = journalDateSpanHelper Nothing
|
|
|
|
|
|
|
|
-- | A helper for journalDateSpan which takes Maybe WhichDate directly. Nothing
|
|
|
|
-- uses both primary and secondary dates.
|
|
|
|
journalDateSpanHelper :: Maybe WhichDate -> Journal -> DateSpan
|
|
|
|
journalDateSpanHelper whichdate j =
|
|
|
|
DateSpan (minimumMay dates) (addDays 1 <$> maximumMay dates)
|
|
|
|
where
|
|
|
|
dates = pdates ++ tdates
|
|
|
|
tdates = concatMap gettdate ts
|
|
|
|
pdates = concatMap getpdate $ concatMap tpostings ts
|
|
|
|
ts = jtxns j
|
|
|
|
gettdate t = case whichdate of
|
|
|
|
Just PrimaryDate -> [tdate t]
|
|
|
|
Just SecondaryDate -> [fromMaybe (tdate t) $ tdate2 t]
|
|
|
|
Nothing -> tdate t : maybeToList (tdate2 t)
|
|
|
|
getpdate p = case whichdate of
|
|
|
|
Just PrimaryDate -> maybeToList $ pdate p
|
|
|
|
Just SecondaryDate -> maybeToList $ pdate2 p <|> pdate p
|
|
|
|
Nothing -> catMaybes [pdate p, pdate2 p]
|
2014-04-25 01:28:20 +04:00
|
|
|
|
2019-04-23 23:58:32 +03:00
|
|
|
-- | The earliest of this journal's transaction and posting dates, or
|
|
|
|
-- Nothing if there are none.
|
|
|
|
journalStartDate :: Bool -> Journal -> Maybe Day
|
|
|
|
journalStartDate secondary j = b where DateSpan b _ = journalDateSpan secondary j
|
|
|
|
|
2021-07-11 23:52:50 +03:00
|
|
|
-- | The "exclusive end date" of this journal: the day following its latest transaction
|
|
|
|
-- or posting date, or Nothing if there are none.
|
2019-04-23 23:58:32 +03:00
|
|
|
journalEndDate :: Bool -> Journal -> Maybe Day
|
|
|
|
journalEndDate secondary j = e where DateSpan _ e = journalDateSpan secondary j
|
|
|
|
|
2021-07-11 23:52:50 +03:00
|
|
|
-- | The latest of this journal's transaction and posting dates, or
|
|
|
|
-- Nothing if there are none.
|
|
|
|
journalLastDay :: Bool -> Journal -> Maybe Day
|
|
|
|
journalLastDay secondary j = addDays (-1) <$> journalEndDate secondary j
|
|
|
|
|
2017-09-05 20:48:35 +03:00
|
|
|
-- | Apply the pivot transformation to all postings in a journal,
|
|
|
|
-- replacing their account name by their value for the given field or tag.
|
|
|
|
journalPivot :: Text -> Journal -> Journal
|
|
|
|
journalPivot fieldortagname j = j{jtxns = map (transactionPivot fieldortagname) . jtxns $ j}
|
|
|
|
|
|
|
|
-- | Replace this transaction's postings' account names with the value
|
|
|
|
-- of the given field or tag, if any.
|
2019-07-15 13:28:52 +03:00
|
|
|
transactionPivot :: Text -> Transaction -> Transaction
|
2017-09-05 20:48:35 +03:00
|
|
|
transactionPivot fieldortagname t = t{tpostings = map (postingPivot fieldortagname) . tpostings $ t}
|
|
|
|
|
|
|
|
-- | Replace this posting's account name with the value
|
|
|
|
-- of the given field or tag, if any, otherwise the empty string.
|
2019-07-15 13:28:52 +03:00
|
|
|
postingPivot :: Text -> Posting -> Posting
|
2019-02-21 07:07:40 +03:00
|
|
|
postingPivot fieldortagname p = p{paccount = pivotedacct, poriginal = Just $ originalPosting p}
|
2017-09-05 20:48:35 +03:00
|
|
|
where
|
|
|
|
pivotedacct
|
2019-07-15 13:28:52 +03:00
|
|
|
| Just t <- ptransaction p, fieldortagname == "code" = tcode t
|
|
|
|
| Just t <- ptransaction p, fieldortagname == "description" = tdescription t
|
|
|
|
| Just t <- ptransaction p, fieldortagname == "payee" = transactionPayee t
|
|
|
|
| Just t <- ptransaction p, fieldortagname == "note" = transactionNote t
|
2017-09-05 20:48:35 +03:00
|
|
|
| Just (_, value) <- postingFindTag fieldortagname p = value
|
|
|
|
| otherwise = ""
|
|
|
|
|
2019-07-15 13:28:52 +03:00
|
|
|
postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue)
|
2017-09-05 20:48:35 +03:00
|
|
|
postingFindTag tagname p = find ((tagname==) . fst) $ postingAllTags p
|
|
|
|
|
2020-11-24 20:17:01 +03:00
|
|
|
-- | Apply some account aliases to all posting account names in the journal, as described by accountNameApplyAliases.
|
2020-11-26 07:59:07 +03:00
|
|
|
-- This can fail due to a bad replacement pattern in a regular expression alias.
|
|
|
|
journalApplyAliases :: [AccountAlias] -> Journal -> Either RegexError Journal
|
2020-11-26 08:01:05 +03:00
|
|
|
-- short circuit the common case, just in case there's a performance impact from txnTieKnot etc.
|
|
|
|
journalApplyAliases [] j = Right j
|
2020-11-26 07:59:07 +03:00
|
|
|
journalApplyAliases aliases j =
|
|
|
|
case mapM (transactionApplyAliases aliases) $ jtxns j of
|
|
|
|
Right ts -> Right j{jtxns = ts}
|
|
|
|
Left err -> Left err
|
2021-03-02 13:32:52 +03:00
|
|
|
|
2019-06-04 03:26:27 +03:00
|
|
|
-- -- | Build a database of market prices in effect on the given date,
|
|
|
|
-- -- from the journal's price directives.
|
|
|
|
-- journalPrices :: Day -> Journal -> Prices
|
|
|
|
-- journalPrices d = toPrices d . jpricedirectives
|
2019-05-25 15:27:55 +03:00
|
|
|
|
|
|
|
-- -- | Render a market price as a P directive.
|
2019-06-04 03:26:27 +03:00
|
|
|
-- showPriceDirectiveDirective :: PriceDirective -> String
|
|
|
|
-- showPriceDirectiveDirective pd = unwords
|
2019-05-25 15:27:55 +03:00
|
|
|
-- [ "P"
|
2019-06-04 03:26:27 +03:00
|
|
|
-- , showDate (pddate pd)
|
|
|
|
-- , T.unpack (pdcommodity pd)
|
2021-02-05 00:57:55 +03:00
|
|
|
-- , (showAmount . amountSetPrecision maxprecision) (pdamount pd
|
2019-06-04 03:26:27 +03:00
|
|
|
-- )
|
2019-05-25 15:27:55 +03:00
|
|
|
-- ]
|
|
|
|
|
2011-08-30 15:37:36 +04:00
|
|
|
-- debug helpers
|
2012-11-20 01:20:10 +04:00
|
|
|
-- traceAmountPrecision a = trace (show $ map (precision . acommodity) $ amounts a) a
|
|
|
|
-- tracePostingsCommodities ps = trace (show $ map ((map (precision . acommodity) . amounts) . pamount) ps) ps
|
2011-08-30 15:37:36 +04:00
|
|
|
|
2012-04-14 05:12:42 +04:00
|
|
|
-- tests
|
2021-08-24 05:34:32 +03:00
|
|
|
--
|
|
|
|
-- A sample journal for testing, similar to examples/sample.journal.
|
|
|
|
-- Provide an option to either use explicit amounts or missing amounts, for testing purposes.
|
2012-05-27 22:14:20 +04:00
|
|
|
--
|
|
|
|
-- 2008/01/01 income
|
|
|
|
-- assets:bank:checking $1
|
|
|
|
-- income:salary
|
|
|
|
--
|
|
|
|
-- 2008/06/01 gift
|
|
|
|
-- assets:bank:checking $1
|
|
|
|
-- income:gifts
|
|
|
|
--
|
|
|
|
-- 2008/06/02 save
|
|
|
|
-- assets:bank:saving $1
|
|
|
|
-- assets:bank:checking
|
|
|
|
--
|
|
|
|
-- 2008/06/03 * eat & shop
|
|
|
|
-- expenses:food $1
|
|
|
|
-- expenses:supplies $1
|
|
|
|
-- assets:cash
|
|
|
|
--
|
2017-07-10 19:43:46 +03:00
|
|
|
-- 2008/10/01 take a loan
|
|
|
|
-- assets:bank:checking $1
|
|
|
|
-- liabilities:debts $-1
|
|
|
|
--
|
2012-05-27 22:14:20 +04:00
|
|
|
-- 2008/12/31 * pay off
|
|
|
|
-- liabilities:debts $1
|
|
|
|
-- assets:bank:checking
|
2021-08-24 05:34:32 +03:00
|
|
|
|
|
|
|
samplejournal = samplejournalMaybeExplicit True
|
|
|
|
|
|
|
|
samplejournalMaybeExplicit :: Bool -> Journal
|
|
|
|
samplejournalMaybeExplicit explicit = nulljournal
|
2012-11-20 01:20:10 +04:00
|
|
|
{jtxns = [
|
2012-05-27 22:14:20 +04:00
|
|
|
txnTieKnot $ Transaction {
|
2015-10-30 06:12:46 +03:00
|
|
|
tindex=0,
|
2014-08-01 04:32:42 +04:00
|
|
|
tsourcepos=nullsourcepos,
|
2020-08-26 11:11:20 +03:00
|
|
|
tdate=fromGregorian 2008 01 01,
|
2012-12-06 08:43:41 +04:00
|
|
|
tdate2=Nothing,
|
2017-06-16 02:25:37 +03:00
|
|
|
tstatus=Unmarked,
|
2012-05-27 22:14:20 +04:00
|
|
|
tcode="",
|
|
|
|
tdescription="income",
|
|
|
|
tcomment="",
|
2012-05-28 02:59:06 +04:00
|
|
|
ttags=[],
|
2012-12-06 04:03:07 +04:00
|
|
|
tpostings=
|
|
|
|
["assets:bank:checking" `post` usd 1
|
2021-08-24 05:34:32 +03:00
|
|
|
,"income:salary" `post` if explicit then usd (-1) else missingamt
|
2012-12-06 04:03:07 +04:00
|
|
|
],
|
2019-01-04 23:01:45 +03:00
|
|
|
tprecedingcomment=""
|
2012-05-27 22:14:20 +04:00
|
|
|
}
|
|
|
|
,
|
|
|
|
txnTieKnot $ Transaction {
|
2015-10-30 06:12:46 +03:00
|
|
|
tindex=0,
|
2014-08-01 04:32:42 +04:00
|
|
|
tsourcepos=nullsourcepos,
|
2020-08-26 11:11:20 +03:00
|
|
|
tdate=fromGregorian 2008 06 01,
|
2012-12-06 08:43:41 +04:00
|
|
|
tdate2=Nothing,
|
2017-06-16 02:25:37 +03:00
|
|
|
tstatus=Unmarked,
|
2012-05-27 22:14:20 +04:00
|
|
|
tcode="",
|
|
|
|
tdescription="gift",
|
|
|
|
tcomment="",
|
2012-05-28 02:59:06 +04:00
|
|
|
ttags=[],
|
2012-12-06 04:03:07 +04:00
|
|
|
tpostings=
|
|
|
|
["assets:bank:checking" `post` usd 1
|
2021-08-24 05:34:32 +03:00
|
|
|
,"income:gifts" `post` if explicit then usd (-1) else missingamt
|
2012-12-06 04:03:07 +04:00
|
|
|
],
|
2019-01-04 23:01:45 +03:00
|
|
|
tprecedingcomment=""
|
2012-05-27 22:14:20 +04:00
|
|
|
}
|
|
|
|
,
|
|
|
|
txnTieKnot $ Transaction {
|
2015-10-30 06:12:46 +03:00
|
|
|
tindex=0,
|
2014-08-01 04:32:42 +04:00
|
|
|
tsourcepos=nullsourcepos,
|
2020-08-26 11:11:20 +03:00
|
|
|
tdate=fromGregorian 2008 06 02,
|
2012-12-06 08:43:41 +04:00
|
|
|
tdate2=Nothing,
|
2017-06-16 02:25:37 +03:00
|
|
|
tstatus=Unmarked,
|
2012-05-27 22:14:20 +04:00
|
|
|
tcode="",
|
|
|
|
tdescription="save",
|
|
|
|
tcomment="",
|
2012-05-28 02:59:06 +04:00
|
|
|
ttags=[],
|
2012-12-06 04:03:07 +04:00
|
|
|
tpostings=
|
|
|
|
["assets:bank:saving" `post` usd 1
|
2021-08-24 05:34:32 +03:00
|
|
|
,"assets:bank:checking" `post` if explicit then usd (-1) else missingamt
|
2012-12-06 04:03:07 +04:00
|
|
|
],
|
2019-01-04 23:01:45 +03:00
|
|
|
tprecedingcomment=""
|
2012-05-27 22:14:20 +04:00
|
|
|
}
|
|
|
|
,
|
|
|
|
txnTieKnot $ Transaction {
|
2015-10-30 06:12:46 +03:00
|
|
|
tindex=0,
|
2014-08-01 04:32:42 +04:00
|
|
|
tsourcepos=nullsourcepos,
|
2020-08-26 11:11:20 +03:00
|
|
|
tdate=fromGregorian 2008 06 03,
|
2012-12-06 08:43:41 +04:00
|
|
|
tdate2=Nothing,
|
2015-05-16 21:51:35 +03:00
|
|
|
tstatus=Cleared,
|
2012-05-27 22:14:20 +04:00
|
|
|
tcode="",
|
|
|
|
tdescription="eat & shop",
|
|
|
|
tcomment="",
|
2012-05-28 02:59:06 +04:00
|
|
|
ttags=[],
|
2012-12-06 04:03:07 +04:00
|
|
|
tpostings=["expenses:food" `post` usd 1
|
|
|
|
,"expenses:supplies" `post` usd 1
|
2021-08-24 05:34:32 +03:00
|
|
|
,"assets:cash" `post` if explicit then usd (-2) else missingamt
|
2012-12-06 04:03:07 +04:00
|
|
|
],
|
2019-01-04 23:01:45 +03:00
|
|
|
tprecedingcomment=""
|
2012-05-27 22:14:20 +04:00
|
|
|
}
|
2017-07-10 19:43:46 +03:00
|
|
|
,
|
|
|
|
txnTieKnot $ Transaction {
|
|
|
|
tindex=0,
|
|
|
|
tsourcepos=nullsourcepos,
|
2020-08-26 11:11:20 +03:00
|
|
|
tdate=fromGregorian 2008 10 01,
|
2017-07-10 19:43:46 +03:00
|
|
|
tdate2=Nothing,
|
|
|
|
tstatus=Unmarked,
|
|
|
|
tcode="",
|
|
|
|
tdescription="take a loan",
|
|
|
|
tcomment="",
|
|
|
|
ttags=[],
|
|
|
|
tpostings=["assets:bank:checking" `post` usd 1
|
|
|
|
,"liabilities:debts" `post` usd (-1)
|
|
|
|
],
|
2019-01-04 23:01:45 +03:00
|
|
|
tprecedingcomment=""
|
2017-07-10 19:43:46 +03:00
|
|
|
}
|
2012-05-27 22:14:20 +04:00
|
|
|
,
|
|
|
|
txnTieKnot $ Transaction {
|
2015-10-30 06:12:46 +03:00
|
|
|
tindex=0,
|
2014-08-01 04:32:42 +04:00
|
|
|
tsourcepos=nullsourcepos,
|
2020-08-26 11:11:20 +03:00
|
|
|
tdate=fromGregorian 2008 12 31,
|
2012-12-06 08:43:41 +04:00
|
|
|
tdate2=Nothing,
|
2017-06-16 02:25:37 +03:00
|
|
|
tstatus=Unmarked,
|
2012-05-27 22:14:20 +04:00
|
|
|
tcode="",
|
|
|
|
tdescription="pay off",
|
|
|
|
tcomment="",
|
2012-05-28 02:59:06 +04:00
|
|
|
ttags=[],
|
2012-12-06 04:03:07 +04:00
|
|
|
tpostings=["liabilities:debts" `post` usd 1
|
2021-08-24 05:34:32 +03:00
|
|
|
,"assets:bank:checking" `post` if explicit then usd (-1) else missingamt
|
2012-12-06 04:03:07 +04:00
|
|
|
],
|
2019-01-04 23:01:45 +03:00
|
|
|
tprecedingcomment=""
|
2012-05-27 22:14:20 +04:00
|
|
|
}
|
|
|
|
]
|
2012-11-20 01:20:10 +04:00
|
|
|
}
|
2012-05-27 22:14:20 +04:00
|
|
|
|
2021-08-30 08:23:23 +03:00
|
|
|
tests_Journal = testGroup "Journal" [
|
2018-09-04 20:10:10 +03:00
|
|
|
|
2021-08-30 08:23:23 +03:00
|
|
|
testCase "journalDateSpan" $
|
2018-09-04 20:10:10 +03:00
|
|
|
journalDateSpan True nulljournal{
|
2020-08-26 11:11:20 +03:00
|
|
|
jtxns = [nulltransaction{tdate = fromGregorian 2014 02 01
|
|
|
|
,tpostings = [posting{pdate=Just (fromGregorian 2014 01 10)}]
|
2018-09-04 20:10:10 +03:00
|
|
|
}
|
2020-08-26 11:11:20 +03:00
|
|
|
,nulltransaction{tdate = fromGregorian 2014 09 01
|
|
|
|
,tpostings = [posting{pdate2=Just (fromGregorian 2014 10 10)}]
|
2018-09-04 20:10:10 +03:00
|
|
|
}
|
|
|
|
]
|
|
|
|
}
|
2019-11-27 23:46:29 +03:00
|
|
|
@?= (DateSpan (Just $ fromGregorian 2014 1 10) (Just $ fromGregorian 2014 10 11))
|
2018-09-04 20:10:10 +03:00
|
|
|
|
2021-08-30 08:23:23 +03:00
|
|
|
,testGroup "standard account type queries" $
|
2018-08-15 21:43:29 +03:00
|
|
|
let
|
|
|
|
j = samplejournal
|
|
|
|
journalAccountNamesMatching :: Query -> Journal -> [AccountName]
|
|
|
|
journalAccountNamesMatching q = filter (q `matchesAccount`) . journalAccountNames
|
|
|
|
namesfrom qfunc = journalAccountNamesMatching (qfunc j) j
|
2021-08-24 05:34:32 +03:00
|
|
|
in [testCase "assets" $ assertEqual "" ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]
|
2020-07-17 18:51:07 +03:00
|
|
|
(namesfrom journalAssetAccountQuery)
|
2021-08-24 05:34:32 +03:00
|
|
|
,testCase "cash" $ assertEqual "" ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]
|
|
|
|
(namesfrom journalCashAccountQuery)
|
|
|
|
,testCase "liabilities" $ assertEqual "" ["liabilities","liabilities:debts"]
|
|
|
|
(namesfrom journalLiabilityAccountQuery)
|
|
|
|
,testCase "equity" $ assertEqual "" []
|
|
|
|
(namesfrom journalEquityAccountQuery)
|
|
|
|
,testCase "income" $ assertEqual "" ["income","income:gifts","income:salary"]
|
|
|
|
(namesfrom journalRevenueAccountQuery)
|
|
|
|
,testCase "expenses" $ assertEqual "" ["expenses","expenses:food","expenses:supplies"]
|
|
|
|
(namesfrom journalExpenseAccountQuery)
|
|
|
|
]
|
2018-08-15 21:43:29 +03:00
|
|
|
]
|