{-|
Functions for ensuring transactions and journals are balanced.
-}

{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PackageImports      #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}

module Hledger.Data.Balancing
( -- * BalancingOpts
  BalancingOpts(..)
, HasBalancingOpts(..)
, defbalancingopts
  -- * transaction balancing
, isTransactionBalanced
, balanceTransaction
, balanceTransactionHelper
, annotateErrorWithTransaction
  -- * journal balancing
, journalBalanceTransactions
, journalCheckBalanceAssertions
  -- * tests
, 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  -- ^ Ignore balance assertions
  , BalancingOpts -> Bool
infer_transaction_prices_ :: Bool  -- ^ Infer prices in unbalanced multicommodity amounts
  , BalancingOpts -> Maybe (Map AccountName AmountStyle)
commodity_styles_         :: Maybe (M.Map CommoditySymbol AmountStyle)  -- ^ commodity display styles
  } deriving (Int -> BalancingOpts -> ShowS
[BalancingOpts] -> ShowS
BalancingOpts -> [Char]
(Int -> BalancingOpts -> ShowS)
-> (BalancingOpts -> [Char])
-> ([BalancingOpts] -> ShowS)
-> Show BalancingOpts
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BalancingOpts] -> ShowS
$cshowList :: [BalancingOpts] -> ShowS
show :: BalancingOpts -> [Char]
$cshow :: BalancingOpts -> [Char]
showsPrec :: Int -> BalancingOpts -> ShowS
$cshowsPrec :: Int -> BalancingOpts -> ShowS
Show)

defbalancingopts :: BalancingOpts
defbalancingopts :: BalancingOpts
defbalancingopts = BalancingOpts :: Bool
-> Bool -> Maybe (Map AccountName AmountStyle) -> BalancingOpts
BalancingOpts
  { ignore_assertions_ :: Bool
ignore_assertions_        = Bool
False
  , infer_transaction_prices_ :: Bool
infer_transaction_prices_ = Bool
True
  , commodity_styles_ :: Maybe (Map AccountName AmountStyle)
commodity_styles_         = Maybe (Map AccountName AmountStyle)
forall a. Maybe a
Nothing
  }

-- | Check that this transaction would appear balanced to a human when displayed.
-- On success, returns the empty list, otherwise one or more error messages.
--
-- In more detail:
-- For the real postings, and separately for the balanced virtual postings:
--
-- 1. Convert amounts to cost where possible
--
-- 2. When there are two or more non-zero amounts
--    (appearing non-zero when displayed, using the given display styles if provided),
--    are they a mix of positives and negatives ?
--    This is checked separately to give a clearer error message.
--    (Best effort; could be confused by postings with multicommodity amounts.)
--
-- 3. Does the amounts' sum appear non-zero when displayed ?
--    (using the given display styles if provided)
--
transactionCheckBalanced :: BalancingOpts -> Transaction -> [String]
transactionCheckBalanced :: BalancingOpts -> Transaction -> [[Char]]
transactionCheckBalanced BalancingOpts{Maybe (Map AccountName AmountStyle)
commodity_styles_ :: Maybe (Map AccountName AmountStyle)
commodity_styles_ :: BalancingOpts -> Maybe (Map AccountName AmountStyle)
commodity_styles_} Transaction
t = [[Char]]
errs
  where
    ([Posting]
rps, [Posting]
bvps) = (Posting -> ([Posting], [Posting]) -> ([Posting], [Posting]))
-> ([Posting], [Posting]) -> [Posting] -> ([Posting], [Posting])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Posting -> ([Posting], [Posting]) -> ([Posting], [Posting])
partitionPosting ([], []) ([Posting] -> ([Posting], [Posting]))
-> [Posting] -> ([Posting], [Posting])
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t
      where
        partitionPosting :: Posting -> ([Posting], [Posting]) -> ([Posting], [Posting])
partitionPosting Posting
p ~([Posting]
l, [Posting]
r) = case Posting -> PostingType
ptype Posting
p of
            PostingType
RegularPosting         -> (Posting
pPosting -> [Posting] -> [Posting]
forall a. a -> [a] -> [a]
:[Posting]
l, [Posting]
r)
            PostingType
BalancedVirtualPosting -> ([Posting]
l, Posting
pPosting -> [Posting] -> [Posting]
forall a. a -> [a] -> [a]
:[Posting]
r)
            PostingType
VirtualPosting         -> ([Posting]
l, [Posting]
r)

    -- check for mixed signs, detecting nonzeros at display precision
    canonicalise :: MixedAmount -> MixedAmount
canonicalise = (MixedAmount -> MixedAmount)
-> (Map AccountName AmountStyle -> MixedAmount -> MixedAmount)
-> Maybe (Map AccountName AmountStyle)
-> MixedAmount
-> MixedAmount
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MixedAmount -> MixedAmount
forall a. a -> a
id Map AccountName AmountStyle -> MixedAmount -> MixedAmount
canonicaliseMixedAmount Maybe (Map AccountName AmountStyle)
commodity_styles_
    signsOk :: [Posting] -> Bool
signsOk [Posting]
ps =
      case (MixedAmount -> Bool) -> [MixedAmount] -> [MixedAmount]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (MixedAmount -> Bool) -> MixedAmount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MixedAmount -> Bool
mixedAmountLooksZero) ([MixedAmount] -> [MixedAmount]) -> [MixedAmount] -> [MixedAmount]
forall a b. (a -> b) -> a -> b
$ (Posting -> MixedAmount) -> [Posting] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (MixedAmount -> MixedAmount
canonicalise(MixedAmount -> MixedAmount)
-> (Posting -> MixedAmount) -> Posting -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MixedAmount -> MixedAmount
mixedAmountCost(MixedAmount -> MixedAmount)
-> (Posting -> MixedAmount) -> Posting -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Posting -> MixedAmount
pamount) [Posting]
ps of
        [MixedAmount]
nonzeros | [MixedAmount] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MixedAmount]
nonzeros Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
                   -> [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Bool] -> [Bool]
forall a. Ord a => [a] -> [a]
nubSort ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ (MixedAmount -> Maybe Bool) -> [MixedAmount] -> [Bool]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MixedAmount -> Maybe Bool
isNegativeMixedAmount [MixedAmount]
nonzeros) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
        [MixedAmount]
_          -> Bool
True
    (Bool
rsignsok, Bool
bvsignsok)       = ([Posting] -> Bool
signsOk [Posting]
rps, [Posting] -> Bool
signsOk [Posting]
bvps)

    -- check for zero sum, at display precision
    (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)

    -- generate error messages, showing amounts with their original precision
    errs :: [[Char]]
errs = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Char]
rmsg, [Char]
bvmsg]
      where
        rmsg :: [Char]
rmsg
          | Bool
rsumok        = [Char]
""
          | Bool -> Bool
not Bool
rsignsok  = [Char]
"real postings all have the same sign"
          | Bool
otherwise     = [Char]
"real postings' sum should be 0 but is: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ MixedAmount -> [Char]
showMixedAmount MixedAmount
rsumcost
        bvmsg :: [Char]
bvmsg
          | Bool
bvsumok       = [Char]
""
          | Bool -> Bool
not Bool
bvsignsok = [Char]
"balanced virtual postings all have the same sign"
          | Bool
otherwise     = [Char]
"balanced virtual postings' sum should be 0 but is: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ MixedAmount -> [Char]
showMixedAmount MixedAmount
bvsumcost

-- | Legacy form of transactionCheckBalanced.
isTransactionBalanced :: BalancingOpts -> Transaction -> Bool
isTransactionBalanced :: BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
bopts = [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[Char]] -> Bool)
-> (Transaction -> [[Char]]) -> Transaction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalancingOpts -> Transaction -> [[Char]]
transactionCheckBalanced BalancingOpts
bopts

-- | Balance this transaction, ensuring that its postings
-- (and its balanced virtual postings) sum to 0,
-- by inferring a missing amount or conversion price(s) if needed.
-- Or if balancing is not possible, because the amounts don't sum to 0 or
-- because there's more than one missing amount, return an error message.
--
-- Transactions with balance assignments can have more than one
-- missing amount; to balance those you should use the more powerful
-- journalBalanceTransactions.
--
-- The "sum to 0" test is done using commodity display precisions,
-- if provided, so that the result agrees with the numbers users can see.
--
balanceTransaction ::
     BalancingOpts
  -> Transaction
  -> Either String Transaction
balanceTransaction :: BalancingOpts -> Transaction -> Either [Char] Transaction
balanceTransaction BalancingOpts
bopts = ((Transaction, [(AccountName, MixedAmount)]) -> Transaction)
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
-> Either [Char] Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Transaction, [(AccountName, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst (Either [Char] (Transaction, [(AccountName, MixedAmount)])
 -> Either [Char] Transaction)
-> (Transaction
    -> Either [Char] (Transaction, [(AccountName, MixedAmount)]))
-> Transaction
-> Either [Char] Transaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalancingOpts
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
balanceTransactionHelper BalancingOpts
bopts

-- | Helper used by balanceTransaction and balanceTransactionWithBalanceAssignmentAndCheckAssertionsB;
-- use one of those instead. It also returns a list of accounts
-- and amounts that were inferred.
balanceTransactionHelper ::
     BalancingOpts
  -> Transaction
  -> Either String (Transaction, [(AccountName, MixedAmount)])
balanceTransactionHelper :: BalancingOpts
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
balanceTransactionHelper BalancingOpts
bopts Transaction
t = do
  (Transaction
t', [(AccountName, MixedAmount)]
inferredamtsandaccts) <- Map AccountName AmountStyle
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
inferBalancingAmount (Map AccountName AmountStyle
-> Maybe (Map AccountName AmountStyle)
-> Map AccountName AmountStyle
forall a. a -> Maybe a -> a
fromMaybe Map AccountName AmountStyle
forall k a. Map k a
M.empty (Maybe (Map AccountName AmountStyle)
 -> Map AccountName AmountStyle)
-> Maybe (Map AccountName AmountStyle)
-> Map AccountName AmountStyle
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Maybe (Map AccountName AmountStyle)
commodity_styles_ BalancingOpts
bopts) (Transaction
 -> Either [Char] (Transaction, [(AccountName, MixedAmount)]))
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. (a -> b) -> a -> b
$
    if BalancingOpts -> Bool
infer_transaction_prices_ BalancingOpts
bopts then Transaction -> Transaction
inferBalancingPrices Transaction
t else Transaction
t
  case BalancingOpts -> Transaction -> [[Char]]
transactionCheckBalanced BalancingOpts
bopts Transaction
t' of
    []   -> (Transaction, [(AccountName, MixedAmount)])
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. b -> Either a b
Right (Transaction -> Transaction
txnTieKnot Transaction
t', [(AccountName, MixedAmount)]
inferredamtsandaccts)
    [[Char]]
errs -> [Char] -> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. a -> Either a b
Left ([Char]
 -> Either [Char] (Transaction, [(AccountName, MixedAmount)]))
-> [Char]
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. (a -> b) -> a -> b
$ Transaction -> [[Char]] -> [Char]
transactionBalanceError Transaction
t' [[Char]]
errs

-- | Generate a transaction balancing error message, given the transaction
-- and one or more suberror messages.
transactionBalanceError :: Transaction -> [String] -> String
transactionBalanceError :: Transaction -> [[Char]] -> [Char]
transactionBalanceError Transaction
t [[Char]]
errs =
  Transaction -> ShowS
annotateErrorWithTransaction Transaction
t ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
  [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"could not balance this transaction:" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
errs

annotateErrorWithTransaction :: Transaction -> String -> String
annotateErrorWithTransaction :: Transaction -> ShowS
annotateErrorWithTransaction Transaction
t [Char]
s =
  [[Char]] -> [Char]
unlines [ (SourcePos, SourcePos) -> [Char]
showSourcePosPair ((SourcePos, SourcePos) -> [Char])
-> (SourcePos, SourcePos) -> [Char]
forall a b. (a -> b) -> a -> b
$ Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t, [Char]
s
          , AccountName -> [Char]
T.unpack (AccountName -> [Char])
-> (AccountName -> AccountName) -> AccountName -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> AccountName
T.stripEnd (AccountName -> [Char]) -> AccountName -> [Char]
forall a b. (a -> b) -> a -> b
$ Transaction -> AccountName
showTransaction Transaction
t
          ]

-- | Infer up to one missing amount for this transactions's real postings, and
-- likewise for its balanced virtual postings, if needed; or return an error
-- message if we can't. Returns the updated transaction and any inferred posting amounts,
-- with the corresponding accounts, in order).
--
-- We can infer a missing amount when there are multiple postings and exactly
-- one of them is amountless. If the amounts had price(s) the inferred amount
-- have the same price(s), and will be converted to the price commodity.
inferBalancingAmount ::
     M.Map CommoditySymbol AmountStyle -- ^ commodity display styles
  -> Transaction
  -> Either String (Transaction, [(AccountName, MixedAmount)])
inferBalancingAmount :: Map AccountName AmountStyle
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
inferBalancingAmount Map AccountName AmountStyle
styles t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps}
  | [Posting] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
amountlessrealps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
      = [Char] -> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. a -> Either a b
Left ([Char]
 -> Either [Char] (Transaction, [(AccountName, MixedAmount)]))
-> [Char]
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. (a -> b) -> a -> b
$ Transaction -> [[Char]] -> [Char]
transactionBalanceError Transaction
t
        [[Char]
"can't have more than one real posting with no amount"
        ,[Char]
"(remember to put two or more spaces between account and amount)"]
  | [Posting] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
amountlessbvps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
      = [Char] -> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. a -> Either a b
Left ([Char]
 -> Either [Char] (Transaction, [(AccountName, MixedAmount)]))
-> [Char]
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. (a -> b) -> a -> b
$ Transaction -> [[Char]] -> [Char]
transactionBalanceError Transaction
t
        [[Char]
"can't have more than one balanced virtual posting with no amount"
        ,[Char]
"(remember to put two or more spaces between account and amount)"]
  | Bool
otherwise
      = let psandinferredamts :: [(Posting, Maybe MixedAmount)]
psandinferredamts = (Posting -> (Posting, Maybe MixedAmount))
-> [Posting] -> [(Posting, Maybe MixedAmount)]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> (Posting, Maybe MixedAmount)
inferamount [Posting]
ps
            inferredacctsandamts :: [(AccountName, MixedAmount)]
inferredacctsandamts = [(Posting -> AccountName
paccount Posting
p, MixedAmount
amt) | (Posting
p, Just MixedAmount
amt) <- [(Posting, Maybe MixedAmount)]
psandinferredamts]
        in (Transaction, [(AccountName, MixedAmount)])
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
forall a b. b -> Either a b
Right (Transaction
t{tpostings :: [Posting]
tpostings=((Posting, Maybe MixedAmount) -> Posting)
-> [(Posting, Maybe MixedAmount)] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (Posting, Maybe MixedAmount) -> Posting
forall a b. (a, b) -> a
fst [(Posting, Maybe MixedAmount)]
psandinferredamts}, [(AccountName, MixedAmount)]
inferredacctsandamts)
  where
    ([Posting]
amountfulrealps, [Posting]
amountlessrealps) = (Posting -> Bool) -> [Posting] -> ([Posting], [Posting])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Posting -> Bool
hasAmount (Transaction -> [Posting]
realPostings Transaction
t)
    realsum :: MixedAmount
realsum = [Posting] -> MixedAmount
sumPostings [Posting]
amountfulrealps
    ([Posting]
amountfulbvps, [Posting]
amountlessbvps) = (Posting -> Bool) -> [Posting] -> ([Posting], [Posting])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Posting -> Bool
hasAmount (Transaction -> [Posting]
balancedVirtualPostings Transaction
t)
    bvsum :: MixedAmount
bvsum = [Posting] -> MixedAmount
sumPostings [Posting]
amountfulbvps

    inferamount :: Posting -> (Posting, Maybe MixedAmount)
    inferamount :: Posting -> (Posting, Maybe MixedAmount)
inferamount Posting
p =
      let
        minferredamt :: Maybe MixedAmount
minferredamt = case Posting -> PostingType
ptype Posting
p of
          PostingType
RegularPosting         | Bool -> Bool
not (Posting -> Bool
hasAmount Posting
p) -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
realsum
          PostingType
BalancedVirtualPosting | Bool -> Bool
not (Posting -> Bool
hasAmount Posting
p) -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
bvsum
          PostingType
_                                          -> Maybe MixedAmount
forall a. Maybe a
Nothing
      in
        case Maybe MixedAmount
minferredamt of
          Maybe MixedAmount
Nothing -> (Posting
p, Maybe MixedAmount
forall a. Maybe a
Nothing)
          Just MixedAmount
a  -> (Posting
p{pamount :: MixedAmount
pamount=MixedAmount
a', poriginal :: Maybe Posting
poriginal=Posting -> Maybe Posting
forall a. a -> Maybe a
Just (Posting -> Maybe Posting) -> Posting -> Maybe Posting
forall a b. (a -> b) -> a -> b
$ Posting -> Posting
originalPosting Posting
p}, MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
a')
            where
              -- Inferred amounts are converted to cost.
              -- Also ensure the new amount has the standard style for its commodity
              -- (since the main amount styling pass happened before this balancing pass);
              a' :: MixedAmount
a' = Map AccountName AmountStyle -> MixedAmount -> MixedAmount
styleMixedAmount Map AccountName AmountStyle
styles (MixedAmount -> MixedAmount)
-> (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> MixedAmount
mixedAmountCost (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
maNegate MixedAmount
a

-- | Infer prices for this transaction's posting amounts, if needed to make
-- the postings balance, and if possible. This is done once for the real
-- postings and again (separately) for the balanced virtual postings. When
-- it's not possible, the transaction is left unchanged.
--
-- The simplest example is a transaction with two postings, each in a
-- different commodity, with no prices specified. In this case we'll add a
-- price to the first posting such that it can be converted to the commodity
-- of the second posting (with -B), and such that the postings balance.
--
-- In general, we can infer a conversion price when the sum of posting amounts
-- contains exactly two different commodities and no explicit prices.  Also
-- all postings are expected to contain an explicit amount (no missing
-- amounts) in a single commodity. Otherwise no price inferring is attempted.
--
-- The transaction itself could contain more than two commodities, and/or
-- prices, if they cancel out; what matters is that the sum of posting amounts
-- contains exactly two commodities and zero prices.
--
-- There can also be more than two postings in either of the commodities.
--
-- We want to avoid excessive display of digits when the calculated price is
-- an irrational number, while hopefully also ensuring the displayed numbers
-- make sense if the user does a manual calculation. This is (mostly) achieved
-- in two ways:
--
-- - when there is only one posting in the "from" commodity, a total price
--   (@@) is used, and all available decimal digits are shown
--
-- - otherwise, a suitable averaged unit price (@) is applied to the relevant
--   postings, with display precision equal to the summed display precisions
--   of the two commodities being converted between, or 2, whichever is larger.
--
-- (We don't always calculate a good-looking display precision for unit prices
-- when the commodity display precisions are low, eg when a journal doesn't
-- use any decimal places. The minimum of 2 helps make the prices shown by the
-- print command a bit less surprising in this case. Could do better.)
--
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

-- | Generate a posting update function which assigns a suitable balancing
-- price to the posting, if and as appropriate for the given transaction and
-- posting type (real or balanced virtual). If we cannot or should not infer
-- prices, just act as the identity on postings.
priceInferrerFor :: Transaction -> PostingType -> (Posting -> Posting)
priceInferrerFor :: Transaction -> PostingType -> Posting -> Posting
priceInferrerFor Transaction
t PostingType
pt = (Posting -> Posting)
-> ((Amount, Amount) -> Posting -> Posting)
-> Maybe (Amount, Amount)
-> Posting
-> Posting
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Posting -> Posting
forall a. a -> a
id (Amount, Amount) -> Posting -> Posting
inferprice Maybe (Amount, Amount)
inferFromAndTo
  where
    postings :: [Posting]
postings     = (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter ((PostingType -> PostingType -> Bool
forall a. Eq a => a -> a -> Bool
==PostingType
pt)(PostingType -> Bool)
-> (Posting -> PostingType) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Posting -> PostingType
ptype) ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t
    pcommodities :: [AccountName]
pcommodities = (Amount -> AccountName) -> [Amount] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> AccountName
acommodity ([Amount] -> [AccountName]) -> [Amount] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ (Posting -> [Amount]) -> [Posting] -> [Amount]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount])
-> (Posting -> MixedAmount) -> Posting -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> MixedAmount
pamount) [Posting]
postings
    sumamounts :: [Amount]
sumamounts   = MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ [Posting] -> MixedAmount
sumPostings [Posting]
postings  -- amounts normalises to one amount per commodity & price

    -- We can infer prices if there are no prices given, exactly two commodities in the normalised
    -- sum of postings in this transaction, and these two have opposite signs. The amount we are
    -- converting from is the first commodity to appear in the ordered list of postings, and the
    -- commodity we are converting to is the other. If we cannot infer prices, return Nothing.
    inferFromAndTo :: Maybe (Amount, Amount)
inferFromAndTo = case [Amount]
sumamounts of
      [Amount
a,Amount
b] | Bool
noprices, Bool
oppositesigns -> [Maybe (Amount, Amount)] -> Maybe (Amount, Amount)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Maybe (Amount, Amount)] -> Maybe (Amount, Amount))
-> [Maybe (Amount, Amount)] -> Maybe (Amount, Amount)
forall a b. (a -> b) -> a -> b
$ (AccountName -> Maybe (Amount, Amount))
-> [AccountName] -> [Maybe (Amount, Amount)]
forall a b. (a -> b) -> [a] -> [b]
map AccountName -> Maybe (Amount, Amount)
orderIfMatches [AccountName]
pcommodities
        where
          noprices :: Bool
noprices      = (Amount -> Bool) -> [Amount] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe AmountPrice -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe AmountPrice -> Bool)
-> (Amount -> Maybe AmountPrice) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Maybe AmountPrice
aprice) [Amount]
sumamounts
          oppositesigns :: Bool
oppositesigns = DecimalRaw Integer -> DecimalRaw Integer
forall a. Num a => a -> a
signum (Amount -> DecimalRaw Integer
aquantity Amount
a) DecimalRaw Integer -> DecimalRaw Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= DecimalRaw Integer -> DecimalRaw Integer
forall a. Num a => a -> a
signum (Amount -> DecimalRaw Integer
aquantity Amount
b)
          orderIfMatches :: AccountName -> Maybe (Amount, Amount)
orderIfMatches AccountName
x | AccountName
x AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> AccountName
acommodity Amount
a = (Amount, Amount) -> Maybe (Amount, Amount)
forall a. a -> Maybe a
Just (Amount
a,Amount
b)
                           | AccountName
x AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> AccountName
acommodity Amount
b = (Amount, Amount) -> Maybe (Amount, Amount)
forall a. a -> Maybe a
Just (Amount
b,Amount
a)
                           | Bool
otherwise         = Maybe (Amount, Amount)
forall a. Maybe a
Nothing
      [Amount]
_ -> Maybe (Amount, Amount)
forall a. Maybe a
Nothing

    -- For each posting, if the posting type matches, there is only a single amount in the posting,
    -- and the commodity of the amount matches the amount we're converting from,
    -- then set its price based on the ratio between fromamount and toamount.
    inferprice :: (Amount, Amount) -> Posting -> Posting
inferprice (Amount
fromamount, Amount
toamount) Posting
posting
        | [Amount
a] <- MixedAmount -> [Amount]
amounts (Posting -> MixedAmount
pamount Posting
posting), Posting -> PostingType
ptype Posting
posting PostingType -> PostingType -> Bool
forall a. Eq a => a -> a -> Bool
== PostingType
pt, Amount -> AccountName
acommodity Amount
a AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> AccountName
acommodity Amount
fromamount
            = Posting
posting{ pamount :: MixedAmount
pamount   = Amount -> MixedAmount
mixedAmount Amount
a{aprice :: Maybe AmountPrice
aprice=AmountPrice -> Maybe AmountPrice
forall a. a -> Maybe a
Just AmountPrice
conversionprice}
                     , poriginal :: Maybe Posting
poriginal = Posting -> Maybe Posting
forall a. a -> Maybe a
Just (Posting -> Maybe Posting) -> Posting -> Maybe Posting
forall a b. (a -> b) -> a -> b
$ Posting -> Posting
originalPosting Posting
posting }
        | Bool
otherwise = Posting
posting
      where
        -- If only one Amount in the posting list matches fromamount we can use TotalPrice.
        -- Otherwise divide the conversion equally among the Amounts by using a unit price.
        conversionprice :: AmountPrice
conversionprice = case (AccountName -> Bool) -> [AccountName] -> [AccountName]
forall a. (a -> Bool) -> [a] -> [a]
filter (AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> AccountName
acommodity Amount
fromamount) [AccountName]
pcommodities of
            [AccountName
_] -> Amount -> AmountPrice
TotalPrice (Amount -> AmountPrice) -> Amount -> AmountPrice
forall a b. (a -> b) -> a -> b
$ Amount -> Amount
forall a. Num a => a -> a
negate Amount
toamount
            [AccountName]
_   -> Amount -> AmountPrice
UnitPrice  (Amount -> AmountPrice) -> Amount -> AmountPrice
forall a b. (a -> b) -> a -> b
$ Amount -> Amount
forall a. Num a => a -> a
negate Amount
unitprice Amount -> AmountPrecision -> Amount
`withPrecision` AmountPrecision
unitprecision

        unitprice :: Amount
unitprice     = Amount -> DecimalRaw Integer
aquantity Amount
fromamount DecimalRaw Integer -> Amount -> Amount
`divideAmount` Amount
toamount
        unitprecision :: AmountPrecision
unitprecision = case (AmountStyle -> AmountPrecision
asprecision (AmountStyle -> AmountPrecision) -> AmountStyle -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Amount -> AmountStyle
astyle Amount
fromamount, AmountStyle -> AmountPrecision
asprecision (AmountStyle -> AmountPrecision) -> AmountStyle -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Amount -> AmountStyle
astyle Amount
toamount) of
            (Precision Word8
a, Precision Word8
b) -> Word8 -> AmountPrecision
Precision (Word8 -> AmountPrecision)
-> (Word8 -> Word8) -> Word8 -> AmountPrecision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
max Word8
2 (Word8 -> AmountPrecision) -> Word8 -> AmountPrecision
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8
forall {a}. (Ord a, Num a, Bounded a) => a -> a -> a
saturatedAdd Word8
a Word8
b
            (AmountPrecision, AmountPrecision)
_                          -> AmountPrecision
NaturalPrecision
        saturatedAdd :: a -> a -> a
saturatedAdd a
a a
b = if a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. Num a => a -> a -> a
- a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b then a
forall a. Bounded a => a
maxBound else a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b


-- | Check any balance assertions in the journal and return an error message
-- if any of them fail (or if the transaction balancing they require fails).
journalCheckBalanceAssertions :: Journal -> Maybe String
journalCheckBalanceAssertions :: Journal -> Maybe [Char]
journalCheckBalanceAssertions = ([Char] -> Maybe [Char])
-> (Journal -> Maybe [Char])
-> Either [Char] Journal
-> Maybe [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (Maybe [Char] -> Journal -> Maybe [Char]
forall a b. a -> b -> a
const Maybe [Char]
forall a. Maybe a
Nothing) (Either [Char] Journal -> Maybe [Char])
-> (Journal -> Either [Char] Journal) -> Journal -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
defbalancingopts

-- "Transaction balancing", including: inferring missing amounts,
-- applying balance assignments, checking transaction balancedness,
-- checking balance assertions, respecting posting dates. These things
-- are all interdependent.
-- WARN tricky algorithm and code ahead. 
--
-- Code overview as of 20190219, this could/should be simplified/documented more:
--  parseAndFinaliseJournal['] (Cli/Utils.hs), journalAddForecast (Common.hs), journalAddBudgetGoalTransactions (BudgetReport.hs), tests (BalanceReport.hs)
--   journalBalanceTransactions
--    runST
--     runExceptT
--      balanceTransaction (Transaction.hs)
--       balanceTransactionHelper
--      runReaderT
--       balanceTransactionAndCheckAssertionsB
--        addAmountAndCheckAssertionB
--        addOrAssignAmountAndCheckAssertionB
--        balanceTransactionHelper (Transaction.hs)
--  uiCheckBalanceAssertions d ui@UIState{aopts=UIOpts{cliopts_=copts}, ajournal=j} (ErrorScreen.hs)
--   journalCheckBalanceAssertions
--    journalBalanceTransactions
--  transactionWizard, postingsBalanced (Add.hs), tests (Transaction.hs)
--   balanceTransaction (Transaction.hs)  XXX hledger add won't allow balance assignments + missing amount ?

-- | Monad used for statefully balancing/amount-inferring/assertion-checking
-- a sequence of transactions.
-- Perhaps can be simplified, or would a different ordering of layers make sense ?
-- If you see a way, let us know.
type Balancing s = ReaderT (BalancingState s) (ExceptT String (ST s))

-- | The state used while balancing a sequence of transactions.
data BalancingState s = BalancingState {
   -- read only
   forall s. BalancingState s -> Maybe (Map AccountName AmountStyle)
bsStyles       :: Maybe (M.Map CommoditySymbol AmountStyle)  -- ^ commodity display styles
  ,forall s. BalancingState s -> Set AccountName
bsUnassignable :: S.Set AccountName                          -- ^ accounts where balance assignments may not be used (because of auto posting rules)
  ,forall s. BalancingState s -> Bool
bsAssrt        :: Bool                                       -- ^ whether to check balance assertions
   -- mutable
  ,forall s. BalancingState s -> HashTable s AccountName MixedAmount
bsBalances     :: H.HashTable s AccountName MixedAmount      -- ^ running account balances, initially empty
  ,forall s. BalancingState s -> STArray s Integer Transaction
bsTransactions :: STArray s Integer Transaction              -- ^ a mutable array of the transactions being balanced
    -- (for efficiency ? journalBalanceTransactions says: not strictly necessary but avoids a sort at the end I think)
  }

-- | Access the current balancing state, and possibly modify the mutable bits,
-- lifting through the Except and Reader layers into the Balancing monad.
withRunningBalance :: (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance :: forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance BalancingState s -> ST s a
f = ReaderT
  (BalancingState s) (ExceptT [Char] (ST s)) (BalancingState s)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT
  (BalancingState s) (ExceptT [Char] (ST s)) (BalancingState s)
-> (BalancingState s
    -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) a)
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExceptT [Char] (ST s) a
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT [Char] (ST s) a
 -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) a)
-> (BalancingState s -> ExceptT [Char] (ST s) a)
-> BalancingState s
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST s a -> ExceptT [Char] (ST s) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s a -> ExceptT [Char] (ST s) a)
-> (BalancingState s -> ST s a)
-> BalancingState s
-> ExceptT [Char] (ST s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalancingState s -> ST s a
f

-- | Get this account's current exclusive running balance.
getRunningBalanceB :: AccountName -> Balancing s MixedAmount
getRunningBalanceB :: forall s. AccountName -> Balancing s MixedAmount
getRunningBalanceB AccountName
acc = (BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance ((BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount)
-> (BalancingState s -> ST s MixedAmount)
-> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ \BalancingState{HashTable s AccountName MixedAmount
bsBalances :: HashTable s AccountName MixedAmount
bsBalances :: forall s. BalancingState s -> HashTable s AccountName MixedAmount
bsBalances} -> do
  MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe MixedAmount
nullmixedamt (Maybe MixedAmount -> MixedAmount)
-> ST s (Maybe MixedAmount) -> ST s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashTable s AccountName MixedAmount
-> AccountName -> ST s (Maybe MixedAmount)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s AccountName MixedAmount
bsBalances AccountName
acc

-- | Add this amount to this account's exclusive running balance.
-- Returns the new running balance.
addToRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB :: forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB AccountName
acc MixedAmount
amt = (BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance ((BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount)
-> (BalancingState s -> ST s MixedAmount)
-> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ \BalancingState{HashTable s AccountName MixedAmount
bsBalances :: HashTable s AccountName MixedAmount
bsBalances :: forall s. BalancingState s -> HashTable s AccountName MixedAmount
bsBalances} -> do
  MixedAmount
old <- MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe MixedAmount
nullmixedamt (Maybe MixedAmount -> MixedAmount)
-> ST s (Maybe MixedAmount) -> ST s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashTable s AccountName MixedAmount
-> AccountName -> ST s (Maybe MixedAmount)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s AccountName MixedAmount
bsBalances AccountName
acc
  let new :: MixedAmount
new = MixedAmount -> MixedAmount -> MixedAmount
maPlus MixedAmount
old MixedAmount
amt
  HashTable s AccountName MixedAmount
-> AccountName -> MixedAmount -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s AccountName MixedAmount
bsBalances AccountName
acc MixedAmount
new
  MixedAmount -> ST s MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return MixedAmount
new

-- | Set this account's exclusive running balance to this amount.
-- Returns the change in exclusive running balance.
setRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
setRunningBalanceB :: forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
setRunningBalanceB AccountName
acc MixedAmount
amt = (BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance ((BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount)
-> (BalancingState s -> ST s MixedAmount)
-> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ \BalancingState{HashTable s AccountName MixedAmount
bsBalances :: HashTable s AccountName MixedAmount
bsBalances :: forall s. BalancingState s -> HashTable s AccountName MixedAmount
bsBalances} -> do
  MixedAmount
old <- MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe MixedAmount
nullmixedamt (Maybe MixedAmount -> MixedAmount)
-> ST s (Maybe MixedAmount) -> ST s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashTable s AccountName MixedAmount
-> AccountName -> ST s (Maybe MixedAmount)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s AccountName MixedAmount
bsBalances AccountName
acc
  HashTable s AccountName MixedAmount
-> AccountName -> MixedAmount -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s AccountName MixedAmount
bsBalances AccountName
acc MixedAmount
amt
  MixedAmount -> ST s MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return (MixedAmount -> ST s MixedAmount)
-> MixedAmount -> ST s MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount -> MixedAmount
maMinus MixedAmount
amt MixedAmount
old

-- | Set this account's exclusive running balance to whatever amount
-- makes its *inclusive* running balance (the sum of exclusive running
-- balances of this account and any subaccounts) be the given amount.
-- Returns the change in exclusive running balance.
setInclusiveRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
setInclusiveRunningBalanceB :: forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
setInclusiveRunningBalanceB AccountName
acc MixedAmount
newibal = (BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance ((BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount)
-> (BalancingState s -> ST s MixedAmount)
-> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ \BalancingState{HashTable s AccountName MixedAmount
bsBalances :: HashTable s AccountName MixedAmount
bsBalances :: forall s. BalancingState s -> HashTable s AccountName MixedAmount
bsBalances} -> do
  MixedAmount
oldebal  <- MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe MixedAmount
nullmixedamt (Maybe MixedAmount -> MixedAmount)
-> ST s (Maybe MixedAmount) -> ST s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashTable s AccountName MixedAmount
-> AccountName -> ST s (Maybe MixedAmount)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s AccountName MixedAmount
bsBalances AccountName
acc
  [(AccountName, MixedAmount)]
allebals <- HashTable s AccountName MixedAmount
-> ST s [(AccountName, MixedAmount)]
forall (h :: * -> * -> * -> *) s k v.
HashTable h =>
h s k v -> ST s [(k, v)]
H.toList HashTable s AccountName MixedAmount
bsBalances
  let subsibal :: MixedAmount
subsibal =  -- sum of any subaccounts' running balances
        [MixedAmount] -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum ([MixedAmount] -> MixedAmount)
-> ([(AccountName, MixedAmount)] -> [MixedAmount])
-> [(AccountName, MixedAmount)]
-> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AccountName, MixedAmount) -> MixedAmount)
-> [(AccountName, MixedAmount)] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName, MixedAmount) -> MixedAmount
forall a b. (a, b) -> b
snd ([(AccountName, MixedAmount)] -> MixedAmount)
-> [(AccountName, MixedAmount)] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ ((AccountName, MixedAmount) -> Bool)
-> [(AccountName, MixedAmount)] -> [(AccountName, MixedAmount)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((AccountName
acc AccountName -> AccountName -> Bool
`isAccountNamePrefixOf`)(AccountName -> Bool)
-> ((AccountName, MixedAmount) -> AccountName)
-> (AccountName, MixedAmount)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(AccountName, MixedAmount) -> AccountName
forall a b. (a, b) -> a
fst) [(AccountName, MixedAmount)]
allebals
  let newebal :: MixedAmount
newebal = MixedAmount -> MixedAmount -> MixedAmount
maMinus MixedAmount
newibal MixedAmount
subsibal
  HashTable s AccountName MixedAmount
-> AccountName -> MixedAmount -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s AccountName MixedAmount
bsBalances AccountName
acc MixedAmount
newebal
  MixedAmount -> ST s MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return (MixedAmount -> ST s MixedAmount)
-> MixedAmount -> ST s MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount -> MixedAmount
maMinus MixedAmount
newebal MixedAmount
oldebal

-- | Update (overwrite) this transaction in the balancing state.
updateTransactionB :: Transaction -> Balancing s ()
updateTransactionB :: forall s. Transaction -> Balancing s ()
updateTransactionB Transaction
t = (BalancingState s -> ST s ()) -> Balancing s ()
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance ((BalancingState s -> ST s ()) -> Balancing s ())
-> (BalancingState s -> ST s ()) -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ \BalancingState{STArray s Integer Transaction
bsTransactions :: STArray s Integer Transaction
bsTransactions :: forall s. BalancingState s -> STArray s Integer Transaction
bsTransactions}  ->
  ST s () -> ST s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ STArray s Integer Transaction -> Integer -> Transaction -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s Integer Transaction
bsTransactions (Transaction -> Integer
tindex Transaction
t) Transaction
t

-- | Infer any missing amounts (to satisfy balance assignments and
-- to balance transactions) and check that all transactions balance
-- and (optional) all balance assertions pass. Or return an error message
-- (just the first error encountered).
--
-- Assumes journalInferCommodityStyles has been called, since those
-- affect transaction balancing.
--
-- This does multiple things at once because amount inferring, balance
-- assignments, balance assertions and posting dates are interdependent.
journalBalanceTransactions :: BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions :: BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
bopts' Journal
j' =
  let
    -- ensure transactions are numbered, so we can store them by number
    j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal -> Journal
journalNumberTransactions Journal
j'
    -- display precisions used in balanced checking
    styles :: Maybe (Map AccountName AmountStyle)
styles = Map AccountName AmountStyle -> Maybe (Map AccountName AmountStyle)
forall a. a -> Maybe a
Just (Map AccountName AmountStyle
 -> Maybe (Map AccountName AmountStyle))
-> Map AccountName AmountStyle
-> Maybe (Map AccountName AmountStyle)
forall a b. (a -> b) -> a -> b
$ Journal -> Map AccountName AmountStyle
journalCommodityStyles Journal
j
    bopts :: BalancingOpts
bopts = BalancingOpts
bopts'{commodity_styles_ :: Maybe (Map AccountName AmountStyle)
commodity_styles_=Maybe (Map AccountName AmountStyle)
styles}
    -- balance assignments are not allowed on accounts affected by auto postings
    autopostingaccts :: Set AccountName
autopostingaccts = [AccountName] -> Set AccountName
forall a. Ord a => [a] -> Set a
S.fromList ([AccountName] -> Set AccountName)
-> ([TransactionModifier] -> [AccountName])
-> [TransactionModifier]
-> Set AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TMPostingRule -> AccountName) -> [TMPostingRule] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map (Posting -> AccountName
paccount (Posting -> AccountName)
-> (TMPostingRule -> Posting) -> TMPostingRule -> AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMPostingRule -> Posting
tmprPosting) ([TMPostingRule] -> [AccountName])
-> ([TransactionModifier] -> [TMPostingRule])
-> [TransactionModifier]
-> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransactionModifier -> [TMPostingRule])
-> [TransactionModifier] -> [TMPostingRule]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TransactionModifier -> [TMPostingRule]
tmpostingrules ([TransactionModifier] -> Set AccountName)
-> [TransactionModifier] -> Set AccountName
forall a b. (a -> b) -> a -> b
$ Journal -> [TransactionModifier]
jtxnmodifiers Journal
j
  in
    (forall s. ST s (Either [Char] Journal)) -> Either [Char] Journal
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Either [Char] Journal)) -> Either [Char] Journal)
-> (forall s. ST s (Either [Char] Journal))
-> Either [Char] Journal
forall a b. (a -> b) -> a -> b
$ do
      -- We'll update a mutable array of transactions as we balance them,
      -- not strictly necessary but avoids a sort at the end I think.
      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

      -- Infer missing posting amounts, check transactions are balanced,
      -- and check balance assertions. This is done in two passes:
      ExceptT [Char] (ST s) Journal -> ST s (Either [Char] Journal)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [Char] (ST s) Journal -> ST s (Either [Char] Journal))
-> ExceptT [Char] (ST s) Journal -> ST s (Either [Char] Journal)
forall a b. (a -> b) -> a -> b
$ do

        -- 1. Step through the transactions, balancing the ones which don't have balance assignments
        -- and leaving the others for later. The balanced ones are split into their postings.
        -- The postings and not-yet-balanced transactions remain in the same relative order.
        [Either Posting Transaction]
psandts :: [Either Posting Transaction] <- ([[Either Posting Transaction]] -> [Either Posting Transaction])
-> ExceptT [Char] (ST s) [[Either Posting Transaction]]
-> ExceptT [Char] (ST s) [Either Posting Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Either Posting Transaction]] -> [Either Posting Transaction]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ExceptT [Char] (ST s) [[Either Posting Transaction]]
 -> ExceptT [Char] (ST s) [Either Posting Transaction])
-> ExceptT [Char] (ST s) [[Either Posting Transaction]]
-> ExceptT [Char] (ST s) [Either Posting Transaction]
forall a b. (a -> b) -> a -> b
$ [Transaction]
-> (Transaction
    -> ExceptT [Char] (ST s) [Either Posting Transaction])
-> ExceptT [Char] (ST s) [[Either Posting Transaction]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Transaction]
ts ((Transaction
  -> ExceptT [Char] (ST s) [Either Posting Transaction])
 -> ExceptT [Char] (ST s) [[Either Posting Transaction]])
-> (Transaction
    -> ExceptT [Char] (ST s) [Either Posting Transaction])
-> ExceptT [Char] (ST s) [[Either Posting Transaction]]
forall a b. (a -> b) -> a -> b
$ \case
          Transaction
t | [Posting] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Posting] -> Bool) -> [Posting] -> Bool
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
assignmentPostings Transaction
t -> case BalancingOpts -> Transaction -> Either [Char] Transaction
balanceTransaction BalancingOpts
bopts Transaction
t of
              Left  [Char]
e  -> [Char] -> ExceptT [Char] (ST s) [Either Posting Transaction]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [Char]
e
              Right Transaction
t' -> do
                ST s () -> ExceptT [Char] (ST s) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s () -> ExceptT [Char] (ST s) ())
-> ST s () -> ExceptT [Char] (ST s) ()
forall a b. (a -> b) -> a -> b
$ STArray s Integer Transaction -> Integer -> Transaction -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s Integer Transaction
balancedtxns (Transaction -> Integer
tindex Transaction
t') Transaction
t'
                [Either Posting Transaction]
-> ExceptT [Char] (ST s) [Either Posting Transaction]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either Posting Transaction]
 -> ExceptT [Char] (ST s) [Either Posting Transaction])
-> [Either Posting Transaction]
-> ExceptT [Char] (ST s) [Either Posting Transaction]
forall a b. (a -> b) -> a -> b
$ (Posting -> Either Posting Transaction)
-> [Posting] -> [Either Posting Transaction]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Either Posting Transaction
forall a b. a -> Either a b
Left ([Posting] -> [Either Posting Transaction])
-> [Posting] -> [Either Posting Transaction]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t'
          Transaction
t -> [Either Posting Transaction]
-> ExceptT [Char] (ST s) [Either Posting Transaction]
forall (m :: * -> *) a. Monad m => a -> m a
return [Transaction -> Either Posting Transaction
forall a b. b -> Either a b
Right Transaction
t]

        -- 2. Sort these items by date, preserving the order of same-day items,
        -- and step through them while keeping running account balances,
        HashTable s AccountName MixedAmount
runningbals <- ST s (HashTable s AccountName MixedAmount)
-> ExceptT [Char] (ST s) (HashTable s AccountName MixedAmount)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s (HashTable s AccountName MixedAmount)
 -> ExceptT [Char] (ST s) (HashTable s AccountName MixedAmount))
-> ST s (HashTable s AccountName MixedAmount)
-> ExceptT [Char] (ST s) (HashTable s AccountName MixedAmount)
forall a b. (a -> b) -> a -> b
$ Int -> ST s (HashTable s AccountName MixedAmount)
forall s k v. Int -> ST s (HashTable s k v)
H.newSized ([AccountName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([AccountName] -> Int) -> [AccountName] -> Int
forall a b. (a -> b) -> a -> b
$ Journal -> [AccountName]
journalAccountNamesUsed Journal
j)
        (ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
 -> BalancingState s -> ExceptT [Char] (ST s) ())
-> BalancingState s
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ExceptT [Char] (ST s) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> BalancingState s -> ExceptT [Char] (ST s) ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Maybe (Map AccountName AmountStyle)
-> Set AccountName
-> Bool
-> HashTable s AccountName MixedAmount
-> STArray s Integer Transaction
-> BalancingState s
forall s.
Maybe (Map AccountName AmountStyle)
-> Set AccountName
-> Bool
-> HashTable s AccountName MixedAmount
-> STArray s Integer Transaction
-> BalancingState s
BalancingState Maybe (Map AccountName AmountStyle)
styles Set AccountName
autopostingaccts (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Bool
ignore_assertions_ BalancingOpts
bopts) HashTable s AccountName MixedAmount
runningbals STArray s Integer Transaction
balancedtxns) (ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
 -> ExceptT [Char] (ST s) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ExceptT [Char] (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
          -- performing balance assignments in, and balancing, the remaining transactions,
          -- and checking balance assertions as each posting is processed.
          ReaderT (BalancingState s) (ExceptT [Char] (ST s)) [()]
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT (BalancingState s) (ExceptT [Char] (ST s)) [()]
 -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) [()]
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$ (Either Posting Transaction
 -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> [Either Posting Transaction]
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) [()]
forall (f :: * -> *) a b. Monad f => (a -> f b) -> [a] -> f [b]
mapM' Either Posting Transaction
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall s. Either Posting Transaction -> Balancing s ()
balanceTransactionAndCheckAssertionsB ([Either Posting Transaction]
 -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) [()])
-> [Either Posting Transaction]
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) [()]
forall a b. (a -> b) -> a -> b
$ (Either Posting Transaction -> Day)
-> [Either Posting Transaction] -> [Either Posting Transaction]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((Posting -> Day)
-> (Transaction -> Day) -> Either Posting Transaction -> Day
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Posting -> Day
postingDate Transaction -> Day
tdate) [Either Posting Transaction]
psandts

        [Transaction]
ts' <- ST s [Transaction] -> ExceptT [Char] (ST s) [Transaction]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s [Transaction] -> ExceptT [Char] (ST s) [Transaction])
-> ST s [Transaction] -> ExceptT [Char] (ST s) [Transaction]
forall a b. (a -> b) -> a -> b
$ STArray s Integer Transaction -> ST s [Transaction]
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m [e]
getElems STArray s Integer Transaction
balancedtxns
        Journal -> ExceptT [Char] (ST s) Journal
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
j{jtxns :: [Transaction]
jtxns=[Transaction]
ts'}

-- | This function is called statefully on each of a date-ordered sequence of
-- 1. fully explicit postings from already-balanced transactions and
-- 2. not-yet-balanced transactions containing balance assignments.
-- It executes balance assignments and finishes balancing the transactions,
-- and checks balance assertions on each posting as it goes.
-- An error will be thrown if a transaction can't be balanced
-- or if an illegal balance assignment is found (cf checkIllegalBalanceAssignment).
-- Transaction prices are removed, which helps eg balance-assertions.test: 15. Mix different commodities and assignments.
-- This stores the balanced transactions in case 2 but not in case 1.
balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing s ()
balanceTransactionAndCheckAssertionsB :: forall s. Either Posting Transaction -> Balancing s ()
balanceTransactionAndCheckAssertionsB (Left p :: Posting
p@Posting{}) =
  -- update the account's running balance and check the balance assertion if any
  ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Posting
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Posting
 -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> (Posting
    -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Posting)
-> Posting
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Posting
forall s. Posting -> Balancing s Posting
addAmountAndCheckAssertionB (Posting -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> Posting -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting -> Posting
postingStripPrices Posting
p
balanceTransactionAndCheckAssertionsB (Right t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps}) = do
  -- make sure we can handle the balance assignments
  (Posting -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> [Posting]
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Posting -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall s. Posting -> Balancing s ()
checkIllegalBalanceAssignmentB [Posting]
ps
  -- for each posting, infer its amount from the balance assignment if applicable,
  -- update the account's running balance and check the balance assertion if any
  [Posting]
ps' <- (Posting
 -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Posting)
-> [Posting]
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) [Posting]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Posting
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Posting
forall s. Posting -> Balancing s Posting
addOrAssignAmountAndCheckAssertionB (Posting
 -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Posting)
-> (Posting -> Posting)
-> Posting
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Posting
postingStripPrices) [Posting]
ps
  -- infer any remaining missing amounts, and make sure the transaction is now fully balanced
  Maybe (Map AccountName AmountStyle)
styles <- (BalancingState s -> Maybe (Map AccountName AmountStyle))
-> ReaderT
     (BalancingState s)
     (ExceptT [Char] (ST s))
     (Maybe (Map AccountName AmountStyle))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Maybe (Map AccountName AmountStyle)
forall s. BalancingState s -> Maybe (Map AccountName AmountStyle)
bsStyles
  case BalancingOpts
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
balanceTransactionHelper BalancingOpts
defbalancingopts{commodity_styles_ :: Maybe (Map AccountName AmountStyle)
commodity_styles_=Maybe (Map AccountName AmountStyle)
styles} Transaction
t{tpostings :: [Posting]
tpostings=[Posting]
ps'} of
    Left [Char]
err -> [Char] -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [Char]
err
    Right (Transaction
t', [(AccountName, MixedAmount)]
inferredacctsandamts) -> do
      -- for each amount just inferred, update the running balance
      ((AccountName, MixedAmount)
 -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) MixedAmount)
-> [(AccountName, MixedAmount)]
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((AccountName
 -> MixedAmount
 -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) MixedAmount)
-> (AccountName, MixedAmount)
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) MixedAmount
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AccountName
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB) [(AccountName, MixedAmount)]
inferredacctsandamts
      -- and save the balanced transaction.
      Transaction
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall s. Transaction -> Balancing s ()
updateTransactionB Transaction
t'

-- | If this posting has an explicit amount, add it to the account's running balance.
-- If it has a missing amount and a balance assignment, infer the amount from, and
-- reset the running balance to, the assigned balance.
-- If it has a missing amount and no balance assignment, leave it for later.
-- Then test the balance assertion if any.
addOrAssignAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addOrAssignAmountAndCheckAssertionB :: forall s. Posting -> Balancing s Posting
addOrAssignAmountAndCheckAssertionB p :: Posting
p@Posting{paccount :: Posting -> AccountName
paccount=AccountName
acc, pamount :: Posting -> MixedAmount
pamount=MixedAmount
amt, pbalanceassertion :: Posting -> Maybe BalanceAssertion
pbalanceassertion=Maybe BalanceAssertion
mba}
  -- an explicit posting amount
  | Posting -> Bool
hasAmount Posting
p = do
      MixedAmount
newbal <- AccountName -> MixedAmount -> Balancing s MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB AccountName
acc MixedAmount
amt
      ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Bool
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((BalancingState s -> Bool)
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Bool
forall s. BalancingState s -> Bool
bsAssrt) (ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
 -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall s. Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB Posting
p MixedAmount
newbal
      Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p

  -- no explicit posting amount, but there is a balance assignment
  | 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
                   -- a total balance assignment (==, all commodities)
                   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
                   -- a partial balance assignment (=, one commodity)
                   else do
                     MixedAmount
oldbalothercommodities <- (Amount -> Bool) -> MixedAmount -> MixedAmount
filterMixedAmount ((Amount -> AccountName
acommodity Amount
baamount AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
/=) (AccountName -> Bool) -> (Amount -> AccountName) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> AccountName
acommodity) (MixedAmount -> MixedAmount)
-> Balancing s MixedAmount -> Balancing s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AccountName -> Balancing s MixedAmount
forall s. AccountName -> Balancing s MixedAmount
getRunningBalanceB AccountName
acc
                     MixedAmount -> Balancing s MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return (MixedAmount -> Balancing s MixedAmount)
-> MixedAmount -> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> Amount -> MixedAmount
maAddAmount MixedAmount
oldbalothercommodities Amount
baamount
      MixedAmount
diff <- (if Bool
bainclusive then AccountName -> MixedAmount -> Balancing s MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
setInclusiveRunningBalanceB else AccountName -> MixedAmount -> Balancing s MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
setRunningBalanceB) AccountName
acc MixedAmount
newbal
      let p' :: Posting
p' = Posting
p{pamount :: MixedAmount
pamount=(Amount -> Bool) -> MixedAmount -> MixedAmount
filterMixedAmount (Bool -> Bool
not (Bool -> Bool) -> (Amount -> Bool) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Bool
amountIsZero) MixedAmount
diff, poriginal :: Maybe Posting
poriginal=Posting -> Maybe Posting
forall a. a -> Maybe a
Just (Posting -> Maybe Posting) -> Posting -> Maybe Posting
forall a b. (a -> b) -> a -> b
$ Posting -> Posting
originalPosting Posting
p}
      ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Bool
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((BalancingState s -> Bool)
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Bool
forall s. BalancingState s -> Bool
bsAssrt) (ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
 -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall s. Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB Posting
p' MixedAmount
newbal
      Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p'

  -- no explicit posting amount, no balance assignment
  | Bool
otherwise = Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p

-- | Add the posting's amount to its account's running balance, and
-- optionally check the posting's balance assertion if any.
-- The posting is expected to have an explicit amount (otherwise this does nothing).
-- Adding and checking balance assertions are tightly paired because we
-- need to see the balance as it stands after each individual posting.
addAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addAmountAndCheckAssertionB :: forall s. Posting -> Balancing s Posting
addAmountAndCheckAssertionB Posting
p | Posting -> Bool
hasAmount Posting
p = do
  MixedAmount
newbal <- AccountName -> MixedAmount -> Balancing s MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB (Posting -> AccountName
paccount Posting
p) (MixedAmount -> Balancing s MixedAmount)
-> MixedAmount -> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
  ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Bool
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((BalancingState s -> Bool)
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Bool
forall s. BalancingState s -> Bool
bsAssrt) (ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
 -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall s. Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB Posting
p MixedAmount
newbal
  Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p
addAmountAndCheckAssertionB Posting
p = Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p

-- | Check a posting's balance assertion against the given actual balance, and
-- return an error if the assertion is not satisfied.
-- If the assertion is partial, unasserted commodities in the actual balance
-- are ignored; if it is total, they will cause the assertion to fail.
checkBalanceAssertionB :: Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB :: forall s. Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB p :: Posting
p@Posting{pbalanceassertion :: Posting -> Maybe BalanceAssertion
pbalanceassertion=Just (BalanceAssertion{Amount
baamount :: Amount
baamount :: BalanceAssertion -> Amount
baamount,Bool
batotal :: Bool
batotal :: BalanceAssertion -> Bool
batotal})} MixedAmount
actualbal =
    [Amount]
-> (Amount
    -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Amount
baamount Amount -> [Amount] -> [Amount]
forall a. a -> [a] -> [a]
: [Amount]
otheramts) ((Amount -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
 -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> (Amount
    -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$ \Amount
amt -> Posting
-> Amount
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall s. Posting -> Amount -> MixedAmount -> Balancing s ()
checkBalanceAssertionOneCommodityB Posting
p Amount
amt MixedAmount
actualbal
  where
    assertedcomm :: AccountName
assertedcomm = Amount -> AccountName
acommodity Amount
baamount
    otheramts :: [Amount]
otheramts | Bool
batotal   = (Amount -> Amount) -> [Amount] -> [Amount]
forall a b. (a -> b) -> [a] -> [b]
map (\Amount
a -> Amount
a{aquantity :: DecimalRaw Integer
aquantity=DecimalRaw Integer
0}) ([Amount] -> [Amount])
-> (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amountsRaw
                          (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ (Amount -> Bool) -> MixedAmount -> MixedAmount
filterMixedAmount ((AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
/=AccountName
assertedcomm)(AccountName -> Bool) -> (Amount -> AccountName) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Amount -> AccountName
acommodity) MixedAmount
actualbal
              | Bool
otherwise = []
checkBalanceAssertionB Posting
_ MixedAmount
_ = () -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Does this (single commodity) expected balance match the amount of that
-- commodity in the given (multicommodity) actual balance ? If not, returns a
-- balance assertion failure message based on the provided posting.  To match,
-- the amounts must be exactly equal (display precision is ignored here).
-- If the assertion is inclusive, the expected amount is compared with the account's
-- subaccount-inclusive balance; otherwise, with the subaccount-exclusive balance.
checkBalanceAssertionOneCommodityB :: Posting -> Amount -> MixedAmount -> Balancing s ()
checkBalanceAssertionOneCommodityB :: forall s. Posting -> Amount -> MixedAmount -> Balancing s ()
checkBalanceAssertionOneCommodityB p :: Posting
p@Posting{paccount :: Posting -> AccountName
paccount=AccountName
assertedacct} Amount
assertedamt MixedAmount
actualbal = do
  let isinclusive :: Bool
isinclusive = Bool
-> (BalanceAssertion -> Bool) -> Maybe BalanceAssertion -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False BalanceAssertion -> Bool
bainclusive (Maybe BalanceAssertion -> Bool) -> Maybe BalanceAssertion -> Bool
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe BalanceAssertion
pbalanceassertion Posting
p
  MixedAmount
actualbal' <-
    if Bool
isinclusive
    then
      -- sum the running balances of this account and any of its subaccounts seen so far
      (BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance ((BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount)
-> (BalancingState s -> ST s MixedAmount)
-> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ \BalancingState{HashTable s AccountName MixedAmount
bsBalances :: HashTable s AccountName MixedAmount
bsBalances :: forall s. BalancingState s -> HashTable s AccountName MixedAmount
bsBalances} ->
        (MixedAmount -> (AccountName, MixedAmount) -> ST s MixedAmount)
-> MixedAmount
-> HashTable s AccountName MixedAmount
-> ST s MixedAmount
forall a k v s.
(a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
H.foldM
          (\MixedAmount
ibal (AccountName
acc, MixedAmount
amt) -> MixedAmount -> ST s MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return (MixedAmount -> ST s MixedAmount)
-> MixedAmount -> ST s MixedAmount
forall a b. (a -> b) -> a -> b
$
            if AccountName
assertedacctAccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
==AccountName
acc Bool -> Bool -> Bool
|| AccountName
assertedacct AccountName -> AccountName -> Bool
`isAccountNamePrefixOf` AccountName
acc then MixedAmount -> MixedAmount -> MixedAmount
maPlus MixedAmount
ibal MixedAmount
amt else MixedAmount
ibal)
          MixedAmount
nullmixedamt
          HashTable s AccountName MixedAmount
bsBalances
    else MixedAmount -> Balancing s MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return MixedAmount
actualbal
  let
    assertedcomm :: AccountName
assertedcomm    = Amount -> AccountName
acommodity Amount
assertedamt
    actualbalincomm :: Amount
actualbalincomm = Amount -> [Amount] -> Amount
forall a. a -> [a] -> a
headDef Amount
nullamt ([Amount] -> Amount)
-> (MixedAmount -> [Amount]) -> MixedAmount -> Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amountsRaw (MixedAmount -> [Amount])
-> (MixedAmount -> MixedAmount) -> MixedAmount -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> MixedAmount -> MixedAmount
filterMixedAmountByCommodity AccountName
assertedcomm (MixedAmount -> Amount) -> MixedAmount -> Amount
forall a b. (a -> b) -> a -> b
$ MixedAmount
actualbal'
    pass :: Bool
pass =
      Amount -> DecimalRaw Integer
aquantity
        -- traceWith (("asserted:"++).showAmountDebug)
        Amount
assertedamt DecimalRaw Integer -> DecimalRaw Integer -> Bool
forall a. Eq a => a -> a -> Bool
==
      Amount -> DecimalRaw Integer
aquantity
        -- traceWith (("actual:"++).showAmountDebug)
        Amount
actualbalincomm

    errmsg :: [Char]
errmsg = [Char]
-> [Char]
-> AccountName
-> [Char]
-> [Char]
-> AccountName
-> [Char]
-> [Char]
-> ShowS
forall r. PrintfType r => [Char] -> r
printf ([[Char]] -> [Char]
unlines
                  [ [Char]
"balance assertion: %s",
                    [Char]
"\nassertion details:",
                    [Char]
"date:       %s",
                    [Char]
"account:    %s%s",
                    [Char]
"commodity:  %s",
                    -- "display precision:  %d",
                    [Char]
"calculated: %s", -- (at display precision: %s)",
                    [Char]
"asserted:   %s", -- (at display precision: %s)",
                    [Char]
"difference: %s"
                  ])
      (case Posting -> Maybe Transaction
ptransaction Posting
p of
         Maybe Transaction
Nothing -> [Char]
"?" -- shouldn't happen
         Just Transaction
t ->  [Char] -> [Char] -> AccountName -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s\ntransaction:\n%s"
                      (SourcePos -> [Char]
showSourcePos SourcePos
pos)
                      (AccountName -> AccountName
textChomp (AccountName -> AccountName) -> AccountName -> AccountName
forall a b. (a -> b) -> a -> b
$ Transaction -> AccountName
showTransaction Transaction
t)
                      :: String
                      where
                        pos :: SourcePos
pos = BalanceAssertion -> SourcePos
baposition (BalanceAssertion -> SourcePos) -> BalanceAssertion -> SourcePos
forall a b. (a -> b) -> a -> b
$ Maybe BalanceAssertion -> BalanceAssertion
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe BalanceAssertion -> BalanceAssertion)
-> Maybe BalanceAssertion -> BalanceAssertion
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe BalanceAssertion
pbalanceassertion Posting
p
      )
      (Day -> AccountName
showDate (Day -> AccountName) -> Day -> AccountName
forall a b. (a -> b) -> a -> b
$ Posting -> Day
postingDate Posting
p)
      (AccountName -> [Char]
T.unpack (AccountName -> [Char]) -> AccountName -> [Char]
forall a b. (a -> b) -> a -> b
$ Posting -> AccountName
paccount Posting
p) -- XXX pack
      (if Bool
isinclusive then [Char]
" (and subs)" else [Char]
"" :: String)
      AccountName
assertedcomm
      -- (asprecision $ astyle actualbalincommodity)  -- should be the standard display precision I think
      (DecimalRaw Integer -> [Char]
forall a. Show a => a -> [Char]
show (DecimalRaw Integer -> [Char]) -> DecimalRaw Integer -> [Char]
forall a b. (a -> b) -> a -> b
$ Amount -> DecimalRaw Integer
aquantity Amount
actualbalincomm)
      -- (showAmount actualbalincommodity)
      (DecimalRaw Integer -> [Char]
forall a. Show a => a -> [Char]
show (DecimalRaw Integer -> [Char]) -> DecimalRaw Integer -> [Char]
forall a b. (a -> b) -> a -> b
$ Amount -> DecimalRaw Integer
aquantity Amount
assertedamt)
      -- (showAmount assertedamt)
      (DecimalRaw Integer -> [Char]
forall a. Show a => a -> [Char]
show (DecimalRaw Integer -> [Char]) -> DecimalRaw Integer -> [Char]
forall a b. (a -> b) -> a -> b
$ Amount -> DecimalRaw Integer
aquantity Amount
assertedamt DecimalRaw Integer -> DecimalRaw Integer -> DecimalRaw Integer
forall a. Num a => a -> a -> a
- Amount -> DecimalRaw Integer
aquantity Amount
actualbalincomm)

  Bool -> Balancing s () -> Balancing s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
pass (Balancing s () -> Balancing s ())
-> Balancing s () -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Balancing s ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [Char]
errmsg

-- | Throw an error if this posting is trying to do an illegal balance assignment.
checkIllegalBalanceAssignmentB :: Posting -> Balancing s ()
checkIllegalBalanceAssignmentB :: forall s. Posting -> Balancing s ()
checkIllegalBalanceAssignmentB Posting
p = do
  Posting -> Balancing s ()
forall s. Posting -> Balancing s ()
checkBalanceAssignmentPostingDateB Posting
p
  Posting -> Balancing s ()
forall s. Posting -> Balancing s ()
checkBalanceAssignmentUnassignableAccountB Posting
p

-- XXX these should show position. annotateErrorWithTransaction t ?

-- | Throw an error if this posting is trying to do a balance assignment and
-- has a custom posting date (which makes amount inference too hard/impossible).
checkBalanceAssignmentPostingDateB :: Posting -> Balancing s ()
checkBalanceAssignmentPostingDateB :: forall s. Posting -> Balancing s ()
checkBalanceAssignmentPostingDateB Posting
p =
  Bool
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Posting -> Bool
hasBalanceAssignment Posting
p Bool -> Bool -> Bool
&& Maybe Day -> Bool
forall a. Maybe a -> Bool
isJust (Posting -> Maybe Day
pdate Posting
p)) (ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
 -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> [Char] -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$ ShowS
chomp ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [
       [Char]
"can't use balance assignment with custom posting date"
      ,[Char]
""
      ,ShowS
chomp1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ AccountName -> [Char]
T.unpack (AccountName -> [Char]) -> AccountName -> [Char]
forall a b. (a -> b) -> a -> b
$ AccountName
-> (Transaction -> AccountName) -> Maybe Transaction -> AccountName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([AccountName] -> AccountName
T.unlines ([AccountName] -> AccountName) -> [AccountName] -> AccountName
forall a b. (a -> b) -> a -> b
$ Posting -> [AccountName]
showPostingLines Posting
p) Transaction -> AccountName
showTransaction (Maybe Transaction -> AccountName)
-> Maybe Transaction -> AccountName
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
      ,[Char]
"Balance assignments may not be used on postings with a custom posting date"
      ,[Char]
"(it makes balancing the journal impossible)."
      ,[Char]
"Please write the posting amount explicitly (or remove the posting date)."
      ]

-- | Throw an error if this posting is trying to do a balance assignment and
-- the account does not allow balance assignments (eg because it is referenced
-- by an auto posting rule, which might generate additional postings to it).
checkBalanceAssignmentUnassignableAccountB :: Posting -> Balancing s ()
checkBalanceAssignmentUnassignableAccountB :: forall s. Posting -> Balancing s ()
checkBalanceAssignmentUnassignableAccountB Posting
p = do
  Set AccountName
unassignable <- (BalancingState s -> Set AccountName)
-> ReaderT
     (BalancingState s) (ExceptT [Char] (ST s)) (Set AccountName)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.asks BalancingState s -> Set AccountName
forall s. BalancingState s -> Set AccountName
bsUnassignable
  Bool -> Balancing s () -> Balancing s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Posting -> Bool
hasBalanceAssignment Posting
p Bool -> Bool -> Bool
&& Posting -> AccountName
paccount Posting
p AccountName -> Set AccountName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set AccountName
unassignable) (Balancing s () -> Balancing s ())
-> Balancing s () -> Balancing s ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> Balancing s ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> Balancing s ()) -> [Char] -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ ShowS
chomp ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [
       [Char]
"can't use balance assignment with auto postings"
      ,[Char]
""
      ,ShowS
chomp1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ AccountName -> [Char]
T.unpack (AccountName -> [Char]) -> AccountName -> [Char]
forall a b. (a -> b) -> a -> b
$ AccountName
-> (Transaction -> AccountName) -> Maybe Transaction -> AccountName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([AccountName] -> AccountName
T.unlines ([AccountName] -> AccountName) -> [AccountName] -> AccountName
forall a b. (a -> b) -> a -> b
$ Posting -> [AccountName]
showPostingLines Posting
p) (Transaction -> AccountName
showTransaction) (Maybe Transaction -> AccountName)
-> Maybe Transaction -> AccountName
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
      ,[Char]
"Balance assignments may not be used on accounts affected by auto posting rules"
      ,[Char]
"(it makes balancing the journal impossible)."
      ,[Char]
"Please write the posting amount explicitly (or remove the auto posting rule(s))."
      ]

-- lenses

makeHledgerClassyLenses ''BalancingOpts

-- tests

tests_Balancing :: TestTree
tests_Balancing :: TestTree
tests_Balancing =
  [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Balancing" [

      [Char] -> Assertion -> TestTree
testCase [Char]
"inferBalancingAmount" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
         ((Transaction, [(AccountName, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst ((Transaction, [(AccountName, MixedAmount)]) -> Transaction)
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
-> Either [Char] Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map AccountName AmountStyle
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
inferBalancingAmount Map AccountName AmountStyle
forall k a. Map k a
M.empty Transaction
nulltransaction) Either [Char] Transaction -> Either [Char] Transaction -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Transaction -> Either [Char] Transaction
forall a b. b -> Either a b
Right Transaction
nulltransaction
         ((Transaction, [(AccountName, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst ((Transaction, [(AccountName, MixedAmount)]) -> Transaction)
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
-> Either [Char] Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map AccountName AmountStyle
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
inferBalancingAmount Map AccountName AmountStyle
forall k a. Map k a
M.empty Transaction
nulltransaction{tpostings :: [Posting]
tpostings = [AccountName
"a" AccountName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
5), AccountName
"b" AccountName -> Amount -> Posting
`post` Amount
missingamt]}) Either [Char] Transaction -> Either [Char] Transaction -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
           Transaction -> Either [Char] Transaction
forall a b. b -> Either a b
Right Transaction
nulltransaction{tpostings :: [Posting]
tpostings = [AccountName
"a" AccountName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
5), AccountName
"b" AccountName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
5]}
         ((Transaction, [(AccountName, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst ((Transaction, [(AccountName, MixedAmount)]) -> Transaction)
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
-> Either [Char] Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map AccountName AmountStyle
-> Transaction
-> Either [Char] (Transaction, [(AccountName, MixedAmount)])
inferBalancingAmount Map AccountName AmountStyle
forall k a. Map k a
M.empty Transaction
nulltransaction{tpostings :: [Posting]
tpostings = [AccountName
"a" AccountName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
5), AccountName
"b" AccountName -> Amount -> Posting
`post` (DecimalRaw Integer -> Amount
eur DecimalRaw Integer
3 Amount -> Amount -> Amount
@@ DecimalRaw Integer -> Amount
usd DecimalRaw Integer
4), AccountName
"c" AccountName -> Amount -> Posting
`post` Amount
missingamt]}) Either [Char] Transaction -> Either [Char] Transaction -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
           Transaction -> Either [Char] Transaction
forall a b. b -> Either a b
Right Transaction
nulltransaction{tpostings :: [Posting]
tpostings = [AccountName
"a" AccountName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
5), AccountName
"b" AccountName -> Amount -> Posting
`post` (DecimalRaw Integer -> Amount
eur DecimalRaw Integer
3 Amount -> Amount -> Amount
@@ DecimalRaw Integer -> Amount
usd DecimalRaw Integer
4), AccountName
"c" AccountName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1]}

    , [Char] -> [TestTree] -> TestTree
testGroup [Char]
"balanceTransaction" [
         [Char] -> Assertion -> TestTree
testCase [Char]
"detect unbalanced entry, sign error" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          Either [Char] Transaction -> Assertion
forall b a. (HasCallStack, Eq b, Show b) => Either a b -> Assertion
assertLeft
            (BalancingOpts -> Transaction -> Either [Char] Transaction
balanceTransaction BalancingOpts
defbalancingopts
               (Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                  Integer
0
                  AccountName
""
                  (SourcePos, SourcePos)
nullsourcepos
                  (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                  Maybe Day
forall a. Maybe a
Nothing
                  Status
Unmarked
                  AccountName
""
                  AccountName
"test"
                  AccountName
""
                  []
                  [Posting
posting {paccount :: AccountName
paccount = AccountName
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1)}, Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1)}]))
        ,[Char] -> Assertion -> TestTree
testCase [Char]
"detect unbalanced entry, multiple missing amounts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          Either [Char] Transaction -> Assertion
forall b a. (HasCallStack, Eq b, Show b) => Either a b -> Assertion
assertLeft (Either [Char] Transaction -> Assertion)
-> Either [Char] Transaction -> Assertion
forall a b. (a -> b) -> a -> b
$
             BalancingOpts -> Transaction -> Either [Char] Transaction
balanceTransaction BalancingOpts
defbalancingopts
               (Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                  Integer
0
                  AccountName
""
                  (SourcePos, SourcePos)
nullsourcepos
                  (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                  Maybe Day
forall a. Maybe a
Nothing
                  Status
Unmarked
                  AccountName
""
                  AccountName
"test"
                  AccountName
""
                  []
                  [ Posting
posting {paccount :: AccountName
paccount = AccountName
"a", pamount :: MixedAmount
pamount = MixedAmount
missingmixedamt}
                  , Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = MixedAmount
missingmixedamt}
                  ])
        ,[Char] -> Assertion -> TestTree
testCase [Char]
"one missing amount is inferred" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          (Posting -> MixedAmount
pamount (Posting -> MixedAmount)
-> (Transaction -> Posting) -> Transaction -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Posting] -> Posting
forall a. [a] -> a
last ([Posting] -> Posting)
-> (Transaction -> [Posting]) -> Transaction -> Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings (Transaction -> MixedAmount)
-> Either [Char] Transaction -> Either [Char] MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
           BalancingOpts -> Transaction -> Either [Char] Transaction
balanceTransaction BalancingOpts
defbalancingopts
             (Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                Integer
0
                AccountName
""
                (SourcePos, SourcePos)
nullsourcepos
                (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                Maybe Day
forall a. Maybe a
Nothing
                Status
Unmarked
                AccountName
""
                AccountName
""
                AccountName
""
                []
                [Posting
posting {paccount :: AccountName
paccount = AccountName
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1)}, Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = MixedAmount
missingmixedamt}])) Either [Char] MixedAmount -> Either [Char] MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          MixedAmount -> Either [Char] MixedAmount
forall a b. b -> Either a b
Right (Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1))
        ,[Char] -> Assertion -> TestTree
testCase [Char]
"conversion price is inferred" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          (Posting -> MixedAmount
pamount (Posting -> MixedAmount)
-> (Transaction -> Posting) -> Transaction -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Posting] -> Posting
forall a. [a] -> a
head ([Posting] -> Posting)
-> (Transaction -> [Posting]) -> Transaction -> Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings (Transaction -> MixedAmount)
-> Either [Char] Transaction -> Either [Char] MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
           BalancingOpts -> Transaction -> Either [Char] Transaction
balanceTransaction BalancingOpts
defbalancingopts
             (Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
                Integer
0
                AccountName
""
                (SourcePos, SourcePos)
nullsourcepos
                (Integer -> Int -> Int -> Day
fromGregorian Integer
2007 Int
01 Int
28)
                Maybe Day
forall a. Maybe a
Nothing
                Status
Unmarked
                AccountName
""
                AccountName
""
                AccountName
""
                []
                [ Posting
posting {paccount :: AccountName
paccount = AccountName
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1.35)}
                , Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
eur (-DecimalRaw Integer
1))}
                ])) Either [Char] MixedAmount -> Either [Char] MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          MixedAmount -> Either [Char] MixedAmount
forall a b. b -> Either a b
Right (Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1.35 Amount -> Amount -> Amount
@@ DecimalRaw Integer -> Amount
eur DecimalRaw Integer
1)
        ,[Char] -> Assertion -> TestTree
testCase [Char]
"balanceTransaction balances based on cost if there are unit prices" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          Either [Char] Transaction -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either [Char] Transaction -> Assertion)
-> Either [Char] Transaction -> Assertion
forall a b. (a -> b) -> a -> b
$
          BalancingOpts -> Transaction -> Either [Char] Transaction
balanceTransaction BalancingOpts
defbalancingopts
            (Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
               Integer
0
               AccountName
""
               (SourcePos, SourcePos)
nullsourcepos
               (Integer -> Int -> Int -> Day
fromGregorian Integer
2011 Int
01 Int
01)
               Maybe Day
forall a. Maybe a
Nothing
               Status
Unmarked
               AccountName
""
               AccountName
""
               AccountName
""
               []
               [ Posting
posting {paccount :: AccountName
paccount = AccountName
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1 Amount -> Amount -> Amount
`at` DecimalRaw Integer -> Amount
eur DecimalRaw Integer
2}
               , Posting
posting {paccount :: AccountName
paccount = AccountName
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
2) Amount -> Amount -> Amount
`at` DecimalRaw Integer -> Amount
eur DecimalRaw Integer
1}
               ])
        ,[Char] -> Assertion -> TestTree
testCase [Char]
"balanceTransaction balances based on cost if there are total prices" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          Either [Char] Transaction -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either [Char] Transaction -> Assertion)
-> Either [Char] Transaction -> Assertion
forall a b. (a -> b) -> a -> b
$
          BalancingOpts -> Transaction -> Either [Char] Transaction
balanceTransaction BalancingOpts
defbalancingopts
            (Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
               Integer
0
               AccountName
""
               (SourcePos, SourcePos)
nullsourcepos
               (Integer -> Int -> Int -> Day
fromGregorian Integer
2011 Int
01 Int
01)
               Maybe Day
forall a. Maybe a
Nothing
               Status
Unmarked
               AccountName
""
               AccountName
""
               AccountName
""
               []
               [ Posting
posting {paccount :: AccountName
paccount = AccountName
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1 Amount -> Amount -> Amount
@@ DecimalRaw Integer -> Amount
eur DecimalRaw Integer
1}
               , Posting
posting {paccount :: AccountName
paccount = AccountName
"a", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
2) Amount -> Amount -> Amount
@@ DecimalRaw Integer -> Amount
eur (-DecimalRaw Integer
1)}
               ])
        ]
    , [Char] -> [TestTree] -> TestTree
testGroup [Char]
"isTransactionBalanced" [
         [Char] -> Assertion -> TestTree
testCase [Char]
"detect balanced" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
          BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
defbalancingopts (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
          Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
            Integer
0
            AccountName
""
            (SourcePos, SourcePos)
nullsourcepos
            (Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
            Maybe Day
forall a. Maybe a
Nothing
            Status
Unmarked
            AccountName
""
            AccountName
"a"
            AccountName
""
            []
            [ Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1.00)}
            , Posting
posting {paccount :: AccountName
paccount = AccountName
"c", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1.00))}
            ]
        ,[Char] -> Assertion -> TestTree
testCase [Char]
"detect unbalanced" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
          Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
defbalancingopts (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
          Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
            Integer
0
            AccountName
""
            (SourcePos, SourcePos)
nullsourcepos
            (Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
            Maybe Day
forall a. Maybe a
Nothing
            Status
Unmarked
            AccountName
""
            AccountName
"a"
            AccountName
""
            []
            [ Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1.00)}
            , Posting
posting {paccount :: AccountName
paccount = AccountName
"c", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1.01))}
            ]
        ,[Char] -> Assertion -> TestTree
testCase [Char]
"detect unbalanced, one posting" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
          Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
defbalancingopts (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
          Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
            Integer
0
            AccountName
""
            (SourcePos, SourcePos)
nullsourcepos
            (Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
            Maybe Day
forall a. Maybe a
Nothing
            Status
Unmarked
            AccountName
""
            AccountName
"a"
            AccountName
""
            []
            [Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1.00)}]
        ,[Char] -> Assertion -> TestTree
testCase [Char]
"one zero posting is considered balanced for now" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
          BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
defbalancingopts (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
          Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
            Integer
0
            AccountName
""
            (SourcePos, SourcePos)
nullsourcepos
            (Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
            Maybe Day
forall a. Maybe a
Nothing
            Status
Unmarked
            AccountName
""
            AccountName
"a"
            AccountName
""
            []
            [Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
0)}]
        ,[Char] -> Assertion -> TestTree
testCase [Char]
"virtual postings don't need to balance" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
          BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
defbalancingopts (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
          Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
            Integer
0
            AccountName
""
            (SourcePos, SourcePos)
nullsourcepos
            (Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
            Maybe Day
forall a. Maybe a
Nothing
            Status
Unmarked
            AccountName
""
            AccountName
"a"
            AccountName
""
            []
            [ Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1.00)}
            , Posting
posting {paccount :: AccountName
paccount = AccountName
"c", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1.00))}
            , Posting
posting {paccount :: AccountName
paccount = AccountName
"d", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
100), ptype :: PostingType
ptype = PostingType
VirtualPosting}
            ]
        ,[Char] -> Assertion -> TestTree
testCase [Char]
"balanced virtual postings need to balance among themselves" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
          Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
defbalancingopts (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
          Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
            Integer
0
            AccountName
""
            (SourcePos, SourcePos)
nullsourcepos
            (Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
            Maybe Day
forall a. Maybe a
Nothing
            Status
Unmarked
            AccountName
""
            AccountName
"a"
            AccountName
""
            []
            [ Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1.00)}
            , Posting
posting {paccount :: AccountName
paccount = AccountName
"c", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1.00))}
            , Posting
posting {paccount :: AccountName
paccount = AccountName
"d", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
100), ptype :: PostingType
ptype = PostingType
BalancedVirtualPosting}
            ]
        ,[Char] -> Assertion -> TestTree
testCase [Char]
"balanced virtual postings need to balance among themselves (2)" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool [Char]
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
          BalancingOpts -> Transaction -> Bool
isTransactionBalanced BalancingOpts
defbalancingopts (Transaction -> Bool) -> Transaction -> Bool
forall a b. (a -> b) -> a -> b
$
          Integer
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction
            Integer
0
            AccountName
""
            (SourcePos, SourcePos)
nullsourcepos
            (Integer -> Int -> Int -> Day
fromGregorian Integer
2009 Int
01 Int
01)
            Maybe Day
forall a. Maybe a
Nothing
            Status
Unmarked
            AccountName
""
            AccountName
"a"
            AccountName
""
            []
            [ Posting
posting {paccount :: AccountName
paccount = AccountName
"b", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1.00)}
            , Posting
posting {paccount :: AccountName
paccount = AccountName
"c", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1.00))}
            , Posting
posting {paccount :: AccountName
paccount = AccountName
"d", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd DecimalRaw Integer
100), ptype :: PostingType
ptype = PostingType
BalancedVirtualPosting}
            , Posting
posting {paccount :: AccountName
paccount = AccountName
"3", pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount (DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
100)), ptype :: PostingType
ptype = PostingType
BalancedVirtualPosting}
            ]
        ]

  ,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"journalBalanceTransactions" [

     [Char] -> Assertion -> TestTree
testCase [Char]
"missing-amounts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      let ej :: Either [Char] Journal
ej = BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either [Char] Journal)
-> Journal -> Either [Char] Journal
forall a b. (a -> b) -> a -> b
$ Bool -> Journal
samplejournalMaybeExplicit Bool
False
      Either [Char] Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight Either [Char] Journal
ej
      Journal -> [Posting]
journalPostings (Journal -> [Posting])
-> Either [Char] Journal -> Either [Char] [Posting]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either [Char] Journal
ej Either [Char] [Posting] -> Either [Char] [Posting] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Posting] -> Either [Char] [Posting]
forall a b. b -> Either a b
Right (Journal -> [Posting]
journalPostings Journal
samplejournal)

    ,[Char] -> Assertion -> TestTree
testCase [Char]
"balance-assignment" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      let ej :: Either [Char] Journal
ej = BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either [Char] Journal)
-> Journal -> Either [Char] Journal
forall a b. (a -> b) -> a -> b
$
            --2019/01/01
            --  (a)            = 1
            Journal
nulljournal{ jtxns :: [Transaction]
jtxns = [
              Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' AccountName
"a" Amount
missingamt (Amount -> Maybe BalanceAssertion
balassert (DecimalRaw Integer -> Amount
num DecimalRaw Integer
1)) ]
            ]}
      Either [Char] Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight Either [Char] Journal
ej
      case Either [Char] Journal
ej of Right Journal
j -> (Journal -> [Transaction]
jtxns Journal
j [Transaction] -> ([Transaction] -> Transaction) -> Transaction
forall a b. a -> (a -> b) -> b
& [Transaction] -> Transaction
forall a. [a] -> a
head Transaction -> (Transaction -> [Posting]) -> [Posting]
forall a b. a -> (a -> b) -> b
& Transaction -> [Posting]
tpostings [Posting] -> ([Posting] -> Posting) -> Posting
forall a b. a -> (a -> b) -> b
& [Posting] -> Posting
forall a. [a] -> a
head Posting -> (Posting -> MixedAmount) -> MixedAmount
forall a b. a -> (a -> b) -> b
& Posting -> MixedAmount
pamount MixedAmount -> (MixedAmount -> [Amount]) -> [Amount]
forall a b. a -> (a -> b) -> b
& MixedAmount -> [Amount]
amountsRaw) [Amount] -> [Amount] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [DecimalRaw Integer -> Amount
num DecimalRaw Integer
1]
                 Left [Char]
_  -> [Char] -> Assertion
forall a. [Char] -> a
error' [Char]
"balance-assignment test: shouldn't happen"

    ,[Char] -> Assertion -> TestTree
testCase [Char]
"same-day-1" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      Either [Char] Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either [Char] Journal -> Assertion)
-> Either [Char] Journal -> Assertion
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either [Char] Journal)
-> Journal -> Either [Char] Journal
forall a b. (a -> b) -> a -> b
$
            --2019/01/01
            --  (a)            = 1
            --2019/01/01
            --  (a)          1 = 2
            Journal
nulljournal{ jtxns :: [Transaction]
jtxns = [
               Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' AccountName
"a" Amount
missingamt (Amount -> Maybe BalanceAssertion
balassert (DecimalRaw Integer -> Amount
num DecimalRaw Integer
1)) ]
              ,Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' AccountName
"a" (DecimalRaw Integer -> Amount
num DecimalRaw Integer
1)    (Amount -> Maybe BalanceAssertion
balassert (DecimalRaw Integer -> Amount
num DecimalRaw Integer
2)) ]
            ]}

    ,[Char] -> Assertion -> TestTree
testCase [Char]
"same-day-2" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      Either [Char] Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either [Char] Journal -> Assertion)
-> Either [Char] Journal -> Assertion
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either [Char] Journal)
-> Journal -> Either [Char] Journal
forall a b. (a -> b) -> a -> b
$
            --2019/01/01
            --    (a)                  2 = 2
            --2019/01/01
            --    b                    1
            --    a
            --2019/01/01
            --    a                    0 = 1
            Journal
nulljournal{ jtxns :: [Transaction]
jtxns = [
               Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' AccountName
"a" (DecimalRaw Integer -> Amount
num DecimalRaw Integer
2)    (Amount -> Maybe BalanceAssertion
balassert (DecimalRaw Integer -> Amount
num DecimalRaw Integer
2)) ]
              ,Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [
                 AccountName -> Amount -> Maybe BalanceAssertion -> Posting
post' AccountName
"b" (DecimalRaw Integer -> Amount
num DecimalRaw Integer
1)     Maybe BalanceAssertion
forall a. Maybe a
Nothing
                ,AccountName -> Amount -> Maybe BalanceAssertion -> Posting
post' AccountName
"a"  Amount
missingamt Maybe BalanceAssertion
forall a. Maybe a
Nothing
              ]
              ,Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
post' AccountName
"a" (DecimalRaw Integer -> Amount
num DecimalRaw Integer
0)     (Amount -> Maybe BalanceAssertion
balassert (DecimalRaw Integer -> Amount
num DecimalRaw Integer
1)) ]
            ]}

    ,[Char] -> Assertion -> TestTree
testCase [Char]
"out-of-order" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      Either [Char] Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either [Char] Journal -> Assertion)
-> Either [Char] Journal -> Assertion
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either [Char] Journal)
-> Journal -> Either [Char] Journal
forall a b. (a -> b) -> a -> b
$
            --2019/1/2
            --  (a)    1 = 2
            --2019/1/1
            --  (a)    1 = 1
            Journal
nulljournal{ jtxns :: [Transaction]
jtxns = [
               Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
02) [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' AccountName
"a" (DecimalRaw Integer -> Amount
num DecimalRaw Integer
1)    (Amount -> Maybe BalanceAssertion
balassert (DecimalRaw Integer -> Amount
num DecimalRaw Integer
2)) ]
              ,Day -> [Posting] -> Transaction
transaction (Integer -> Int -> Int -> Day
fromGregorian Integer
2019 Int
01 Int
01) [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' AccountName
"a" (DecimalRaw Integer -> Amount
num DecimalRaw Integer
1)    (Amount -> Maybe BalanceAssertion
balassert (DecimalRaw Integer -> Amount
num DecimalRaw Integer
1)) ]
            ]}

    ]

    ,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"commodityStylesFromAmounts" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$ [

      -- Journal similar to the one on #1091:
      -- 2019/09/24
      --     (a)            1,000.00
      -- 
      -- 2019/09/26
      --     (a)             1000,000
      --
      [Char] -> Assertion -> TestTree
testCase [Char]
"1091a" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        [Amount] -> Either [Char] (Map AccountName AmountStyle)
commodityStylesFromAmounts [
           Amount
nullamt{aquantity :: DecimalRaw Integer
aquantity=DecimalRaw Integer
1000, astyle :: AmountStyle
astyle=Side
-> Bool
-> AmountPrecision
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False (Word8 -> AmountPrecision
Precision Word8
3) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
',') Maybe DigitGroupStyle
forall a. Maybe a
Nothing}
          ,Amount
nullamt{aquantity :: DecimalRaw Integer
aquantity=DecimalRaw Integer
1000, astyle :: AmountStyle
astyle=Side
-> Bool
-> AmountPrecision
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False (Word8 -> AmountPrecision
Precision Word8
2) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.') (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3]))}
          ]
         Either [Char] (Map AccountName AmountStyle)
-> Either [Char] (Map AccountName AmountStyle) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          -- The commodity style should have period as decimal mark
          -- and comma as digit group mark.
          Map AccountName AmountStyle
-> Either [Char] (Map AccountName AmountStyle)
forall a b. b -> Either a b
Right ([(AccountName, AmountStyle)] -> Map AccountName AmountStyle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
            (AccountName
"", Side
-> Bool
-> AmountPrecision
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False (Word8 -> AmountPrecision
Precision Word8
3) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.') (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3])))
          ])
        -- same journal, entries in reverse order
      ,[Char] -> Assertion -> TestTree
testCase [Char]
"1091b" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        [Amount] -> Either [Char] (Map AccountName AmountStyle)
commodityStylesFromAmounts [
           Amount
nullamt{aquantity :: DecimalRaw Integer
aquantity=DecimalRaw Integer
1000, astyle :: AmountStyle
astyle=Side
-> Bool
-> AmountPrecision
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False (Word8 -> AmountPrecision
Precision Word8
2) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.') (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3]))}
          ,Amount
nullamt{aquantity :: DecimalRaw Integer
aquantity=DecimalRaw Integer
1000, astyle :: AmountStyle
astyle=Side
-> Bool
-> AmountPrecision
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False (Word8 -> AmountPrecision
Precision Word8
3) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
',') Maybe DigitGroupStyle
forall a. Maybe a
Nothing}
          ]
         Either [Char] (Map AccountName AmountStyle)
-> Either [Char] (Map AccountName AmountStyle) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          -- The commodity style should have period as decimal mark
          -- and comma as digit group mark.
          Map AccountName AmountStyle
-> Either [Char] (Map AccountName AmountStyle)
forall a b. b -> Either a b
Right ([(AccountName, AmountStyle)] -> Map AccountName AmountStyle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
            (AccountName
"", Side
-> Bool
-> AmountPrecision
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False (Word8 -> AmountPrecision
Precision Word8
3) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.') (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3])))
          ])

     ]

  ]