{-|
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 in which balance assignments may not be used
  ,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 will not be allowed on these
    txnmodifieraccts :: Set AccountName
txnmodifieraccts = [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
txnmodifieraccts (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=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)) ())
-> (AccountName -> [Char])
-> AccountName
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> [Char]
T.unpack (AccountName
 -> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ())
-> AccountName
-> ReaderT (BalancingState s) (ExceptT [Char] (ST s)) ()
forall a b. (a -> b) -> a -> b
$ [AccountName] -> AccountName
T.unlines
      [AccountName
"postings which are balance assignments may not have a custom date."
      ,AccountName
"Please write the posting amount explicitly, or remove the posting date:"
      ,AccountName
""
      ,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
      ]

-- | 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 a transaction modifier, 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 ())
-> (AccountName -> [Char]) -> AccountName -> Balancing s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> [Char]
T.unpack (AccountName -> Balancing s ()) -> AccountName -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ [AccountName] -> AccountName
T.unlines
      [AccountName
"balance assignments cannot be used with accounts which are"
      ,AccountName
"posted to by transaction modifier rules (auto postings)."
      ,AccountName
"Please write the posting amount explicitly, or remove the rule."
      ,AccountName
""
      ,AccountName
"account: " AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> Posting -> AccountName
paccount Posting
p
      ,AccountName
""
      ,AccountName
"transaction:"
      ,AccountName
""
      ,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
      ]

-- 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
      let Right Journal
j = Either [Char] Journal
ej
      (Journal -> [Transaction]
jtxns Journal
j [Transaction] -> ([Transaction] -> Transaction) -> Transaction
forall a b. a -> (a -> b) -> b
& [Transaction] -> Transaction
forall a. [a] -> a
head Transaction -> (Transaction -> [Posting]) -> [Posting]
forall a b. a -> (a -> b) -> b
& Transaction -> [Posting]
tpostings [Posting] -> ([Posting] -> Posting) -> Posting
forall a b. a -> (a -> b) -> b
& [Posting] -> Posting
forall a. [a] -> a
head Posting -> (Posting -> MixedAmount) -> MixedAmount
forall a b. a -> (a -> b) -> b
& Posting -> MixedAmount
pamount MixedAmount -> (MixedAmount -> [Amount]) -> [Amount]
forall a b. a -> (a -> b) -> b
& MixedAmount -> [Amount]
amountsRaw) [Amount] -> [Amount] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [DecimalRaw Integer -> Amount
num DecimalRaw Integer
1]

    ,[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])))
          ])

     ]

  ]