{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Data.Balancing
(
BalancingOpts(..)
, HasBalancingOpts(..)
, defbalancingopts
, isTransactionBalanced
, balanceTransaction
, balanceTransactionHelper
, annotateErrorWithTransaction
, journalBalanceTransactions
, journalCheckBalanceAssertions
, tests_Balancing
)
where
import Control.Monad.Except (ExceptT(..), runExceptT, throwError)
import "extra" Control.Monad.Extra (whenM)
import Control.Monad.Reader as R
import Control.Monad.ST (ST, runST)
import Data.Array.ST (STArray, getElems, newListArray, writeArray)
import Data.Foldable (asum)
import Data.Function ((&))
import qualified Data.HashTable.Class as H (toList)
import qualified Data.HashTable.ST.Cuckoo as H
import Data.List (intercalate, partition, sortOn)
import Data.List.Extra (nubSort)
import Data.Maybe (fromJust, fromMaybe, isJust, isNothing, mapMaybe)
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Time.Calendar (fromGregorian)
import qualified Data.Map as M
import Safe (headDef)
import Text.Printf (printf)
import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.AccountName (isAccountNamePrefixOf)
import Hledger.Data.Amount
import Hledger.Data.Dates (showDate)
import Hledger.Data.Journal
import Hledger.Data.Posting
import Hledger.Data.Transaction
data BalancingOpts = BalancingOpts
{ BalancingOpts -> Bool
ignore_assertions_ :: Bool
, BalancingOpts -> Bool
infer_transaction_prices_ :: Bool
, BalancingOpts -> Maybe (Map AccountName AmountStyle)
commodity_styles_ :: Maybe (M.Map CommoditySymbol AmountStyle)
} deriving (Int -> BalancingOpts -> ShowS
[BalancingOpts] -> ShowS
BalancingOpts -> [Char]
(Int -> BalancingOpts -> ShowS)
-> (BalancingOpts -> [Char])
-> ([BalancingOpts] -> ShowS)
-> Show BalancingOpts
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BalancingOpts] -> ShowS
$cshowList :: [BalancingOpts] -> ShowS
show :: BalancingOpts -> [Char]
$cshow :: BalancingOpts -> [Char]
showsPrec :: Int -> BalancingOpts -> ShowS
$cshowsPrec :: Int -> BalancingOpts -> ShowS
Show)
defbalancingopts :: BalancingOpts
defbalancingopts :: BalancingOpts
defbalancingopts = BalancingOpts :: Bool
-> Bool -> Maybe (Map AccountName AmountStyle) -> BalancingOpts
BalancingOpts
{ ignore_assertions_ :: Bool
ignore_assertions_ = Bool
False
, infer_transaction_prices_ :: Bool
infer_transaction_prices_ = Bool
True
, commodity_styles_ :: Maybe (Map AccountName AmountStyle)
commodity_styles_ = Maybe (Map AccountName AmountStyle)
forall a. Maybe a
Nothing
}
transactionCheckBalanced :: BalancingOpts -> Transaction -> [String]
transactionCheckBalanced :: BalancingOpts -> Transaction -> [[Char]]
transactionCheckBalanced BalancingOpts{Maybe (Map AccountName AmountStyle)
commodity_styles_ :: Maybe (Map AccountName AmountStyle)
commodity_styles_ :: BalancingOpts -> Maybe (Map AccountName AmountStyle)
commodity_styles_} Transaction
t = [[Char]]
errs
where
([Posting]
rps, [Posting]
bvps) = (Posting -> ([Posting], [Posting]) -> ([Posting], [Posting]))
-> ([Posting], [Posting]) -> [Posting] -> ([Posting], [Posting])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Posting -> ([Posting], [Posting]) -> ([Posting], [Posting])
partitionPosting ([], []) ([Posting] -> ([Posting], [Posting]))
-> [Posting] -> ([Posting], [Posting])
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t
where
partitionPosting :: Posting -> ([Posting], [Posting]) -> ([Posting], [Posting])
partitionPosting Posting
p ~([Posting]
l, [Posting]
r) = case Posting -> PostingType
ptype Posting
p of
PostingType
RegularPosting -> (Posting
pPosting -> [Posting] -> [Posting]
forall a. a -> [a] -> [a]
:[Posting]
l, [Posting]
r)
PostingType
BalancedVirtualPosting -> ([Posting]
l, Posting
pPosting -> [Posting] -> [Posting]
forall a. a -> [a] -> [a]
:[Posting]
r)
PostingType
VirtualPosting -> ([Posting]
l, [Posting]
r)
canonicalise :: MixedAmount -> MixedAmount
canonicalise = (MixedAmount -> MixedAmount)
-> (Map AccountName AmountStyle -> MixedAmount -> MixedAmount)
-> Maybe (Map AccountName AmountStyle)
-> MixedAmount
-> MixedAmount
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MixedAmount -> MixedAmount
forall a. a -> a
id Map AccountName AmountStyle -> MixedAmount -> MixedAmount
canonicaliseMixedAmount Maybe (Map AccountName AmountStyle)
commodity_styles_
signsOk :: [Posting] -> Bool
signsOk [Posting]
ps =
case (MixedAmount -> Bool) -> [MixedAmount] -> [MixedAmount]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (MixedAmount -> Bool) -> MixedAmount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MixedAmount -> Bool
mixedAmountLooksZero) ([MixedAmount] -> [MixedAmount]) -> [MixedAmount] -> [MixedAmount]
forall a b. (a -> b) -> a -> b
$ (Posting -> MixedAmount) -> [Posting] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (MixedAmount -> MixedAmount
canonicalise(MixedAmount -> MixedAmount)
-> (Posting -> MixedAmount) -> Posting -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MixedAmount -> MixedAmount
mixedAmountCost(MixedAmount -> MixedAmount)
-> (Posting -> MixedAmount) -> Posting -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Posting -> MixedAmount
pamount) [Posting]
ps of
[MixedAmount]
nonzeros | [MixedAmount] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MixedAmount]
nonzeros Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
-> [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Bool] -> [Bool]
forall a. Ord a => [a] -> [a]
nubSort ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ (MixedAmount -> Maybe Bool) -> [MixedAmount] -> [Bool]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MixedAmount -> Maybe Bool
isNegativeMixedAmount [MixedAmount]
nonzeros) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
[MixedAmount]
_ -> Bool
True
(Bool
rsignsok, Bool
bvsignsok) = ([Posting] -> Bool
signsOk [Posting]
rps, [Posting] -> Bool
signsOk [Posting]
bvps)
(MixedAmount
rsum, MixedAmount
bvsum) = ([Posting] -> MixedAmount
sumPostings [Posting]
rps, [Posting] -> MixedAmount
sumPostings [Posting]
bvps)
(MixedAmount
rsumcost, MixedAmount
bvsumcost) = (MixedAmount -> MixedAmount
mixedAmountCost MixedAmount
rsum, MixedAmount -> MixedAmount
mixedAmountCost MixedAmount
bvsum)
(MixedAmount
rsumdisplay, MixedAmount
bvsumdisplay) = (MixedAmount -> MixedAmount
canonicalise MixedAmount
rsumcost, MixedAmount -> MixedAmount
canonicalise MixedAmount
bvsumcost)
(Bool
rsumok, Bool
bvsumok) = (MixedAmount -> Bool
mixedAmountLooksZero MixedAmount
rsumdisplay, MixedAmount -> Bool
mixedAmountLooksZero MixedAmount
bvsumdisplay)
errs :: [[Char]]
errs = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Char]
rmsg, [Char]
bvmsg]
where
rmsg :: [Char]
rmsg
| Bool
rsumok = [Char]
""
| Bool -> Bool
not Bool
rsignsok = [Char]
"real postings all have the same sign"
| Bool
otherwise = [Char]
"real postings' sum should be 0 but is: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ MixedAmount -> [Char]
showMixedAmount MixedAmount
rsumcost
bvmsg :: [Char]
bvmsg
| Bool
bvsumok = [Char]
""
| Bool -> Bool
not Bool
bvsignsok = [Char]
"balanced virtual postings all have the same sign"
| Bool
otherwise = [Char]
"balanced virtual postings' sum should be 0 but is: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ MixedAmount -> [Char]
showMixedAmount MixedAmount
bvsumcost
isTransactionBalanced :: BalancingOpts -> Transaction -> Bool
isTransactionBalanced :: BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
bopts = [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[Char]] -> Bool)
-> (Transaction -> [[Char]]) -> Transaction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalancingOpts -> Transaction -> [[Char]]
transactionCheckBalanced BalancingOpts
bopts
balanceTransaction ::
BalancingOpts
-> Transaction
-> Either String Transaction
balanceTransaction :: BalancingOpts -> Transaction -> Either [Char] Transaction
balanceTransaction BalancingOpts
bopts = ((Transaction, [(AccountName, MixedAmount)]) -> Transaction)
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
-> Either [Char] Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Transaction, [(AccountName, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst (Either [Char] (Transaction, [(AccountName, MixedAmount)])
-> Either [Char] Transaction)
-> (Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)]))
-> Transaction
-> Either [Char] Transaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalancingOpts
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
balanceTransactionHelper BalancingOpts
bopts
balanceTransactionHelper ::
BalancingOpts
-> Transaction
-> Either String (Transaction, [(AccountName, MixedAmount)])
balanceTransactionHelper :: BalancingOpts
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
balanceTransactionHelper BalancingOpts
bopts Transaction
t = do
(Transaction
t', [(AccountName, MixedAmount)]
inferredamtsandaccts) <- Map AccountName AmountStyle
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
inferBalancingAmount (Map AccountName AmountStyle
-> Maybe (Map AccountName AmountStyle)
-> Map AccountName AmountStyle
forall a. a -> Maybe a -> a
fromMaybe Map AccountName AmountStyle
forall k a. Map k a
M.empty (Maybe (Map AccountName AmountStyle)
-> Map AccountName AmountStyle)
-> Maybe (Map AccountName AmountStyle)
-> Map AccountName AmountStyle
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Maybe (Map AccountName AmountStyle)
commodity_styles_ BalancingOpts
bopts) (Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)]))
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. (a -> b) -> a -> b
$
if BalancingOpts -> Bool
infer_transaction_prices_ BalancingOpts
bopts then Transaction -> Transaction
inferBalancingPrices Transaction
t else Transaction
t
case BalancingOpts -> Transaction -> [[Char]]
transactionCheckBalanced BalancingOpts
bopts Transaction
t' of
[] -> (Transaction, [(AccountName, MixedAmount)])
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. b -> Either a b
Right (Transaction -> Transaction
txnTieKnot Transaction
t', [(AccountName, MixedAmount)]
inferredamtsandaccts)
[[Char]]
errs -> [Char] -> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. a -> Either a b
Left ([Char]
-> Either [Char] (Transaction, [(AccountName, MixedAmount)]))
-> [Char]
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. (a -> b) -> a -> b
$ Transaction -> [[Char]] -> [Char]
transactionBalanceError Transaction
t' [[Char]]
errs
transactionBalanceError :: Transaction -> [String] -> String
transactionBalanceError :: Transaction -> [[Char]] -> [Char]
transactionBalanceError Transaction
t [[Char]]
errs =
Transaction -> ShowS
annotateErrorWithTransaction Transaction
t ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
[Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"could not balance this transaction:" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
errs
annotateErrorWithTransaction :: Transaction -> String -> String
annotateErrorWithTransaction :: Transaction -> ShowS
annotateErrorWithTransaction Transaction
t [Char]
s =
[[Char]] -> [Char]
unlines [ (SourcePos, SourcePos) -> [Char]
showSourcePosPair ((SourcePos, SourcePos) -> [Char])
-> (SourcePos, SourcePos) -> [Char]
forall a b. (a -> b) -> a -> b
$ Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t, [Char]
s
, AccountName -> [Char]
T.unpack (AccountName -> [Char])
-> (AccountName -> AccountName) -> AccountName -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> AccountName
T.stripEnd (AccountName -> [Char]) -> AccountName -> [Char]
forall a b. (a -> b) -> a -> b
$ Transaction -> AccountName
showTransaction Transaction
t
]
inferBalancingAmount ::
M.Map CommoditySymbol AmountStyle
-> Transaction
-> Either String (Transaction, [(AccountName, MixedAmount)])
inferBalancingAmount :: Map AccountName AmountStyle
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
inferBalancingAmount Map AccountName AmountStyle
styles t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps}
| [Posting] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
amountlessrealps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
= [Char] -> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. a -> Either a b
Left ([Char]
-> Either [Char] (Transaction, [(AccountName, MixedAmount)]))
-> [Char]
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. (a -> b) -> a -> b
$ Transaction -> [[Char]] -> [Char]
transactionBalanceError Transaction
t
[[Char]
"can't have more than one real posting with no amount"
,[Char]
"(remember to put two or more spaces between account and amount)"]
| [Posting] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
amountlessbvps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
= [Char] -> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. a -> Either a b
Left ([Char]
-> Either [Char] (Transaction, [(AccountName, MixedAmount)]))
-> [Char]
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. (a -> b) -> a -> b
$ Transaction -> [[Char]] -> [Char]
transactionBalanceError Transaction
t
[[Char]
"can't have more than one balanced virtual posting with no amount"
,[Char]
"(remember to put two or more spaces between account and amount)"]
| Bool
otherwise
= let psandinferredamts :: [(Posting, Maybe MixedAmount)]
psandinferredamts = (Posting -> (Posting, Maybe MixedAmount))
-> [Posting] -> [(Posting, Maybe MixedAmount)]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> (Posting, Maybe MixedAmount)
inferamount [Posting]
ps
inferredacctsandamts :: [(AccountName, MixedAmount)]
inferredacctsandamts = [(Posting -> AccountName
paccount Posting
p, MixedAmount
amt) | (Posting
p, Just MixedAmount
amt) <- [(Posting, Maybe MixedAmount)]
psandinferredamts]
in (Transaction, [(AccountName, MixedAmount)])
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. b -> Either a b
Right (Transaction
t{tpostings :: [Posting]
tpostings=((Posting, Maybe MixedAmount) -> Posting)
-> [(Posting, Maybe MixedAmount)] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (Posting, Maybe MixedAmount) -> Posting
forall a b. (a, b) -> a
fst [(Posting, Maybe MixedAmount)]
psandinferredamts}, [(AccountName, MixedAmount)]
inferredacctsandamts)
where
([Posting]
amountfulrealps, [Posting]
amountlessrealps) = (Posting -> Bool) -> [Posting] -> ([Posting], [Posting])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Posting -> Bool
hasAmount (Transaction -> [Posting]
realPostings Transaction
t)
realsum :: MixedAmount
realsum = [Posting] -> MixedAmount
sumPostings [Posting]
amountfulrealps
([Posting]
amountfulbvps, [Posting]
amountlessbvps) = (Posting -> Bool) -> [Posting] -> ([Posting], [Posting])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Posting -> Bool
hasAmount (Transaction -> [Posting]
balancedVirtualPostings Transaction
t)
bvsum :: MixedAmount
bvsum = [Posting] -> MixedAmount
sumPostings [Posting]
amountfulbvps
inferamount :: Posting -> (Posting, Maybe MixedAmount)
inferamount :: Posting -> (Posting, Maybe MixedAmount)
inferamount Posting
p =
let
minferredamt :: Maybe MixedAmount
minferredamt = case Posting -> PostingType
ptype Posting
p of
PostingType
RegularPosting | Bool -> Bool
not (Posting -> Bool
hasAmount Posting
p) -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
realsum
PostingType
BalancedVirtualPosting | Bool -> Bool
not (Posting -> Bool
hasAmount Posting
p) -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
bvsum
PostingType
_ -> Maybe MixedAmount
forall a. Maybe a
Nothing
in
case Maybe MixedAmount
minferredamt of
Maybe MixedAmount
Nothing -> (Posting
p, Maybe MixedAmount
forall a. Maybe a
Nothing)
Just MixedAmount
a -> (Posting
p{pamount :: MixedAmount
pamount=MixedAmount
a', 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}, MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
a')
where
a' :: MixedAmount
a' = Map AccountName AmountStyle -> MixedAmount -> MixedAmount
styleMixedAmount Map AccountName AmountStyle
styles (MixedAmount -> MixedAmount)
-> (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> MixedAmount
mixedAmountCost (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
maNegate MixedAmount
a
inferBalancingPrices :: Transaction -> Transaction
inferBalancingPrices :: Transaction -> Transaction
inferBalancingPrices t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=[Posting]
ps'}
where
ps' :: [Posting]
ps' = (Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (Transaction -> PostingType -> Posting -> Posting
priceInferrerFor Transaction
t PostingType
BalancedVirtualPosting (Posting -> Posting) -> (Posting -> Posting) -> Posting -> Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> PostingType -> Posting -> Posting
priceInferrerFor Transaction
t PostingType
RegularPosting) [Posting]
ps
priceInferrerFor :: Transaction -> PostingType -> (Posting -> Posting)
priceInferrerFor :: Transaction -> PostingType -> Posting -> Posting
priceInferrerFor Transaction
t PostingType
pt = (Posting -> Posting)
-> ((Amount, Amount) -> Posting -> Posting)
-> Maybe (Amount, Amount)
-> Posting
-> Posting
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Posting -> Posting
forall a. a -> a
id (Amount, Amount) -> Posting -> Posting
inferprice Maybe (Amount, Amount)
inferFromAndTo
where
postings :: [Posting]
postings = (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter ((PostingType -> PostingType -> Bool
forall a. Eq a => a -> a -> Bool
==PostingType
pt)(PostingType -> Bool)
-> (Posting -> PostingType) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Posting -> PostingType
ptype) ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t
pcommodities :: [AccountName]
pcommodities = (Amount -> AccountName) -> [Amount] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> AccountName
acommodity ([Amount] -> [AccountName]) -> [Amount] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ (Posting -> [Amount]) -> [Posting] -> [Amount]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount])
-> (Posting -> MixedAmount) -> Posting -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> MixedAmount
pamount) [Posting]
postings
sumamounts :: [Amount]
sumamounts = MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ [Posting] -> MixedAmount
sumPostings [Posting]
postings
inferFromAndTo :: Maybe (Amount, Amount)
inferFromAndTo = case [Amount]
sumamounts of
[Amount
a,Amount
b] | Bool
noprices, Bool
oppositesigns -> [Maybe (Amount, Amount)] -> Maybe (Amount, Amount)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Maybe (Amount, Amount)] -> Maybe (Amount, Amount))
-> [Maybe (Amount, Amount)] -> Maybe (Amount, Amount)
forall a b. (a -> b) -> a -> b
$ (AccountName -> Maybe (Amount, Amount))
-> [AccountName] -> [Maybe (Amount, Amount)]
forall a b. (a -> b) -> [a] -> [b]
map AccountName -> Maybe (Amount, Amount)
orderIfMatches [AccountName]
pcommodities
where
noprices :: Bool
noprices = (Amount -> Bool) -> [Amount] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe AmountPrice -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe AmountPrice -> Bool)
-> (Amount -> Maybe AmountPrice) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Maybe AmountPrice
aprice) [Amount]
sumamounts
oppositesigns :: Bool
oppositesigns = DecimalRaw Integer -> DecimalRaw Integer
forall a. Num a => a -> a
signum (Amount -> DecimalRaw Integer
aquantity Amount
a) DecimalRaw Integer -> DecimalRaw Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= DecimalRaw Integer -> DecimalRaw Integer
forall a. Num a => a -> a
signum (Amount -> DecimalRaw Integer
aquantity Amount
b)
orderIfMatches :: AccountName -> Maybe (Amount, Amount)
orderIfMatches AccountName
x | AccountName
x AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> AccountName
acommodity Amount
a = (Amount, Amount) -> Maybe (Amount, Amount)
forall a. a -> Maybe a
Just (Amount
a,Amount
b)
| AccountName
x AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> AccountName
acommodity Amount
b = (Amount, Amount) -> Maybe (Amount, Amount)
forall a. a -> Maybe a
Just (Amount
b,Amount
a)
| Bool
otherwise = Maybe (Amount, Amount)
forall a. Maybe a
Nothing
[Amount]
_ -> Maybe (Amount, Amount)
forall a. Maybe a
Nothing
inferprice :: (Amount, Amount) -> Posting -> Posting
inferprice (Amount
fromamount, Amount
toamount) Posting
posting
| [Amount
a] <- MixedAmount -> [Amount]
amounts (Posting -> MixedAmount
pamount Posting
posting), Posting -> PostingType
ptype Posting
posting PostingType -> PostingType -> Bool
forall a. Eq a => a -> a -> Bool
== PostingType
pt, Amount -> AccountName
acommodity Amount
a AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> AccountName
acommodity Amount
fromamount
= Posting
posting{ pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount Amount
a{aprice :: Maybe AmountPrice
aprice=AmountPrice -> Maybe AmountPrice
forall a. a -> Maybe a
Just AmountPrice
conversionprice}
, 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
posting }
| Bool
otherwise = Posting
posting
where
conversionprice :: AmountPrice
conversionprice = case (AccountName -> Bool) -> [AccountName] -> [AccountName]
forall a. (a -> Bool) -> [a] -> [a]
filter (AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> AccountName
acommodity Amount
fromamount) [AccountName]
pcommodities of
[AccountName
_] -> Amount -> AmountPrice
TotalPrice (Amount -> AmountPrice) -> Amount -> AmountPrice
forall a b. (a -> b) -> a -> b
$ Amount -> Amount
forall a. Num a => a -> a
negate Amount
toamount
[AccountName]
_ -> Amount -> AmountPrice
UnitPrice (Amount -> AmountPrice) -> Amount -> AmountPrice
forall a b. (a -> b) -> a -> b
$ Amount -> Amount
forall a. Num a => a -> a
negate Amount
unitprice Amount -> AmountPrecision -> Amount
`withPrecision` AmountPrecision
unitprecision
unitprice :: Amount
unitprice = Amount -> DecimalRaw Integer
aquantity Amount
fromamount DecimalRaw Integer -> Amount -> Amount
`divideAmount` Amount
toamount
unitprecision :: AmountPrecision
unitprecision = case (AmountStyle -> AmountPrecision
asprecision (AmountStyle -> AmountPrecision) -> AmountStyle -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Amount -> AmountStyle
astyle Amount
fromamount, AmountStyle -> AmountPrecision
asprecision (AmountStyle -> AmountPrecision) -> AmountStyle -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Amount -> AmountStyle
astyle Amount
toamount) of
(Precision Word8
a, Precision Word8
b) -> Word8 -> AmountPrecision
Precision (Word8 -> AmountPrecision)
-> (Word8 -> Word8) -> Word8 -> AmountPrecision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
max Word8
2 (Word8 -> AmountPrecision) -> Word8 -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8
forall {a}. (Ord a, Num a, Bounded a) => a -> a -> a
saturatedAdd Word8
a Word8
b
(AmountPrecision, AmountPrecision)
_ -> AmountPrecision
NaturalPrecision
saturatedAdd :: a -> a -> a
saturatedAdd a
a a
b = if a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. Num a => a -> a -> a
- a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b then a
forall a. Bounded a => a
maxBound else a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b
journalCheckBalanceAssertions :: Journal -> Maybe String
journalCheckBalanceAssertions :: Journal -> Maybe [Char]
journalCheckBalanceAssertions = ([Char] -> Maybe [Char])
-> (Journal -> Maybe [Char])
-> Either [Char] Journal
-> Maybe [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (Maybe [Char] -> Journal -> Maybe [Char]
forall a b. a -> b -> a
const Maybe [Char]
forall a. Maybe a
Nothing) (Either [Char] Journal -> Maybe [Char])
-> (Journal -> Either [Char] Journal) -> Journal -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
defbalancingopts
type Balancing s = ReaderT (BalancingState s) (ExceptT String (ST s))
data BalancingState s = BalancingState {
forall s. BalancingState s -> Maybe (Map AccountName AmountStyle)
bsStyles :: Maybe (M.Map CommoditySymbol AmountStyle)
,forall s. BalancingState s -> Set AccountName
bsUnassignable :: S.Set AccountName
,forall s. BalancingState s -> Bool
bsAssrt :: Bool
,forall s. BalancingState s -> HashTable s AccountName MixedAmount
bsBalances :: H.HashTable s AccountName MixedAmount
,forall s. BalancingState s -> STArray s Integer Transaction
bsTransactions :: STArray s Integer Transaction
}
withRunningBalance :: (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance :: forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance BalancingState s -> ST s a
f = ReaderT
(BalancingState s) (ExceptT [Char] (ST s)) (BalancingState s)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT
(BalancingState s) (ExceptT [Char] (ST s)) (BalancingState s)
-> (BalancingState s
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) a)
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExceptT [Char] (ST s) a
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT [Char] (ST s) a
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) a)
-> (BalancingState s -> ExceptT [Char] (ST s) a)
-> BalancingState s
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST s a -> ExceptT [Char] (ST s) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s a -> ExceptT [Char] (ST s) a)
-> (BalancingState s -> ST s a)
-> BalancingState s
-> ExceptT [Char] (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 :: forall s. AccountName -> Balancing s MixedAmount
getRunningBalanceB 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 MixedAmount
nullmixedamt (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 :: forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB AccountName
acc 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 MixedAmount
nullmixedamt (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 -> MixedAmount -> MixedAmount
maPlus MixedAmount
old 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 :: forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
setRunningBalanceB AccountName
acc 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 MixedAmount
nullmixedamt (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 -> MixedAmount -> MixedAmount
maMinus MixedAmount
amt MixedAmount
old
setInclusiveRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
setInclusiveRunningBalanceB :: forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
setInclusiveRunningBalanceB AccountName
acc 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 MixedAmount
nullmixedamt (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 :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum ([MixedAmount] -> MixedAmount)
-> ([(AccountName, MixedAmount)] -> [MixedAmount])
-> [(AccountName, MixedAmount)]
-> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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 -> MixedAmount -> MixedAmount
maMinus MixedAmount
newibal 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 -> MixedAmount -> MixedAmount
maMinus MixedAmount
newebal MixedAmount
oldebal
updateTransactionB :: Transaction -> Balancing s ()
updateTransactionB :: forall s. Transaction -> Balancing s ()
updateTransactionB 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 Integer Transaction
bsTransactions :: STArray s Integer Transaction
bsTransactions :: forall s. BalancingState s -> STArray s Integer 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 Integer Transaction -> Integer -> Transaction -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s Integer Transaction
bsTransactions (Transaction -> Integer
tindex Transaction
t) Transaction
t
journalBalanceTransactions :: BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions :: BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
bopts' 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
bopts :: BalancingOpts
bopts = BalancingOpts
bopts'{commodity_styles_ :: Maybe (Map AccountName AmountStyle)
commodity_styles_=Maybe (Map AccountName AmountStyle)
styles}
autopostingaccts :: Set AccountName
autopostingaccts = [AccountName] -> Set AccountName
forall a. Ord a => [a] -> Set a
S.fromList ([AccountName] -> Set AccountName)
-> ([TransactionModifier] -> [AccountName])
-> [TransactionModifier]
-> Set AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TMPostingRule -> AccountName) -> [TMPostingRule] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map (Posting -> AccountName
paccount (Posting -> AccountName)
-> (TMPostingRule -> Posting) -> TMPostingRule -> AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMPostingRule -> Posting
tmprPosting) ([TMPostingRule] -> [AccountName])
-> ([TransactionModifier] -> [TMPostingRule])
-> [TransactionModifier]
-> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransactionModifier -> [TMPostingRule])
-> [TransactionModifier] -> [TMPostingRule]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TransactionModifier -> [TMPostingRule]
tmpostingrules ([TransactionModifier] -> Set AccountName)
-> [TransactionModifier] -> Set AccountName
forall a b. (a -> b) -> a -> b
$ Journal -> [TransactionModifier]
jtxnmodifiers Journal
j
in
(forall s. ST s (Either [Char] Journal)) -> Either [Char] Journal
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Either [Char] Journal)) -> Either [Char] Journal)
-> (forall s. ST s (Either [Char] Journal))
-> Either [Char] Journal
forall a b. (a -> b) -> a -> b
$ do
STArray s Integer Transaction
balancedtxns <- (Integer, Integer)
-> [Transaction] -> ST s (STArray s Integer Transaction)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> [e] -> m (a i e)
newListArray (Integer
1, Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
ts) [Transaction]
ts
ExceptT [Char] (ST s) Journal -> ST s (Either [Char] Journal)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [Char] (ST s) Journal -> ST s (Either [Char] Journal))
-> ExceptT [Char] (ST s) Journal -> ST s (Either [Char] Journal)
forall a b. (a -> b) -> a -> b
$ do
[Either Posting Transaction]
psandts :: [Either Posting Transaction] <- ([[Either Posting Transaction]] -> [Either Posting Transaction])
-> ExceptT [Char] (ST s) [[Either Posting Transaction]]
-> ExceptT [Char] (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 [Char] (ST s) [[Either Posting Transaction]]
-> ExceptT [Char] (ST s) [Either Posting Transaction])
-> ExceptT [Char] (ST s) [[Either Posting Transaction]]
-> ExceptT [Char] (ST s) [Either Posting Transaction]
forall a b. (a -> b) -> a -> b
$ [Transaction]
-> (Transaction
-> ExceptT [Char] (ST s) [Either Posting Transaction])
-> ExceptT [Char] (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 [Char] (ST s) [Either Posting Transaction])
-> ExceptT [Char] (ST s) [[Either Posting Transaction]])
-> (Transaction
-> ExceptT [Char] (ST s) [Either Posting Transaction])
-> ExceptT [Char] (ST s) [[Either Posting Transaction]]
forall a b. (a -> b) -> a -> b
$ \case
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 BalancingOpts -> Transaction -> Either [Char] Transaction
balanceTransaction BalancingOpts
bopts Transaction
t of
Left [Char]
e -> [Char] -> ExceptT [Char] (ST s) [Either Posting Transaction]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [Char]
e
Right Transaction
t' -> do
ST s () -> ExceptT [Char] (ST s) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s () -> ExceptT [Char] (ST s) ())
-> ST s () -> ExceptT [Char] (ST s) ()
forall a b. (a -> b) -> a -> b
$ STArray s Integer Transaction -> Integer -> Transaction -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s Integer Transaction
balancedtxns (Transaction -> Integer
tindex Transaction
t') Transaction
t'
[Either Posting Transaction]
-> ExceptT [Char] (ST s) [Either Posting Transaction]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either Posting Transaction]
-> ExceptT [Char] (ST s) [Either Posting Transaction])
-> [Either Posting Transaction]
-> ExceptT [Char] (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'
Transaction
t -> [Either Posting Transaction]
-> ExceptT [Char] (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 [Char] (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 [Char] (ST s) (HashTable s AccountName MixedAmount))
-> ST s (HashTable s AccountName MixedAmount)
-> ExceptT [Char] (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 [Char] (ST s)) ()
-> BalancingState s -> ExceptT [Char] (ST s) ())
-> BalancingState s
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ExceptT [Char] (ST s) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> BalancingState s -> ExceptT [Char] (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 Integer Transaction
-> BalancingState s
forall s.
Maybe (Map AccountName AmountStyle)
-> Set AccountName
-> Bool
-> HashTable s AccountName MixedAmount
-> STArray s Integer Transaction
-> BalancingState s
BalancingState Maybe (Map AccountName AmountStyle)
styles Set AccountName
autopostingaccts (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Bool
ignore_assertions_ BalancingOpts
bopts) HashTable s AccountName MixedAmount
runningbals STArray s Integer Transaction
balancedtxns) (ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ExceptT [Char] (ST s) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ExceptT [Char] (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
ReaderT (BalancingState s) (ExceptT [Char] (ST s)) [()]
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT (BalancingState s) (ExceptT [Char] (ST s)) [()]
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) [()]
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$ (Either Posting Transaction
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> [Either Posting Transaction]
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) [()]
forall (f :: * -> *) a b. Monad f => (a -> f b) -> [a] -> f [b]
mapM' Either Posting Transaction
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall s. Either Posting Transaction -> Balancing s ()
balanceTransactionAndCheckAssertionsB ([Either Posting Transaction]
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) [()])
-> [Either Posting Transaction]
-> ReaderT (BalancingState s) (ExceptT [Char] (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 [Char] (ST s) [Transaction]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s [Transaction] -> ExceptT [Char] (ST s) [Transaction])
-> ST s [Transaction] -> ExceptT [Char] (ST s) [Transaction]
forall a b. (a -> b) -> a -> b
$ STArray s Integer Transaction -> ST s [Transaction]
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m [e]
getElems STArray s Integer Transaction
balancedtxns
Journal -> ExceptT [Char] (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 :: forall s. Either Posting Transaction -> Balancing s ()
balanceTransactionAndCheckAssertionsB (Left p :: Posting
p@Posting{}) =
ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Posting
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Posting
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> (Posting
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Posting)
-> Posting
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Posting
forall s. Posting -> Balancing s Posting
addAmountAndCheckAssertionB (Posting -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> Posting -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting -> Posting
postingStripPrices Posting
p
balanceTransactionAndCheckAssertionsB (Right t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps}) = do
(Posting -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> [Posting]
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Posting -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall s. Posting -> Balancing s ()
checkIllegalBalanceAssignmentB [Posting]
ps
[Posting]
ps' <- (Posting
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Posting)
-> [Posting]
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) [Posting]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Posting
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Posting
forall s. Posting -> Balancing s Posting
addOrAssignAmountAndCheckAssertionB (Posting
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Posting)
-> (Posting -> Posting)
-> Posting
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Posting
postingStripPrices) [Posting]
ps
Maybe (Map AccountName AmountStyle)
styles <- (BalancingState s -> Maybe (Map AccountName AmountStyle))
-> ReaderT
(BalancingState s)
(ExceptT [Char] (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 BalancingOpts
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
balanceTransactionHelper BalancingOpts
defbalancingopts{commodity_styles_ :: Maybe (Map AccountName AmountStyle)
commodity_styles_=Maybe (Map AccountName AmountStyle)
styles} Transaction
t{tpostings :: [Posting]
tpostings=[Posting]
ps'} of
Left [Char]
err -> [Char] -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [Char]
err
Right (Transaction
t', [(AccountName, MixedAmount)]
inferredacctsandamts) -> do
((AccountName, MixedAmount)
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) MixedAmount)
-> [(AccountName, MixedAmount)]
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((AccountName
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) MixedAmount)
-> (AccountName, MixedAmount)
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) MixedAmount
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AccountName
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB) [(AccountName, MixedAmount)]
inferredacctsandamts
Transaction
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall s. Transaction -> Balancing s ()
updateTransactionB Transaction
t'
addOrAssignAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addOrAssignAmountAndCheckAssertionB :: forall s. 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 [Char] (ST s)) Bool
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((BalancingState s -> Bool)
-> ReaderT (BalancingState s) (ExceptT [Char] (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 [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT [Char] (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
MixedAmount
newbal <- if Bool
batotal
then MixedAmount -> Balancing s MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return (MixedAmount -> Balancing s MixedAmount)
-> MixedAmount -> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ Amount -> MixedAmount
mixedAmount Amount
baamount
else 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
MixedAmount -> Balancing s MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return (MixedAmount -> Balancing s MixedAmount)
-> MixedAmount -> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> Amount -> MixedAmount
maAddAmount MixedAmount
oldbalothercommodities 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
let p' :: Posting
p' = Posting
p{pamount :: MixedAmount
pamount=(Amount -> Bool) -> MixedAmount -> MixedAmount
filterMixedAmount (Bool -> Bool
not (Bool -> Bool) -> (Amount -> Bool) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Bool
amountIsZero) 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 [Char] (ST s)) Bool
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((BalancingState s -> Bool)
-> ReaderT (BalancingState s) (ExceptT [Char] (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 [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT [Char] (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 :: forall s. Posting -> Balancing s Posting
addAmountAndCheckAssertionB 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) (MixedAmount -> Balancing s MixedAmount)
-> MixedAmount -> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Bool
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((BalancingState s -> Bool)
-> ReaderT (BalancingState s) (ExceptT [Char] (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 [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT [Char] (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 Posting
p = Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p
checkBalanceAssertionB :: Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB :: forall s. 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})} MixedAmount
actualbal =
[Amount]
-> (Amount
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Amount
baamount Amount -> [Amount] -> [Amount]
forall a. a -> [a] -> [a]
: [Amount]
otheramts) ((Amount -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> (Amount
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$ \Amount
amt -> Posting
-> Amount
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall s. Posting -> Amount -> MixedAmount -> Balancing s ()
checkBalanceAssertionOneCommodityB Posting
p Amount
amt MixedAmount
actualbal
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 (\Amount
a -> Amount
a{aquantity :: DecimalRaw Integer
aquantity=DecimalRaw Integer
0}) ([Amount] -> [Amount])
-> (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amountsRaw
(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 Posting
_ MixedAmount
_ = () -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkBalanceAssertionOneCommodityB :: Posting -> Amount -> MixedAmount -> Balancing s ()
checkBalanceAssertionOneCommodityB :: forall s. Posting -> Amount -> MixedAmount -> Balancing s ()
checkBalanceAssertionOneCommodityB p :: Posting
p@Posting{paccount :: Posting -> AccountName
paccount=AccountName
assertedacct} Amount
assertedamt 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
(\MixedAmount
ibal (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
$
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 -> MixedAmount -> MixedAmount
maPlus MixedAmount
ibal MixedAmount
amt else MixedAmount
ibal)
MixedAmount
nullmixedamt
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 Amount
nullamt ([Amount] -> Amount)
-> (MixedAmount -> [Amount]) -> MixedAmount -> Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amountsRaw (MixedAmount -> [Amount])
-> (MixedAmount -> MixedAmount) -> MixedAmount -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> MixedAmount -> MixedAmount
filterMixedAmountByCommodity AccountName
assertedcomm (MixedAmount -> Amount) -> MixedAmount -> Amount
forall a b. (a -> b) -> a -> b
$ MixedAmount
actualbal'
pass :: Bool
pass =
Amount -> DecimalRaw Integer
aquantity
Amount
assertedamt DecimalRaw Integer -> DecimalRaw Integer -> Bool
forall a. Eq a => a -> a -> Bool
==
Amount -> DecimalRaw Integer
aquantity
Amount
actualbalincomm
errmsg :: [Char]
errmsg = [Char]
-> [Char]
-> AccountName
-> [Char]
-> [Char]
-> AccountName
-> [Char]
-> [Char]
-> ShowS
forall r. PrintfType r => [Char] -> r
printf ([[Char]] -> [Char]
unlines
[ [Char]
"balance assertion: %s",
[Char]
"\nassertion details:",
[Char]
"date: %s",
[Char]
"account: %s%s",
[Char]
"commodity: %s",
[Char]
"calculated: %s",
[Char]
"asserted: %s",
[Char]
"difference: %s"
])
(case Posting -> Maybe Transaction
ptransaction Posting
p of
Maybe Transaction
Nothing -> [Char]
"?"
Just Transaction
t -> [Char] -> [Char] -> AccountName -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s\ntransaction:\n%s"
(SourcePos -> [Char]
showSourcePos SourcePos
pos)
(AccountName -> AccountName
textChomp (AccountName -> AccountName) -> AccountName -> AccountName
forall a b. (a -> b) -> a -> b
$ Transaction -> AccountName
showTransaction Transaction
t)
:: String
where
pos :: SourcePos
pos = BalanceAssertion -> SourcePos
baposition (BalanceAssertion -> SourcePos) -> BalanceAssertion -> SourcePos
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 -> AccountName
showDate (Day -> AccountName) -> Day -> AccountName
forall a b. (a -> b) -> a -> b
$ Posting -> Day
postingDate Posting
p)
(AccountName -> [Char]
T.unpack (AccountName -> [Char]) -> AccountName -> [Char]
forall a b. (a -> b) -> a -> b
$ Posting -> AccountName
paccount Posting
p)
(if Bool
isinclusive then [Char]
" (and subs)" else [Char]
"" :: String)
AccountName
assertedcomm
(DecimalRaw Integer -> [Char]
forall a. Show a => a -> [Char]
show (DecimalRaw Integer -> [Char]) -> DecimalRaw Integer -> [Char]
forall a b. (a -> b) -> a -> b
$ Amount -> DecimalRaw Integer
aquantity Amount
actualbalincomm)
(DecimalRaw Integer -> [Char]
forall a. Show a => a -> [Char]
show (DecimalRaw Integer -> [Char]) -> DecimalRaw Integer -> [Char]
forall a b. (a -> b) -> a -> b
$ Amount -> DecimalRaw Integer
aquantity Amount
assertedamt)
(DecimalRaw Integer -> [Char]
forall a. Show a => a -> [Char]
show (DecimalRaw Integer -> [Char]) -> DecimalRaw Integer -> [Char]
forall a b. (a -> b) -> a -> b
$ Amount -> DecimalRaw Integer
aquantity Amount
assertedamt DecimalRaw Integer -> DecimalRaw Integer -> DecimalRaw Integer
forall a. Num a => a -> a -> a
- Amount -> DecimalRaw Integer
aquantity Amount
actualbalincomm)
Bool -> Balancing s () -> Balancing s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
pass (Balancing s () -> Balancing s ())
-> Balancing s () -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Balancing s ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [Char]
errmsg
checkIllegalBalanceAssignmentB :: Posting -> Balancing s ()
checkIllegalBalanceAssignmentB :: forall s. Posting -> Balancing s ()
checkIllegalBalanceAssignmentB 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 :: forall s. Posting -> Balancing s ()
checkBalanceAssignmentPostingDateB Posting
p =
Bool
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST 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)) (ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$
[Char] -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> [Char] -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$ ShowS
chomp ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [
[Char]
"can't use balance assignment with custom posting date"
,[Char]
""
,ShowS
chomp1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ AccountName -> [Char]
T.unpack (AccountName -> [Char]) -> AccountName -> [Char]
forall a b. (a -> b) -> a -> b
$ AccountName
-> (Transaction -> AccountName) -> Maybe Transaction -> AccountName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([AccountName] -> AccountName
T.unlines ([AccountName] -> AccountName) -> [AccountName] -> AccountName
forall a b. (a -> b) -> a -> b
$ Posting -> [AccountName]
showPostingLines Posting
p) Transaction -> AccountName
showTransaction (Maybe Transaction -> AccountName)
-> Maybe Transaction -> AccountName
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
,[Char]
"Balance assignments may not be used on postings with a custom posting date"
,[Char]
"(it makes balancing the journal impossible)."
,[Char]
"Please write the posting amount explicitly (or remove the posting date)."
]
checkBalanceAssignmentUnassignableAccountB :: Posting -> Balancing s ()
checkBalanceAssignmentUnassignableAccountB :: forall s. Posting -> Balancing s ()
checkBalanceAssignmentUnassignableAccountB Posting
p = do
Set AccountName
unassignable <- (BalancingState s -> Set AccountName)
-> ReaderT
(BalancingState s) (ExceptT [Char] (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
$
[Char] -> Balancing s ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> Balancing s ()) -> [Char] -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ ShowS
chomp ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [
[Char]
"can't use balance assignment with auto postings"
,[Char]
""
,ShowS
chomp1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ AccountName -> [Char]
T.unpack (AccountName -> [Char]) -> AccountName -> [Char]
forall a b. (a -> b) -> a -> b
$ AccountName
-> (Transaction -> AccountName) -> Maybe Transaction -> AccountName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([AccountName] -> AccountName
T.unlines ([AccountName] -> AccountName) -> [AccountName] -> AccountName
forall a b. (a -> b) -> a -> b
$ Posting -> [AccountName]
showPostingLines Posting
p) (Transaction -> AccountName
showTransaction) (Maybe Transaction -> AccountName)
-> Maybe Transaction -> AccountName
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
,[Char]
"Balance assignments may not be used on accounts affected by auto posting rules"
,[Char]
"(it makes balancing the journal impossible)."
,[Char]
"Please write the posting amount explicitly (or remove the auto posting rule(s))."
]
makeHledgerClassyLenses ''BalancingOpts
tests_Balancing :: TestTree
tests_Balancing :: TestTree
tests_Balancing =
[Char] -> [TestTree] -> TestTree
testGroup [Char]
"Balancing" [
[Char] -> Assertion -> TestTree
testCase [Char]
"inferBalancingAmount" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
((Transaction, [(AccountName, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst ((Transaction, [(AccountName, MixedAmount)]) -> Transaction)
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
-> Either [Char] Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map AccountName AmountStyle
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
inferBalancingAmount Map AccountName AmountStyle
forall k a. Map k a
M.empty Transaction
nulltransaction) Either [Char] Transaction -> Either [Char] Transaction -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Transaction -> Either [Char] Transaction
forall a b. b -> Either a b
Right Transaction
nulltransaction
((Transaction, [(AccountName, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst ((Transaction, [(AccountName, MixedAmount)]) -> Transaction)
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
-> Either [Char] Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map AccountName AmountStyle
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
inferBalancingAmount Map AccountName AmountStyle
forall k a. Map k a
M.empty Transaction
nulltransaction{tpostings :: [Posting]
tpostings = [AccountName
"a" AccountName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
5), AccountName
"b" AccountName -> Amount -> Posting
`post` Amount
missingamt]}) Either [Char] Transaction -> Either [Char] Transaction -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
Transaction -> Either [Char] Transaction
forall a b. b -> Either a b
Right Transaction
nulltransaction{tpostings :: [Posting]
tpostings = [AccountName
"a" AccountName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
5), AccountName
"b" AccountName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
5]}
((Transaction, [(AccountName, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst ((Transaction, [(AccountName, MixedAmount)]) -> Transaction)
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
-> Either [Char] Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map AccountName AmountStyle
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
inferBalancingAmount Map AccountName AmountStyle
forall k a. Map k a
M.empty Transaction
nulltransaction{tpostings :: [Posting]
tpostings = [AccountName
"a" AccountName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
5), AccountName
"b" AccountName -> Amount -> Posting
`post` (DecimalRaw Integer -> Amount
eur DecimalRaw Integer
3 Amount -> Amount -> Amount
@@ DecimalRaw Integer -> Amount
usd DecimalRaw Integer
4), AccountName
"c" AccountName -> Amount -> Posting
`post` Amount
missingamt]}) Either [Char] Transaction -> Either [Char] Transaction -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
Transaction -> Either [Char] Transaction
forall a b. b -> Either a b
Right Transaction
nulltransaction{tpostings :: [Posting]
tpostings = [AccountName
"a" AccountName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
5), AccountName
"b" AccountName -> Amount -> Posting
`post` (DecimalRaw Integer -> Amount
eur DecimalRaw Integer
3 Amount -> Amount -> Amount
@@ DecimalRaw Integer -> Amount
usd DecimalRaw Integer
4), AccountName
"c" AccountName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1]}
, [Char] -> [TestTree] -> TestTree
testGroup [Char]
"balanceTransaction" [
[Char] -> Assertion -> TestTree
testCase [Char]
"detect unbalanced entry, sign error" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
Either [Char] Transaction -> Assertion
forall b a. (HasCallStack, Eq b, Show b) => Either a b -> Assertion
assertLeft
(BalancingOpts -> Transaction -> Either [Char] Transaction
balanceTransaction BalancingOpts
defbalancingopts
(Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
AccountName
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
AccountName
""
AccountName
"test"
AccountName
""
[]
[Posting
posting {paccount :: AccountName
paccount = AccountName
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1)}, Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1)}]))
,[Char] -> Assertion -> TestTree
testCase [Char]
"detect unbalanced entry, multiple missing amounts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
Either [Char] Transaction -> Assertion
forall b a. (HasCallStack, Eq b, Show b) => Either a b -> Assertion
assertLeft (Either [Char] Transaction -> Assertion)
-> Either [Char] Transaction -> Assertion
forall a b. (a -> b) -> a -> b
$
BalancingOpts -> Transaction -> Either [Char] Transaction
balanceTransaction BalancingOpts
defbalancingopts
(Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
AccountName
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
AccountName
""
AccountName
"test"
AccountName
""
[]
[ Posting
posting {paccount :: AccountName
paccount = AccountName
"a", pamount :: MixedAmount
pamount = MixedAmount
missingmixedamt}
, Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = MixedAmount
missingmixedamt}
])
,[Char] -> Assertion -> TestTree
testCase [Char]
"one missing amount is inferred" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
(Posting -> MixedAmount
pamount (Posting -> MixedAmount)
-> (Transaction -> Posting) -> Transaction -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Posting] -> Posting
forall a. [a] -> a
last ([Posting] -> Posting)
-> (Transaction -> [Posting]) -> Transaction -> Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings (Transaction -> MixedAmount)
-> Either [Char] Transaction -> Either [Char] MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
BalancingOpts -> Transaction -> Either [Char] Transaction
balanceTransaction BalancingOpts
defbalancingopts
(Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
AccountName
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
AccountName
""
AccountName
""
AccountName
""
[]
[Posting
posting {paccount :: AccountName
paccount = AccountName
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1)}, Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = MixedAmount
missingmixedamt}])) Either [Char] MixedAmount -> Either [Char] MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
MixedAmount -> Either [Char] MixedAmount
forall a b. b -> Either a b
Right (Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1))
,[Char] -> Assertion -> TestTree
testCase [Char]
"conversion price is inferred" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
(Posting -> MixedAmount
pamount (Posting -> MixedAmount)
-> (Transaction -> Posting) -> Transaction -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Posting] -> Posting
forall a. [a] -> a
head ([Posting] -> Posting)
-> (Transaction -> [Posting]) -> Transaction -> Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings (Transaction -> MixedAmount)
-> Either [Char] Transaction -> Either [Char] MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
BalancingOpts -> Transaction -> Either [Char] Transaction
balanceTransaction BalancingOpts
defbalancingopts
(Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
AccountName
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
AccountName
""
AccountName
""
AccountName
""
[]
[ Posting
posting {paccount :: AccountName
paccount = AccountName
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1.35)}
, Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
eur (-DecimalRaw Integer
1))}
])) Either [Char] MixedAmount -> Either [Char] MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
MixedAmount -> Either [Char] MixedAmount
forall a b. b -> Either a b
Right (Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1.35 Amount -> Amount -> Amount
@@ DecimalRaw Integer -> Amount
eur DecimalRaw Integer
1)
,[Char] -> Assertion -> TestTree
testCase [Char]
"balanceTransaction balances based on cost if there are unit prices" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
Either [Char] Transaction -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either [Char] Transaction -> Assertion)
-> Either [Char] Transaction -> Assertion
forall a b. (a -> b) -> a -> b
$
BalancingOpts -> Transaction -> Either [Char] Transaction
balanceTransaction BalancingOpts
defbalancingopts
(Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
AccountName
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2011 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
AccountName
""
AccountName
""
AccountName
""
[]
[ Posting
posting {paccount :: AccountName
paccount = AccountName
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1 Amount -> Amount -> Amount
`at` DecimalRaw Integer -> Amount
eur DecimalRaw Integer
2}
, Posting
posting {paccount :: AccountName
paccount = AccountName
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
2) Amount -> Amount -> Amount
`at` DecimalRaw Integer -> Amount
eur DecimalRaw Integer
1}
])
,[Char] -> Assertion -> TestTree
testCase [Char]
"balanceTransaction balances based on cost if there are total prices" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
Either [Char] Transaction -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either [Char] Transaction -> Assertion)
-> Either [Char] Transaction -> Assertion
forall a b. (a -> b) -> a -> b
$
BalancingOpts -> Transaction -> Either [Char] Transaction
balanceTransaction BalancingOpts
defbalancingopts
(Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
AccountName
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2011 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
AccountName
""
AccountName
""
AccountName
""
[]
[ Posting
posting {paccount :: AccountName
paccount = AccountName
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1 Amount -> Amount -> Amount
@@ DecimalRaw Integer -> Amount
eur DecimalRaw Integer
1}
, Posting
posting {paccount :: AccountName
paccount = AccountName
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
2) Amount -> Amount -> Amount
@@ DecimalRaw Integer -> Amount
eur (-DecimalRaw Integer
1)}
])
]
, [Char] -> [TestTree] -> TestTree
testGroup [Char]
"isTransactionBalanced" [
[Char] -> Assertion -> TestTree
testCase [Char]
"detect balanced" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
defbalancingopts (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
AccountName
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
AccountName
""
AccountName
"a"
AccountName
""
[]
[ Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1.00)}
, Posting
posting {paccount :: AccountName
paccount = AccountName
"c", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1.00))}
]
,[Char] -> Assertion -> TestTree
testCase [Char]
"detect unbalanced" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
defbalancingopts (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
AccountName
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
AccountName
""
AccountName
"a"
AccountName
""
[]
[ Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1.00)}
, Posting
posting {paccount :: AccountName
paccount = AccountName
"c", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1.01))}
]
,[Char] -> Assertion -> TestTree
testCase [Char]
"detect unbalanced, one posting" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
defbalancingopts (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
AccountName
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
AccountName
""
AccountName
"a"
AccountName
""
[]
[Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1.00)}]
,[Char] -> Assertion -> TestTree
testCase [Char]
"one zero posting is considered balanced for now" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
defbalancingopts (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
AccountName
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
AccountName
""
AccountName
"a"
AccountName
""
[]
[Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
0)}]
,[Char] -> Assertion -> TestTree
testCase [Char]
"virtual postings don't need to balance" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
defbalancingopts (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
AccountName
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
AccountName
""
AccountName
"a"
AccountName
""
[]
[ Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1.00)}
, Posting
posting {paccount :: AccountName
paccount = AccountName
"c", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1.00))}
, Posting
posting {paccount :: AccountName
paccount = AccountName
"d", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
100), ptype :: PostingType
ptype = PostingType
VirtualPosting}
]
,[Char] -> Assertion -> TestTree
testCase [Char]
"balanced virtual postings need to balance among themselves" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
defbalancingopts (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
AccountName
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
AccountName
""
AccountName
"a"
AccountName
""
[]
[ Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1.00)}
, Posting
posting {paccount :: AccountName
paccount = AccountName
"c", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1.00))}
, Posting
posting {paccount :: AccountName
paccount = AccountName
"d", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
100), ptype :: PostingType
ptype = PostingType
BalancedVirtualPosting}
]
,[Char] -> Assertion -> TestTree
testCase [Char]
"balanced virtual postings need to balance among themselves (2)" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
defbalancingopts (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
AccountName
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
AccountName
""
AccountName
"a"
AccountName
""
[]
[ Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1.00)}
, Posting
posting {paccount :: AccountName
paccount = AccountName
"c", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1.00))}
, Posting
posting {paccount :: AccountName
paccount = AccountName
"d", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
100), ptype :: PostingType
ptype = PostingType
BalancedVirtualPosting}
, Posting
posting {paccount :: AccountName
paccount = AccountName
"3", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
100)), ptype :: PostingType
ptype = PostingType
BalancedVirtualPosting}
]
]
,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"journalBalanceTransactions" [
[Char] -> Assertion -> TestTree
testCase [Char]
"missing-amounts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
let ej :: Either [Char] Journal
ej = BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either [Char] Journal)
-> Journal -> Either [Char] Journal
forall a b. (a -> b) -> a -> b
$ Bool -> Journal
samplejournalMaybeExplicit Bool
False
Either [Char] Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight Either [Char] Journal
ej
Journal -> [Posting]
journalPostings (Journal -> [Posting])
-> Either [Char] Journal -> Either [Char] [Posting]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either [Char] Journal
ej Either [Char] [Posting] -> Either [Char] [Posting] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Posting] -> Either [Char] [Posting]
forall a b. b -> Either a b
Right (Journal -> [Posting]
journalPostings Journal
samplejournal)
,[Char] -> Assertion -> TestTree
testCase [Char]
"balance-assignment" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
let ej :: Either [Char] Journal
ej = BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either [Char] Journal)
-> Journal -> Either [Char] Journal
forall a b. (a -> b) -> a -> b
$
Journal
nulljournal{ jtxns :: [Transaction]
jtxns = [
Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' AccountName
"a" Amount
missingamt (Amount -> Maybe BalanceAssertion
balassert (DecimalRaw Integer -> Amount
num DecimalRaw Integer
1)) ]
]}
Either [Char] Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight Either [Char] Journal
ej
case Either [Char] Journal
ej of Right Journal
j -> (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 -> [Amount]) -> [Amount]
forall a b. a -> (a -> b) -> b
& MixedAmount -> [Amount]
amountsRaw) [Amount] -> [Amount] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [DecimalRaw Integer -> Amount
num DecimalRaw Integer
1]
Left [Char]
_ -> [Char] -> Assertion
forall a. [Char] -> a
error' [Char]
"balance-assignment test: shouldn't happen"
,[Char] -> Assertion -> TestTree
testCase [Char]
"same-day-1" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
Either [Char] Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either [Char] Journal -> Assertion)
-> Either [Char] Journal -> Assertion
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either [Char] Journal)
-> Journal -> Either [Char] Journal
forall a b. (a -> b) -> a -> b
$
Journal
nulljournal{ jtxns :: [Transaction]
jtxns = [
Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' AccountName
"a" Amount
missingamt (Amount -> Maybe BalanceAssertion
balassert (DecimalRaw Integer -> Amount
num DecimalRaw Integer
1)) ]
,Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' AccountName
"a" (DecimalRaw Integer -> Amount
num DecimalRaw Integer
1) (Amount -> Maybe BalanceAssertion
balassert (DecimalRaw Integer -> Amount
num DecimalRaw Integer
2)) ]
]}
,[Char] -> Assertion -> TestTree
testCase [Char]
"same-day-2" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
Either [Char] Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either [Char] Journal -> Assertion)
-> Either [Char] Journal -> Assertion
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either [Char] Journal)
-> Journal -> Either [Char] Journal
forall a b. (a -> b) -> a -> b
$
Journal
nulljournal{ jtxns :: [Transaction]
jtxns = [
Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' AccountName
"a" (DecimalRaw Integer -> Amount
num DecimalRaw Integer
2) (Amount -> Maybe BalanceAssertion
balassert (DecimalRaw Integer -> Amount
num DecimalRaw Integer
2)) ]
,Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [
AccountName -> Amount -> Maybe BalanceAssertion -> Posting
post' AccountName
"b" (DecimalRaw Integer -> Amount
num DecimalRaw Integer
1) Maybe BalanceAssertion
forall a. Maybe a
Nothing
,AccountName -> Amount -> Maybe BalanceAssertion -> Posting
post' AccountName
"a" Amount
missingamt Maybe BalanceAssertion
forall a. Maybe a
Nothing
]
,Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
post' AccountName
"a" (DecimalRaw Integer -> Amount
num DecimalRaw Integer
0) (Amount -> Maybe BalanceAssertion
balassert (DecimalRaw Integer -> Amount
num DecimalRaw Integer
1)) ]
]}
,[Char] -> Assertion -> TestTree
testCase [Char]
"out-of-order" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
Either [Char] Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either [Char] Journal -> Assertion)
-> Either [Char] Journal -> Assertion
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either [Char] Journal)
-> Journal -> Either [Char] Journal
forall a b. (a -> b) -> a -> b
$
Journal
nulljournal{ jtxns :: [Transaction]
jtxns = [
Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
02) [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' AccountName
"a" (DecimalRaw Integer -> Amount
num DecimalRaw Integer
1) (Amount -> Maybe BalanceAssertion
balassert (DecimalRaw Integer -> Amount
num DecimalRaw Integer
2)) ]
,Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' AccountName
"a" (DecimalRaw Integer -> Amount
num DecimalRaw Integer
1) (Amount -> Maybe BalanceAssertion
balassert (DecimalRaw Integer -> Amount
num DecimalRaw Integer
1)) ]
]}
]
,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"commodityStylesFromAmounts" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$ [
[Char] -> Assertion -> TestTree
testCase [Char]
"1091a" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
[Amount] -> Either [Char] (Map AccountName AmountStyle)
commodityStylesFromAmounts [
Amount
nullamt{aquantity :: DecimalRaw Integer
aquantity=DecimalRaw Integer
1000, astyle :: AmountStyle
astyle=Side
-> Bool
-> AmountPrecision
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False (Word8 -> AmountPrecision
Precision Word8
3) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
',') Maybe DigitGroupStyle
forall a. Maybe a
Nothing}
,Amount
nullamt{aquantity :: DecimalRaw Integer
aquantity=DecimalRaw Integer
1000, astyle :: AmountStyle
astyle=Side
-> Bool
-> AmountPrecision
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False (Word8 -> AmountPrecision
Precision Word8
2) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.') (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3]))}
]
Either [Char] (Map AccountName AmountStyle)
-> Either [Char] (Map AccountName AmountStyle) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
Map AccountName AmountStyle
-> Either [Char] (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 [
(AccountName
"", Side
-> Bool
-> AmountPrecision
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False (Word8 -> AmountPrecision
Precision Word8
3) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.') (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3])))
])
,[Char] -> Assertion -> TestTree
testCase [Char]
"1091b" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
[Amount] -> Either [Char] (Map AccountName AmountStyle)
commodityStylesFromAmounts [
Amount
nullamt{aquantity :: DecimalRaw Integer
aquantity=DecimalRaw Integer
1000, astyle :: AmountStyle
astyle=Side
-> Bool
-> AmountPrecision
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False (Word8 -> AmountPrecision
Precision Word8
2) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.') (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3]))}
,Amount
nullamt{aquantity :: DecimalRaw Integer
aquantity=DecimalRaw Integer
1000, astyle :: AmountStyle
astyle=Side
-> Bool
-> AmountPrecision
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False (Word8 -> AmountPrecision
Precision Word8
3) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
',') Maybe DigitGroupStyle
forall a. Maybe a
Nothing}
]
Either [Char] (Map AccountName AmountStyle)
-> Either [Char] (Map AccountName AmountStyle) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
Map AccountName AmountStyle
-> Either [Char] (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 [
(AccountName
"", Side
-> Bool
-> AmountPrecision
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False (Word8 -> AmountPrecision
Precision Word8
3) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.') (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3])))
])
]
]