{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
module Hledger.Data.Journal (
addPriceDirective,
addTransactionModifier,
addPeriodicTransaction,
addTransaction,
journalBalanceTransactions,
journalInferMarketPricesFromTransactions,
journalApplyCommodityStyles,
commodityStylesFromAmounts,
journalCommodityStyles,
journalToCost,
journalReverse,
journalSetLastReadTime,
journalPivot,
filterJournalTransactions,
filterJournalPostings,
filterJournalAmounts,
filterTransactionAmounts,
filterTransactionPostings,
filterPostingAmount,
mapJournalTransactions,
mapJournalPostings,
mapTransactionPostings,
journalAccountNamesUsed,
journalAccountNamesImplied,
journalAccountNamesDeclared,
journalAccountNamesDeclaredOrUsed,
journalAccountNamesDeclaredOrImplied,
journalAccountNames,
journalDateSpan,
journalStartDate,
journalEndDate,
journalDescriptions,
journalFilePath,
journalFilePaths,
journalTransactionAt,
journalNextTransaction,
journalPrevTransaction,
journalPostings,
journalBalanceSheetAccountQuery,
journalProfitAndLossAccountQuery,
journalRevenueAccountQuery,
journalExpenseAccountQuery,
journalAssetAccountQuery,
journalLiabilityAccountQuery,
journalEquityAccountQuery,
journalCashAccountQuery,
canonicalStyleFrom,
matchpats,
nulljournal,
journalCheckBalanceAssertions,
journalNumberAndTieTransactions,
journalUntieTransactions,
journalModifyTransactions,
samplejournal,
tests_Journal,
)
where
import Control.Monad
import Control.Monad.Except
import Control.Monad.Extra
import Control.Monad.Reader as R
import Control.Monad.ST
import Data.Array.ST
import Data.Default (Default(..))
import Data.Function ((&))
import qualified Data.HashTable.Class as H (toList)
import qualified Data.HashTable.ST.Cuckoo as H
import Data.List
import Data.List.Extra (groupSort, nubSort)
import qualified Data.Map as M
import Data.Maybe
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Safe (headMay, headDef)
import Data.Time.Calendar
import Data.Tree
import System.Time (ClockTime(TOD))
import Text.Printf
import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.AccountName
import Hledger.Data.Amount
import Hledger.Data.Dates
import Hledger.Data.Transaction
import Hledger.Data.TransactionModifier
import Hledger.Data.Posting
import Hledger.Query
instance Show Journal where
show :: Journal -> String
show j :: Journal
j
| Int
debugLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 3 = String -> String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf "Journal %s with %d transactions, %d accounts"
(Journal -> String
journalFilePath Journal
j)
([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Transaction] -> Int) -> [Transaction] -> Int
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j)
([AccountName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AccountName]
accounts)
| Int
debugLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 6 = String -> String -> Int -> Int -> ShowS
forall r. PrintfType r => String -> r
printf "Journal %s with %d transactions, %d accounts: %s"
(Journal -> String
journalFilePath Journal
j)
([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Transaction] -> Int) -> [Transaction] -> Int
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j)
([AccountName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AccountName]
accounts)
([AccountName] -> String
forall a. Show a => a -> String
show [AccountName]
accounts)
| Bool
otherwise = String -> String -> Int -> Int -> String -> ShowS
forall r. PrintfType r => String -> r
printf "Journal %s with %d transactions, %d accounts: %s, commodity styles: %s"
(Journal -> String
journalFilePath Journal
j)
([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Transaction] -> Int) -> [Transaction] -> Int
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j)
([AccountName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AccountName]
accounts)
([AccountName] -> String
forall a. Show a => a -> String
show [AccountName]
accounts)
(Map AccountName AmountStyle -> String
forall a. Show a => a -> String
show (Map AccountName AmountStyle -> String)
-> Map AccountName AmountStyle -> String
forall a b. (a -> b) -> a -> b
$ Journal -> Map AccountName AmountStyle
jinferredcommodities Journal
j)
where accounts :: [AccountName]
accounts = (AccountName -> Bool) -> [AccountName] -> [AccountName]
forall a. (a -> Bool) -> [a] -> [a]
filter (AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
/= "root") ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ Tree AccountName -> [AccountName]
forall a. Tree a -> [a]
flatten (Tree AccountName -> [AccountName])
-> Tree AccountName -> [AccountName]
forall a b. (a -> b) -> a -> b
$ Journal -> Tree AccountName
journalAccountNameTree Journal
j
instance Semigroup Journal where
j1 :: Journal
j1 <> :: Journal -> Journal -> Journal
<> j2 :: Journal
j2 = Journal :: Maybe Year
-> Maybe (AccountName, AmountStyle)
-> [AccountName]
-> [AccountAlias]
-> [TimeclockEntry]
-> [String]
-> [(AccountName, AccountDeclarationInfo)]
-> Map AccountType [AccountName]
-> Map AccountName Commodity
-> Map AccountName AmountStyle
-> [PriceDirective]
-> [MarketPrice]
-> [TransactionModifier]
-> [PeriodicTransaction]
-> [Transaction]
-> AccountName
-> [(String, AccountName)]
-> ClockTime
-> Journal
Journal {
jparsedefaultyear :: Maybe Year
jparsedefaultyear = Journal -> Maybe Year
jparsedefaultyear Journal
j2
,jparsedefaultcommodity :: Maybe (AccountName, AmountStyle)
jparsedefaultcommodity = Journal -> Maybe (AccountName, AmountStyle)
jparsedefaultcommodity Journal
j2
,jparseparentaccounts :: [AccountName]
jparseparentaccounts = Journal -> [AccountName]
jparseparentaccounts Journal
j2
,jparsealiases :: [AccountAlias]
jparsealiases = Journal -> [AccountAlias]
jparsealiases Journal
j2
,jparsetimeclockentries :: [TimeclockEntry]
jparsetimeclockentries = Journal -> [TimeclockEntry]
jparsetimeclockentries Journal
j1 [TimeclockEntry] -> [TimeclockEntry] -> [TimeclockEntry]
forall a. Semigroup a => a -> a -> a
<> Journal -> [TimeclockEntry]
jparsetimeclockentries Journal
j2
,jincludefilestack :: [String]
jincludefilestack = Journal -> [String]
jincludefilestack Journal
j2
,jdeclaredaccounts :: [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts = Journal -> [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j1 [(AccountName, AccountDeclarationInfo)]
-> [(AccountName, AccountDeclarationInfo)]
-> [(AccountName, AccountDeclarationInfo)]
forall a. Semigroup a => a -> a -> a
<> Journal -> [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j2
,jdeclaredaccounttypes :: Map AccountType [AccountName]
jdeclaredaccounttypes = Journal -> Map AccountType [AccountName]
jdeclaredaccounttypes Journal
j1 Map AccountType [AccountName]
-> Map AccountType [AccountName] -> Map AccountType [AccountName]
forall a. Semigroup a => a -> a -> a
<> Journal -> Map AccountType [AccountName]
jdeclaredaccounttypes Journal
j2
,jcommodities :: Map AccountName Commodity
jcommodities = Journal -> Map AccountName Commodity
jcommodities Journal
j1 Map AccountName Commodity
-> Map AccountName Commodity -> Map AccountName Commodity
forall a. Semigroup a => a -> a -> a
<> Journal -> Map AccountName Commodity
jcommodities Journal
j2
,jinferredcommodities :: Map AccountName AmountStyle
jinferredcommodities = Journal -> Map AccountName AmountStyle
jinferredcommodities Journal
j1 Map AccountName AmountStyle
-> Map AccountName AmountStyle -> Map AccountName AmountStyle
forall a. Semigroup a => a -> a -> a
<> Journal -> Map AccountName AmountStyle
jinferredcommodities Journal
j2
,jpricedirectives :: [PriceDirective]
jpricedirectives = Journal -> [PriceDirective]
jpricedirectives Journal
j1 [PriceDirective] -> [PriceDirective] -> [PriceDirective]
forall a. Semigroup a => a -> a -> a
<> Journal -> [PriceDirective]
jpricedirectives Journal
j2
,jinferredmarketprices :: [MarketPrice]
jinferredmarketprices = Journal -> [MarketPrice]
jinferredmarketprices Journal
j1 [MarketPrice] -> [MarketPrice] -> [MarketPrice]
forall a. Semigroup a => a -> a -> a
<> Journal -> [MarketPrice]
jinferredmarketprices Journal
j2
,jtxnmodifiers :: [TransactionModifier]
jtxnmodifiers = Journal -> [TransactionModifier]
jtxnmodifiers Journal
j1 [TransactionModifier]
-> [TransactionModifier] -> [TransactionModifier]
forall a. Semigroup a => a -> a -> a
<> Journal -> [TransactionModifier]
jtxnmodifiers Journal
j2
,jperiodictxns :: [PeriodicTransaction]
jperiodictxns = Journal -> [PeriodicTransaction]
jperiodictxns Journal
j1 [PeriodicTransaction]
-> [PeriodicTransaction] -> [PeriodicTransaction]
forall a. Semigroup a => a -> a -> a
<> Journal -> [PeriodicTransaction]
jperiodictxns Journal
j2
,jtxns :: [Transaction]
jtxns = Journal -> [Transaction]
jtxns Journal
j1 [Transaction] -> [Transaction] -> [Transaction]
forall a. Semigroup a => a -> a -> a
<> Journal -> [Transaction]
jtxns Journal
j2
,jfinalcommentlines :: AccountName
jfinalcommentlines = Journal -> AccountName
jfinalcommentlines Journal
j2
,jfiles :: [(String, AccountName)]
jfiles = Journal -> [(String, AccountName)]
jfiles Journal
j1 [(String, AccountName)]
-> [(String, AccountName)] -> [(String, AccountName)]
forall a. Semigroup a => a -> a -> a
<> Journal -> [(String, AccountName)]
jfiles Journal
j2
,jlastreadtime :: ClockTime
jlastreadtime = ClockTime -> ClockTime -> ClockTime
forall a. Ord a => a -> a -> a
max (Journal -> ClockTime
jlastreadtime Journal
j1) (Journal -> ClockTime
jlastreadtime Journal
j2)
}
instance Default Journal where
def :: Journal
def = Journal
nulljournal
nulljournal :: Journal
nulljournal :: Journal
nulljournal = Journal :: Maybe Year
-> Maybe (AccountName, AmountStyle)
-> [AccountName]
-> [AccountAlias]
-> [TimeclockEntry]
-> [String]
-> [(AccountName, AccountDeclarationInfo)]
-> Map AccountType [AccountName]
-> Map AccountName Commodity
-> Map AccountName AmountStyle
-> [PriceDirective]
-> [MarketPrice]
-> [TransactionModifier]
-> [PeriodicTransaction]
-> [Transaction]
-> AccountName
-> [(String, AccountName)]
-> ClockTime
-> Journal
Journal {
jparsedefaultyear :: Maybe Year
jparsedefaultyear = Maybe Year
forall a. Maybe a
Nothing
,jparsedefaultcommodity :: Maybe (AccountName, AmountStyle)
jparsedefaultcommodity = Maybe (AccountName, AmountStyle)
forall a. Maybe a
Nothing
,jparseparentaccounts :: [AccountName]
jparseparentaccounts = []
,jparsealiases :: [AccountAlias]
jparsealiases = []
,jparsetimeclockentries :: [TimeclockEntry]
jparsetimeclockentries = []
,jincludefilestack :: [String]
jincludefilestack = []
,jdeclaredaccounts :: [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts = []
,jdeclaredaccounttypes :: Map AccountType [AccountName]
jdeclaredaccounttypes = Map AccountType [AccountName]
forall k a. Map k a
M.empty
,jcommodities :: Map AccountName Commodity
jcommodities = Map AccountName Commodity
forall k a. Map k a
M.empty
,jinferredcommodities :: Map AccountName AmountStyle
jinferredcommodities = Map AccountName AmountStyle
forall k a. Map k a
M.empty
,jpricedirectives :: [PriceDirective]
jpricedirectives = []
,jinferredmarketprices :: [MarketPrice]
jinferredmarketprices = []
,jtxnmodifiers :: [TransactionModifier]
jtxnmodifiers = []
,jperiodictxns :: [PeriodicTransaction]
jperiodictxns = []
,jtxns :: [Transaction]
jtxns = []
,jfinalcommentlines :: AccountName
jfinalcommentlines = ""
,jfiles :: [(String, AccountName)]
jfiles = []
,jlastreadtime :: ClockTime
jlastreadtime = Year -> Year -> ClockTime
TOD 0 0
}
journalFilePath :: Journal -> FilePath
journalFilePath :: Journal -> String
journalFilePath = (String, AccountName) -> String
forall a b. (a, b) -> a
fst ((String, AccountName) -> String)
-> (Journal -> (String, AccountName)) -> Journal -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> (String, AccountName)
mainfile
journalFilePaths :: Journal -> [FilePath]
journalFilePaths :: Journal -> [String]
journalFilePaths = ((String, AccountName) -> String)
-> [(String, AccountName)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, AccountName) -> String
forall a b. (a, b) -> a
fst ([(String, AccountName)] -> [String])
-> (Journal -> [(String, AccountName)]) -> Journal -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [(String, AccountName)]
jfiles
mainfile :: Journal -> (FilePath, Text)
mainfile :: Journal -> (String, AccountName)
mainfile = (String, AccountName)
-> [(String, AccountName)] -> (String, AccountName)
forall a. a -> [a] -> a
headDef ("", "") ([(String, AccountName)] -> (String, AccountName))
-> (Journal -> [(String, AccountName)])
-> Journal
-> (String, AccountName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [(String, AccountName)]
jfiles
addTransaction :: Transaction -> Journal -> Journal
addTransaction :: Transaction -> Journal -> Journal
addTransaction t :: Transaction
t j :: Journal
j = Journal
j { jtxns :: [Transaction]
jtxns = Transaction
t Transaction -> [Transaction] -> [Transaction]
forall a. a -> [a] -> [a]
: Journal -> [Transaction]
jtxns Journal
j }
addTransactionModifier :: TransactionModifier -> Journal -> Journal
addTransactionModifier :: TransactionModifier -> Journal -> Journal
addTransactionModifier mt :: TransactionModifier
mt j :: Journal
j = Journal
j { jtxnmodifiers :: [TransactionModifier]
jtxnmodifiers = TransactionModifier
mt TransactionModifier
-> [TransactionModifier] -> [TransactionModifier]
forall a. a -> [a] -> [a]
: Journal -> [TransactionModifier]
jtxnmodifiers Journal
j }
addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal
addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal
addPeriodicTransaction pt :: PeriodicTransaction
pt j :: Journal
j = Journal
j { jperiodictxns :: [PeriodicTransaction]
jperiodictxns = PeriodicTransaction
pt PeriodicTransaction
-> [PeriodicTransaction] -> [PeriodicTransaction]
forall a. a -> [a] -> [a]
: Journal -> [PeriodicTransaction]
jperiodictxns Journal
j }
addPriceDirective :: PriceDirective -> Journal -> Journal
addPriceDirective :: PriceDirective -> Journal -> Journal
addPriceDirective h :: PriceDirective
h j :: Journal
j = Journal
j { jpricedirectives :: [PriceDirective]
jpricedirectives = PriceDirective
h PriceDirective -> [PriceDirective] -> [PriceDirective]
forall a. a -> [a] -> [a]
: Journal -> [PriceDirective]
jpricedirectives Journal
j }
journalTransactionAt :: Journal -> Integer -> Maybe Transaction
journalTransactionAt :: Journal -> Year -> Maybe Transaction
journalTransactionAt Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} i :: Year
i =
[Transaction] -> Maybe Transaction
forall a. [a] -> Maybe a
headMay [Transaction
t | Transaction
t <- [Transaction]
ts, Transaction -> Year
tindex Transaction
t Year -> Year -> Bool
forall a. Eq a => a -> a -> Bool
== Year
i]
journalNextTransaction :: Journal -> Transaction -> Maybe Transaction
journalNextTransaction :: Journal -> Transaction -> Maybe Transaction
journalNextTransaction j :: Journal
j t :: Transaction
t = Journal -> Year -> Maybe Transaction
journalTransactionAt Journal
j (Transaction -> Year
tindex Transaction
t Year -> Year -> Year
forall a. Num a => a -> a -> a
+ 1)
journalPrevTransaction :: Journal -> Transaction -> Maybe Transaction
journalPrevTransaction :: Journal -> Transaction -> Maybe Transaction
journalPrevTransaction j :: Journal
j t :: Transaction
t = Journal -> Year -> Maybe Transaction
journalTransactionAt Journal
j (Transaction -> Year
tindex Transaction
t Year -> Year -> Year
forall a. Num a => a -> a -> a
- 1)
journalDescriptions :: Journal -> [Text]
journalDescriptions :: Journal -> [AccountName]
journalDescriptions = [AccountName] -> [AccountName]
forall a. Ord a => [a] -> [a]
nubSort ([AccountName] -> [AccountName])
-> (Journal -> [AccountName]) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transaction -> AccountName) -> [Transaction] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> AccountName
tdescription ([Transaction] -> [AccountName])
-> (Journal -> [Transaction]) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Transaction]
jtxns
journalPostings :: Journal -> [Posting]
journalPostings :: Journal -> [Posting]
journalPostings = (Transaction -> [Posting]) -> [Transaction] -> [Posting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Posting]
tpostings ([Transaction] -> [Posting])
-> (Journal -> [Transaction]) -> Journal -> [Posting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Transaction]
jtxns
journalAccountNamesUsed :: Journal -> [AccountName]
journalAccountNamesUsed :: Journal -> [AccountName]
journalAccountNamesUsed = [Posting] -> [AccountName]
accountNamesFromPostings ([Posting] -> [AccountName])
-> (Journal -> [Posting]) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Posting]
journalPostings
journalAccountNamesImplied :: Journal -> [AccountName]
journalAccountNamesImplied :: Journal -> [AccountName]
journalAccountNamesImplied = [AccountName] -> [AccountName]
expandAccountNames ([AccountName] -> [AccountName])
-> (Journal -> [AccountName]) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [AccountName]
journalAccountNamesUsed
journalAccountNamesDeclared :: Journal -> [AccountName]
journalAccountNamesDeclared :: Journal -> [AccountName]
journalAccountNamesDeclared = [AccountName] -> [AccountName]
forall a. Ord a => [a] -> [a]
nubSort ([AccountName] -> [AccountName])
-> (Journal -> [AccountName]) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AccountName, AccountDeclarationInfo) -> AccountName)
-> [(AccountName, AccountDeclarationInfo)] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName, AccountDeclarationInfo) -> AccountName
forall a b. (a, b) -> a
fst ([(AccountName, AccountDeclarationInfo)] -> [AccountName])
-> (Journal -> [(AccountName, AccountDeclarationInfo)])
-> Journal
-> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts
journalAccountNamesDeclaredOrUsed :: Journal -> [AccountName]
journalAccountNamesDeclaredOrUsed :: Journal -> [AccountName]
journalAccountNamesDeclaredOrUsed j :: Journal
j = [AccountName] -> [AccountName]
forall a. Ord a => [a] -> [a]
nubSort ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ Journal -> [AccountName]
journalAccountNamesDeclared Journal
j [AccountName] -> [AccountName] -> [AccountName]
forall a. [a] -> [a] -> [a]
++ Journal -> [AccountName]
journalAccountNamesUsed Journal
j
journalAccountNamesDeclaredOrImplied :: Journal -> [AccountName]
journalAccountNamesDeclaredOrImplied :: Journal -> [AccountName]
journalAccountNamesDeclaredOrImplied j :: Journal
j = [AccountName] -> [AccountName]
forall a. Ord a => [a] -> [a]
nubSort ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ Journal -> [AccountName]
journalAccountNamesDeclared Journal
j [AccountName] -> [AccountName] -> [AccountName]
forall a. [a] -> [a] -> [a]
++ Journal -> [AccountName]
journalAccountNamesImplied Journal
j
journalAccountNames :: Journal -> [AccountName]
journalAccountNames :: Journal -> [AccountName]
journalAccountNames = Journal -> [AccountName]
journalAccountNamesDeclaredOrImplied
journalAccountNameTree :: Journal -> Tree AccountName
journalAccountNameTree :: Journal -> Tree AccountName
journalAccountNameTree = [AccountName] -> Tree AccountName
accountNameTreeFrom ([AccountName] -> Tree AccountName)
-> (Journal -> [AccountName]) -> Journal -> Tree AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [AccountName]
journalAccountNames
journalAccountTypeQuery :: AccountType -> Regexp -> Journal -> Query
journalAccountTypeQuery :: AccountType -> String -> Journal -> Query
journalAccountTypeQuery atype :: AccountType
atype fallbackregex :: String
fallbackregex j :: Journal
j =
case AccountType -> Map AccountType [AccountName] -> Maybe [AccountName]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AccountType
atype (Journal -> Map AccountType [AccountName]
jdeclaredaccounttypes Journal
j) of
Nothing -> String -> Query
Acct String
fallbackregex
Just as :: [AccountName]
as ->
[Query] -> Query
And [
[Query] -> Query
Or ([Query] -> Query) -> [Query] -> Query
forall a b. (a -> b) -> a -> b
$ (AccountName -> Query) -> [AccountName] -> [Query]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Query
Acct (String -> Query)
-> (AccountName -> String) -> AccountName -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> String
accountNameToAccountRegex) [AccountName]
as
,Query -> Query
Not (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ [Query] -> Query
Or ([Query] -> Query) -> [Query] -> Query
forall a b. (a -> b) -> a -> b
$ (AccountName -> Query) -> [AccountName] -> [Query]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Query
Acct (String -> Query)
-> (AccountName -> String) -> AccountName -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> String
accountNameToAccountRegex) [AccountName]
differentlytypedsubs
]
where
differentlytypedsubs :: [AccountName]
differentlytypedsubs = [[AccountName]] -> [AccountName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[[AccountName]
subs | (t :: AccountType
t,bs :: [AccountName]
bs) <- Map AccountType [AccountName] -> [(AccountType, [AccountName])]
forall k a. Map k a -> [(k, a)]
M.toList (Journal -> Map AccountType [AccountName]
jdeclaredaccounttypes Journal
j)
, AccountType
t AccountType -> AccountType -> Bool
forall a. Eq a => a -> a -> Bool
/= AccountType
atype
, let subs :: [AccountName]
subs = [AccountName
b | AccountName
b <- [AccountName]
bs, (AccountName -> Bool) -> [AccountName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (AccountName -> AccountName -> Bool
`isAccountNamePrefixOf` AccountName
b) [AccountName]
as]
]
journalAssetAccountQuery :: Journal -> Query
journalAssetAccountQuery :: Journal -> Query
journalAssetAccountQuery = AccountType -> String -> Journal -> Query
journalAccountTypeQuery AccountType
Asset "^assets?(:|$)"
journalLiabilityAccountQuery :: Journal -> Query
journalLiabilityAccountQuery :: Journal -> Query
journalLiabilityAccountQuery = AccountType -> String -> Journal -> Query
journalAccountTypeQuery AccountType
Liability "^(debts?|liabilit(y|ies))(:|$)"
journalEquityAccountQuery :: Journal -> Query
journalEquityAccountQuery :: Journal -> Query
journalEquityAccountQuery = AccountType -> String -> Journal -> Query
journalAccountTypeQuery AccountType
Equity "^equity(:|$)"
journalRevenueAccountQuery :: Journal -> Query
journalRevenueAccountQuery :: Journal -> Query
journalRevenueAccountQuery = AccountType -> String -> Journal -> Query
journalAccountTypeQuery AccountType
Revenue "^(income|revenue)s?(:|$)"
journalExpenseAccountQuery :: Journal -> Query
journalExpenseAccountQuery :: Journal -> Query
journalExpenseAccountQuery = AccountType -> String -> Journal -> Query
journalAccountTypeQuery AccountType
Expense "^expenses?(:|$)"
journalBalanceSheetAccountQuery :: Journal -> Query
journalBalanceSheetAccountQuery :: Journal -> Query
journalBalanceSheetAccountQuery j :: Journal
j = [Query] -> Query
Or [Journal -> Query
journalAssetAccountQuery Journal
j
,Journal -> Query
journalLiabilityAccountQuery Journal
j
,Journal -> Query
journalEquityAccountQuery Journal
j
]
journalProfitAndLossAccountQuery :: Journal -> Query
journalProfitAndLossAccountQuery :: Journal -> Query
journalProfitAndLossAccountQuery j :: Journal
j = [Query] -> Query
Or [Journal -> Query
journalRevenueAccountQuery Journal
j
,Journal -> Query
journalExpenseAccountQuery Journal
j
]
journalCashAccountQuery :: Journal -> Query
journalCashAccountQuery :: Journal -> Query
journalCashAccountQuery j :: Journal
j = [Query] -> Query
And [Journal -> Query
journalAssetAccountQuery Journal
j, Query -> Query
Not (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ String -> Query
Acct "(receivable|:A/R|:fixed)"]
filterJournalTransactions :: Query -> Journal -> Journal
filterJournalTransactions :: Query -> Journal -> Journal
filterJournalTransactions q :: Query
q j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Bool) -> [Transaction] -> [Transaction]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query
q Query -> Transaction -> Bool
`matchesTransaction`) [Transaction]
ts}
filterJournalPostings :: Query -> Journal -> Journal
filterJournalPostings :: Query -> Journal -> Journal
filterJournalPostings q :: Query
q j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (Query -> Transaction -> Transaction
filterTransactionPostings Query
q) [Transaction]
ts}
filterJournalAmounts :: Query -> Journal -> Journal
filterJournalAmounts :: Query -> Journal -> Journal
filterJournalAmounts q :: Query
q j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (Query -> Transaction -> Transaction
filterTransactionAmounts Query
q) [Transaction]
ts}
filterTransactionAmounts :: Query -> Transaction -> Transaction
filterTransactionAmounts :: Query -> Transaction -> Transaction
filterTransactionAmounts q :: Query
q t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (Query -> Posting -> Posting
filterPostingAmount Query
q) [Posting]
ps}
filterPostingAmount :: Query -> Posting -> Posting
filterPostingAmount :: Query -> Posting -> Posting
filterPostingAmount q :: Query
q p :: Posting
p@Posting{pamount :: Posting -> MixedAmount
pamount=Mixed as :: [Amount]
as} = Posting
p{pamount :: MixedAmount
pamount=[Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount) -> [Amount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Amount -> Bool) -> [Amount] -> [Amount]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query
q Query -> Amount -> Bool
`matchesAmount`) [Amount]
as}
filterTransactionPostings :: Query -> Transaction -> Transaction
filterTransactionPostings :: Query -> Transaction -> Transaction
filterTransactionPostings q :: Query
q t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query
q Query -> Posting -> Bool
`matchesPosting`) [Posting]
ps}
mapJournalTransactions :: (Transaction -> Transaction) -> Journal -> Journal
mapJournalTransactions :: (Transaction -> Transaction) -> Journal -> Journal
mapJournalTransactions f :: Transaction -> Transaction
f j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Transaction
f [Transaction]
ts}
mapJournalPostings :: (Posting -> Posting) -> Journal -> Journal
mapJournalPostings :: (Posting -> Posting) -> Journal -> Journal
mapJournalPostings f :: Posting -> Posting
f j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map ((Posting -> Posting) -> Transaction -> Transaction
mapTransactionPostings Posting -> Posting
f) [Transaction]
ts}
mapTransactionPostings :: (Posting -> Posting) -> Transaction -> Transaction
mapTransactionPostings :: (Posting -> Posting) -> Transaction -> Transaction
mapTransactionPostings f :: Posting -> Posting
f t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Posting
f [Posting]
ps}
journalReverse :: Journal -> Journal
journalReverse :: Journal -> Journal
journalReverse j :: Journal
j =
Journal
j {jfiles :: [(String, AccountName)]
jfiles = [(String, AccountName)] -> [(String, AccountName)]
forall a. [a] -> [a]
reverse ([(String, AccountName)] -> [(String, AccountName)])
-> [(String, AccountName)] -> [(String, AccountName)]
forall a b. (a -> b) -> a -> b
$ Journal -> [(String, AccountName)]
jfiles Journal
j
,jdeclaredaccounts :: [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts = [(AccountName, AccountDeclarationInfo)]
-> [(AccountName, AccountDeclarationInfo)]
forall a. [a] -> [a]
reverse ([(AccountName, AccountDeclarationInfo)]
-> [(AccountName, AccountDeclarationInfo)])
-> [(AccountName, AccountDeclarationInfo)]
-> [(AccountName, AccountDeclarationInfo)]
forall a b. (a -> b) -> a -> b
$ Journal -> [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j
,jtxns :: [Transaction]
jtxns = [Transaction] -> [Transaction]
forall a. [a] -> [a]
reverse ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
,jtxnmodifiers :: [TransactionModifier]
jtxnmodifiers = [TransactionModifier] -> [TransactionModifier]
forall a. [a] -> [a]
reverse ([TransactionModifier] -> [TransactionModifier])
-> [TransactionModifier] -> [TransactionModifier]
forall a b. (a -> b) -> a -> b
$ Journal -> [TransactionModifier]
jtxnmodifiers Journal
j
,jperiodictxns :: [PeriodicTransaction]
jperiodictxns = [PeriodicTransaction] -> [PeriodicTransaction]
forall a. [a] -> [a]
reverse ([PeriodicTransaction] -> [PeriodicTransaction])
-> [PeriodicTransaction] -> [PeriodicTransaction]
forall a b. (a -> b) -> a -> b
$ Journal -> [PeriodicTransaction]
jperiodictxns Journal
j
,jpricedirectives :: [PriceDirective]
jpricedirectives = [PriceDirective] -> [PriceDirective]
forall a. [a] -> [a]
reverse ([PriceDirective] -> [PriceDirective])
-> [PriceDirective] -> [PriceDirective]
forall a b. (a -> b) -> a -> b
$ Journal -> [PriceDirective]
jpricedirectives Journal
j
}
journalSetLastReadTime :: ClockTime -> Journal -> Journal
journalSetLastReadTime :: ClockTime -> Journal -> Journal
journalSetLastReadTime t :: ClockTime
t j :: Journal
j = Journal
j{ jlastreadtime :: ClockTime
jlastreadtime = ClockTime
t }
journalNumberAndTieTransactions :: Journal -> Journal
journalNumberAndTieTransactions = Journal -> Journal
journalTieTransactions (Journal -> Journal) -> (Journal -> Journal) -> Journal -> Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Journal
journalNumberTransactions
journalNumberTransactions :: Journal -> Journal
journalNumberTransactions :: Journal -> Journal
journalNumberTransactions j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=((Year, Transaction) -> Transaction)
-> [(Year, Transaction)] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (\(i :: Year
i,t :: Transaction
t) -> Transaction
t{tindex :: Year
tindex=Year
i}) ([(Year, Transaction)] -> [Transaction])
-> [(Year, Transaction)] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ [Year] -> [Transaction] -> [(Year, Transaction)]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..] [Transaction]
ts}
journalTieTransactions :: Journal -> Journal
journalTieTransactions :: Journal -> Journal
journalTieTransactions j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Transaction
txnTieKnot [Transaction]
ts}
journalUntieTransactions :: Transaction -> Transaction
journalUntieTransactions :: Transaction -> Transaction
journalUntieTransactions t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (\p :: Posting
p -> Posting
p{ptransaction :: Maybe Transaction
ptransaction=Maybe Transaction
forall a. Maybe a
Nothing}) [Posting]
ps}
journalModifyTransactions :: Journal -> Journal
journalModifyTransactions :: Journal -> Journal
journalModifyTransactions j :: Journal
j = Journal
j{ jtxns :: [Transaction]
jtxns = [TransactionModifier] -> [Transaction] -> [Transaction]
modifyTransactions (Journal -> [TransactionModifier]
jtxnmodifiers Journal
j) (Journal -> [Transaction]
jtxns Journal
j) }
journalCheckBalanceAssertions :: Journal -> Maybe String
journalCheckBalanceAssertions :: Journal -> Maybe String
journalCheckBalanceAssertions = (String -> Maybe String)
-> (Journal -> Maybe String)
-> Either String Journal
-> Maybe String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Maybe String
forall a. a -> Maybe a
Just (Maybe String -> Journal -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing) (Either String Journal -> Maybe String)
-> (Journal -> Either String Journal) -> Journal -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Journal -> Either String Journal
journalBalanceTransactions Bool
True
type Balancing s = ReaderT (BalancingState s) (ExceptT String (ST s))
data BalancingState s = BalancingState {
BalancingState s -> Maybe (Map AccountName AmountStyle)
bsStyles :: Maybe (M.Map CommoditySymbol AmountStyle)
,BalancingState s -> Set AccountName
bsUnassignable :: S.Set AccountName
,BalancingState s -> Bool
bsAssrt :: Bool
,BalancingState s -> HashTable s AccountName MixedAmount
bsBalances :: H.HashTable s AccountName MixedAmount
,BalancingState s -> STArray s Year Transaction
bsTransactions :: STArray s Integer Transaction
}
withRunningBalance :: (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance :: (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance f :: BalancingState s -> ST s a
f = ReaderT
(BalancingState s) (ExceptT String (ST s)) (BalancingState s)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT
(BalancingState s) (ExceptT String (ST s)) (BalancingState s)
-> (BalancingState s -> Balancing s a) -> Balancing s a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExceptT String (ST s) a -> Balancing s a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT String (ST s) a -> Balancing s a)
-> (BalancingState s -> ExceptT String (ST s) a)
-> BalancingState s
-> Balancing s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST s a -> ExceptT String (ST s) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s a -> ExceptT String (ST s) a)
-> (BalancingState s -> ST s a)
-> BalancingState s
-> ExceptT String (ST s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalancingState s -> ST s a
f
getRunningBalanceB :: AccountName -> Balancing s MixedAmount
getRunningBalanceB :: AccountName -> Balancing s MixedAmount
getRunningBalanceB acc :: AccountName
acc = (BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance ((BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount)
-> (BalancingState s -> ST s MixedAmount)
-> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ \BalancingState{HashTable s AccountName MixedAmount
bsBalances :: HashTable s AccountName MixedAmount
bsBalances :: forall s. BalancingState s -> HashTable s AccountName MixedAmount
bsBalances} -> do
MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe MixedAmount -> MixedAmount)
-> ST s (Maybe MixedAmount) -> ST s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashTable s AccountName MixedAmount
-> AccountName -> ST s (Maybe MixedAmount)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s AccountName MixedAmount
bsBalances AccountName
acc
addToRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB acc :: AccountName
acc amt :: MixedAmount
amt = (BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance ((BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount)
-> (BalancingState s -> ST s MixedAmount)
-> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ \BalancingState{HashTable s AccountName MixedAmount
bsBalances :: HashTable s AccountName MixedAmount
bsBalances :: forall s. BalancingState s -> HashTable s AccountName MixedAmount
bsBalances} -> do
MixedAmount
old <- MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe MixedAmount -> MixedAmount)
-> ST s (Maybe MixedAmount) -> ST s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashTable s AccountName MixedAmount
-> AccountName -> ST s (Maybe MixedAmount)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s AccountName MixedAmount
bsBalances AccountName
acc
let new :: MixedAmount
new = MixedAmount
old MixedAmount -> MixedAmount -> MixedAmount
forall a. Num a => a -> a -> a
+ MixedAmount
amt
HashTable s AccountName MixedAmount
-> AccountName -> MixedAmount -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s AccountName MixedAmount
bsBalances AccountName
acc MixedAmount
new
MixedAmount -> ST s MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return MixedAmount
new
setRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
setRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
setRunningBalanceB acc :: AccountName
acc amt :: MixedAmount
amt = (BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance ((BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount)
-> (BalancingState s -> ST s MixedAmount)
-> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ \BalancingState{HashTable s AccountName MixedAmount
bsBalances :: HashTable s AccountName MixedAmount
bsBalances :: forall s. BalancingState s -> HashTable s AccountName MixedAmount
bsBalances} -> do
MixedAmount
old <- MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe MixedAmount -> MixedAmount)
-> ST s (Maybe MixedAmount) -> ST s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashTable s AccountName MixedAmount
-> AccountName -> ST s (Maybe MixedAmount)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s AccountName MixedAmount
bsBalances AccountName
acc
HashTable s AccountName MixedAmount
-> AccountName -> MixedAmount -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s AccountName MixedAmount
bsBalances AccountName
acc MixedAmount
amt
MixedAmount -> ST s MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return (MixedAmount -> ST s MixedAmount)
-> MixedAmount -> ST s MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount
amt MixedAmount -> MixedAmount -> MixedAmount
forall a. Num a => a -> a -> a
- MixedAmount
old
setInclusiveRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
setInclusiveRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
setInclusiveRunningBalanceB acc :: AccountName
acc newibal :: MixedAmount
newibal = (BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance ((BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount)
-> (BalancingState s -> ST s MixedAmount)
-> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ \BalancingState{HashTable s AccountName MixedAmount
bsBalances :: HashTable s AccountName MixedAmount
bsBalances :: forall s. BalancingState s -> HashTable s AccountName MixedAmount
bsBalances} -> do
MixedAmount
oldebal <- MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe MixedAmount -> MixedAmount)
-> ST s (Maybe MixedAmount) -> ST s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashTable s AccountName MixedAmount
-> AccountName -> ST s (Maybe MixedAmount)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s AccountName MixedAmount
bsBalances AccountName
acc
[(AccountName, MixedAmount)]
allebals <- HashTable s AccountName MixedAmount
-> ST s [(AccountName, MixedAmount)]
forall (h :: * -> * -> * -> *) s k v.
HashTable h =>
h s k v -> ST s [(k, v)]
H.toList HashTable s AccountName MixedAmount
bsBalances
let subsibal :: MixedAmount
subsibal =
[MixedAmount] -> MixedAmount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([MixedAmount] -> MixedAmount) -> [MixedAmount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ ((AccountName, MixedAmount) -> MixedAmount)
-> [(AccountName, MixedAmount)] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName, MixedAmount) -> MixedAmount
forall a b. (a, b) -> b
snd ([(AccountName, MixedAmount)] -> [MixedAmount])
-> [(AccountName, MixedAmount)] -> [MixedAmount]
forall a b. (a -> b) -> a -> b
$ ((AccountName, MixedAmount) -> Bool)
-> [(AccountName, MixedAmount)] -> [(AccountName, MixedAmount)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((AccountName
acc AccountName -> AccountName -> Bool
`isAccountNamePrefixOf`)(AccountName -> Bool)
-> ((AccountName, MixedAmount) -> AccountName)
-> (AccountName, MixedAmount)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(AccountName, MixedAmount) -> AccountName
forall a b. (a, b) -> a
fst) [(AccountName, MixedAmount)]
allebals
let newebal :: MixedAmount
newebal = MixedAmount
newibal MixedAmount -> MixedAmount -> MixedAmount
forall a. Num a => a -> a -> a
- MixedAmount
subsibal
HashTable s AccountName MixedAmount
-> AccountName -> MixedAmount -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s AccountName MixedAmount
bsBalances AccountName
acc MixedAmount
newebal
MixedAmount -> ST s MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return (MixedAmount -> ST s MixedAmount)
-> MixedAmount -> ST s MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount
newebal MixedAmount -> MixedAmount -> MixedAmount
forall a. Num a => a -> a -> a
- MixedAmount
oldebal
updateTransactionB :: Transaction -> Balancing s ()
updateTransactionB :: Transaction -> Balancing s ()
updateTransactionB t :: Transaction
t = (BalancingState s -> ST s ()) -> Balancing s ()
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance ((BalancingState s -> ST s ()) -> Balancing s ())
-> (BalancingState s -> ST s ()) -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ \BalancingState{STArray s Year Transaction
bsTransactions :: STArray s Year Transaction
bsTransactions :: forall s. BalancingState s -> STArray s Year Transaction
bsTransactions} ->
ST s () -> ST s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ STArray s Year Transaction -> Year -> Transaction -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s Year Transaction
bsTransactions (Transaction -> Year
tindex Transaction
t) Transaction
t
journalBalanceTransactions :: Bool -> Journal -> Either String Journal
journalBalanceTransactions :: Bool -> Journal -> Either String Journal
journalBalanceTransactions assrt :: Bool
assrt j' :: Journal
j' =
let
j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal -> Journal
journalNumberTransactions Journal
j'
styles :: Maybe (Map AccountName AmountStyle)
styles = Map AccountName AmountStyle -> Maybe (Map AccountName AmountStyle)
forall a. a -> Maybe a
Just (Map AccountName AmountStyle
-> Maybe (Map AccountName AmountStyle))
-> Map AccountName AmountStyle
-> Maybe (Map AccountName AmountStyle)
forall a b. (a -> b) -> a -> b
$ Journal -> Map AccountName AmountStyle
journalCommodityStyles Journal
j
txnmodifieraccts :: Set AccountName
txnmodifieraccts = [AccountName] -> Set AccountName
forall a. Ord a => [a] -> Set a
S.fromList ([AccountName] -> Set AccountName)
-> [AccountName] -> Set AccountName
forall a b. (a -> b) -> a -> b
$ (Posting -> AccountName) -> [Posting] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> AccountName
paccount ([Posting] -> [AccountName]) -> [Posting] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ (TransactionModifier -> [Posting])
-> [TransactionModifier] -> [Posting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TransactionModifier -> [Posting]
tmpostingrules ([TransactionModifier] -> [Posting])
-> [TransactionModifier] -> [Posting]
forall a b. (a -> b) -> a -> b
$ Journal -> [TransactionModifier]
jtxnmodifiers Journal
j
in
(forall s. ST s (Either String Journal)) -> Either String Journal
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Either String Journal)) -> Either String Journal)
-> (forall s. ST s (Either String Journal))
-> Either String Journal
forall a b. (a -> b) -> a -> b
$ do
STArray s Year Transaction
balancedtxns <- (Year, Year) -> [Transaction] -> ST s (STArray s Year Transaction)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> [e] -> m (a i e)
newListArray (1, [Transaction] -> Year
forall i a. Num i => [a] -> i
genericLength [Transaction]
ts) [Transaction]
ts
ExceptT String (ST s) Journal -> ST s (Either String Journal)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String (ST s) Journal -> ST s (Either String Journal))
-> ExceptT String (ST s) Journal -> ST s (Either String Journal)
forall a b. (a -> b) -> a -> b
$ do
[Either Posting Transaction]
psandts :: [Either Posting Transaction] <- ([[Either Posting Transaction]] -> [Either Posting Transaction])
-> ExceptT String (ST s) [[Either Posting Transaction]]
-> ExceptT String (ST s) [Either Posting Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Either Posting Transaction]] -> [Either Posting Transaction]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ExceptT String (ST s) [[Either Posting Transaction]]
-> ExceptT String (ST s) [Either Posting Transaction])
-> ExceptT String (ST s) [[Either Posting Transaction]]
-> ExceptT String (ST s) [Either Posting Transaction]
forall a b. (a -> b) -> a -> b
$ [Transaction]
-> (Transaction
-> ExceptT String (ST s) [Either Posting Transaction])
-> ExceptT String (ST s) [[Either Posting Transaction]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Transaction]
ts ((Transaction
-> ExceptT String (ST s) [Either Posting Transaction])
-> ExceptT String (ST s) [[Either Posting Transaction]])
-> (Transaction
-> ExceptT String (ST s) [Either Posting Transaction])
-> ExceptT String (ST s) [[Either Posting Transaction]]
forall a b. (a -> b) -> a -> b
$ \case
t :: Transaction
t | [Posting] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Posting] -> Bool) -> [Posting] -> Bool
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
assignmentPostings Transaction
t -> case Maybe (Map AccountName AmountStyle)
-> Transaction -> Either String Transaction
balanceTransaction Maybe (Map AccountName AmountStyle)
styles Transaction
t of
Left e :: String
e -> String -> ExceptT String (ST s) [Either Posting Transaction]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
e
Right t' :: Transaction
t' -> do
ST s () -> ExceptT String (ST s) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s () -> ExceptT String (ST s) ())
-> ST s () -> ExceptT String (ST s) ()
forall a b. (a -> b) -> a -> b
$ STArray s Year Transaction -> Year -> Transaction -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s Year Transaction
balancedtxns (Transaction -> Year
tindex Transaction
t') Transaction
t'
[Either Posting Transaction]
-> ExceptT String (ST s) [Either Posting Transaction]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either Posting Transaction]
-> ExceptT String (ST s) [Either Posting Transaction])
-> [Either Posting Transaction]
-> ExceptT String (ST s) [Either Posting Transaction]
forall a b. (a -> b) -> a -> b
$ (Posting -> Either Posting Transaction)
-> [Posting] -> [Either Posting Transaction]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Either Posting Transaction
forall a b. a -> Either a b
Left ([Posting] -> [Either Posting Transaction])
-> [Posting] -> [Either Posting Transaction]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t'
t :: Transaction
t -> [Either Posting Transaction]
-> ExceptT String (ST s) [Either Posting Transaction]
forall (m :: * -> *) a. Monad m => a -> m a
return [Transaction -> Either Posting Transaction
forall a b. b -> Either a b
Right Transaction
t]
HashTable s AccountName MixedAmount
runningbals <- ST s (HashTable s AccountName MixedAmount)
-> ExceptT String (ST s) (HashTable s AccountName MixedAmount)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s (HashTable s AccountName MixedAmount)
-> ExceptT String (ST s) (HashTable s AccountName MixedAmount))
-> ST s (HashTable s AccountName MixedAmount)
-> ExceptT String (ST s) (HashTable s AccountName MixedAmount)
forall a b. (a -> b) -> a -> b
$ Int -> ST s (HashTable s AccountName MixedAmount)
forall s k v. Int -> ST s (HashTable s k v)
H.newSized ([AccountName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([AccountName] -> Int) -> [AccountName] -> Int
forall a b. (a -> b) -> a -> b
$ Journal -> [AccountName]
journalAccountNamesUsed Journal
j)
(ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> BalancingState s -> ExceptT String (ST s) ())
-> BalancingState s
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ExceptT String (ST s) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> BalancingState s -> ExceptT String (ST s) ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Maybe (Map AccountName AmountStyle)
-> Set AccountName
-> Bool
-> HashTable s AccountName MixedAmount
-> STArray s Year Transaction
-> BalancingState s
forall s.
Maybe (Map AccountName AmountStyle)
-> Set AccountName
-> Bool
-> HashTable s AccountName MixedAmount
-> STArray s Year Transaction
-> BalancingState s
BalancingState Maybe (Map AccountName AmountStyle)
styles Set AccountName
txnmodifieraccts Bool
assrt HashTable s AccountName MixedAmount
runningbals STArray s Year Transaction
balancedtxns) (ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ExceptT String (ST s) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ExceptT String (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
ReaderT (BalancingState s) (ExceptT String (ST s)) [()]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT (BalancingState s) (ExceptT String (ST s)) [()]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [()]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$ (Either Posting Transaction
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> [Either Posting Transaction]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [()]
forall (f :: * -> *) a b. Monad f => (a -> f b) -> [a] -> f [b]
mapM' Either Posting Transaction
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall s. Either Posting Transaction -> Balancing s ()
balanceTransactionAndCheckAssertionsB ([Either Posting Transaction]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [()])
-> [Either Posting Transaction]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [()]
forall a b. (a -> b) -> a -> b
$ (Either Posting Transaction -> Day)
-> [Either Posting Transaction] -> [Either Posting Transaction]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((Posting -> Day)
-> (Transaction -> Day) -> Either Posting Transaction -> Day
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Posting -> Day
postingDate Transaction -> Day
tdate) [Either Posting Transaction]
psandts
[Transaction]
ts' <- ST s [Transaction] -> ExceptT String (ST s) [Transaction]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s [Transaction] -> ExceptT String (ST s) [Transaction])
-> ST s [Transaction] -> ExceptT String (ST s) [Transaction]
forall a b. (a -> b) -> a -> b
$ STArray s Year Transaction -> ST s [Transaction]
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m [e]
getElems STArray s Year Transaction
balancedtxns
Journal -> ExceptT String (ST s) Journal
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
j{jtxns :: [Transaction]
jtxns=[Transaction]
ts'}
balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing s ()
balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing s ()
balanceTransactionAndCheckAssertionsB (Left p :: Posting
p@Posting{}) =
ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
-> Balancing s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
-> Balancing s ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
-> Balancing s ()
forall a b. (a -> b) -> a -> b
$ Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
forall s. Posting -> Balancing s Posting
addAmountAndCheckAssertionB (Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting)
-> Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
forall a b. (a -> b) -> a -> b
$ Posting -> Posting
removePrices Posting
p
balanceTransactionAndCheckAssertionsB (Right t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps}) = do
(Posting -> Balancing s ()) -> [Posting] -> Balancing s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Posting -> Balancing s ()
forall s. Posting -> Balancing s ()
checkIllegalBalanceAssignmentB [Posting]
ps
[Posting]
ps' <- [Posting]
-> (Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [Posting]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Posting]
ps ((Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [Posting])
-> (Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [Posting]
forall a b. (a -> b) -> a -> b
$ \p :: Posting
p -> Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Posting -> Posting
removePrices Posting
p) ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
-> (Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
forall s. Posting -> Balancing s Posting
addOrAssignAmountAndCheckAssertionB
Maybe (Map AccountName AmountStyle)
styles <- (BalancingState s -> Maybe (Map AccountName AmountStyle))
-> ReaderT
(BalancingState s)
(ExceptT String (ST s))
(Maybe (Map AccountName AmountStyle))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Maybe (Map AccountName AmountStyle)
forall s. BalancingState s -> Maybe (Map AccountName AmountStyle)
bsStyles
case Maybe (Map AccountName AmountStyle)
-> Transaction
-> Either String (Transaction, [(AccountName, MixedAmount)])
balanceTransactionHelper Maybe (Map AccountName AmountStyle)
styles Transaction
t{tpostings :: [Posting]
tpostings=[Posting]
ps'} of
Left err :: String
err -> String -> Balancing s ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
err
Right (t' :: Transaction
t', inferredacctsandamts :: [(AccountName, MixedAmount)]
inferredacctsandamts) -> do
((AccountName, MixedAmount)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) MixedAmount)
-> [(AccountName, MixedAmount)] -> Balancing s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((AccountName
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) MixedAmount)
-> (AccountName, MixedAmount)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) MixedAmount
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AccountName
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB) [(AccountName, MixedAmount)]
inferredacctsandamts
Transaction -> Balancing s ()
forall s. Transaction -> Balancing s ()
updateTransactionB Transaction
t'
addOrAssignAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addOrAssignAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addOrAssignAmountAndCheckAssertionB p :: Posting
p@Posting{paccount :: Posting -> AccountName
paccount=AccountName
acc, pamount :: Posting -> MixedAmount
pamount=MixedAmount
amt, pbalanceassertion :: Posting -> Maybe BalanceAssertion
pbalanceassertion=Maybe BalanceAssertion
mba}
| Posting -> Bool
hasAmount Posting
p = do
MixedAmount
newbal <- AccountName -> MixedAmount -> Balancing s MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB AccountName
acc MixedAmount
amt
ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((BalancingState s -> Bool)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Bool
forall s. BalancingState s -> Bool
bsAssrt) (ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall s. Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB Posting
p MixedAmount
newbal
Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p
| Just BalanceAssertion{Amount
baamount :: BalanceAssertion -> Amount
baamount :: Amount
baamount,Bool
batotal :: BalanceAssertion -> Bool
batotal :: Bool
batotal,Bool
bainclusive :: BalanceAssertion -> Bool
bainclusive :: Bool
bainclusive} <- Maybe BalanceAssertion
mba = do
(diff :: MixedAmount
diff,newbal :: MixedAmount
newbal) <- case Bool
batotal of
True -> do
let newbal :: MixedAmount
newbal = [Amount] -> MixedAmount
Mixed [Amount
baamount]
MixedAmount
diff <- (if Bool
bainclusive then AccountName -> MixedAmount -> Balancing s MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
setInclusiveRunningBalanceB else AccountName -> MixedAmount -> Balancing s MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
setRunningBalanceB) AccountName
acc MixedAmount
newbal
(MixedAmount, MixedAmount)
-> ReaderT
(BalancingState s)
(ExceptT String (ST s))
(MixedAmount, MixedAmount)
forall (m :: * -> *) a. Monad m => a -> m a
return (MixedAmount
diff,MixedAmount
newbal)
False -> do
MixedAmount
oldbalothercommodities <- (Amount -> Bool) -> MixedAmount -> MixedAmount
filterMixedAmount ((Amount -> AccountName
acommodity Amount
baamount AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
/=) (AccountName -> Bool) -> (Amount -> AccountName) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> AccountName
acommodity) (MixedAmount -> MixedAmount)
-> Balancing s MixedAmount -> Balancing s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AccountName -> Balancing s MixedAmount
forall s. AccountName -> Balancing s MixedAmount
getRunningBalanceB AccountName
acc
let assignedbalthiscommodity :: MixedAmount
assignedbalthiscommodity = [Amount] -> MixedAmount
Mixed [Amount
baamount]
newbal :: MixedAmount
newbal = MixedAmount
oldbalothercommodities MixedAmount -> MixedAmount -> MixedAmount
forall a. Num a => a -> a -> a
+ MixedAmount
assignedbalthiscommodity
MixedAmount
diff <- (if Bool
bainclusive then AccountName -> MixedAmount -> Balancing s MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
setInclusiveRunningBalanceB else AccountName -> MixedAmount -> Balancing s MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
setRunningBalanceB) AccountName
acc MixedAmount
newbal
(MixedAmount, MixedAmount)
-> ReaderT
(BalancingState s)
(ExceptT String (ST s))
(MixedAmount, MixedAmount)
forall (m :: * -> *) a. Monad m => a -> m a
return (MixedAmount
diff,MixedAmount
newbal)
let p' :: Posting
p' = Posting
p{pamount :: MixedAmount
pamount=MixedAmount
diff, poriginal :: Maybe Posting
poriginal=Posting -> Maybe Posting
forall a. a -> Maybe a
Just (Posting -> Maybe Posting) -> Posting -> Maybe Posting
forall a b. (a -> b) -> a -> b
$ Posting -> Posting
originalPosting Posting
p}
ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((BalancingState s -> Bool)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Bool
forall s. BalancingState s -> Bool
bsAssrt) (ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall s. Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB Posting
p' MixedAmount
newbal
Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p'
| Bool
otherwise = Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p
addAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addAmountAndCheckAssertionB p :: Posting
p | Posting -> Bool
hasAmount Posting
p = do
MixedAmount
newbal <- AccountName -> MixedAmount -> Balancing s MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB (Posting -> AccountName
paccount Posting
p) (Posting -> MixedAmount
pamount Posting
p)
ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((BalancingState s -> Bool)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Bool
forall s. BalancingState s -> Bool
bsAssrt) (ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall s. Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB Posting
p MixedAmount
newbal
Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p
addAmountAndCheckAssertionB p :: Posting
p = Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p
checkBalanceAssertionB :: Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB :: Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB p :: Posting
p@Posting{pbalanceassertion :: Posting -> Maybe BalanceAssertion
pbalanceassertion=Just (BalanceAssertion{Amount
baamount :: Amount
baamount :: BalanceAssertion -> Amount
baamount,Bool
batotal :: Bool
batotal :: BalanceAssertion -> Bool
batotal})} actualbal :: MixedAmount
actualbal =
[Amount] -> (Amount -> Balancing s ()) -> Balancing s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Amount]
assertedamts ((Amount -> Balancing s ()) -> Balancing s ())
-> (Amount -> Balancing s ()) -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ \amt :: Amount
amt -> Posting -> Amount -> MixedAmount -> Balancing s ()
forall s. Posting -> Amount -> MixedAmount -> Balancing s ()
checkBalanceAssertionOneCommodityB Posting
p Amount
amt MixedAmount
actualbal
where
assertedamts :: [Amount]
assertedamts = Amount
baamount Amount -> [Amount] -> [Amount]
forall a. a -> [a] -> [a]
: [Amount]
otheramts
where
assertedcomm :: AccountName
assertedcomm = Amount -> AccountName
acommodity Amount
baamount
otheramts :: [Amount]
otheramts | Bool
batotal = (Amount -> Amount) -> [Amount] -> [Amount]
forall a b. (a -> b) -> [a] -> [b]
map (\a :: Amount
a -> Amount
a{aquantity :: Quantity
aquantity=0}) ([Amount] -> [Amount]) -> [Amount] -> [Amount]
forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ (Amount -> Bool) -> MixedAmount -> MixedAmount
filterMixedAmount ((AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
/=AccountName
assertedcomm)(AccountName -> Bool) -> (Amount -> AccountName) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Amount -> AccountName
acommodity) MixedAmount
actualbal
| Bool
otherwise = []
checkBalanceAssertionB _ _ = () -> Balancing s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkBalanceAssertionOneCommodityB :: Posting -> Amount -> MixedAmount -> Balancing s ()
checkBalanceAssertionOneCommodityB :: Posting -> Amount -> MixedAmount -> Balancing s ()
checkBalanceAssertionOneCommodityB p :: Posting
p@Posting{paccount :: Posting -> AccountName
paccount=AccountName
assertedacct} assertedamt :: Amount
assertedamt actualbal :: MixedAmount
actualbal = do
let isinclusive :: Bool
isinclusive = Bool
-> (BalanceAssertion -> Bool) -> Maybe BalanceAssertion -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False BalanceAssertion -> Bool
bainclusive (Maybe BalanceAssertion -> Bool) -> Maybe BalanceAssertion -> Bool
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe BalanceAssertion
pbalanceassertion Posting
p
MixedAmount
actualbal' <-
if Bool
isinclusive
then
(BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance ((BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount)
-> (BalancingState s -> ST s MixedAmount)
-> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ \BalancingState{HashTable s AccountName MixedAmount
bsBalances :: HashTable s AccountName MixedAmount
bsBalances :: forall s. BalancingState s -> HashTable s AccountName MixedAmount
bsBalances} ->
(MixedAmount -> (AccountName, MixedAmount) -> ST s MixedAmount)
-> MixedAmount
-> HashTable s AccountName MixedAmount
-> ST s MixedAmount
forall a k v s.
(a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
H.foldM
(\ibal :: MixedAmount
ibal (acc :: AccountName
acc, amt :: MixedAmount
amt) -> MixedAmount -> ST s MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return (MixedAmount -> ST s MixedAmount)
-> MixedAmount -> ST s MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount
ibal MixedAmount -> MixedAmount -> MixedAmount
forall a. Num a => a -> a -> a
+
if AccountName
assertedacctAccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
==AccountName
acc Bool -> Bool -> Bool
|| AccountName
assertedacct AccountName -> AccountName -> Bool
`isAccountNamePrefixOf` AccountName
acc then MixedAmount
amt else 0)
0
HashTable s AccountName MixedAmount
bsBalances
else MixedAmount -> Balancing s MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return MixedAmount
actualbal
let
assertedcomm :: AccountName
assertedcomm = Amount -> AccountName
acommodity Amount
assertedamt
actualbalincomm :: Amount
actualbalincomm = Amount -> [Amount] -> Amount
forall a. a -> [a] -> a
headDef 0 ([Amount] -> Amount) -> [Amount] -> Amount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ AccountName -> MixedAmount -> MixedAmount
filterMixedAmountByCommodity AccountName
assertedcomm (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount
actualbal'
pass :: Bool
pass =
Amount -> Quantity
aquantity
Amount
assertedamt Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
==
Amount -> Quantity
aquantity
Amount
actualbalincomm
errmsg :: String
errmsg = String
-> String
-> String
-> String
-> String
-> AccountName
-> String
-> String
-> ShowS
forall r. PrintfType r => String -> r
printf ([String] -> String
unlines
[ "balance assertion: %s",
"\nassertion details:",
"date: %s",
"account: %s%s",
"commodity: %s",
"calculated: %s",
"asserted: %s",
"difference: %s"
])
(case Posting -> Maybe Transaction
ptransaction Posting
p of
Nothing -> "?"
Just t :: Transaction
t -> String -> String -> ShowS
forall r. PrintfType r => String -> r
printf "%s\ntransaction:\n%s"
(GenericSourcePos -> String
showGenericSourcePos GenericSourcePos
pos)
(ShowS
chomp ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Transaction -> String
showTransaction Transaction
t)
:: String
where
pos :: GenericSourcePos
pos = BalanceAssertion -> GenericSourcePos
baposition (BalanceAssertion -> GenericSourcePos)
-> BalanceAssertion -> GenericSourcePos
forall a b. (a -> b) -> a -> b
$ Maybe BalanceAssertion -> BalanceAssertion
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe BalanceAssertion -> BalanceAssertion)
-> Maybe BalanceAssertion -> BalanceAssertion
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe BalanceAssertion
pbalanceassertion Posting
p
)
(Day -> String
showDate (Day -> String) -> Day -> String
forall a b. (a -> b) -> a -> b
$ Posting -> Day
postingDate Posting
p)
(AccountName -> String
T.unpack (AccountName -> String) -> AccountName -> String
forall a b. (a -> b) -> a -> b
$ Posting -> AccountName
paccount Posting
p)
(if Bool
isinclusive then " (and subs)" else "" :: String)
AccountName
assertedcomm
(Quantity -> String
forall a. Show a => a -> String
show (Quantity -> String) -> Quantity -> String
forall a b. (a -> b) -> a -> b
$ Amount -> Quantity
aquantity Amount
actualbalincomm)
(Quantity -> String
forall a. Show a => a -> String
show (Quantity -> String) -> Quantity -> String
forall a b. (a -> b) -> a -> b
$ Amount -> Quantity
aquantity Amount
assertedamt)
(Quantity -> String
forall a. Show a => a -> String
show (Quantity -> String) -> Quantity -> String
forall a b. (a -> b) -> a -> b
$ Amount -> Quantity
aquantity Amount
assertedamt Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
- Amount -> Quantity
aquantity Amount
actualbalincomm)
Bool -> Balancing s () -> Balancing s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
pass) (Balancing s () -> Balancing s ())
-> Balancing s () -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ String -> Balancing s ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
errmsg
checkIllegalBalanceAssignmentB :: Posting -> Balancing s ()
checkIllegalBalanceAssignmentB :: Posting -> Balancing s ()
checkIllegalBalanceAssignmentB p :: Posting
p = do
Posting -> Balancing s ()
forall s. Posting -> Balancing s ()
checkBalanceAssignmentPostingDateB Posting
p
Posting -> Balancing s ()
forall s. Posting -> Balancing s ()
checkBalanceAssignmentUnassignableAccountB Posting
p
checkBalanceAssignmentPostingDateB :: Posting -> Balancing s ()
checkBalanceAssignmentPostingDateB :: Posting -> Balancing s ()
checkBalanceAssignmentPostingDateB p :: Posting
p =
Bool -> Balancing s () -> Balancing s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Posting -> Bool
hasBalanceAssignment Posting
p Bool -> Bool -> Bool
&& Maybe Day -> Bool
forall a. Maybe a -> Bool
isJust (Posting -> Maybe Day
pdate Posting
p)) (Balancing s () -> Balancing s ())
-> Balancing s () -> Balancing s ()
forall a b. (a -> b) -> a -> b
$
String -> Balancing s ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Balancing s ()) -> String -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
["postings which are balance assignments may not have a custom date."
,"Please write the posting amount explicitly, or remove the posting date:"
,""
,String -> (Transaction -> String) -> Maybe Transaction -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Posting -> [String]
showPostingLines Posting
p) Transaction -> String
showTransaction (Maybe Transaction -> String) -> Maybe Transaction -> String
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
]
checkBalanceAssignmentUnassignableAccountB :: Posting -> Balancing s ()
checkBalanceAssignmentUnassignableAccountB :: Posting -> Balancing s ()
checkBalanceAssignmentUnassignableAccountB p :: Posting
p = do
Set AccountName
unassignable <- (BalancingState s -> Set AccountName)
-> ReaderT
(BalancingState s) (ExceptT String (ST s)) (Set AccountName)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.asks BalancingState s -> Set AccountName
forall s. BalancingState s -> Set AccountName
bsUnassignable
Bool -> Balancing s () -> Balancing s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Posting -> Bool
hasBalanceAssignment Posting
p Bool -> Bool -> Bool
&& Posting -> AccountName
paccount Posting
p AccountName -> Set AccountName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set AccountName
unassignable) (Balancing s () -> Balancing s ())
-> Balancing s () -> Balancing s ()
forall a b. (a -> b) -> a -> b
$
String -> Balancing s ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Balancing s ()) -> String -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
["balance assignments cannot be used with accounts which are"
,"posted to by transaction modifier rules (auto postings)."
,"Please write the posting amount explicitly, or remove the rule."
,""
,"account: "String -> ShowS
forall a. [a] -> [a] -> [a]
++AccountName -> String
T.unpack (Posting -> AccountName
paccount Posting
p)
,""
,"transaction:"
,""
,String -> (Transaction -> String) -> Maybe Transaction -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Posting -> [String]
showPostingLines Posting
p) Transaction -> String
showTransaction (Maybe Transaction -> String) -> Maybe Transaction -> String
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
]
journalApplyCommodityStyles :: Journal -> Either String Journal
journalApplyCommodityStyles :: Journal -> Either String Journal
journalApplyCommodityStyles j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts, jpricedirectives :: Journal -> [PriceDirective]
jpricedirectives=[PriceDirective]
pds} =
case Journal -> Either String Journal
journalInferCommodityStyles Journal
j of
Left e :: String
e -> String -> Either String Journal
forall a b. a -> Either a b
Left String
e
Right j' :: Journal
j' -> Journal -> Either String Journal
forall a b. b -> Either a b
Right Journal
j''
where
styles :: Map AccountName AmountStyle
styles = Journal -> Map AccountName AmountStyle
journalCommodityStyles Journal
j'
j'' :: Journal
j'' = Journal
j'{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Transaction
fixtransaction [Transaction]
ts
,jpricedirectives :: [PriceDirective]
jpricedirectives=(PriceDirective -> PriceDirective)
-> [PriceDirective] -> [PriceDirective]
forall a b. (a -> b) -> [a] -> [b]
map PriceDirective -> PriceDirective
fixpricedirective [PriceDirective]
pds
}
fixtransaction :: Transaction -> Transaction
fixtransaction t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Posting
fixposting [Posting]
ps}
fixposting :: Posting -> Posting
fixposting p :: Posting
p = Posting
p{pamount :: MixedAmount
pamount=Map AccountName AmountStyle -> MixedAmount -> MixedAmount
styleMixedAmount Map AccountName AmountStyle
styles (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
,pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion=BalanceAssertion -> BalanceAssertion
fixbalanceassertion (BalanceAssertion -> BalanceAssertion)
-> Maybe BalanceAssertion -> Maybe BalanceAssertion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Posting -> Maybe BalanceAssertion
pbalanceassertion Posting
p}
fixbalanceassertion :: BalanceAssertion -> BalanceAssertion
fixbalanceassertion ba :: BalanceAssertion
ba = BalanceAssertion
ba{baamount :: Amount
baamount=Map AccountName AmountStyle -> Amount -> Amount
styleAmount Map AccountName AmountStyle
styles (Amount -> Amount) -> Amount -> Amount
forall a b. (a -> b) -> a -> b
$ BalanceAssertion -> Amount
baamount BalanceAssertion
ba}
fixpricedirective :: PriceDirective -> PriceDirective
fixpricedirective pd :: PriceDirective
pd@PriceDirective{pdamount :: PriceDirective -> Amount
pdamount=Amount
a} = PriceDirective
pd{pdamount :: Amount
pdamount=Map AccountName AmountStyle -> Amount -> Amount
styleAmountExceptPrecision Map AccountName AmountStyle
styles Amount
a}
journalCommodityStyles :: Journal -> M.Map CommoditySymbol AmountStyle
journalCommodityStyles :: Journal -> Map AccountName AmountStyle
journalCommodityStyles j :: Journal
j =
Map AccountName AmountStyle
commoditystyles Map AccountName AmountStyle
-> Map AccountName AmountStyle -> Map AccountName AmountStyle
forall a. Semigroup a => a -> a -> a
<> Map AccountName AmountStyle
defaultcommoditystyle Map AccountName AmountStyle
-> Map AccountName AmountStyle -> Map AccountName AmountStyle
forall a. Semigroup a => a -> a -> a
<> Map AccountName AmountStyle
inferredstyles
where
commoditystyles :: Map AccountName AmountStyle
commoditystyles = (Commodity -> Maybe AmountStyle)
-> Map AccountName Commodity -> Map AccountName AmountStyle
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe Commodity -> Maybe AmountStyle
cformat (Map AccountName Commodity -> Map AccountName AmountStyle)
-> Map AccountName Commodity -> Map AccountName AmountStyle
forall a b. (a -> b) -> a -> b
$ Journal -> Map AccountName Commodity
jcommodities Journal
j
defaultcommoditystyle :: Map AccountName AmountStyle
defaultcommoditystyle = [(AccountName, AmountStyle)] -> Map AccountName AmountStyle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(AccountName, AmountStyle)] -> Map AccountName AmountStyle)
-> [(AccountName, AmountStyle)] -> Map AccountName AmountStyle
forall a b. (a -> b) -> a -> b
$ [Maybe (AccountName, AmountStyle)] -> [(AccountName, AmountStyle)]
forall a. [Maybe a] -> [a]
catMaybes [Journal -> Maybe (AccountName, AmountStyle)
jparsedefaultcommodity Journal
j]
inferredstyles :: Map AccountName AmountStyle
inferredstyles = Journal -> Map AccountName AmountStyle
jinferredcommodities Journal
j
journalInferCommodityStyles :: Journal -> Either String Journal
journalInferCommodityStyles :: Journal -> Either String Journal
journalInferCommodityStyles j :: Journal
j =
case
[Amount] -> Either String (Map AccountName AmountStyle)
commodityStylesFromAmounts ([Amount] -> Either String (Map AccountName AmountStyle))
-> [Amount] -> Either String (Map AccountName AmountStyle)
forall a b. (a -> b) -> a -> b
$
String -> [Amount] -> [Amount]
forall a. Show a => String -> a -> a
dbg8 "journalInferCommodityStyles using amounts" ([Amount] -> [Amount]) -> [Amount] -> [Amount]
forall a b. (a -> b) -> a -> b
$
Journal -> [Amount]
journalStyleInfluencingAmounts Journal
j
of
Left e :: String
e -> String -> Either String Journal
forall a b. a -> Either a b
Left String
e
Right cs :: Map AccountName AmountStyle
cs -> Journal -> Either String Journal
forall a b. b -> Either a b
Right Journal
j{jinferredcommodities :: Map AccountName AmountStyle
jinferredcommodities = Map AccountName AmountStyle
cs}
commodityStylesFromAmounts :: [Amount] -> Either String (M.Map CommoditySymbol AmountStyle)
commodityStylesFromAmounts :: [Amount] -> Either String (Map AccountName AmountStyle)
commodityStylesFromAmounts amts :: [Amount]
amts =
Map AccountName AmountStyle
-> Either String (Map AccountName AmountStyle)
forall a b. b -> Either a b
Right (Map AccountName AmountStyle
-> Either String (Map AccountName AmountStyle))
-> Map AccountName AmountStyle
-> Either String (Map AccountName AmountStyle)
forall a b. (a -> b) -> a -> b
$ [(AccountName, AmountStyle)] -> Map AccountName AmountStyle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(AccountName, AmountStyle)]
commstyles
where
commamts :: [(AccountName, [Amount])]
commamts = [(AccountName, Amount)] -> [(AccountName, [Amount])]
forall k v. Ord k => [(k, v)] -> [(k, [v])]
groupSort [(Amount -> AccountName
acommodity Amount
as, Amount
as) | Amount
as <- [Amount]
amts]
commstyles :: [(AccountName, AmountStyle)]
commstyles = [(AccountName
c, [AmountStyle] -> AmountStyle
canonicalStyleFrom ([AmountStyle] -> AmountStyle) -> [AmountStyle] -> AmountStyle
forall a b. (a -> b) -> a -> b
$ (Amount -> AmountStyle) -> [Amount] -> [AmountStyle]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> AmountStyle
astyle [Amount]
as) | (c :: AccountName
c,as :: [Amount]
as) <- [(AccountName, [Amount])]
commamts]
canonicalStyleFrom :: [AmountStyle] -> AmountStyle
canonicalStyleFrom :: [AmountStyle] -> AmountStyle
canonicalStyleFrom [] = AmountStyle
amountstyle
canonicalStyleFrom ss :: [AmountStyle]
ss@(s :: AmountStyle
s:_) =
AmountStyle
s{asprecision :: Int
asprecision=Int
prec, asdecimalpoint :: Maybe Char
asdecimalpoint=Char -> Maybe Char
forall a. a -> Maybe a
Just Char
decmark, asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
mgrps}
where
prec :: Int
prec = [Int] -> Int
forall a. Ord a => [a] -> a
maximumStrict ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (AmountStyle -> Int) -> [AmountStyle] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map AmountStyle -> Int
asprecision [AmountStyle]
ss
mgrps :: Maybe DigitGroupStyle
mgrps = [DigitGroupStyle] -> Maybe DigitGroupStyle
forall a. [a] -> Maybe a
headMay ([DigitGroupStyle] -> Maybe DigitGroupStyle)
-> [DigitGroupStyle] -> Maybe DigitGroupStyle
forall a b. (a -> b) -> a -> b
$ (AmountStyle -> Maybe DigitGroupStyle)
-> [AmountStyle] -> [DigitGroupStyle]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AmountStyle -> Maybe DigitGroupStyle
asdigitgroups [AmountStyle]
ss
defdecmark :: Char
defdecmark =
case Maybe DigitGroupStyle
mgrps of
Just (DigitGroups '.' _) -> ','
_ -> '.'
decmark :: Char
decmark = case Maybe DigitGroupStyle
mgrps of
Just _ -> Char
defdecmark
_ -> Char -> String -> Char
forall a. a -> [a] -> a
headDef Char
defdecmark (String -> Char) -> String -> Char
forall a b. (a -> b) -> a -> b
$ (AmountStyle -> Maybe Char) -> [AmountStyle] -> String
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AmountStyle -> Maybe Char
asdecimalpoint [AmountStyle]
ss
journalInferMarketPricesFromTransactions :: Journal -> Journal
journalInferMarketPricesFromTransactions :: Journal -> Journal
journalInferMarketPricesFromTransactions j :: Journal
j =
Journal
j{jinferredmarketprices :: [MarketPrice]
jinferredmarketprices =
String -> [MarketPrice] -> [MarketPrice]
forall a. Show a => String -> a -> a
dbg4 "jinferredmarketprices" ([MarketPrice] -> [MarketPrice]) -> [MarketPrice] -> [MarketPrice]
forall a b. (a -> b) -> a -> b
$
(Posting -> Maybe MarketPrice) -> [Posting] -> [MarketPrice]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Posting -> Maybe MarketPrice
postingInferredmarketPrice ([Posting] -> [MarketPrice]) -> [Posting] -> [MarketPrice]
forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings Journal
j
}
postingInferredmarketPrice :: Posting -> Maybe MarketPrice
postingInferredmarketPrice :: Posting -> Maybe MarketPrice
postingInferredmarketPrice p :: Posting
p@Posting{MixedAmount
pamount :: MixedAmount
pamount :: Posting -> MixedAmount
pamount} =
case MixedAmount -> MixedAmount
mixedAmountTotalPriceToUnitPrice MixedAmount
pamount of
Mixed ( Amount{acommodity :: Amount -> AccountName
acommodity=AccountName
fromcomm, aprice :: Amount -> Maybe AmountPrice
aprice = Just (UnitPrice Amount{acommodity :: Amount -> AccountName
acommodity=AccountName
tocomm, aquantity :: Amount -> Quantity
aquantity=Quantity
rate})} : _) ->
MarketPrice -> Maybe MarketPrice
forall a. a -> Maybe a
Just MarketPrice :: Day -> AccountName -> AccountName -> Quantity -> MarketPrice
MarketPrice {
mpdate :: Day
mpdate = Posting -> Day
postingDate Posting
p
,mpfrom :: AccountName
mpfrom = AccountName
fromcomm
,mpto :: AccountName
mpto = AccountName
tocomm
,mprate :: Quantity
mprate = Quantity
rate
}
_ -> Maybe MarketPrice
forall a. Maybe a
Nothing
journalToCost :: Journal -> Journal
journalToCost :: Journal -> Journal
journalToCost j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (Map AccountName AmountStyle -> Transaction -> Transaction
transactionToCost Map AccountName AmountStyle
styles) [Transaction]
ts}
where
styles :: Map AccountName AmountStyle
styles = Journal -> Map AccountName AmountStyle
journalCommodityStyles Journal
j
journalStyleInfluencingAmounts :: Journal -> [Amount]
journalStyleInfluencingAmounts :: Journal -> [Amount]
journalStyleInfluencingAmounts j :: Journal
j = [Maybe Amount] -> [Amount]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Amount] -> [Amount]) -> [Maybe Amount] -> [Amount]
forall a b. (a -> b) -> a -> b
$ [[Maybe Amount]] -> [Maybe Amount]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
[Maybe Amount
mdefaultcommodityamt]
,(PriceDirective -> Maybe Amount)
-> [PriceDirective] -> [Maybe Amount]
forall a b. (a -> b) -> [a] -> [b]
map (Amount -> Maybe Amount
forall a. a -> Maybe a
Just (Amount -> Maybe Amount)
-> (PriceDirective -> Amount) -> PriceDirective -> Maybe Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PriceDirective -> Amount
pdamount) ([PriceDirective] -> [Maybe Amount])
-> [PriceDirective] -> [Maybe Amount]
forall a b. (a -> b) -> a -> b
$ Journal -> [PriceDirective]
jpricedirectives Journal
j
,(Amount -> Maybe Amount) -> [Amount] -> [Maybe Amount]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> Maybe Amount
forall a. a -> Maybe a
Just ([Amount] -> [Maybe Amount]) -> [Amount] -> [Maybe Amount]
forall a b. (a -> b) -> a -> b
$ (MixedAmount -> [Amount]) -> [MixedAmount] -> [Amount]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap MixedAmount -> [Amount]
amounts ([MixedAmount] -> [Amount]) -> [MixedAmount] -> [Amount]
forall a b. (a -> b) -> a -> b
$ (Posting -> MixedAmount) -> [Posting] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> MixedAmount
pamount ([Posting] -> [MixedAmount]) -> [Posting] -> [MixedAmount]
forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings Journal
j
]
where
mdefaultcommodityamt :: Maybe Amount
mdefaultcommodityamt =
case Journal -> Maybe (AccountName, AmountStyle)
jparsedefaultcommodity Journal
j of
Just (symbol :: AccountName
symbol,style :: AmountStyle
style) -> Amount -> Maybe Amount
forall a. a -> Maybe a
Just Amount
nullamt{acommodity :: AccountName
acommodity=AccountName
symbol,astyle :: AmountStyle
astyle=AmountStyle
style}
Nothing -> Maybe Amount
forall a. Maybe a
Nothing
journalDateSpan :: Bool -> Journal -> DateSpan
journalDateSpan :: Bool -> Journal -> DateSpan
journalDateSpan secondary :: Bool
secondary j :: Journal
j
| [Transaction] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Transaction]
ts = Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing Maybe Day
forall a. Maybe a
Nothing
| Bool
otherwise = Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
earliest) (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Year -> Day -> Day
addDays 1 Day
latest)
where
earliest :: Day
earliest = [Day] -> Day
forall a. Ord a => [a] -> a
minimumStrict [Day]
dates
latest :: Day
latest = [Day] -> Day
forall a. Ord a => [a] -> a
maximumStrict [Day]
dates
dates :: [Day]
dates = [Day]
pdates [Day] -> [Day] -> [Day]
forall a. [a] -> [a] -> [a]
++ [Day]
tdates
tdates :: [Day]
tdates = (Transaction -> Day) -> [Transaction] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map (if Bool
secondary then Transaction -> Day
transactionDate2 else Transaction -> Day
tdate) [Transaction]
ts
pdates :: [Day]
pdates = (Transaction -> [Day]) -> [Transaction] -> [Day]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Posting -> Maybe Day) -> [Posting] -> [Day]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (if Bool
secondary then (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> (Posting -> Day) -> Posting -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Day
postingDate2) else Posting -> Maybe Day
pdate) ([Posting] -> [Day])
-> (Transaction -> [Posting]) -> Transaction -> [Day]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings) [Transaction]
ts
ts :: [Transaction]
ts = Journal -> [Transaction]
jtxns Journal
j
journalStartDate :: Bool -> Journal -> Maybe Day
journalStartDate :: Bool -> Journal -> Maybe Day
journalStartDate secondary :: Bool
secondary j :: Journal
j = Maybe Day
b where DateSpan b :: Maybe Day
b _ = Bool -> Journal -> DateSpan
journalDateSpan Bool
secondary Journal
j
journalEndDate :: Bool -> Journal -> Maybe Day
journalEndDate :: Bool -> Journal -> Maybe Day
journalEndDate secondary :: Bool
secondary j :: Journal
j = Maybe Day
e where DateSpan _ e :: Maybe Day
e = Bool -> Journal -> DateSpan
journalDateSpan Bool
secondary Journal
j
journalPivot :: Text -> Journal -> Journal
journalPivot :: AccountName -> Journal -> Journal
journalPivot fieldortagname :: AccountName
fieldortagname j :: Journal
j = Journal
j{jtxns :: [Transaction]
jtxns = (Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName -> Transaction -> Transaction
transactionPivot AccountName
fieldortagname) ([Transaction] -> [Transaction])
-> (Journal -> [Transaction]) -> Journal -> [Transaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Transaction]
jtxns (Journal -> [Transaction]) -> Journal -> [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal
j}
transactionPivot :: Text -> Transaction -> Transaction
transactionPivot :: AccountName -> Transaction -> Transaction
transactionPivot fieldortagname :: AccountName
fieldortagname t :: Transaction
t = Transaction
t{tpostings :: [Posting]
tpostings = (Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName -> Posting -> Posting
postingPivot AccountName
fieldortagname) ([Posting] -> [Posting])
-> (Transaction -> [Posting]) -> Transaction -> [Posting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings (Transaction -> [Posting]) -> Transaction -> [Posting]
forall a b. (a -> b) -> a -> b
$ Transaction
t}
postingPivot :: Text -> Posting -> Posting
postingPivot :: AccountName -> Posting -> Posting
postingPivot fieldortagname :: AccountName
fieldortagname p :: Posting
p = Posting
p{paccount :: AccountName
paccount = AccountName
pivotedacct, poriginal :: Maybe Posting
poriginal = Posting -> Maybe Posting
forall a. a -> Maybe a
Just (Posting -> Maybe Posting) -> Posting -> Maybe Posting
forall a b. (a -> b) -> a -> b
$ Posting -> Posting
originalPosting Posting
p}
where
pivotedacct :: AccountName
pivotedacct
| Just t :: Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, AccountName
fieldortagname AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== "code" = Transaction -> AccountName
tcode Transaction
t
| Just t :: Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, AccountName
fieldortagname AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== "description" = Transaction -> AccountName
tdescription Transaction
t
| Just t :: Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, AccountName
fieldortagname AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== "payee" = Transaction -> AccountName
transactionPayee Transaction
t
| Just t :: Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, AccountName
fieldortagname AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== "note" = Transaction -> AccountName
transactionNote Transaction
t
| Just (_, value :: AccountName
value) <- AccountName -> Posting -> Maybe (AccountName, AccountName)
postingFindTag AccountName
fieldortagname Posting
p = AccountName
value
| Bool
otherwise = ""
postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue)
postingFindTag :: AccountName -> Posting -> Maybe (AccountName, AccountName)
postingFindTag tagname :: AccountName
tagname p :: Posting
p = ((AccountName, AccountName) -> Bool)
-> [(AccountName, AccountName)] -> Maybe (AccountName, AccountName)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((AccountName
tagnameAccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
==) (AccountName -> Bool)
-> ((AccountName, AccountName) -> AccountName)
-> (AccountName, AccountName)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AccountName, AccountName) -> AccountName
forall a b. (a, b) -> a
fst) ([(AccountName, AccountName)] -> Maybe (AccountName, AccountName))
-> [(AccountName, AccountName)] -> Maybe (AccountName, AccountName)
forall a b. (a -> b) -> a -> b
$ Posting -> [(AccountName, AccountName)]
postingAllTags Posting
p
matchpats :: [String] -> String -> Bool
matchpats :: [String] -> String -> Bool
matchpats pats :: [String]
pats str :: String
str =
([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
positives Bool -> Bool -> Bool
|| (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
match [String]
positives) Bool -> Bool -> Bool
&& ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
negatives Bool -> Bool -> Bool
|| Bool -> Bool
not ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
match [String]
negatives))
where
(negatives :: [String]
negatives,positives :: [String]
positives) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition String -> Bool
isnegativepat [String]
pats
match :: String -> Bool
match "" = Bool
True
match pat :: String
pat = String -> String -> Bool
regexMatchesCI (ShowS
abspat String
pat) String
str
negateprefix :: String
negateprefix = "not:"
isnegativepat :: String -> Bool
isnegativepat = (String
negateprefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)
abspat :: ShowS
abspat pat :: String
pat = if String -> Bool
isnegativepat String
pat then Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
negateprefix) String
pat else String
pat
Right samplejournal :: Journal
samplejournal = Bool -> Journal -> Either String Journal
journalBalanceTransactions Bool
False (Journal -> Either String Journal)
-> Journal -> Either String Journal
forall a b. (a -> b) -> a -> b
$
Journal
nulljournal
{jtxns :: [Transaction]
jtxns = [
Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
tindex :: Year
tindex=0,
tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
tdate :: Day
tdate=String -> Day
parsedate "2008/01/01",
tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
tstatus :: Status
tstatus=Status
Unmarked,
tcode :: AccountName
tcode="",
tdescription :: AccountName
tdescription="income",
tcomment :: AccountName
tcomment="",
ttags :: [(AccountName, AccountName)]
ttags=[],
tpostings :: [Posting]
tpostings=
["assets:bank:checking" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd 1
,"income:salary" AccountName -> Amount -> Posting
`post` Amount
missingamt
],
tprecedingcomment :: AccountName
tprecedingcomment=""
}
,
Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
tindex :: Year
tindex=0,
tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
tdate :: Day
tdate=String -> Day
parsedate "2008/06/01",
tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
tstatus :: Status
tstatus=Status
Unmarked,
tcode :: AccountName
tcode="",
tdescription :: AccountName
tdescription="gift",
tcomment :: AccountName
tcomment="",
ttags :: [(AccountName, AccountName)]
ttags=[],
tpostings :: [Posting]
tpostings=
["assets:bank:checking" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd 1
,"income:gifts" AccountName -> Amount -> Posting
`post` Amount
missingamt
],
tprecedingcomment :: AccountName
tprecedingcomment=""
}
,
Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
tindex :: Year
tindex=0,
tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
tdate :: Day
tdate=String -> Day
parsedate "2008/06/02",
tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
tstatus :: Status
tstatus=Status
Unmarked,
tcode :: AccountName
tcode="",
tdescription :: AccountName
tdescription="save",
tcomment :: AccountName
tcomment="",
ttags :: [(AccountName, AccountName)]
ttags=[],
tpostings :: [Posting]
tpostings=
["assets:bank:saving" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd 1
,"assets:bank:checking" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd (-1)
],
tprecedingcomment :: AccountName
tprecedingcomment=""
}
,
Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
tindex :: Year
tindex=0,
tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
tdate :: Day
tdate=String -> Day
parsedate "2008/06/03",
tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
tstatus :: Status
tstatus=Status
Cleared,
tcode :: AccountName
tcode="",
tdescription :: AccountName
tdescription="eat & shop",
tcomment :: AccountName
tcomment="",
ttags :: [(AccountName, AccountName)]
ttags=[],
tpostings :: [Posting]
tpostings=["expenses:food" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd 1
,"expenses:supplies" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd 1
,"assets:cash" AccountName -> Amount -> Posting
`post` Amount
missingamt
],
tprecedingcomment :: AccountName
tprecedingcomment=""
}
,
Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
tindex :: Year
tindex=0,
tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
tdate :: Day
tdate=String -> Day
parsedate "2008/10/01",
tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
tstatus :: Status
tstatus=Status
Unmarked,
tcode :: AccountName
tcode="",
tdescription :: AccountName
tdescription="take a loan",
tcomment :: AccountName
tcomment="",
ttags :: [(AccountName, AccountName)]
ttags=[],
tpostings :: [Posting]
tpostings=["assets:bank:checking" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd 1
,"liabilities:debts" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd (-1)
],
tprecedingcomment :: AccountName
tprecedingcomment=""
}
,
Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
tindex :: Year
tindex=0,
tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
tdate :: Day
tdate=String -> Day
parsedate "2008/12/31",
tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
tstatus :: Status
tstatus=Status
Unmarked,
tcode :: AccountName
tcode="",
tdescription :: AccountName
tdescription="pay off",
tcomment :: AccountName
tcomment="",
ttags :: [(AccountName, AccountName)]
ttags=[],
tpostings :: [Posting]
tpostings=["liabilities:debts" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd 1
,"assets:bank:checking" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd (-1)
],
tprecedingcomment :: AccountName
tprecedingcomment=""
}
]
}
tests_Journal :: TestTree
tests_Journal = String -> [TestTree] -> TestTree
tests "Journal" [
String -> Assertion -> TestTree
test "journalDateSpan" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
Bool -> Journal -> DateSpan
journalDateSpan Bool
True Journal
nulljournal{
jtxns :: [Transaction]
jtxns = [Transaction
nulltransaction{tdate :: Day
tdate = String -> Day
parsedate "2014/02/01"
,tpostings :: [Posting]
tpostings = [Posting
posting{pdate :: Maybe Day
pdate=Day -> Maybe Day
forall a. a -> Maybe a
Just (String -> Day
parsedate "2014/01/10")}]
}
,Transaction
nulltransaction{tdate :: Day
tdate = String -> Day
parsedate "2014/09/01"
,tpostings :: [Posting]
tpostings = [Posting
posting{pdate2 :: Maybe Day
pdate2=Day -> Maybe Day
forall a. a -> Maybe a
Just (String -> Day
parsedate "2014/10/10")}]
}
]
}
DateSpan -> DateSpan -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian 2014 1 10) (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian 2014 10 11))
,String -> [TestTree] -> TestTree
tests "standard account type queries" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$
let
j :: Journal
j = Journal
samplejournal
journalAccountNamesMatching :: Query -> Journal -> [AccountName]
journalAccountNamesMatching :: Query -> Journal -> [AccountName]
journalAccountNamesMatching q :: Query
q = (AccountName -> Bool) -> [AccountName] -> [AccountName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query
q Query -> AccountName -> Bool
`matchesAccount`) ([AccountName] -> [AccountName])
-> (Journal -> [AccountName]) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [AccountName]
journalAccountNames
namesfrom :: (Journal -> Query) -> [AccountName]
namesfrom qfunc :: Journal -> Query
qfunc = Query -> Journal -> [AccountName]
journalAccountNamesMatching (Journal -> Query
qfunc Journal
j) Journal
j
in [
String -> Assertion -> TestTree
test "assets" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ String -> [AccountName] -> [AccountName] -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual "" ((Journal -> Query) -> [AccountName]
namesfrom Journal -> Query
journalAssetAccountQuery) ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]
,String -> Assertion -> TestTree
test "liabilities" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ String -> [AccountName] -> [AccountName] -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual "" ((Journal -> Query) -> [AccountName]
namesfrom Journal -> Query
journalLiabilityAccountQuery) ["liabilities","liabilities:debts"]
,String -> Assertion -> TestTree
test "equity" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ String -> [AccountName] -> [AccountName] -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual "" ((Journal -> Query) -> [AccountName]
namesfrom Journal -> Query
journalEquityAccountQuery) []
,String -> Assertion -> TestTree
test "income" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ String -> [AccountName] -> [AccountName] -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual "" ((Journal -> Query) -> [AccountName]
namesfrom Journal -> Query
journalRevenueAccountQuery) ["income","income:gifts","income:salary"]
,String -> Assertion -> TestTree
test "expenses" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ String -> [AccountName] -> [AccountName] -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual "" ((Journal -> Query) -> [AccountName]
namesfrom Journal -> Query
journalExpenseAccountQuery) ["expenses","expenses:food","expenses:supplies"]
]
,String -> [TestTree] -> TestTree
tests "journalBalanceTransactions" [
String -> Assertion -> TestTree
test "balance-assignment" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
let ej :: Either String Journal
ej = Bool -> Journal -> Either String Journal
journalBalanceTransactions Bool
True (Journal -> Either String Journal)
-> Journal -> Either String Journal
forall a b. (a -> b) -> a -> b
$
Journal
nulljournal{ jtxns :: [Transaction]
jtxns = [
String -> [Posting] -> Transaction
transaction "2019/01/01" [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' "a" Amount
missingamt (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num 1)) ]
]}
Either String Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight Either String Journal
ej
let Right j :: Journal
j = Either String Journal
ej
(Journal -> [Transaction]
jtxns Journal
j [Transaction] -> ([Transaction] -> Transaction) -> Transaction
forall a b. a -> (a -> b) -> b
& [Transaction] -> Transaction
forall a. [a] -> a
head Transaction -> (Transaction -> [Posting]) -> [Posting]
forall a b. a -> (a -> b) -> b
& Transaction -> [Posting]
tpostings [Posting] -> ([Posting] -> Posting) -> Posting
forall a b. a -> (a -> b) -> b
& [Posting] -> Posting
forall a. [a] -> a
head Posting -> (Posting -> MixedAmount) -> MixedAmount
forall a b. a -> (a -> b) -> b
& Posting -> MixedAmount
pamount) MixedAmount -> MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Amount] -> MixedAmount
Mixed [Quantity -> Amount
num 1]
,String -> Assertion -> TestTree
test "same-day-1" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
Either String Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either String Journal -> Assertion)
-> Either String Journal -> Assertion
forall a b. (a -> b) -> a -> b
$ Bool -> Journal -> Either String Journal
journalBalanceTransactions Bool
True (Journal -> Either String Journal)
-> Journal -> Either String Journal
forall a b. (a -> b) -> a -> b
$
Journal
nulljournal{ jtxns :: [Transaction]
jtxns = [
String -> [Posting] -> Transaction
transaction "2019/01/01" [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' "a" Amount
missingamt (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num 1)) ]
,String -> [Posting] -> Transaction
transaction "2019/01/01" [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' "a" (Quantity -> Amount
num 1) (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num 2)) ]
]}
,String -> Assertion -> TestTree
test "same-day-2" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
Either String Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either String Journal -> Assertion)
-> Either String Journal -> Assertion
forall a b. (a -> b) -> a -> b
$ Bool -> Journal -> Either String Journal
journalBalanceTransactions Bool
True (Journal -> Either String Journal)
-> Journal -> Either String Journal
forall a b. (a -> b) -> a -> b
$
Journal
nulljournal{ jtxns :: [Transaction]
jtxns = [
String -> [Posting] -> Transaction
transaction "2019/01/01" [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' "a" (Quantity -> Amount
num 2) (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num 2)) ]
,String -> [Posting] -> Transaction
transaction "2019/01/01" [
AccountName -> Amount -> Maybe BalanceAssertion -> Posting
post' "b" (Quantity -> Amount
num 1) Maybe BalanceAssertion
forall a. Maybe a
Nothing
,AccountName -> Amount -> Maybe BalanceAssertion -> Posting
post' "a" Amount
missingamt Maybe BalanceAssertion
forall a. Maybe a
Nothing
]
,String -> [Posting] -> Transaction
transaction "2019/01/01" [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
post' "a" (Quantity -> Amount
num 0) (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num 1)) ]
]}
,String -> Assertion -> TestTree
test "out-of-order" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
Either String Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either String Journal -> Assertion)
-> Either String Journal -> Assertion
forall a b. (a -> b) -> a -> b
$ Bool -> Journal -> Either String Journal
journalBalanceTransactions Bool
True (Journal -> Either String Journal)
-> Journal -> Either String Journal
forall a b. (a -> b) -> a -> b
$
Journal
nulljournal{ jtxns :: [Transaction]
jtxns = [
String -> [Posting] -> Transaction
transaction "2019/01/02" [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' "a" (Quantity -> Amount
num 1) (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num 2)) ]
,String -> [Posting] -> Transaction
transaction "2019/01/01" [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' "a" (Quantity -> Amount
num 1) (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num 1)) ]
]}
]
,String -> [TestTree] -> TestTree
tests "commodityStylesFromAmounts" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$ [
String -> Assertion -> TestTree
test "1091a" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
[Amount] -> Either String (Map AccountName AmountStyle)
commodityStylesFromAmounts [
Amount
nullamt{aquantity :: Quantity
aquantity=1000, astyle :: AmountStyle
astyle=Side
-> Bool
-> Int
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False 3 (Char -> Maybe Char
forall a. a -> Maybe a
Just ',') Maybe DigitGroupStyle
forall a. Maybe a
Nothing}
,Amount
nullamt{aquantity :: Quantity
aquantity=1000, astyle :: AmountStyle
astyle=Side
-> Bool
-> Int
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False 2 (Char -> Maybe Char
forall a. a -> Maybe a
Just '.') (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Int] -> DigitGroupStyle
DigitGroups ',' [3]))}
]
Either String (Map AccountName AmountStyle)
-> Either String (Map AccountName AmountStyle) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
Map AccountName AmountStyle
-> Either String (Map AccountName AmountStyle)
forall a b. b -> Either a b
Right ([(AccountName, AmountStyle)] -> Map AccountName AmountStyle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
("", Side
-> Bool
-> Int
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False 3 (Char -> Maybe Char
forall a. a -> Maybe a
Just '.') (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Int] -> DigitGroupStyle
DigitGroups ',' [3])))
])
,String -> Assertion -> TestTree
test "1091b" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
[Amount] -> Either String (Map AccountName AmountStyle)
commodityStylesFromAmounts [
Amount
nullamt{aquantity :: Quantity
aquantity=1000, astyle :: AmountStyle
astyle=Side
-> Bool
-> Int
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False 2 (Char -> Maybe Char
forall a. a -> Maybe a
Just '.') (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Int] -> DigitGroupStyle
DigitGroups ',' [3]))}
,Amount
nullamt{aquantity :: Quantity
aquantity=1000, astyle :: AmountStyle
astyle=Side
-> Bool
-> Int
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False 3 (Char -> Maybe Char
forall a. a -> Maybe a
Just ',') Maybe DigitGroupStyle
forall a. Maybe a
Nothing}
]
Either String (Map AccountName AmountStyle)
-> Either String (Map AccountName AmountStyle) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
Map AccountName AmountStyle
-> Either String (Map AccountName AmountStyle)
forall a b. b -> Either a b
Right ([(AccountName, AmountStyle)] -> Map AccountName AmountStyle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
("", Side
-> Bool
-> Int
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False 3 (Char -> Maybe Char
forall a. a -> Maybe a
Just '.') (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Int] -> DigitGroupStyle
DigitGroups ',' [3])))
])
]
]