{-# 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 CommoditySymbol AmountStyle)
commodity_styles_ :: Maybe (M.Map CommoditySymbol AmountStyle)
} deriving (Int -> BalancingOpts -> ShowS
[BalancingOpts] -> ShowS
BalancingOpts -> String
(Int -> BalancingOpts -> ShowS)
-> (BalancingOpts -> String)
-> ([BalancingOpts] -> ShowS)
-> Show BalancingOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BalancingOpts] -> ShowS
$cshowList :: [BalancingOpts] -> ShowS
show :: BalancingOpts -> String
$cshow :: BalancingOpts -> String
showsPrec :: Int -> BalancingOpts -> ShowS
$cshowsPrec :: Int -> BalancingOpts -> ShowS
Show)
defbalancingopts :: BalancingOpts
defbalancingopts :: BalancingOpts
defbalancingopts = BalancingOpts :: Bool
-> Bool -> Maybe (Map CommoditySymbol AmountStyle) -> BalancingOpts
BalancingOpts
{ ignore_assertions_ :: Bool
ignore_assertions_ = Bool
False
, infer_transaction_prices_ :: Bool
infer_transaction_prices_ = Bool
True
, commodity_styles_ :: Maybe (Map CommoditySymbol AmountStyle)
commodity_styles_ = Maybe (Map CommoditySymbol AmountStyle)
forall a. Maybe a
Nothing
}
transactionCheckBalanced :: BalancingOpts -> Transaction -> [String]
transactionCheckBalanced :: BalancingOpts -> Transaction -> [String]
transactionCheckBalanced BalancingOpts{Maybe (Map CommoditySymbol AmountStyle)
commodity_styles_ :: Maybe (Map CommoditySymbol AmountStyle)
commodity_styles_ :: BalancingOpts -> Maybe (Map CommoditySymbol AmountStyle)
commodity_styles_} Transaction
t = [String]
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 CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount)
-> Maybe (Map CommoditySymbol AmountStyle)
-> MixedAmount
-> MixedAmount
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MixedAmount -> MixedAmount
forall a. a -> a
id Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
canonicaliseMixedAmount Maybe (Map CommoditySymbol 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 :: [String]
errs = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String
rmsg, String
bvmsg]
where
rmsg :: String
rmsg
| Bool
rsumok = String
""
| Bool -> Bool
not Bool
rsignsok = String
"real postings all have the same sign"
| Bool
otherwise = String
"real postings' sum should be 0 but is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ MixedAmount -> String
showMixedAmount MixedAmount
rsumcost
bvmsg :: String
bvmsg
| Bool
bvsumok = String
""
| Bool -> Bool
not Bool
bvsignsok = String
"balanced virtual postings all have the same sign"
| Bool
otherwise = String
"balanced virtual postings' sum should be 0 but is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ MixedAmount -> String
showMixedAmount MixedAmount
bvsumcost
isTransactionBalanced :: BalancingOpts -> Transaction -> Bool
isTransactionBalanced :: BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
bopts = [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool)
-> (Transaction -> [String]) -> Transaction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalancingOpts -> Transaction -> [String]
transactionCheckBalanced BalancingOpts
bopts
balanceTransaction ::
BalancingOpts
-> Transaction
-> Either String Transaction
balanceTransaction :: BalancingOpts -> Transaction -> Either String Transaction
balanceTransaction BalancingOpts
bopts = ((Transaction, [(CommoditySymbol, MixedAmount)]) -> Transaction)
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
-> Either String Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Transaction, [(CommoditySymbol, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst (Either String (Transaction, [(CommoditySymbol, MixedAmount)])
-> Either String Transaction)
-> (Transaction
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)]))
-> Transaction
-> Either String Transaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalancingOpts
-> Transaction
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
balanceTransactionHelper BalancingOpts
bopts
balanceTransactionHelper ::
BalancingOpts
-> Transaction
-> Either String (Transaction, [(AccountName, MixedAmount)])
balanceTransactionHelper :: BalancingOpts
-> Transaction
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
balanceTransactionHelper BalancingOpts
bopts Transaction
t = do
(Transaction
t', [(CommoditySymbol, MixedAmount)]
inferredamtsandaccts) <- Map CommoditySymbol AmountStyle
-> Transaction
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
inferBalancingAmount (Map CommoditySymbol AmountStyle
-> Maybe (Map CommoditySymbol AmountStyle)
-> Map CommoditySymbol AmountStyle
forall a. a -> Maybe a -> a
fromMaybe Map CommoditySymbol AmountStyle
forall k a. Map k a
M.empty (Maybe (Map CommoditySymbol AmountStyle)
-> Map CommoditySymbol AmountStyle)
-> Maybe (Map CommoditySymbol AmountStyle)
-> Map CommoditySymbol AmountStyle
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Maybe (Map CommoditySymbol AmountStyle)
commodity_styles_ BalancingOpts
bopts) (Transaction
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)]))
-> Transaction
-> Either String (Transaction, [(CommoditySymbol, 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 -> [String]
transactionCheckBalanced BalancingOpts
bopts Transaction
t' of
[] -> (Transaction, [(CommoditySymbol, MixedAmount)])
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall a b. b -> Either a b
Right (Transaction -> Transaction
txnTieKnot Transaction
t', [(CommoditySymbol, MixedAmount)]
inferredamtsandaccts)
[String]
errs -> String
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall a b. a -> Either a b
Left (String
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)]))
-> String
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall a b. (a -> b) -> a -> b
$ Transaction -> [String] -> String
transactionBalanceError Transaction
t' [String]
errs
transactionBalanceError :: Transaction -> [String] -> String
transactionBalanceError :: Transaction -> [String] -> String
transactionBalanceError Transaction
t [String]
errs =
Transaction -> ShowS
annotateErrorWithTransaction Transaction
t ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"could not balance this transaction:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
errs
annotateErrorWithTransaction :: Transaction -> String -> String
annotateErrorWithTransaction :: Transaction -> ShowS
annotateErrorWithTransaction Transaction
t String
s =
[String] -> String
unlines [ (SourcePos, SourcePos) -> String
showSourcePosPair ((SourcePos, SourcePos) -> String)
-> (SourcePos, SourcePos) -> String
forall a b. (a -> b) -> a -> b
$ Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t, String
s
, CommoditySymbol -> String
T.unpack (CommoditySymbol -> String)
-> (CommoditySymbol -> CommoditySymbol)
-> CommoditySymbol
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommoditySymbol -> CommoditySymbol
T.stripEnd (CommoditySymbol -> String) -> CommoditySymbol -> String
forall a b. (a -> b) -> a -> b
$ Transaction -> CommoditySymbol
showTransaction Transaction
t
]
inferBalancingAmount ::
M.Map CommoditySymbol AmountStyle
-> Transaction
-> Either String (Transaction, [(AccountName, MixedAmount)])
inferBalancingAmount :: Map CommoditySymbol AmountStyle
-> Transaction
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
inferBalancingAmount Map CommoditySymbol 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
= String
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall a b. a -> Either a b
Left (String
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)]))
-> String
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall a b. (a -> b) -> a -> b
$ Transaction -> [String] -> String
transactionBalanceError Transaction
t
[String
"can't have more than one real posting with no amount"
,String
"(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
= String
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall a b. a -> Either a b
Left (String
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)]))
-> String
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall a b. (a -> b) -> a -> b
$ Transaction -> [String] -> String
transactionBalanceError Transaction
t
[String
"can't have more than one balanced virtual posting with no amount"
,String
"(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 :: [(CommoditySymbol, MixedAmount)]
inferredacctsandamts = [(Posting -> CommoditySymbol
paccount Posting
p, MixedAmount
amt) | (Posting
p, Just MixedAmount
amt) <- [(Posting, Maybe MixedAmount)]
psandinferredamts]
in (Transaction, [(CommoditySymbol, MixedAmount)])
-> Either String (Transaction, [(CommoditySymbol, 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}, [(CommoditySymbol, 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 CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
styleMixedAmount Map CommoditySymbol 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 :: [CommoditySymbol]
pcommodities = (Amount -> CommoditySymbol) -> [Amount] -> [CommoditySymbol]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> CommoditySymbol
acommodity ([Amount] -> [CommoditySymbol]) -> [Amount] -> [CommoditySymbol]
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
$ (CommoditySymbol -> Maybe (Amount, Amount))
-> [CommoditySymbol] -> [Maybe (Amount, Amount)]
forall a b. (a -> b) -> [a] -> [b]
map CommoditySymbol -> Maybe (Amount, Amount)
orderIfMatches [CommoditySymbol]
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 = Quantity -> Quantity
forall a. Num a => a -> a
signum (Amount -> Quantity
aquantity Amount
a) Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
/= Quantity -> Quantity
forall a. Num a => a -> a
signum (Amount -> Quantity
aquantity Amount
b)
orderIfMatches :: CommoditySymbol -> Maybe (Amount, Amount)
orderIfMatches CommoditySymbol
x | CommoditySymbol
x CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> CommoditySymbol
acommodity Amount
a = (Amount, Amount) -> Maybe (Amount, Amount)
forall a. a -> Maybe a
Just (Amount
a,Amount
b)
| CommoditySymbol
x CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> CommoditySymbol
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 -> CommoditySymbol
acommodity Amount
a CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> CommoditySymbol
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 (CommoditySymbol -> Bool) -> [CommoditySymbol] -> [CommoditySymbol]
forall a. (a -> Bool) -> [a] -> [a]
filter (CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> CommoditySymbol
acommodity Amount
fromamount) [CommoditySymbol]
pcommodities of
[CommoditySymbol
_] -> 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
[CommoditySymbol]
_ -> 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 -> Quantity
aquantity Amount
fromamount Quantity -> 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 p. (Ord p, Num p, Bounded p) => p -> p -> p
saturatedAdd Word8
a Word8
b
(AmountPrecision, AmountPrecision)
_ -> AmountPrecision
NaturalPrecision
saturatedAdd :: p -> p -> p
saturatedAdd p
a p
b = if p
forall a. Bounded a => a
maxBound p -> p -> p
forall a. Num a => a -> a -> a
- p
a p -> p -> Bool
forall a. Ord a => a -> a -> Bool
< p
b then p
forall a. Bounded a => a
maxBound else p
a p -> p -> p
forall a. Num a => a -> a -> a
+ p
b
journalCheckBalanceAssertions :: Journal -> Maybe String
journalCheckBalanceAssertions :: Journal -> Maybe String
journalCheckBalanceAssertions = (String -> Maybe String)
-> (Journal -> Maybe String)
-> Either String Journal
-> Maybe String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Maybe String
forall a. a -> Maybe a
Just (Maybe String -> Journal -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing) (Either String Journal -> Maybe String)
-> (Journal -> Either String Journal) -> Journal -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions BalancingOpts
defbalancingopts
type Balancing s = ReaderT (BalancingState s) (ExceptT String (ST s))
data BalancingState s = BalancingState {
BalancingState s -> Maybe (Map CommoditySymbol AmountStyle)
bsStyles :: Maybe (M.Map CommoditySymbol AmountStyle)
,BalancingState s -> Set CommoditySymbol
bsUnassignable :: S.Set AccountName
,BalancingState s -> Bool
bsAssrt :: Bool
,BalancingState s -> HashTable s CommoditySymbol MixedAmount
bsBalances :: H.HashTable s AccountName MixedAmount
,BalancingState s -> STArray s Integer Transaction
bsTransactions :: STArray s Integer Transaction
}
withRunningBalance :: (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance :: (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance BalancingState s -> ST s a
f = ReaderT
(BalancingState s) (ExceptT String (ST s)) (BalancingState s)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT
(BalancingState s) (ExceptT String (ST s)) (BalancingState s)
-> (BalancingState s -> Balancing s a) -> Balancing s a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExceptT String (ST s) a -> Balancing s a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT String (ST s) a -> Balancing s a)
-> (BalancingState s -> ExceptT String (ST s) a)
-> BalancingState s
-> Balancing s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST s a -> ExceptT String (ST s) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s a -> ExceptT String (ST s) a)
-> (BalancingState s -> ST s a)
-> BalancingState s
-> ExceptT String (ST s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalancingState s -> ST s a
f
getRunningBalanceB :: AccountName -> Balancing s MixedAmount
getRunningBalanceB :: CommoditySymbol -> Balancing s MixedAmount
getRunningBalanceB CommoditySymbol
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 CommoditySymbol MixedAmount
bsBalances :: HashTable s CommoditySymbol MixedAmount
bsBalances :: forall s.
BalancingState s -> HashTable s CommoditySymbol 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 CommoditySymbol MixedAmount
-> CommoditySymbol -> 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 CommoditySymbol MixedAmount
bsBalances CommoditySymbol
acc
addToRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB :: CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB CommoditySymbol
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 CommoditySymbol MixedAmount
bsBalances :: HashTable s CommoditySymbol MixedAmount
bsBalances :: forall s.
BalancingState s -> HashTable s CommoditySymbol 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 CommoditySymbol MixedAmount
-> CommoditySymbol -> 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 CommoditySymbol MixedAmount
bsBalances CommoditySymbol
acc
let new :: MixedAmount
new = MixedAmount -> MixedAmount -> MixedAmount
maPlus MixedAmount
old MixedAmount
amt
HashTable s CommoditySymbol MixedAmount
-> CommoditySymbol -> MixedAmount -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s CommoditySymbol MixedAmount
bsBalances CommoditySymbol
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 :: CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
setRunningBalanceB CommoditySymbol
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 CommoditySymbol MixedAmount
bsBalances :: HashTable s CommoditySymbol MixedAmount
bsBalances :: forall s.
BalancingState s -> HashTable s CommoditySymbol 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 CommoditySymbol MixedAmount
-> CommoditySymbol -> 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 CommoditySymbol MixedAmount
bsBalances CommoditySymbol
acc
HashTable s CommoditySymbol MixedAmount
-> CommoditySymbol -> MixedAmount -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s CommoditySymbol MixedAmount
bsBalances CommoditySymbol
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 :: CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
setInclusiveRunningBalanceB CommoditySymbol
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 CommoditySymbol MixedAmount
bsBalances :: HashTable s CommoditySymbol MixedAmount
bsBalances :: forall s.
BalancingState s -> HashTable s CommoditySymbol 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 CommoditySymbol MixedAmount
-> CommoditySymbol -> 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 CommoditySymbol MixedAmount
bsBalances CommoditySymbol
acc
[(CommoditySymbol, MixedAmount)]
allebals <- HashTable s CommoditySymbol MixedAmount
-> ST s [(CommoditySymbol, MixedAmount)]
forall (h :: * -> * -> * -> *) s k v.
HashTable h =>
h s k v -> ST s [(k, v)]
H.toList HashTable s CommoditySymbol MixedAmount
bsBalances
let subsibal :: MixedAmount
subsibal =
[MixedAmount] -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum ([MixedAmount] -> MixedAmount)
-> ([(CommoditySymbol, MixedAmount)] -> [MixedAmount])
-> [(CommoditySymbol, MixedAmount)]
-> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CommoditySymbol, MixedAmount) -> MixedAmount)
-> [(CommoditySymbol, MixedAmount)] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (CommoditySymbol, MixedAmount) -> MixedAmount
forall a b. (a, b) -> b
snd ([(CommoditySymbol, MixedAmount)] -> MixedAmount)
-> [(CommoditySymbol, MixedAmount)] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ ((CommoditySymbol, MixedAmount) -> Bool)
-> [(CommoditySymbol, MixedAmount)]
-> [(CommoditySymbol, MixedAmount)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CommoditySymbol
acc CommoditySymbol -> CommoditySymbol -> Bool
`isAccountNamePrefixOf`)(CommoditySymbol -> Bool)
-> ((CommoditySymbol, MixedAmount) -> CommoditySymbol)
-> (CommoditySymbol, MixedAmount)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CommoditySymbol, MixedAmount) -> CommoditySymbol
forall a b. (a, b) -> a
fst) [(CommoditySymbol, MixedAmount)]
allebals
let newebal :: MixedAmount
newebal = MixedAmount -> MixedAmount -> MixedAmount
maMinus MixedAmount
newibal MixedAmount
subsibal
HashTable s CommoditySymbol MixedAmount
-> CommoditySymbol -> MixedAmount -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s CommoditySymbol MixedAmount
bsBalances CommoditySymbol
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 :: 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 String 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 CommoditySymbol AmountStyle)
styles = Map CommoditySymbol AmountStyle
-> Maybe (Map CommoditySymbol AmountStyle)
forall a. a -> Maybe a
Just (Map CommoditySymbol AmountStyle
-> Maybe (Map CommoditySymbol AmountStyle))
-> Map CommoditySymbol AmountStyle
-> Maybe (Map CommoditySymbol AmountStyle)
forall a b. (a -> b) -> a -> b
$ Journal -> Map CommoditySymbol AmountStyle
journalCommodityStyles Journal
j
bopts :: BalancingOpts
bopts = BalancingOpts
bopts'{commodity_styles_ :: Maybe (Map CommoditySymbol AmountStyle)
commodity_styles_=Maybe (Map CommoditySymbol AmountStyle)
styles}
txnmodifieraccts :: Set CommoditySymbol
txnmodifieraccts = [CommoditySymbol] -> Set CommoditySymbol
forall a. Ord a => [a] -> Set a
S.fromList ([CommoditySymbol] -> Set CommoditySymbol)
-> ([TransactionModifier] -> [CommoditySymbol])
-> [TransactionModifier]
-> Set CommoditySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TMPostingRule -> CommoditySymbol)
-> [TMPostingRule] -> [CommoditySymbol]
forall a b. (a -> b) -> [a] -> [b]
map (Posting -> CommoditySymbol
paccount (Posting -> CommoditySymbol)
-> (TMPostingRule -> Posting) -> TMPostingRule -> CommoditySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMPostingRule -> Posting
tmprPosting) ([TMPostingRule] -> [CommoditySymbol])
-> ([TransactionModifier] -> [TMPostingRule])
-> [TransactionModifier]
-> [CommoditySymbol]
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 CommoditySymbol)
-> [TransactionModifier] -> Set CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Journal -> [TransactionModifier]
jtxnmodifiers Journal
j
in
(forall s. ST s (Either String Journal)) -> Either String Journal
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Either String Journal)) -> Either String Journal)
-> (forall s. ST s (Either String Journal))
-> Either String Journal
forall a b. (a -> b) -> a -> b
$ do
STArray s 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 String (ST s) Journal -> ST s (Either String Journal)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String (ST s) Journal -> ST s (Either String Journal))
-> ExceptT String (ST s) Journal -> ST s (Either String Journal)
forall a b. (a -> b) -> a -> b
$ do
[Either Posting Transaction]
psandts :: [Either Posting Transaction] <- ([[Either Posting Transaction]] -> [Either Posting Transaction])
-> ExceptT String (ST s) [[Either Posting Transaction]]
-> ExceptT String (ST s) [Either Posting Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Either Posting Transaction]] -> [Either Posting Transaction]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ExceptT String (ST s) [[Either Posting Transaction]]
-> ExceptT String (ST s) [Either Posting Transaction])
-> ExceptT String (ST s) [[Either Posting Transaction]]
-> ExceptT String (ST s) [Either Posting Transaction]
forall a b. (a -> b) -> a -> b
$ [Transaction]
-> (Transaction
-> ExceptT String (ST s) [Either Posting Transaction])
-> ExceptT String (ST s) [[Either Posting Transaction]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Transaction]
ts ((Transaction
-> ExceptT String (ST s) [Either Posting Transaction])
-> ExceptT String (ST s) [[Either Posting Transaction]])
-> (Transaction
-> ExceptT String (ST s) [Either Posting Transaction])
-> ExceptT String (ST s) [[Either Posting Transaction]]
forall a b. (a -> b) -> a -> b
$ \case
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 String Transaction
balanceTransaction BalancingOpts
bopts Transaction
t of
Left String
e -> String -> ExceptT String (ST s) [Either Posting Transaction]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
e
Right Transaction
t' -> do
ST s () -> ExceptT String (ST s) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s () -> ExceptT String (ST s) ())
-> ST s () -> ExceptT String (ST s) ()
forall a b. (a -> b) -> a -> b
$ STArray s 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 String (ST s) [Either Posting Transaction]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either Posting Transaction]
-> ExceptT String (ST s) [Either Posting Transaction])
-> [Either Posting Transaction]
-> ExceptT String (ST s) [Either Posting Transaction]
forall a b. (a -> b) -> a -> b
$ (Posting -> Either Posting Transaction)
-> [Posting] -> [Either Posting Transaction]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Either Posting Transaction
forall a b. a -> Either a b
Left ([Posting] -> [Either Posting Transaction])
-> [Posting] -> [Either Posting Transaction]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t'
Transaction
t -> [Either Posting Transaction]
-> ExceptT String (ST s) [Either Posting Transaction]
forall (m :: * -> *) a. Monad m => a -> m a
return [Transaction -> Either Posting Transaction
forall a b. b -> Either a b
Right Transaction
t]
HashTable s CommoditySymbol MixedAmount
runningbals <- ST s (HashTable s CommoditySymbol MixedAmount)
-> ExceptT String (ST s) (HashTable s CommoditySymbol MixedAmount)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s (HashTable s CommoditySymbol MixedAmount)
-> ExceptT String (ST s) (HashTable s CommoditySymbol MixedAmount))
-> ST s (HashTable s CommoditySymbol MixedAmount)
-> ExceptT String (ST s) (HashTable s CommoditySymbol MixedAmount)
forall a b. (a -> b) -> a -> b
$ Int -> ST s (HashTable s CommoditySymbol MixedAmount)
forall s k v. Int -> ST s (HashTable s k v)
H.newSized ([CommoditySymbol] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([CommoditySymbol] -> Int) -> [CommoditySymbol] -> Int
forall a b. (a -> b) -> a -> b
$ Journal -> [CommoditySymbol]
journalAccountNamesUsed Journal
j)
(ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> BalancingState s -> ExceptT String (ST s) ())
-> BalancingState s
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ExceptT String (ST s) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> BalancingState s -> ExceptT String (ST s) ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Maybe (Map CommoditySymbol AmountStyle)
-> Set CommoditySymbol
-> Bool
-> HashTable s CommoditySymbol MixedAmount
-> STArray s Integer Transaction
-> BalancingState s
forall s.
Maybe (Map CommoditySymbol AmountStyle)
-> Set CommoditySymbol
-> Bool
-> HashTable s CommoditySymbol MixedAmount
-> STArray s Integer Transaction
-> BalancingState s
BalancingState Maybe (Map CommoditySymbol AmountStyle)
styles Set CommoditySymbol
txnmodifieraccts (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Bool
ignore_assertions_ BalancingOpts
bopts) HashTable s CommoditySymbol MixedAmount
runningbals STArray s Integer Transaction
balancedtxns) (ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ExceptT String (ST s) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ExceptT String (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
ReaderT (BalancingState s) (ExceptT String (ST s)) [()]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT (BalancingState s) (ExceptT String (ST s)) [()]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [()]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$ (Either Posting Transaction
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> [Either Posting Transaction]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [()]
forall (f :: * -> *) a b. Monad f => (a -> f b) -> [a] -> f [b]
mapM' Either Posting Transaction
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall s. Either Posting Transaction -> Balancing s ()
balanceTransactionAndCheckAssertionsB ([Either Posting Transaction]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [()])
-> [Either Posting Transaction]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [()]
forall a b. (a -> b) -> a -> b
$ (Either Posting Transaction -> Day)
-> [Either Posting Transaction] -> [Either Posting Transaction]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((Posting -> Day)
-> (Transaction -> Day) -> Either Posting Transaction -> Day
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Posting -> Day
postingDate Transaction -> Day
tdate) [Either Posting Transaction]
psandts
[Transaction]
ts' <- ST s [Transaction] -> ExceptT String (ST s) [Transaction]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s [Transaction] -> ExceptT String (ST s) [Transaction])
-> ST s [Transaction] -> ExceptT String (ST s) [Transaction]
forall a b. (a -> b) -> a -> b
$ STArray s 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 String (ST s) Journal
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
j{jtxns :: [Transaction]
jtxns=[Transaction]
ts'}
balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing s ()
balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing s ()
balanceTransactionAndCheckAssertionsB (Left p :: Posting
p@Posting{}) =
ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
-> Balancing s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
-> Balancing s ())
-> (Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting)
-> Posting
-> Balancing s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
forall s. Posting -> Balancing s Posting
addAmountAndCheckAssertionB (Posting -> Balancing s ()) -> Posting -> Balancing 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 -> Balancing s ()) -> [Posting] -> Balancing s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Posting -> Balancing s ()
forall s. Posting -> Balancing s ()
checkIllegalBalanceAssignmentB [Posting]
ps
[Posting]
ps' <- (Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting)
-> [Posting]
-> ReaderT (BalancingState s) (ExceptT String (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 String (ST s)) Posting
forall s. Posting -> Balancing s Posting
addOrAssignAmountAndCheckAssertionB (Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting)
-> (Posting -> Posting)
-> Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Posting
postingStripPrices) [Posting]
ps
Maybe (Map CommoditySymbol AmountStyle)
styles <- (BalancingState s -> Maybe (Map CommoditySymbol AmountStyle))
-> ReaderT
(BalancingState s)
(ExceptT String (ST s))
(Maybe (Map CommoditySymbol AmountStyle))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Maybe (Map CommoditySymbol AmountStyle)
forall s.
BalancingState s -> Maybe (Map CommoditySymbol AmountStyle)
bsStyles
case BalancingOpts
-> Transaction
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
balanceTransactionHelper BalancingOpts
defbalancingopts{commodity_styles_ :: Maybe (Map CommoditySymbol AmountStyle)
commodity_styles_=Maybe (Map CommoditySymbol AmountStyle)
styles} Transaction
t{tpostings :: [Posting]
tpostings=[Posting]
ps'} of
Left String
err -> String -> Balancing s ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
err
Right (Transaction
t', [(CommoditySymbol, MixedAmount)]
inferredacctsandamts) -> do
((CommoditySymbol, MixedAmount)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) MixedAmount)
-> [(CommoditySymbol, MixedAmount)] -> Balancing s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((CommoditySymbol
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) MixedAmount)
-> (CommoditySymbol, MixedAmount)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) MixedAmount
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CommoditySymbol
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) MixedAmount
forall s. CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB) [(CommoditySymbol, MixedAmount)]
inferredacctsandamts
Transaction -> Balancing s ()
forall s. Transaction -> Balancing s ()
updateTransactionB Transaction
t'
addOrAssignAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addOrAssignAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addOrAssignAmountAndCheckAssertionB p :: Posting
p@Posting{paccount :: Posting -> CommoditySymbol
paccount=CommoditySymbol
acc, pamount :: Posting -> MixedAmount
pamount=MixedAmount
amt, pbalanceassertion :: Posting -> Maybe BalanceAssertion
pbalanceassertion=Maybe BalanceAssertion
mba}
| Posting -> Bool
hasAmount Posting
p = do
MixedAmount
newbal <- CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
forall s. CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB CommoditySymbol
acc MixedAmount
amt
ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((BalancingState s -> Bool)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Bool
forall s. BalancingState s -> Bool
bsAssrt) (ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall s. Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB Posting
p MixedAmount
newbal
Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p
| Just BalanceAssertion{Amount
baamount :: BalanceAssertion -> Amount
baamount :: Amount
baamount,Bool
batotal :: BalanceAssertion -> Bool
batotal :: Bool
batotal,Bool
bainclusive :: BalanceAssertion -> Bool
bainclusive :: Bool
bainclusive} <- Maybe BalanceAssertion
mba = do
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 -> CommoditySymbol
acommodity Amount
baamount CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
/=) (CommoditySymbol -> Bool)
-> (Amount -> CommoditySymbol) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> CommoditySymbol
acommodity) (MixedAmount -> MixedAmount)
-> Balancing s MixedAmount -> Balancing s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CommoditySymbol -> Balancing s MixedAmount
forall s. CommoditySymbol -> Balancing s MixedAmount
getRunningBalanceB CommoditySymbol
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 CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
forall s. CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
setInclusiveRunningBalanceB else CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
forall s. CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
setRunningBalanceB) CommoditySymbol
acc MixedAmount
newbal
let p' :: Posting
p' = Posting
p{pamount :: MixedAmount
pamount=MixedAmount
diff, poriginal :: Maybe Posting
poriginal=Posting -> Maybe Posting
forall a. a -> Maybe a
Just (Posting -> Maybe Posting) -> Posting -> Maybe Posting
forall a b. (a -> b) -> a -> b
$ Posting -> Posting
originalPosting Posting
p}
ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((BalancingState s -> Bool)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Bool
forall s. BalancingState s -> Bool
bsAssrt) (ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall s. Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB Posting
p' MixedAmount
newbal
Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p'
| Bool
otherwise = Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p
addAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addAmountAndCheckAssertionB Posting
p | Posting -> Bool
hasAmount Posting
p = do
MixedAmount
newbal <- CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
forall s. CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB (Posting -> CommoditySymbol
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 String (ST s)) Bool
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((BalancingState s -> Bool)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Bool
forall s. BalancingState s -> Bool
bsAssrt) (ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall s. Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB Posting
p MixedAmount
newbal
Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p
addAmountAndCheckAssertionB Posting
p = Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p
checkBalanceAssertionB :: Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB :: Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB p :: Posting
p@Posting{pbalanceassertion :: Posting -> Maybe BalanceAssertion
pbalanceassertion=Just (BalanceAssertion{Amount
baamount :: Amount
baamount :: BalanceAssertion -> Amount
baamount,Bool
batotal :: Bool
batotal :: BalanceAssertion -> Bool
batotal})} MixedAmount
actualbal =
[Amount] -> (Amount -> Balancing s ()) -> Balancing s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Amount
baamount Amount -> [Amount] -> [Amount]
forall a. a -> [a] -> [a]
: [Amount]
otheramts) ((Amount -> Balancing s ()) -> Balancing s ())
-> (Amount -> Balancing s ()) -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ \Amount
amt -> Posting -> Amount -> MixedAmount -> Balancing s ()
forall s. Posting -> Amount -> MixedAmount -> Balancing s ()
checkBalanceAssertionOneCommodityB Posting
p Amount
amt MixedAmount
actualbal
where
assertedcomm :: CommoditySymbol
assertedcomm = Amount -> CommoditySymbol
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 :: Quantity
aquantity=Quantity
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 ((CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
/=CommoditySymbol
assertedcomm)(CommoditySymbol -> Bool)
-> (Amount -> CommoditySymbol) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Amount -> CommoditySymbol
acommodity) MixedAmount
actualbal
| Bool
otherwise = []
checkBalanceAssertionB Posting
_ MixedAmount
_ = () -> Balancing s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkBalanceAssertionOneCommodityB :: Posting -> Amount -> MixedAmount -> Balancing s ()
checkBalanceAssertionOneCommodityB :: Posting -> Amount -> MixedAmount -> Balancing s ()
checkBalanceAssertionOneCommodityB p :: Posting
p@Posting{paccount :: Posting -> CommoditySymbol
paccount=CommoditySymbol
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 CommoditySymbol MixedAmount
bsBalances :: HashTable s CommoditySymbol MixedAmount
bsBalances :: forall s.
BalancingState s -> HashTable s CommoditySymbol MixedAmount
bsBalances} ->
(MixedAmount -> (CommoditySymbol, MixedAmount) -> ST s MixedAmount)
-> MixedAmount
-> HashTable s CommoditySymbol 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 (CommoditySymbol
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 CommoditySymbol
assertedacctCommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
==CommoditySymbol
acc Bool -> Bool -> Bool
|| CommoditySymbol
assertedacct CommoditySymbol -> CommoditySymbol -> Bool
`isAccountNamePrefixOf` CommoditySymbol
acc then MixedAmount -> MixedAmount -> MixedAmount
maPlus MixedAmount
ibal MixedAmount
amt else MixedAmount
ibal)
MixedAmount
nullmixedamt
HashTable s CommoditySymbol MixedAmount
bsBalances
else MixedAmount -> Balancing s MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return MixedAmount
actualbal
let
assertedcomm :: CommoditySymbol
assertedcomm = Amount -> CommoditySymbol
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
. CommoditySymbol -> MixedAmount -> MixedAmount
filterMixedAmountByCommodity CommoditySymbol
assertedcomm (MixedAmount -> Amount) -> MixedAmount -> Amount
forall a b. (a -> b) -> a -> b
$ MixedAmount
actualbal'
pass :: Bool
pass =
Amount -> Quantity
aquantity
Amount
assertedamt Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
==
Amount -> Quantity
aquantity
Amount
actualbalincomm
errmsg :: String
errmsg = String
-> String
-> CommoditySymbol
-> String
-> String
-> CommoditySymbol
-> String
-> String
-> ShowS
forall r. PrintfType r => String -> r
printf ([String] -> String
unlines
[ String
"balance assertion: %s",
String
"\nassertion details:",
String
"date: %s",
String
"account: %s%s",
String
"commodity: %s",
String
"calculated: %s",
String
"asserted: %s",
String
"difference: %s"
])
(case Posting -> Maybe Transaction
ptransaction Posting
p of
Maybe Transaction
Nothing -> String
"?"
Just Transaction
t -> String -> String -> CommoditySymbol -> String
forall r. PrintfType r => String -> r
printf String
"%s\ntransaction:\n%s"
(SourcePos -> String
showSourcePos SourcePos
pos)
(CommoditySymbol -> CommoditySymbol
textChomp (CommoditySymbol -> CommoditySymbol)
-> CommoditySymbol -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Transaction -> CommoditySymbol
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 -> CommoditySymbol
showDate (Day -> CommoditySymbol) -> Day -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Posting -> Day
postingDate Posting
p)
(CommoditySymbol -> String
T.unpack (CommoditySymbol -> String) -> CommoditySymbol -> String
forall a b. (a -> b) -> a -> b
$ Posting -> CommoditySymbol
paccount Posting
p)
(if Bool
isinclusive then String
" (and subs)" else String
"" :: String)
CommoditySymbol
assertedcomm
(Quantity -> String
forall a. Show a => a -> String
show (Quantity -> String) -> Quantity -> String
forall a b. (a -> b) -> a -> b
$ Amount -> Quantity
aquantity Amount
actualbalincomm)
(Quantity -> String
forall a. Show a => a -> String
show (Quantity -> String) -> Quantity -> String
forall a b. (a -> b) -> a -> b
$ Amount -> Quantity
aquantity Amount
assertedamt)
(Quantity -> String
forall a. Show a => a -> String
show (Quantity -> String) -> Quantity -> String
forall a b. (a -> b) -> a -> b
$ Amount -> Quantity
aquantity Amount
assertedamt Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
- Amount -> Quantity
aquantity Amount
actualbalincomm)
Bool -> Balancing s () -> Balancing s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
pass (Balancing s () -> Balancing s ())
-> Balancing s () -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ String -> Balancing s ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
errmsg
checkIllegalBalanceAssignmentB :: Posting -> Balancing s ()
checkIllegalBalanceAssignmentB :: Posting -> Balancing s ()
checkIllegalBalanceAssignmentB Posting
p = do
Posting -> Balancing s ()
forall s. Posting -> Balancing s ()
checkBalanceAssignmentPostingDateB Posting
p
Posting -> Balancing s ()
forall s. Posting -> Balancing s ()
checkBalanceAssignmentUnassignableAccountB Posting
p
checkBalanceAssignmentPostingDateB :: Posting -> Balancing s ()
checkBalanceAssignmentPostingDateB :: Posting -> Balancing s ()
checkBalanceAssignmentPostingDateB Posting
p =
Bool -> Balancing s () -> Balancing s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Posting -> Bool
hasBalanceAssignment Posting
p Bool -> Bool -> Bool
&& Maybe Day -> Bool
forall a. Maybe a -> Bool
isJust (Posting -> Maybe Day
pdate Posting
p)) (Balancing s () -> Balancing s ())
-> Balancing s () -> Balancing s ()
forall a b. (a -> b) -> a -> b
$
String -> Balancing s ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Balancing s ())
-> (CommoditySymbol -> String) -> CommoditySymbol -> Balancing s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommoditySymbol -> String
T.unpack (CommoditySymbol -> Balancing s ())
-> CommoditySymbol -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ [CommoditySymbol] -> CommoditySymbol
T.unlines
[CommoditySymbol
"postings which are balance assignments may not have a custom date."
,CommoditySymbol
"Please write the posting amount explicitly, or remove the posting date:"
,CommoditySymbol
""
,CommoditySymbol
-> (Transaction -> CommoditySymbol)
-> Maybe Transaction
-> CommoditySymbol
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([CommoditySymbol] -> CommoditySymbol
T.unlines ([CommoditySymbol] -> CommoditySymbol)
-> [CommoditySymbol] -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Posting -> [CommoditySymbol]
showPostingLines Posting
p) Transaction -> CommoditySymbol
showTransaction (Maybe Transaction -> CommoditySymbol)
-> Maybe Transaction -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
]
checkBalanceAssignmentUnassignableAccountB :: Posting -> Balancing s ()
checkBalanceAssignmentUnassignableAccountB :: Posting -> Balancing s ()
checkBalanceAssignmentUnassignableAccountB Posting
p = do
Set CommoditySymbol
unassignable <- (BalancingState s -> Set CommoditySymbol)
-> ReaderT
(BalancingState s) (ExceptT String (ST s)) (Set CommoditySymbol)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.asks BalancingState s -> Set CommoditySymbol
forall s. BalancingState s -> Set CommoditySymbol
bsUnassignable
Bool -> Balancing s () -> Balancing s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Posting -> Bool
hasBalanceAssignment Posting
p Bool -> Bool -> Bool
&& Posting -> CommoditySymbol
paccount Posting
p CommoditySymbol -> Set CommoditySymbol -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set CommoditySymbol
unassignable) (Balancing s () -> Balancing s ())
-> Balancing s () -> Balancing s ()
forall a b. (a -> b) -> a -> b
$
String -> Balancing s ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Balancing s ())
-> (CommoditySymbol -> String) -> CommoditySymbol -> Balancing s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommoditySymbol -> String
T.unpack (CommoditySymbol -> Balancing s ())
-> CommoditySymbol -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ [CommoditySymbol] -> CommoditySymbol
T.unlines
[CommoditySymbol
"balance assignments cannot be used with accounts which are"
,CommoditySymbol
"posted to by transaction modifier rules (auto postings)."
,CommoditySymbol
"Please write the posting amount explicitly, or remove the rule."
,CommoditySymbol
""
,CommoditySymbol
"account: " CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> Posting -> CommoditySymbol
paccount Posting
p
,CommoditySymbol
""
,CommoditySymbol
"transaction:"
,CommoditySymbol
""
,CommoditySymbol
-> (Transaction -> CommoditySymbol)
-> Maybe Transaction
-> CommoditySymbol
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([CommoditySymbol] -> CommoditySymbol
T.unlines ([CommoditySymbol] -> CommoditySymbol)
-> [CommoditySymbol] -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Posting -> [CommoditySymbol]
showPostingLines Posting
p) Transaction -> CommoditySymbol
showTransaction (Maybe Transaction -> CommoditySymbol)
-> Maybe Transaction -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
]
makeHledgerClassyLenses ''BalancingOpts
tests_Balancing :: TestTree
tests_Balancing :: TestTree
tests_Balancing =
String -> [TestTree] -> TestTree
testGroup String
"Balancing" [
String -> Assertion -> TestTree
testCase String
"inferBalancingAmount" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
((Transaction, [(CommoditySymbol, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst ((Transaction, [(CommoditySymbol, MixedAmount)]) -> Transaction)
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
-> Either String Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map CommoditySymbol AmountStyle
-> Transaction
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
inferBalancingAmount Map CommoditySymbol AmountStyle
forall k a. Map k a
M.empty Transaction
nulltransaction) Either String Transaction -> Either String Transaction -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Transaction -> Either String Transaction
forall a b. b -> Either a b
Right Transaction
nulltransaction
((Transaction, [(CommoditySymbol, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst ((Transaction, [(CommoditySymbol, MixedAmount)]) -> Transaction)
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
-> Either String Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map CommoditySymbol AmountStyle
-> Transaction
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
inferBalancingAmount Map CommoditySymbol AmountStyle
forall k a. Map k a
M.empty Transaction
nulltransaction{tpostings :: [Posting]
tpostings = [CommoditySymbol
"a" CommoditySymbol -> Amount -> Posting
`post` Quantity -> Amount
usd (-Quantity
5), CommoditySymbol
"b" CommoditySymbol -> Amount -> Posting
`post` Amount
missingamt]}) Either String Transaction -> Either String Transaction -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
Transaction -> Either String Transaction
forall a b. b -> Either a b
Right Transaction
nulltransaction{tpostings :: [Posting]
tpostings = [CommoditySymbol
"a" CommoditySymbol -> Amount -> Posting
`post` Quantity -> Amount
usd (-Quantity
5), CommoditySymbol
"b" CommoditySymbol -> Amount -> Posting
`post` Quantity -> Amount
usd Quantity
5]}
((Transaction, [(CommoditySymbol, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst ((Transaction, [(CommoditySymbol, MixedAmount)]) -> Transaction)
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
-> Either String Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map CommoditySymbol AmountStyle
-> Transaction
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
inferBalancingAmount Map CommoditySymbol AmountStyle
forall k a. Map k a
M.empty Transaction
nulltransaction{tpostings :: [Posting]
tpostings = [CommoditySymbol
"a" CommoditySymbol -> Amount -> Posting
`post` Quantity -> Amount
usd (-Quantity
5), CommoditySymbol
"b" CommoditySymbol -> Amount -> Posting
`post` (Quantity -> Amount
eur Quantity
3 Amount -> Amount -> Amount
@@ Quantity -> Amount
usd Quantity
4), CommoditySymbol
"c" CommoditySymbol -> Amount -> Posting
`post` Amount
missingamt]}) Either String Transaction -> Either String Transaction -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
Transaction -> Either String Transaction
forall a b. b -> Either a b
Right Transaction
nulltransaction{tpostings :: [Posting]
tpostings = [CommoditySymbol
"a" CommoditySymbol -> Amount -> Posting
`post` Quantity -> Amount
usd (-Quantity
5), CommoditySymbol
"b" CommoditySymbol -> Amount -> Posting
`post` (Quantity -> Amount
eur Quantity
3 Amount -> Amount -> Amount
@@ Quantity -> Amount
usd Quantity
4), CommoditySymbol
"c" CommoditySymbol -> Amount -> Posting
`post` Quantity -> Amount
usd Quantity
1]}
, String -> [TestTree] -> TestTree
testGroup String
"balanceTransaction" [
String -> Assertion -> TestTree
testCase String
"detect unbalanced entry, sign error" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
Either String Transaction -> Assertion
forall b a. (HasCallStack, Eq b, Show b) => Either a b -> Assertion
assertLeft
(BalancingOpts -> Transaction -> Either String Transaction
balanceTransaction BalancingOpts
defbalancingopts
(Integer
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
CommoditySymbol
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
CommoditySymbol
""
CommoditySymbol
"test"
CommoditySymbol
""
[]
[Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
1)}, Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
1)}]))
,String -> Assertion -> TestTree
testCase String
"detect unbalanced entry, multiple missing amounts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
Either String Transaction -> Assertion
forall b a. (HasCallStack, Eq b, Show b) => Either a b -> Assertion
assertLeft (Either String Transaction -> Assertion)
-> Either String Transaction -> Assertion
forall a b. (a -> b) -> a -> b
$
BalancingOpts -> Transaction -> Either String Transaction
balanceTransaction BalancingOpts
defbalancingopts
(Integer
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
CommoditySymbol
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
CommoditySymbol
""
CommoditySymbol
"test"
CommoditySymbol
""
[]
[ Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"a", pamount :: MixedAmount
pamount = MixedAmount
missingmixedamt}
, Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"b", pamount :: MixedAmount
pamount = MixedAmount
missingmixedamt}
])
,String -> Assertion -> TestTree
testCase String
"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 String Transaction -> Either String MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
BalancingOpts -> Transaction -> Either String Transaction
balanceTransaction BalancingOpts
defbalancingopts
(Integer
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
CommoditySymbol
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
CommoditySymbol
""
CommoditySymbol
""
CommoditySymbol
""
[]
[Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
1)}, Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"b", pamount :: MixedAmount
pamount = MixedAmount
missingmixedamt}])) Either String MixedAmount -> Either String MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
MixedAmount -> Either String MixedAmount
forall a b. b -> Either a b
Right (Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd (-Quantity
1))
,String -> Assertion -> TestTree
testCase String
"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 String Transaction -> Either String MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
BalancingOpts -> Transaction -> Either String Transaction
balanceTransaction BalancingOpts
defbalancingopts
(Integer
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
CommoditySymbol
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
CommoditySymbol
""
CommoditySymbol
""
CommoditySymbol
""
[]
[ Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
1.35)}
, Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
eur (-Quantity
1))}
])) Either String MixedAmount -> Either String MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
MixedAmount -> Either String MixedAmount
forall a b. b -> Either a b
Right (Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd Quantity
1.35 Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
1)
,String -> Assertion -> TestTree
testCase String
"balanceTransaction balances based on cost if there are unit prices" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
Either String Transaction -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either String Transaction -> Assertion)
-> Either String Transaction -> Assertion
forall a b. (a -> b) -> a -> b
$
BalancingOpts -> Transaction -> Either String Transaction
balanceTransaction BalancingOpts
defbalancingopts
(Integer
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
CommoditySymbol
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2011 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
CommoditySymbol
""
CommoditySymbol
""
CommoditySymbol
""
[]
[ Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
2}
, Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd (-Quantity
2) Amount -> Amount -> Amount
`at` Quantity -> Amount
eur Quantity
1}
])
,String -> Assertion -> TestTree
testCase String
"balanceTransaction balances based on cost if there are total prices" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
Either String Transaction -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either String Transaction -> Assertion)
-> Either String Transaction -> Assertion
forall a b. (a -> b) -> a -> b
$
BalancingOpts -> Transaction -> Either String Transaction
balanceTransaction BalancingOpts
defbalancingopts
(Integer
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
CommoditySymbol
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2011 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
CommoditySymbol
""
CommoditySymbol
""
CommoditySymbol
""
[]
[ Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd Quantity
1 Amount -> Amount -> Amount
@@ Quantity -> Amount
eur Quantity
1}
, Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd (-Quantity
2) Amount -> Amount -> Amount
@@ Quantity -> Amount
eur (-Quantity
1)}
])
]
, String -> [TestTree] -> TestTree
testGroup String
"isTransactionBalanced" [
String -> Assertion -> TestTree
testCase String
"detect balanced" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"" (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
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
CommoditySymbol
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
CommoditySymbol
""
CommoditySymbol
"a"
CommoditySymbol
""
[]
[ Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
1.00)}
, Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"c", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd (-Quantity
1.00))}
]
,String -> Assertion -> TestTree
testCase String
"detect unbalanced" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"" (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
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
CommoditySymbol
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
CommoditySymbol
""
CommoditySymbol
"a"
CommoditySymbol
""
[]
[ Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
1.00)}
, Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"c", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd (-Quantity
1.01))}
]
,String -> Assertion -> TestTree
testCase String
"detect unbalanced, one posting" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"" (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
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
CommoditySymbol
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
CommoditySymbol
""
CommoditySymbol
"a"
CommoditySymbol
""
[]
[Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
1.00)}]
,String -> Assertion -> TestTree
testCase String
"one zero posting is considered balanced for now" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"" (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
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
CommoditySymbol
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
CommoditySymbol
""
CommoditySymbol
"a"
CommoditySymbol
""
[]
[Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
0)}]
,String -> Assertion -> TestTree
testCase String
"virtual postings don't need to balance" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"" (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
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
CommoditySymbol
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
CommoditySymbol
""
CommoditySymbol
"a"
CommoditySymbol
""
[]
[ Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
1.00)}
, Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"c", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd (-Quantity
1.00))}
, Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"d", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
100), ptype :: PostingType
ptype = PostingType
VirtualPosting}
]
,String -> Assertion -> TestTree
testCase String
"balanced virtual postings need to balance among themselves" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"" (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
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
CommoditySymbol
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
CommoditySymbol
""
CommoditySymbol
"a"
CommoditySymbol
""
[]
[ Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
1.00)}
, Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"c", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd (-Quantity
1.00))}
, Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"d", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
100), ptype :: PostingType
ptype = PostingType
BalancedVirtualPosting}
]
,String -> Assertion -> TestTree
testCase String
"balanced virtual postings need to balance among themselves (2)" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"" (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
-> CommoditySymbol
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> Transaction
Transaction
Integer
0
CommoditySymbol
""
(SourcePos, SourcePos)
nullsourcepos
(Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
Maybe Day
forall a. Maybe a
Nothing
Status
Unmarked
CommoditySymbol
""
CommoditySymbol
"a"
CommoditySymbol
""
[]
[ Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
1.00)}
, Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"c", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd (-Quantity
1.00))}
, Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"d", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd Quantity
100), ptype :: PostingType
ptype = PostingType
BalancedVirtualPosting}
, Posting
posting {paccount :: CommoditySymbol
paccount = CommoditySymbol
"3", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Quantity -> Amount
usd (-Quantity
100)), ptype :: PostingType
ptype = PostingType
BalancedVirtualPosting}
]
]
,String -> [TestTree] -> TestTree
testGroup String
"journalBalanceTransactions" [
String -> Assertion -> TestTree
testCase String
"missing-amounts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
let ej :: Either String Journal
ej = BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either String Journal)
-> Journal -> Either String Journal
forall a b. (a -> b) -> a -> b
$ Bool -> Journal
samplejournalMaybeExplicit Bool
False
Either String Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight Either String Journal
ej
Journal -> [Posting]
journalPostings (Journal -> [Posting])
-> Either String Journal -> Either String [Posting]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String Journal
ej Either String [Posting] -> Either String [Posting] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Posting] -> Either String [Posting]
forall a b. b -> Either a b
Right (Journal -> [Posting]
journalPostings Journal
samplejournal)
,String -> Assertion -> TestTree
testCase String
"balance-assignment" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
let ej :: Either String Journal
ej = BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either String Journal)
-> Journal -> Either String 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) [ CommoditySymbol -> Amount -> Maybe BalanceAssertion -> Posting
vpost' CommoditySymbol
"a" Amount
missingamt (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num Quantity
1)) ]
]}
Either String Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight Either String Journal
ej
let Right Journal
j = Either String Journal
ej
(Journal -> [Transaction]
jtxns Journal
j [Transaction] -> ([Transaction] -> Transaction) -> Transaction
forall a b. a -> (a -> b) -> b
& [Transaction] -> Transaction
forall a. [a] -> a
head Transaction -> (Transaction -> [Posting]) -> [Posting]
forall a b. a -> (a -> b) -> b
& Transaction -> [Posting]
tpostings [Posting] -> ([Posting] -> Posting) -> Posting
forall a b. a -> (a -> b) -> b
& [Posting] -> Posting
forall a. [a] -> a
head Posting -> (Posting -> MixedAmount) -> MixedAmount
forall a b. a -> (a -> b) -> b
& Posting -> MixedAmount
pamount MixedAmount -> (MixedAmount -> [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
@?= [Quantity -> Amount
num Quantity
1]
,String -> Assertion -> TestTree
testCase String
"same-day-1" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
Either String Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either String Journal -> Assertion)
-> Either String Journal -> Assertion
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either String Journal)
-> Journal -> Either String 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) [ CommoditySymbol -> Amount -> Maybe BalanceAssertion -> Posting
vpost' CommoditySymbol
"a" Amount
missingamt (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num Quantity
1)) ]
,Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [ CommoditySymbol -> Amount -> Maybe BalanceAssertion -> Posting
vpost' CommoditySymbol
"a" (Quantity -> Amount
num Quantity
1) (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num Quantity
2)) ]
]}
,String -> Assertion -> TestTree
testCase String
"same-day-2" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
Either String Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either String Journal -> Assertion)
-> Either String Journal -> Assertion
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either String Journal)
-> Journal -> Either String 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) [ CommoditySymbol -> Amount -> Maybe BalanceAssertion -> Posting
vpost' CommoditySymbol
"a" (Quantity -> Amount
num Quantity
2) (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num Quantity
2)) ]
,Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [
CommoditySymbol -> Amount -> Maybe BalanceAssertion -> Posting
post' CommoditySymbol
"b" (Quantity -> Amount
num Quantity
1) Maybe BalanceAssertion
forall a. Maybe a
Nothing
,CommoditySymbol -> Amount -> Maybe BalanceAssertion -> Posting
post' CommoditySymbol
"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) [ CommoditySymbol -> Amount -> Maybe BalanceAssertion -> Posting
post' CommoditySymbol
"a" (Quantity -> Amount
num Quantity
0) (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num Quantity
1)) ]
]}
,String -> Assertion -> TestTree
testCase String
"out-of-order" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
Either String Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either String Journal -> Assertion)
-> Either String Journal -> Assertion
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either String Journal)
-> Journal -> Either String 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) [ CommoditySymbol -> Amount -> Maybe BalanceAssertion -> Posting
vpost' CommoditySymbol
"a" (Quantity -> Amount
num Quantity
1) (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num Quantity
2)) ]
,Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [ CommoditySymbol -> Amount -> Maybe BalanceAssertion -> Posting
vpost' CommoditySymbol
"a" (Quantity -> Amount
num Quantity
1) (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num Quantity
1)) ]
]}
]
,String -> [TestTree] -> TestTree
testGroup String
"commodityStylesFromAmounts" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$ [
String -> Assertion -> TestTree
testCase String
"1091a" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
[Amount] -> Either String (Map CommoditySymbol AmountStyle)
commodityStylesFromAmounts [
Amount
nullamt{aquantity :: Quantity
aquantity=Quantity
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 :: Quantity
aquantity=Quantity
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 String (Map CommoditySymbol AmountStyle)
-> Either String (Map CommoditySymbol AmountStyle) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
Map CommoditySymbol AmountStyle
-> Either String (Map CommoditySymbol AmountStyle)
forall a b. b -> Either a b
Right ([(CommoditySymbol, AmountStyle)] -> Map CommoditySymbol AmountStyle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
(CommoditySymbol
"", 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])))
])
,String -> Assertion -> TestTree
testCase String
"1091b" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
[Amount] -> Either String (Map CommoditySymbol AmountStyle)
commodityStylesFromAmounts [
Amount
nullamt{aquantity :: Quantity
aquantity=Quantity
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 :: Quantity
aquantity=Quantity
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 String (Map CommoditySymbol AmountStyle)
-> Either String (Map CommoditySymbol AmountStyle) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
Map CommoditySymbol AmountStyle
-> Either String (Map CommoditySymbol AmountStyle)
forall a b. b -> Either a b
Right ([(CommoditySymbol, AmountStyle)] -> Map CommoditySymbol AmountStyle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
(CommoditySymbol
"", 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])))
])
]
]