{-|
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
  -- * journal balancing
, journalBalanceTransactions
  -- * tests
, tests_Balancing
)
where

import Control.Monad (forM, forM_, when, unless)
import Control.Monad.Except (ExceptT(..), runExceptT, throwError)
import "extra" Control.Monad.Extra (whenM)
import Control.Monad.Reader as R (ReaderT, reader, runReaderT, ask, asks)
import Control.Monad.ST (ST, runST)
import Control.Monad.Trans.Class (lift)
import Data.Array.ST (STArray, getElems, newListArray, writeArray)
import Data.Foldable (asum)
import Data.Function ((&))
import Data.Functor ((<&>))
import "base-compat" Data.Functor.Compat (void)
import qualified Data.HashTable.Class as H (toList)
import qualified Data.HashTable.ST.Cuckoo as H
import Data.List (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 (headErr)
import Text.Printf (printf)

import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.AccountName (isAccountNamePrefixOf)
import Hledger.Data.Amount
import Hledger.Data.Journal
import Hledger.Data.Posting
import Hledger.Data.Transaction
import Hledger.Data.Errors
import Data.Bifunctor (second)


data BalancingOpts = BalancingOpts
  { BalancingOpts -> Bool
ignore_assertions_     :: Bool  -- ^ should failing balance assertions be ignored ?
  , BalancingOpts -> Bool
infer_balancing_costs_ :: Bool  -- ^ Are we permitted to infer missing costs to balance transactions ?
                                    --   Distinct from InputOpts{infer_costs_}.
  , BalancingOpts -> Maybe (Map CommoditySymbol AmountStyle)
commodity_styles_      :: Maybe (M.Map CommoditySymbol AmountStyle)  -- ^ commodity display styles
  } deriving (BalancingOpts -> BalancingOpts -> Bool
(BalancingOpts -> BalancingOpts -> Bool)
-> (BalancingOpts -> BalancingOpts -> Bool) -> Eq BalancingOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BalancingOpts -> BalancingOpts -> Bool
== :: BalancingOpts -> BalancingOpts -> Bool
$c/= :: BalancingOpts -> BalancingOpts -> Bool
/= :: BalancingOpts -> BalancingOpts -> Bool
Eq, Eq BalancingOpts
Eq BalancingOpts =>
(BalancingOpts -> BalancingOpts -> Ordering)
-> (BalancingOpts -> BalancingOpts -> Bool)
-> (BalancingOpts -> BalancingOpts -> Bool)
-> (BalancingOpts -> BalancingOpts -> Bool)
-> (BalancingOpts -> BalancingOpts -> Bool)
-> (BalancingOpts -> BalancingOpts -> BalancingOpts)
-> (BalancingOpts -> BalancingOpts -> BalancingOpts)
-> Ord BalancingOpts
BalancingOpts -> BalancingOpts -> Bool
BalancingOpts -> BalancingOpts -> Ordering
BalancingOpts -> BalancingOpts -> BalancingOpts
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BalancingOpts -> BalancingOpts -> Ordering
compare :: BalancingOpts -> BalancingOpts -> Ordering
$c< :: BalancingOpts -> BalancingOpts -> Bool
< :: BalancingOpts -> BalancingOpts -> Bool
$c<= :: BalancingOpts -> BalancingOpts -> Bool
<= :: BalancingOpts -> BalancingOpts -> Bool
$c> :: BalancingOpts -> BalancingOpts -> Bool
> :: BalancingOpts -> BalancingOpts -> Bool
$c>= :: BalancingOpts -> BalancingOpts -> Bool
>= :: BalancingOpts -> BalancingOpts -> Bool
$cmax :: BalancingOpts -> BalancingOpts -> BalancingOpts
max :: BalancingOpts -> BalancingOpts -> BalancingOpts
$cmin :: BalancingOpts -> BalancingOpts -> BalancingOpts
min :: BalancingOpts -> BalancingOpts -> BalancingOpts
Ord, Int -> BalancingOpts -> String -> String
[BalancingOpts] -> String -> String
BalancingOpts -> String
(Int -> BalancingOpts -> String -> String)
-> (BalancingOpts -> String)
-> ([BalancingOpts] -> String -> String)
-> Show BalancingOpts
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> BalancingOpts -> String -> String
showsPrec :: Int -> BalancingOpts -> String -> String
$cshow :: BalancingOpts -> String
show :: BalancingOpts -> String
$cshowList :: [BalancingOpts] -> String -> String
showList :: [BalancingOpts] -> String -> String
Show)

defbalancingopts :: BalancingOpts
defbalancingopts :: BalancingOpts
defbalancingopts = BalancingOpts
  { ignore_assertions_ :: Bool
ignore_assertions_     = Bool
False
  , infer_balancing_costs_ :: Bool
infer_balancing_costs_ = Bool
True
  , commodity_styles_ :: Maybe (Map CommoditySymbol AmountStyle)
commodity_styles_      = Maybe (Map CommoditySymbol 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 -> [String]
transactionCheckBalanced BalancingOpts{Maybe (Map CommoditySymbol AmountStyle)
commodity_styles_ :: BalancingOpts -> Maybe (Map CommoditySymbol AmountStyle)
commodity_styles_ :: Maybe (Map CommoditySymbol AmountStyle)
commodity_styles_} Transaction
t = [String]
errs
  where
    -- get real and balanced virtual postings, to be checked separately
    ([Posting]
rps, [Posting]
bvps) = (Posting -> ([Posting], [Posting]) -> ([Posting], [Posting]))
-> ([Posting], [Posting]) -> [Posting] -> ([Posting], [Posting])
forall a b. (a -> b -> b) -> b -> [a] -> b
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)

    -- convert this posting's amount to cost,
    -- unless it has been marked as a redundant cost (equivalent to some nearby equity conversion postings),
    -- in which case ignore it.
    postingBalancingAmount :: Posting -> MixedAmount
postingBalancingAmount Posting
p
      | CommoditySymbol
costPostingTagName CommoditySymbol -> [CommoditySymbol] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((CommoditySymbol, CommoditySymbol) -> CommoditySymbol)
-> [(CommoditySymbol, CommoditySymbol)] -> [CommoditySymbol]
forall a b. (a -> b) -> [a] -> [b]
map (CommoditySymbol, CommoditySymbol) -> CommoditySymbol
forall a b. (a, b) -> a
fst (Posting -> [(CommoditySymbol, CommoditySymbol)]
ptags Posting
p) = MixedAmount -> MixedAmount
mixedAmountStripCosts (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
      | Bool
otherwise                                   = MixedAmount -> MixedAmount
mixedAmountCost (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p

    -- transaction balancedness is checked at each commodity's display precision
    lookszero :: MixedAmount -> Bool
lookszero = MixedAmount -> Bool
mixedAmountLooksZero (MixedAmount -> Bool)
-> (MixedAmount -> MixedAmount) -> MixedAmount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> MixedAmount
atdisplayprecision
      where
        atdisplayprecision :: MixedAmount -> MixedAmount
atdisplayprecision = (MixedAmount -> MixedAmount)
-> (Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount)
-> Maybe (Map CommoditySymbol AmountStyle)
-> MixedAmount
-> MixedAmount
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MixedAmount -> MixedAmount
forall a. a -> a
id Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map CommoditySymbol AmountStyle -> a -> a
styleAmounts (Maybe (Map CommoditySymbol AmountStyle)
 -> MixedAmount -> MixedAmount)
-> Maybe (Map CommoditySymbol AmountStyle)
-> MixedAmount
-> MixedAmount
forall a b. (a -> b) -> a -> b
$ Maybe (Map CommoditySymbol AmountStyle)
commodity_styles_

    -- when there's multiple non-zeros, check they do not all have the same sign
    (Bool
rsignsok, Bool
bvsignsok) = ([Posting] -> Bool
signsOk [Posting]
rps, [Posting] -> Bool
signsOk [Posting]
bvps)
      where
        signsOk :: [Posting] -> Bool
signsOk [Posting]
ps = [MixedAmount] -> Int
forall a. [a] -> 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 -> Bool -> Bool
|| [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
nonzerosigns Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
          where
            nonzeros :: [MixedAmount]
nonzeros = (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
lookszero) ([MixedAmount] -> [MixedAmount]) -> [MixedAmount] -> [MixedAmount]
forall a b. (a -> b) -> a -> b
$ (Posting -> MixedAmount) -> [Posting] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> MixedAmount
postingBalancingAmount [Posting]
ps
            nonzerosigns :: [Bool]
nonzerosigns = [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

    -- check that the sum looks like zero
    (MixedAmount
rsumcost, MixedAmount
bvsumcost) = ((Posting -> MixedAmount) -> [Posting] -> MixedAmount
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Posting -> MixedAmount
postingBalancingAmount [Posting]
rps, (Posting -> MixedAmount) -> [Posting] -> MixedAmount
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Posting -> MixedAmount
postingBalancingAmount [Posting]
bvps)
    (Bool
rsumok, Bool
bvsumok) = (MixedAmount -> Bool
lookszero MixedAmount
rsumcost, MixedAmount -> Bool
lookszero MixedAmount
bvsumcost)

    -- Generate error messages if any. Show amounts with their original precisions.
    errs :: [String]
errs = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String
rmsg, String
bvmsg]
      where
        rmsg :: String
rmsg
          | Bool
rsumok        = String
""
          | Bool -> Bool
not Bool
rsignsok  = String
"The real postings all have the same sign. Consider negating some of them."
          | Bool
otherwise     = String
"The real postings' sum should be 0 but is: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
              (AmountFormat -> MixedAmount -> String
showMixedAmountWith AmountFormat
oneLineNoCostFmt{displayCost=True, displayZeroCommodity=True} (MixedAmount -> String) -> MixedAmount -> String
forall a b. (a -> b) -> a -> b
$
              Maybe Word8 -> MixedAmount -> MixedAmount
mixedAmountSetFullPrecisionUpTo Maybe Word8
forall a. Maybe a
Nothing (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
mixedAmountSetFullPrecision
              MixedAmount
rsumcost)
        bvmsg :: String
bvmsg
          | Bool
bvsumok       = String
""
          | Bool -> Bool
not Bool
bvsignsok = String
"The balanced virtual postings all have the same sign. Consider negating some of them."
          | Bool
otherwise     = String
"The balanced virtual postings' sum should be 0 but is: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
              (AmountFormat -> MixedAmount -> String
showMixedAmountWith AmountFormat
oneLineNoCostFmt{displayCost=True, displayZeroCommodity=True} (MixedAmount -> String) -> MixedAmount -> String
forall a b. (a -> b) -> a -> b
$
              Maybe Word8 -> MixedAmount -> MixedAmount
mixedAmountSetFullPrecisionUpTo Maybe Word8
forall a. Maybe a
Nothing (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
mixedAmountSetFullPrecision
              MixedAmount
bvsumcost)

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

-- | 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 String Transaction
balanceTransaction BalancingOpts
bopts = ((Transaction, [(CommoditySymbol, MixedAmount)]) -> Transaction)
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
-> Either String Transaction
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Transaction, [(CommoditySymbol, MixedAmount)]) -> Transaction
forall a b. (a, b) -> a
fst (Either String (Transaction, [(CommoditySymbol, MixedAmount)])
 -> Either String Transaction)
-> (Transaction
    -> Either String (Transaction, [(CommoditySymbol, MixedAmount)]))
-> Transaction
-> Either String Transaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalancingOpts
-> Transaction
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
balanceTransactionHelper BalancingOpts
bopts

-- | 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 String (Transaction, [(CommoditySymbol, MixedAmount)])
balanceTransactionHelper BalancingOpts
bopts Transaction
t = do
  let lbl :: String -> String -> String
lbl = String -> String -> String -> String
lbl_ String
"balanceTransactionHelper"
  (Transaction
t', [(CommoditySymbol, MixedAmount)]
inferredamtsandaccts) <- Transaction
t
    Transaction -> (Transaction -> Transaction) -> Transaction
forall a b. a -> (a -> b) -> b
& (if BalancingOpts -> Bool
infer_balancing_costs_ BalancingOpts
bopts then Transaction -> Transaction
transactionInferBalancingCosts else Transaction -> Transaction
forall a. a -> a
id)
    Transaction -> (Transaction -> Transaction) -> Transaction
forall a b. a -> (a -> b) -> b
& (Transaction -> String) -> Transaction -> Transaction
forall a. Show a => (a -> String) -> a -> a
dbg9With (String -> String -> String
lbl String
"amounts after balancing-cost-inferring"(String -> String)
-> (Transaction -> String) -> Transaction -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> String
forall a. Show a => a -> String
show([String] -> String)
-> (Transaction -> [String]) -> Transaction -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MixedAmount -> String) -> [MixedAmount] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map MixedAmount -> String
showMixedAmountOneLine([MixedAmount] -> [String])
-> (Transaction -> [MixedAmount]) -> Transaction -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Transaction -> [MixedAmount]
transactionAmounts)
    Transaction
-> (Transaction
    -> Either String (Transaction, [(CommoditySymbol, MixedAmount)]))
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall a b. a -> (a -> b) -> b
& Map CommoditySymbol AmountStyle
-> Transaction
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
transactionInferBalancingAmount (Map CommoditySymbol AmountStyle
-> Maybe (Map CommoditySymbol AmountStyle)
-> Map CommoditySymbol AmountStyle
forall a. a -> Maybe a -> a
fromMaybe Map CommoditySymbol AmountStyle
forall k a. Map k a
M.empty (Maybe (Map CommoditySymbol AmountStyle)
 -> Map CommoditySymbol AmountStyle)
-> Maybe (Map CommoditySymbol AmountStyle)
-> Map CommoditySymbol AmountStyle
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Maybe (Map CommoditySymbol AmountStyle)
commodity_styles_ BalancingOpts
bopts)
    Either String (Transaction, [(CommoditySymbol, MixedAmount)])
-> ((Transaction, [(CommoditySymbol, MixedAmount)])
    -> (Transaction, [(CommoditySymbol, MixedAmount)]))
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((Transaction, [(CommoditySymbol, MixedAmount)]) -> String)
-> (Transaction, [(CommoditySymbol, MixedAmount)])
-> (Transaction, [(CommoditySymbol, MixedAmount)])
forall a. Show a => (a -> String) -> a -> a
dbg9With (String -> String -> String
lbl String
"balancing amounts inferred"(String -> String)
-> ((Transaction, [(CommoditySymbol, MixedAmount)]) -> String)
-> (Transaction, [(CommoditySymbol, MixedAmount)])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[(CommoditySymbol, String)] -> String
forall a. Show a => a -> String
show([(CommoditySymbol, String)] -> String)
-> ((Transaction, [(CommoditySymbol, MixedAmount)])
    -> [(CommoditySymbol, String)])
-> (Transaction, [(CommoditySymbol, MixedAmount)])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((CommoditySymbol, MixedAmount) -> (CommoditySymbol, String))
-> [(CommoditySymbol, MixedAmount)] -> [(CommoditySymbol, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((MixedAmount -> String)
-> (CommoditySymbol, MixedAmount) -> (CommoditySymbol, String)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second MixedAmount -> String
showMixedAmountOneLine)([(CommoditySymbol, MixedAmount)] -> [(CommoditySymbol, String)])
-> ((Transaction, [(CommoditySymbol, MixedAmount)])
    -> [(CommoditySymbol, MixedAmount)])
-> (Transaction, [(CommoditySymbol, MixedAmount)])
-> [(CommoditySymbol, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Transaction, [(CommoditySymbol, MixedAmount)])
-> [(CommoditySymbol, MixedAmount)]
forall a b. (a, b) -> b
snd)
  case BalancingOpts -> Transaction -> [String]
transactionCheckBalanced BalancingOpts
bopts Transaction
t' of
    []   -> (Transaction, [(CommoditySymbol, MixedAmount)])
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall a b. b -> Either a b
Right (Transaction -> Transaction
txnTieKnot Transaction
t', [(CommoditySymbol, MixedAmount)]
inferredamtsandaccts)
    [String]
errs -> String
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall a b. a -> Either a b
Left (String
 -> Either String (Transaction, [(CommoditySymbol, MixedAmount)]))
-> String
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall a b. (a -> b) -> a -> b
$ Transaction -> [String] -> String
transactionBalanceError Transaction
t' [String]
errs'
      where
        ismulticommodity :: Bool
ismulticommodity = (Set CommoditySymbol -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Set CommoditySymbol -> Int) -> Set CommoditySymbol -> Int
forall a b. (a -> b) -> a -> b
$ Transaction -> Set CommoditySymbol
transactionCommodities Transaction
t') Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
        errs' :: [String]
errs' =
          [ String
"Automatic commodity conversion is not enabled."
          | Bool
ismulticommodity Bool -> Bool -> Bool
&& Bool -> Bool
not (BalancingOpts -> Bool
infer_balancing_costs_ BalancingOpts
bopts)
          ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
          [String]
errs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
          if Bool
ismulticommodity
          then
          [ String
"Consider adjusting this entry's amounts, adding missing postings,"
          , String
"or recording conversion price(s) with @, @@ or equity postings." 
          ]
          else
          [ String
"Consider adjusting this entry's amounts, or adding missing postings."
          ]

transactionCommodities :: Transaction -> S.Set CommoditySymbol
transactionCommodities :: Transaction -> Set CommoditySymbol
transactionCommodities Transaction
t = [Set CommoditySymbol] -> Set CommoditySymbol
forall a. Monoid a => [a] -> a
mconcat ([Set CommoditySymbol] -> Set CommoditySymbol)
-> [Set CommoditySymbol] -> Set CommoditySymbol
forall a b. (a -> b) -> a -> b
$ (Posting -> Set CommoditySymbol)
-> [Posting] -> [Set CommoditySymbol]
forall a b. (a -> b) -> [a] -> [b]
map (MixedAmount -> Set CommoditySymbol
maCommodities (MixedAmount -> Set CommoditySymbol)
-> (Posting -> MixedAmount) -> Posting -> Set CommoditySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> MixedAmount
pamount) ([Posting] -> [Set CommoditySymbol])
-> [Posting] -> [Set CommoditySymbol]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t

-- | Generate a transaction balancing error message, given the transaction
-- and one or more suberror messages.
transactionBalanceError :: Transaction -> [String] -> String
transactionBalanceError :: Transaction -> [String] -> String
transactionBalanceError Transaction
t [String]
errs = String -> String -> CommoditySymbol -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s:\n%s\n\nThis %stransaction is unbalanced.\n%s"
  ((SourcePos, SourcePos) -> String
sourcePosPairPretty ((SourcePos, SourcePos) -> String)
-> (SourcePos, SourcePos) -> String
forall a b. (a -> b) -> a -> b
$ Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t)
  (CommoditySymbol -> CommoditySymbol
textChomp CommoditySymbol
ex)
  (if Bool
ismulticommodity then String
"multi-commodity " else String
"" :: String)
  (String -> String
chomp (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String]
errs)
  where
    ismulticommodity :: Bool
ismulticommodity = (Set CommoditySymbol -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Set CommoditySymbol -> Int) -> Set CommoditySymbol -> Int
forall a b. (a -> b) -> a -> b
$ Transaction -> Set CommoditySymbol
transactionCommodities Transaction
t) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
    (String
_f,Int
_l,Maybe (Int, Maybe Int)
_mcols,CommoditySymbol
ex) = Transaction
-> (Transaction -> Maybe (Int, Maybe Int))
-> (String, Int, Maybe (Int, Maybe Int), CommoditySymbol)
makeTransactionErrorExcerpt Transaction
t Transaction -> Maybe (Int, Maybe Int)
forall {p} {a}. p -> Maybe a
finderrcols
      where
        finderrcols :: p -> Maybe a
finderrcols p
_ = Maybe a
forall a. Maybe a
Nothing
        -- finderrcols t = Just (1, Just w)
        --   where
        --     w = maximumDef 1 $ map T.length $ T.lines $ showTransaction 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.
transactionInferBalancingAmount ::
     M.Map CommoditySymbol AmountStyle -- ^ commodity display styles
  -> Transaction
  -> Either String (Transaction, [(AccountName, MixedAmount)])
transactionInferBalancingAmount :: Map CommoditySymbol AmountStyle
-> Transaction
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
transactionInferBalancingAmount Map CommoditySymbol AmountStyle
styles t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps}
  | [Posting] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
amountlessrealps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
      = String
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall a b. a -> Either a b
Left (String
 -> Either String (Transaction, [(CommoditySymbol, MixedAmount)]))
-> String
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall a b. (a -> b) -> a -> b
$ Transaction -> [String] -> String
transactionBalanceError Transaction
t
        [String
"There can't be more than one real posting with no amount."
        ,String
"(Remember to put two or more spaces between account and amount.)"]
  | [Posting] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
amountlessbvps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
      = String
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall a b. a -> Either a b
Left (String
 -> Either String (Transaction, [(CommoditySymbol, MixedAmount)]))
-> String
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall a b. (a -> b) -> a -> b
$ Transaction -> [String] -> String
transactionBalanceError Transaction
t
        [String
"There can't be more than one balanced virtual posting with no amount."
        ,String
"(Remember to put two or more spaces between account and amount.)"]
  | Bool
otherwise
      = let psandinferredamts :: [(Posting, Maybe MixedAmount)]
psandinferredamts = (Posting -> (Posting, Maybe MixedAmount))
-> [Posting] -> [(Posting, Maybe MixedAmount)]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> (Posting, Maybe MixedAmount)
inferamount [Posting]
ps
            inferredacctsandamts :: [(CommoditySymbol, MixedAmount)]
inferredacctsandamts = [(Posting -> CommoditySymbol
paccount Posting
p, MixedAmount
amt) | (Posting
p, Just MixedAmount
amt) <- [(Posting, Maybe MixedAmount)]
psandinferredamts]
        in (Transaction, [(CommoditySymbol, MixedAmount)])
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
forall a b. b -> Either a b
Right (
           Transaction
t{tpostings=map fst psandinferredamts}
          ,[(CommoditySymbol, MixedAmount)]
inferredacctsandamts
           -- & dbg9With (lbl "inferred".show.map (showMixedAmountOneLine.snd))
          )
  where
    lbl :: String -> String -> String
lbl = String -> String -> String -> String
lbl_ String
"transactionInferBalancingAmount"
    ([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
      -- & dbg9With (lbl "real balancing amount".showMixedAmountOneLine)
    ([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
VirtualPosting         | Bool -> Bool
not (Posting -> Bool
hasAmount Posting
p) -> MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
0
          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=a', poriginal=Just $ originalPosting 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' = MixedAmount -> MixedAmount
maNegate MixedAmount
a
                -- & dbg9With (lbl "balancing amount".showMixedAmountOneLine)
                MixedAmount -> (MixedAmount -> MixedAmount) -> MixedAmount
forall a b. a -> (a -> b) -> b
& MixedAmount -> MixedAmount
mixedAmountCost
                -- & dbg9With (lbl "balancing amount converted to cost".showMixedAmountOneLine)
                MixedAmount -> (MixedAmount -> MixedAmount) -> MixedAmount
forall a b. a -> (a -> b) -> b
& Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
forall a. HasAmounts a => Map CommoditySymbol AmountStyle -> a -> a
styleAmounts (Map CommoditySymbol AmountStyle
styles
                                -- Needed until we switch to locally-inferred balancing precisions:
                                -- these had hard rounding set to help with balanced-checking;
                                -- set no rounding now to avoid excessive display precision in output
                                Map CommoditySymbol AmountStyle
-> (Map CommoditySymbol AmountStyle
    -> Map CommoditySymbol AmountStyle)
-> Map CommoditySymbol AmountStyle
forall a b. a -> (a -> b) -> b
& Rounding
-> Map CommoditySymbol AmountStyle
-> Map CommoditySymbol AmountStyle
amountStylesSetRounding Rounding
NoRounding
                                Map CommoditySymbol AmountStyle
-> (Map CommoditySymbol AmountStyle
    -> Map CommoditySymbol AmountStyle)
-> Map CommoditySymbol AmountStyle
forall a b. a -> (a -> b) -> b
& (Map CommoditySymbol AmountStyle -> String)
-> Map CommoditySymbol AmountStyle
-> Map CommoditySymbol AmountStyle
forall a. Show a => (a -> String) -> a -> a
dbg9With (String -> String -> String
lbl String
"balancing amount styles"(String -> String)
-> (Map CommoditySymbol AmountStyle -> String)
-> Map CommoditySymbol AmountStyle
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Map CommoditySymbol AmountStyle -> String
forall a. Show a => a -> String
show))
                MixedAmount -> (MixedAmount -> MixedAmount) -> MixedAmount
forall a b. a -> (a -> b) -> b
& (MixedAmount -> String) -> MixedAmount -> MixedAmount
forall a. Show a => (a -> String) -> a -> a
dbg9With (String -> String -> String
lbl String
"balancing amount styled"(String -> String)
-> (MixedAmount -> String) -> MixedAmount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MixedAmount -> String
showMixedAmountOneLine)

-- | Infer costs for this transaction's posting amounts, if needed to make
-- the postings balance, and if permitted. 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 costs specified. In this case we'll add a
-- cost 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 cost (conversion rate) when the sum of posting amounts
-- contains exactly two different commodities and no explicit costs.  Also
-- all postings are expected to contain an explicit amount (no missing
-- amounts) in a single commodity. Otherwise no cost inferring is attempted.
--
-- The transaction itself could contain more than two commodities, and/or
-- costs, if they cancel out; what matters is that the sum of posting amounts
-- contains exactly two commodities and zero costs.
--
-- There can also be more than two postings in either of the commodities.
--
-- We want to avoid excessive display of digits when the calculated cost 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 cost
--   (@@) is used, and all available decimal digits are shown
--
-- - otherwise, a suitable averaged unit cost (@) 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 costs
-- when the commodity display precisions are low, eg when a journal doesn't
-- use any decimal places. The minimum of 2 helps make the costs shown by the
-- print command a bit less surprising in this case. Could do better.)
--
transactionInferBalancingCosts :: Transaction -> Transaction
transactionInferBalancingCosts :: Transaction -> Transaction
transactionInferBalancingCosts t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings=ps'}
  where
    ps' :: [Posting]
ps' = (Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (Transaction -> PostingType -> Posting -> Posting
costInferrerFor Transaction
t PostingType
BalancedVirtualPosting (Posting -> Posting) -> (Posting -> Posting) -> Posting -> Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> PostingType -> Posting -> Posting
costInferrerFor Transaction
t PostingType
RegularPosting) [Posting]
ps

-- | Generate a posting update function which assigns a suitable cost to
-- balance the posting, if and as appropriate for the given transaction and
-- posting type (real or balanced virtual) (or if we cannot or should not infer
-- costs, leaves the posting unchanged).
costInferrerFor :: Transaction -> PostingType -> (Posting -> Posting)
costInferrerFor :: Transaction -> PostingType -> Posting -> Posting
costInferrerFor 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
infercost Maybe (Amount, Amount)
inferFromAndTo
  where
    lbl :: String -> String -> String
lbl = String -> String -> String -> String
lbl_ String
"costInferrerFor"
    postings :: [Posting]
postings     = (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter ((PostingType -> PostingType -> Bool
forall a. Eq a => a -> a -> Bool
==PostingType
pt)(PostingType -> Bool)
-> (Posting -> PostingType) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Posting -> PostingType
ptype) ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t
    pcommodities :: [CommoditySymbol]
pcommodities = (Amount -> CommoditySymbol) -> [Amount] -> [CommoditySymbol]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> CommoditySymbol
acommodity ([Amount] -> [CommoditySymbol]) -> [Amount] -> [CommoditySymbol]
forall a b. (a -> b) -> a -> b
$ (Posting -> [Amount]) -> [Posting] -> [Amount]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount])
-> (Posting -> MixedAmount) -> Posting -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> MixedAmount
pamount) [Posting]
postings
    sumamounts :: [Amount]
sumamounts   = MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ [Posting] -> MixedAmount
sumPostings [Posting]
postings  -- 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
$ (CommoditySymbol -> Maybe (Amount, Amount))
-> [CommoditySymbol] -> [Maybe (Amount, Amount)]
forall a b. (a -> b) -> [a] -> [b]
map CommoditySymbol -> Maybe (Amount, Amount)
orderIfMatches [CommoditySymbol]
pcommodities
        where
          noprices :: Bool
noprices      = (Amount -> Bool) -> [Amount] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe AmountCost -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe AmountCost -> Bool)
-> (Amount -> Maybe AmountCost) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Maybe AmountCost
acost) [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 :: CommoditySymbol -> Maybe (Amount, Amount)
orderIfMatches CommoditySymbol
x | CommoditySymbol
x CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> CommoditySymbol
acommodity Amount
a = (Amount, Amount) -> Maybe (Amount, Amount)
forall a. a -> Maybe a
Just (Amount
a,Amount
b)
                           | CommoditySymbol
x CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> CommoditySymbol
acommodity Amount
b = (Amount, Amount) -> Maybe (Amount, Amount)
forall a. a -> Maybe a
Just (Amount
b,Amount
a)
                           | Bool
otherwise         = Maybe (Amount, Amount)
forall a. Maybe a
Nothing
      [Amount]
_ -> Maybe (Amount, Amount)
forall a. Maybe a
Nothing

    -- 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 cost based on the ratio between fromamount and toamount.
    infercost :: (Amount, Amount) -> Posting -> Posting
infercost (Amount
fromamount, Amount
toamount) Posting
p
        | [Amount
a] <- MixedAmount -> [Amount]
amounts (Posting -> MixedAmount
pamount Posting
p), Posting -> PostingType
ptype Posting
p PostingType -> PostingType -> Bool
forall a. Eq a => a -> a -> Bool
== PostingType
pt, Amount -> CommoditySymbol
acommodity Amount
a CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> CommoditySymbol
acommodity Amount
fromamount
            = Posting
p{ pamount   = mixedAmount a{acost=Just conversionprice}
                  & dbg9With (lbl "inferred cost".showMixedAmountOneLine)
               , poriginal = Just $ originalPosting p }
        | Bool
otherwise = Posting
p
      where
        -- If only one Amount in the posting list matches fromamount we can use TotalCost.
        -- Otherwise divide the conversion equally among the Amounts by using a unit price.
        conversionprice :: AmountCost
conversionprice = case (CommoditySymbol -> Bool) -> [CommoditySymbol] -> [CommoditySymbol]
forall a. (a -> Bool) -> [a] -> [a]
filter (CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> CommoditySymbol
acommodity Amount
fromamount) [CommoditySymbol]
pcommodities of
            [CommoditySymbol
_] -> Amount -> AmountCost
TotalCost (Amount -> AmountCost) -> Amount -> AmountCost
forall a b. (a -> b) -> a -> b
$ Amount -> Amount
forall a. Num a => a -> a
negate Amount
toamount
            [CommoditySymbol]
_   -> Amount -> AmountCost
UnitCost  (Amount -> AmountCost) -> Amount -> AmountCost
forall a b. (a -> b) -> a -> b
$ Amount -> Amount
forall a. Num a => a -> a
negate Amount
unitcost Amount -> AmountPrecision -> Amount
`withPrecision` AmountPrecision
unitprecision

        unitcost :: Amount
unitcost     = 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


-- "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 CommoditySymbol AmountStyle)
bsStyles       :: Maybe (M.Map CommoditySymbol AmountStyle)  -- ^ commodity display styles
  ,forall s. BalancingState s -> Set CommoditySymbol
bsUnassignable :: S.Set AccountName                          -- ^ accounts where balance assignments may not be used (because of auto posting rules)
  ,forall s. BalancingState s -> Bool
bsAssrt        :: Bool                                       -- ^ whether to check balance assertions
   -- mutable
  ,forall s.
BalancingState s -> HashTable s CommoditySymbol 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 String (ST s)) (BalancingState s)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT
  (BalancingState s) (ExceptT String (ST s)) (BalancingState s)
-> (BalancingState s
    -> ReaderT (BalancingState s) (ExceptT String (ST s)) a)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) a
forall a b.
ReaderT (BalancingState s) (ExceptT String (ST s)) a
-> (a -> ReaderT (BalancingState s) (ExceptT String (ST s)) b)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExceptT String (ST s) a
-> ReaderT (BalancingState s) (ExceptT String (ST s)) a
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (BalancingState s) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT String (ST s) a
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) a)
-> (BalancingState s -> ExceptT String (ST s) a)
-> BalancingState s
-> ReaderT (BalancingState s) (ExceptT String (ST s)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST s a -> ExceptT String (ST s) a
forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s a -> ExceptT String (ST s) a)
-> (BalancingState s -> ST s a)
-> BalancingState s
-> ExceptT String (ST s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalancingState s -> ST s a
f

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

-- | Add this amount to this account's exclusive running balance.
-- Returns the new running balance.
addToRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB :: forall s. CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB CommoditySymbol
acc MixedAmount
amt = (BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance ((BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount)
-> (BalancingState s -> ST s MixedAmount)
-> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ \BalancingState{HashTable s CommoditySymbol MixedAmount
bsBalances :: forall s.
BalancingState s -> HashTable s CommoditySymbol MixedAmount
bsBalances :: HashTable s CommoditySymbol MixedAmount
bsBalances} -> do
  MixedAmount
old <- MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe MixedAmount
nullmixedamt (Maybe MixedAmount -> MixedAmount)
-> ST s (Maybe MixedAmount) -> ST s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashTable s CommoditySymbol MixedAmount
-> CommoditySymbol -> ST s (Maybe MixedAmount)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s CommoditySymbol MixedAmount
bsBalances CommoditySymbol
acc
  let new :: MixedAmount
new = MixedAmount -> MixedAmount -> MixedAmount
maPlus MixedAmount
old MixedAmount
amt
  HashTable s CommoditySymbol MixedAmount
-> CommoditySymbol -> MixedAmount -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s CommoditySymbol MixedAmount
bsBalances CommoditySymbol
acc MixedAmount
new
  MixedAmount -> ST s MixedAmount
forall a. a -> ST s a
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. CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
setRunningBalanceB CommoditySymbol
acc MixedAmount
amt = (BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance ((BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount)
-> (BalancingState s -> ST s MixedAmount)
-> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ \BalancingState{HashTable s CommoditySymbol MixedAmount
bsBalances :: forall s.
BalancingState s -> HashTable s CommoditySymbol MixedAmount
bsBalances :: HashTable s CommoditySymbol MixedAmount
bsBalances} -> do
  MixedAmount
old <- MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe MixedAmount
nullmixedamt (Maybe MixedAmount -> MixedAmount)
-> ST s (Maybe MixedAmount) -> ST s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashTable s CommoditySymbol MixedAmount
-> CommoditySymbol -> ST s (Maybe MixedAmount)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s CommoditySymbol MixedAmount
bsBalances CommoditySymbol
acc
  HashTable s CommoditySymbol MixedAmount
-> CommoditySymbol -> MixedAmount -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s CommoditySymbol MixedAmount
bsBalances CommoditySymbol
acc MixedAmount
amt
  MixedAmount -> ST s MixedAmount
forall a. a -> ST s a
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. CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
setInclusiveRunningBalanceB CommoditySymbol
acc MixedAmount
newibal = (BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withRunningBalance ((BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount)
-> (BalancingState s -> ST s MixedAmount)
-> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ \BalancingState{HashTable s CommoditySymbol MixedAmount
bsBalances :: forall s.
BalancingState s -> HashTable s CommoditySymbol MixedAmount
bsBalances :: HashTable s CommoditySymbol MixedAmount
bsBalances} -> do
  MixedAmount
oldebal  <- MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe MixedAmount
nullmixedamt (Maybe MixedAmount -> MixedAmount)
-> ST s (Maybe MixedAmount) -> ST s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashTable s CommoditySymbol MixedAmount
-> CommoditySymbol -> ST s (Maybe MixedAmount)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s CommoditySymbol MixedAmount
bsBalances CommoditySymbol
acc
  [(CommoditySymbol, MixedAmount)]
allebals <- HashTable s CommoditySymbol MixedAmount
-> ST s [(CommoditySymbol, MixedAmount)]
forall (h :: * -> * -> * -> *) s k v.
HashTable h =>
h s k v -> ST s [(k, v)]
H.toList HashTable s CommoditySymbol MixedAmount
bsBalances
  let subsibal :: MixedAmount
subsibal =  -- sum of any subaccounts' running balances
        [MixedAmount] -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum ([MixedAmount] -> MixedAmount)
-> ([(CommoditySymbol, MixedAmount)] -> [MixedAmount])
-> [(CommoditySymbol, MixedAmount)]
-> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CommoditySymbol, MixedAmount) -> MixedAmount)
-> [(CommoditySymbol, MixedAmount)] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (CommoditySymbol, MixedAmount) -> MixedAmount
forall a b. (a, b) -> b
snd ([(CommoditySymbol, MixedAmount)] -> MixedAmount)
-> [(CommoditySymbol, MixedAmount)] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ ((CommoditySymbol, MixedAmount) -> Bool)
-> [(CommoditySymbol, MixedAmount)]
-> [(CommoditySymbol, MixedAmount)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CommoditySymbol
acc CommoditySymbol -> CommoditySymbol -> Bool
`isAccountNamePrefixOf`)(CommoditySymbol -> Bool)
-> ((CommoditySymbol, MixedAmount) -> CommoditySymbol)
-> (CommoditySymbol, MixedAmount)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CommoditySymbol, MixedAmount) -> CommoditySymbol
forall a b. (a, b) -> a
fst) [(CommoditySymbol, MixedAmount)]
allebals
  let newebal :: MixedAmount
newebal = MixedAmount -> MixedAmount -> MixedAmount
maMinus MixedAmount
newibal MixedAmount
subsibal
  HashTable s CommoditySymbol MixedAmount
-> CommoditySymbol -> MixedAmount -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s CommoditySymbol MixedAmount
bsBalances CommoditySymbol
acc MixedAmount
newebal
  MixedAmount -> ST s MixedAmount
forall a. a -> ST s a
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 :: forall s. BalancingState s -> STArray s Integer Transaction
bsTransactions :: 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 and/or conversion costs
-- (as needed to balance transactions and satisfy balance assignments);
-- and check that all transactions are balanced;
-- and (optional) check that all balance assertions pass.
-- Or, return an error message (just the first error encountered).
--
-- Assumes journalStyleAmounts has been called, since amount styles
-- 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 String 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 CommoditySymbol AmountStyle)
styles = Map CommoditySymbol AmountStyle
-> Maybe (Map CommoditySymbol AmountStyle)
forall a. a -> Maybe a
Just (Map CommoditySymbol AmountStyle
 -> Maybe (Map CommoditySymbol AmountStyle))
-> Map CommoditySymbol AmountStyle
-> Maybe (Map CommoditySymbol AmountStyle)
forall a b. (a -> b) -> a -> b
$
      -- Use all the specified commodity display precisions, with hard rounding, when checking txn balancedness.
      -- XXX Problem, those precisions will also be used when inferring balancing amounts;
      -- it would be better to give those the precision of the amount they are balancing.
      Rounding -> Journal -> Map CommoditySymbol AmountStyle
journalCommodityStylesWith Rounding
HardRounding
      Journal
j
    bopts :: BalancingOpts
bopts = BalancingOpts
bopts'{commodity_styles_=styles}
      -- XXX ^ The commodity directive styles and default style and inferred styles
      -- are merged into the command line styles in commodity_styles_ - why ?
      -- Mainly for the precisions, used during amount and cost inference and balanced checking ?
    -- balance assignments are not allowed on accounts affected by auto postings
    autopostingaccts :: Set CommoditySymbol
autopostingaccts = [CommoditySymbol] -> Set CommoditySymbol
forall a. Ord a => [a] -> Set a
S.fromList ([CommoditySymbol] -> Set CommoditySymbol)
-> ([TransactionModifier] -> [CommoditySymbol])
-> [TransactionModifier]
-> Set CommoditySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TMPostingRule -> CommoditySymbol)
-> [TMPostingRule] -> [CommoditySymbol]
forall a b. (a -> b) -> [a] -> [b]
map (Posting -> CommoditySymbol
paccount (Posting -> CommoditySymbol)
-> (TMPostingRule -> Posting) -> TMPostingRule -> CommoditySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMPostingRule -> Posting
tmprPosting) ([TMPostingRule] -> [CommoditySymbol])
-> ([TransactionModifier] -> [TMPostingRule])
-> [TransactionModifier]
-> [CommoditySymbol]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransactionModifier -> [TMPostingRule])
-> [TransactionModifier] -> [TMPostingRule]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TransactionModifier -> [TMPostingRule]
tmpostingrules ([TransactionModifier] -> Set CommoditySymbol)
-> [TransactionModifier] -> Set CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Journal -> [TransactionModifier]
jtxnmodifiers Journal
j
  in
    -- Store the transactions in a mutable array, which we'll update as we balance them.
    -- Not strictly necessary but avoids a sort at the end I think.
    (forall s. ST s (Either String Journal)) -> Either String Journal
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Either String Journal)) -> Either String Journal)
-> (forall s. ST s (Either String Journal))
-> Either String Journal
forall a b. (a -> b) -> a -> b
$ do
      STArray s Integer Transaction
balancedtxns <- (Integer, Integer)
-> [Transaction] -> ST s (STArray s Integer Transaction)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> [e] -> m (a i e)
newListArray (Integer
1, Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [Transaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
ts) [Transaction]
ts

      -- Process all transactions, or short-circuit with an error.
      ExceptT String (ST s) Journal -> ST s (Either String Journal)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String (ST s) Journal -> ST s (Either String Journal))
-> ExceptT String (ST s) Journal -> ST s (Either String Journal)
forall a b. (a -> b) -> a -> b
$ do

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

        -- 2. Step through these items in date order (and preserved same-day order),
        -- keeping running balances for all accounts.
        HashTable s CommoditySymbol MixedAmount
runningbals <- ST s (HashTable s CommoditySymbol MixedAmount)
-> ExceptT String (ST s) (HashTable s CommoditySymbol MixedAmount)
forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s (HashTable s CommoditySymbol MixedAmount)
 -> ExceptT String (ST s) (HashTable s CommoditySymbol MixedAmount))
-> ST s (HashTable s CommoditySymbol MixedAmount)
-> ExceptT String (ST s) (HashTable s CommoditySymbol MixedAmount)
forall a b. (a -> b) -> a -> b
$ Int -> ST s (HashTable s CommoditySymbol MixedAmount)
forall s k v. Int -> ST s (HashTable s k v)
H.newSized ([CommoditySymbol] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([CommoditySymbol] -> Int) -> [CommoditySymbol] -> Int
forall a b. (a -> b) -> a -> b
$ Journal -> [CommoditySymbol]
journalAccountNamesUsed Journal
j)
        (ReaderT (BalancingState s) (ExceptT String (ST s)) ()
 -> BalancingState s -> ExceptT String (ST s) ())
-> BalancingState s
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ExceptT String (ST s) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> BalancingState s -> ExceptT String (ST s) ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Maybe (Map CommoditySymbol AmountStyle)
-> Set CommoditySymbol
-> Bool
-> HashTable s CommoditySymbol MixedAmount
-> STArray s Integer Transaction
-> BalancingState s
forall s.
Maybe (Map CommoditySymbol AmountStyle)
-> Set CommoditySymbol
-> Bool
-> HashTable s CommoditySymbol MixedAmount
-> STArray s Integer Transaction
-> BalancingState s
BalancingState Maybe (Map CommoditySymbol AmountStyle)
styles Set CommoditySymbol
autopostingaccts (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Bool
ignore_assertions_ BalancingOpts
bopts) HashTable s CommoditySymbol MixedAmount
runningbals STArray s Integer Transaction
balancedtxns) (ReaderT (BalancingState s) (ExceptT String (ST s)) ()
 -> ExceptT String (ST s) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ExceptT String (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
          -- On encountering any not-yet-balanced transaction with a balance assignment,
          -- enact the balance assignment then finish balancing the transaction.
          -- And, check any balance assertions encountered along the way.
          ReaderT (BalancingState s) (ExceptT String (ST s)) [()]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT (BalancingState s) (ExceptT String (ST s)) [()]
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [()]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$ (Either Posting Transaction
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> [Either Posting Transaction]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [()]
forall (f :: * -> *) a b. Monad f => (a -> f b) -> [a] -> f [b]
mapM' Either Posting Transaction
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall s. Either Posting Transaction -> Balancing s ()
balanceTransactionAndCheckAssertionsB ([Either Posting Transaction]
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) [()])
-> [Either Posting Transaction]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [()]
forall a b. (a -> b) -> a -> b
$ (Either Posting Transaction -> Day)
-> [Either Posting Transaction] -> [Either Posting Transaction]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((Posting -> Day)
-> (Transaction -> Day) -> Either Posting Transaction -> Day
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Posting -> Day
postingDate Transaction -> Day
tdate) [Either Posting Transaction]
psandts

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

-- Before #2039: "Costs are removed, which helps eg balance-assertions.test: 15. Mix different commodities and assignments."

-- | 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).
-- 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.
  -- Cost is ignored when checking balance assertions currently.
  ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
forall s. Posting -> Balancing s Posting
addAmountAndCheckAssertionB (Posting
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting)
-> Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
forall a b. (a -> b) -> a -> b
$ Posting -> Posting
postingStripCosts 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 String (ST s)) ())
-> [Posting]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Posting -> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall s. Posting -> Balancing s ()
checkIllegalBalanceAssignmentB [Posting]
ps
  -- for each posting, in date order (though without disturbing their display order),
  -- 1. infer its amount from the balance assignment if applicable,
  -- 2. update the account's running balance, and
  -- 3. check the balance assertion if any.
  [Posting]
ps' <- [Posting]
ps
    [Posting]
-> ([Posting] -> [(Integer, Posting)]) -> [(Integer, Posting)]
forall a b. a -> (a -> b) -> b
& [Integer] -> [Posting] -> [(Integer, Posting)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..]                 -- attach original positions
    [(Integer, Posting)]
-> ([(Integer, Posting)] -> [(Integer, Posting)])
-> [(Integer, Posting)]
forall a b. a -> (a -> b) -> b
& ((Integer, Posting) -> Day)
-> [(Integer, Posting)] -> [(Integer, Posting)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Posting -> Day
postingDate(Posting -> Day)
-> ((Integer, Posting) -> Posting) -> (Integer, Posting) -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Integer, Posting) -> Posting
forall a b. (a, b) -> b
snd)  -- sort by date
    [(Integer, Posting)]
-> ([(Integer, Posting)]
    -> ReaderT
         (BalancingState s) (ExceptT String (ST s)) [(Integer, Posting)])
-> ReaderT
     (BalancingState s) (ExceptT String (ST s)) [(Integer, Posting)]
forall a b. a -> (a -> b) -> b
& ((Integer, Posting)
 -> ReaderT
      (BalancingState s) (ExceptT String (ST s)) (Integer, Posting))
-> [(Integer, Posting)]
-> ReaderT
     (BalancingState s) (ExceptT String (ST s)) [(Integer, Posting)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (f :: * -> *) a b. Monad f => (a -> f b) -> [a] -> f [b]
mapM (Integer, Posting)
-> ReaderT
     (BalancingState s) (ExceptT String (ST s)) (Integer, Posting)
forall s. (Integer, Posting) -> Balancing s (Integer, Posting)
addOrAssignAmountAndCheckAssertionB  -- infer amount, check assertion on each one
    ReaderT
  (BalancingState s) (ExceptT String (ST s)) [(Integer, Posting)]
-> ([(Integer, Posting)] -> [(Integer, Posting)])
-> ReaderT
     (BalancingState s) (ExceptT String (ST s)) [(Integer, Posting)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((Integer, Posting) -> Integer)
-> [(Integer, Posting)] -> [(Integer, Posting)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Integer, Posting) -> Integer
forall a b. (a, b) -> a
fst              -- restore original order
    ReaderT
  (BalancingState s) (ExceptT String (ST s)) [(Integer, Posting)]
-> ([(Integer, Posting)] -> [Posting])
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [Posting]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((Integer, Posting) -> Posting)
-> [(Integer, Posting)] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, Posting) -> Posting
forall a b. (a, b) -> b
snd                 -- discard positions

  -- infer any remaining missing amounts, and make sure the transaction is now fully balanced
  Maybe (Map CommoditySymbol AmountStyle)
styles <- (BalancingState s -> Maybe (Map CommoditySymbol AmountStyle))
-> ReaderT
     (BalancingState s)
     (ExceptT String (ST s))
     (Maybe (Map CommoditySymbol AmountStyle))
forall a.
(BalancingState s -> a)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Maybe (Map CommoditySymbol AmountStyle)
forall s.
BalancingState s -> Maybe (Map CommoditySymbol AmountStyle)
bsStyles
  case BalancingOpts
-> Transaction
-> Either String (Transaction, [(CommoditySymbol, MixedAmount)])
balanceTransactionHelper BalancingOpts
defbalancingopts{commodity_styles_=styles} Transaction
t{tpostings=ps'} of
    Left String
err -> String -> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a.
String -> ReaderT (BalancingState s) (ExceptT String (ST s)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
err
    Right (Transaction
t', [(CommoditySymbol, MixedAmount)]
inferredacctsandamts) -> do
      -- for each amount just inferred, update the running balance
      ((CommoditySymbol, MixedAmount)
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) MixedAmount)
-> [(CommoditySymbol, MixedAmount)]
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((CommoditySymbol
 -> MixedAmount
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) MixedAmount)
-> (CommoditySymbol, MixedAmount)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) MixedAmount
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CommoditySymbol
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) MixedAmount
forall s. CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB) [(CommoditySymbol, MixedAmount)]
inferredacctsandamts
      -- and save the balanced transaction.
      Transaction
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall s. Transaction -> Balancing s ()
updateTransactionB Transaction
t'

type NumberedPosting = (Integer, Posting)

-- | 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 :: NumberedPosting -> Balancing s NumberedPosting
addOrAssignAmountAndCheckAssertionB :: forall s. (Integer, Posting) -> Balancing s (Integer, Posting)
addOrAssignAmountAndCheckAssertionB (Integer
i,p :: Posting
p@Posting{paccount :: Posting -> CommoditySymbol
paccount=CommoditySymbol
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 <- CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
forall s. CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB CommoditySymbol
acc MixedAmount
amt
      ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((BalancingState s -> Bool)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
forall a.
(BalancingState s -> a)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Bool
forall s. BalancingState s -> Bool
bsAssrt) (ReaderT (BalancingState s) (ExceptT String (ST s)) ()
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall s. Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB Posting
p MixedAmount
newbal
      (Integer, Posting) -> Balancing s (Integer, Posting)
forall a. a -> ReaderT (BalancingState s) (ExceptT String (ST s)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
i,Posting
p)

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

  -- no explicit posting amount, no balance assignment
  | Bool
otherwise = (Integer, Posting) -> Balancing s (Integer, Posting)
forall a. a -> ReaderT (BalancingState s) (ExceptT String (ST s)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
i,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 <- CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
forall s. CommoditySymbol -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB (Posting -> CommoditySymbol
paccount Posting
p) (MixedAmount -> Balancing s MixedAmount)
-> MixedAmount -> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
  ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((BalancingState s -> Bool)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
forall a.
(BalancingState s -> a)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Bool
forall s. BalancingState s -> Bool
bsAssrt) (ReaderT (BalancingState s) (ExceptT String (ST s)) ()
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall s. Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB Posting
p MixedAmount
newbal
  Posting -> Balancing s Posting
forall a. a -> ReaderT (BalancingState s) (ExceptT String (ST s)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p
addAmountAndCheckAssertionB Posting
p = Posting -> Balancing s Posting
forall a. a -> ReaderT (BalancingState s) (ExceptT String (ST s)) a
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 :: BalanceAssertion -> Amount
baamount :: Amount
baamount,Bool
batotal :: BalanceAssertion -> Bool
batotal :: Bool
batotal})} MixedAmount
actualbal =
  [Amount]
-> (Amount
    -> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (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 String (ST s)) ())
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> (Amount
    -> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$ \Amount
amt -> Posting
-> Amount
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall s. Posting -> Amount -> MixedAmount -> Balancing s ()
checkBalanceAssertionOneCommodityB Posting
p Amount
amt MixedAmount
actualbal
  where
    assertedcomm :: CommoditySymbol
assertedcomm = Amount -> CommoditySymbol
acommodity Amount
baamount
    otheramts :: [Amount]
otheramts | Bool
batotal   = (Amount -> Amount) -> [Amount] -> [Amount]
forall a b. (a -> b) -> [a] -> [b]
map (\Amount
a -> Amount
a{aquantity=0}) ([Amount] -> [Amount])
-> (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amountsRaw
                          (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ (Amount -> Bool) -> MixedAmount -> MixedAmount
filterMixedAmount ((CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
/=CommoditySymbol
assertedcomm)(CommoditySymbol -> Bool)
-> (Amount -> CommoditySymbol) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Amount -> CommoditySymbol
acommodity) MixedAmount
actualbal
              | Bool
otherwise = []
checkBalanceAssertionB Posting
_ MixedAmount
_ = () -> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a. a -> ReaderT (BalancingState s) (ExceptT String (ST s)) a
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, ignoring costs ?
-- 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 -> CommoditySymbol
paccount=CommoditySymbol
assertedacct} Amount
assertedcommbal 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
  let istotal :: Bool
istotal     = Bool
-> (BalanceAssertion -> Bool) -> Maybe BalanceAssertion -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False BalanceAssertion -> Bool
batotal     (Maybe BalanceAssertion -> Bool) -> Maybe BalanceAssertion -> Bool
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe BalanceAssertion
pbalanceassertion Posting
p
  -- mstyles <- R.reader bsStyles
  -- let styled = maybe id styleAmounts mstyles
  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 CommoditySymbol MixedAmount
bsBalances :: forall s.
BalancingState s -> HashTable s CommoditySymbol MixedAmount
bsBalances :: HashTable s CommoditySymbol MixedAmount
bsBalances} ->
        (MixedAmount -> (CommoditySymbol, MixedAmount) -> ST s MixedAmount)
-> MixedAmount
-> HashTable s CommoditySymbol MixedAmount
-> ST s MixedAmount
forall a k v s.
(a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
H.foldM
          (\MixedAmount
ibal (CommoditySymbol
acc, MixedAmount
amt) -> MixedAmount -> ST s MixedAmount
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (MixedAmount -> ST s MixedAmount)
-> MixedAmount -> ST s MixedAmount
forall a b. (a -> b) -> a -> b
$
            if CommoditySymbol
assertedacctCommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
==CommoditySymbol
acc Bool -> Bool -> Bool
|| CommoditySymbol
assertedacct CommoditySymbol -> CommoditySymbol -> Bool
`isAccountNamePrefixOf` CommoditySymbol
acc then MixedAmount -> MixedAmount -> MixedAmount
maPlus MixedAmount
ibal MixedAmount
amt else MixedAmount
ibal)
          MixedAmount
nullmixedamt
          HashTable s CommoditySymbol MixedAmount
bsBalances
    else MixedAmount -> Balancing s MixedAmount
forall a. a -> ReaderT (BalancingState s) (ExceptT String (ST s)) a
forall (m :: * -> *) a. Monad m => a -> m a
return MixedAmount
actualbal
  let
    assertedcomm :: CommoditySymbol
assertedcomm = Amount -> CommoditySymbol
acommodity Amount
assertedcommbal

    -- The asserted single-commodity balance, without cost
    assertedcommbalcostless :: Amount
assertedcommbalcostless = Amount -> Amount
amountStripCost Amount
assertedcommbal

    -- The balance in this commodity, from the current multi-commodity running balance at this point.
    -- This is unnormalised, and could include one or more different costs.
    actualcommbal :: MixedAmount
actualcommbal           = CommoditySymbol -> MixedAmount -> MixedAmount
filterMixedAmountByCommodity CommoditySymbol
assertedcomm (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount
actualbal'

    -- The above balance without costs, as a single Amount (Amount's + discards costs).
    actualcommbalcostless :: Amount
actualcommbalcostless   = [Amount] -> Amount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Amount] -> Amount) -> [Amount] -> Amount
forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
amountsRaw MixedAmount
actualcommbal

    -- test the assertion
    pass :: Bool
pass =
      Amount -> DecimalRaw Integer
aquantity Amount
assertedcommbalcostless
      DecimalRaw Integer -> DecimalRaw Integer -> Bool
forall a. Eq a => a -> a -> Bool
==
      Amount -> DecimalRaw Integer
aquantity Amount
actualcommbalcostless

    errmsg :: String
errmsg = String -> String
chomp (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
-> String
-> CommoditySymbol
-> String
-> CommoditySymbol
-> String
-> CommoditySymbol
-> CommoditySymbol
-> String
-> String
-> String
-> String
forall r. PrintfType r => String -> r
printf ([String] -> String
unlines
      [ String
"%s:",
        String
"%s\n",
        String
"Balance assertion failed in %s",
        String
"%s at this point, %s, ignoring costs,",
        String
"the asserted balance is:        %s",
        String
"but the calculated balance is:  %s",
        String
"(difference: %s)",
        String
"To troubleshoot, check this account's running balance with assertions disabled, eg:",
        String
"hledger reg -I '%s'%s"
      ])

      (SourcePos -> String
sourcePosPretty SourcePos
pos)  -- position
      (CommoditySymbol -> CommoditySymbol
textChomp CommoditySymbol
ex)  -- journal excerpt
      String
acct  -- asserted account
      (if Bool
istotal then CommoditySymbol
"Across all commodities" else CommoditySymbol
"In commodity " CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> CommoditySymbol
assertedcommstr)  -- asserted commodity or all commodities ?
      (if Bool
isinclusive then String
"including subaccounts" else String
"excluding subaccounts" :: String)  -- inclusive or exclusive balance asserted ?
      (String -> CommoditySymbol
pad String
assertedstr  -- asserted amount, without cost
        CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> if Int
debugLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 then CommoditySymbol
" (with cost:  " CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> String -> CommoditySymbol
T.pack (AmountFormat -> Amount -> String
showAmountWith AmountFormat
fmt Amount
assertedcommbal) CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> CommoditySymbol
")" else CommoditySymbol
""
      )
      (String -> CommoditySymbol
pad String
actualstr    -- actual amount, without cost
        CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> if Int
debugLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 then CommoditySymbol
" (with costs: " CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> String -> CommoditySymbol
T.pack (AmountFormat -> MixedAmount -> String
showMixedAmountWith AmountFormat
fmt MixedAmount
actualcommbal) CommoditySymbol -> CommoditySymbol -> CommoditySymbol
forall a. Semigroup a => a -> a -> a
<> CommoditySymbol
")" else CommoditySymbol
""
      )
      String
diffstr  -- their difference
      (String
acct String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
isinclusive then String
"" else String
"$")  -- query matching the account(s) postings
      (if Bool
istotal then String
"" else (String
" cur:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
quoteForCommandLine (CommoditySymbol -> String
T.unpack CommoditySymbol
assertedcomm)))  -- query matching the commodity(ies)

      where
        acct :: String
acct = CommoditySymbol -> String
T.unpack (CommoditySymbol -> String) -> CommoditySymbol -> String
forall a b. (a -> b) -> a -> b
$ Posting -> CommoditySymbol
paccount Posting
p
        ass :: BalanceAssertion
ass = 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  -- PARTIAL: fromJust won't fail, there is a balance assertion
        pos :: SourcePos
pos = BalanceAssertion -> SourcePos
baposition BalanceAssertion
ass
        (String
_,Int
_,Maybe (Int, Maybe Int)
_,CommoditySymbol
ex) = Posting -> (String, Int, Maybe (Int, Maybe Int), CommoditySymbol)
makeBalanceAssertionErrorExcerpt Posting
p
        assertedcommstr :: CommoditySymbol
assertedcommstr = if CommoditySymbol -> Bool
T.null CommoditySymbol
assertedcomm then CommoditySymbol
"\"\"" else CommoditySymbol
assertedcomm
        fmt :: AmountFormat
fmt = AmountFormat
oneLineFmt{displayZeroCommodity=True}
        assertedstr :: String
assertedstr = AmountFormat -> Amount -> String
showAmountWith AmountFormat
fmt Amount
assertedcommbalcostless
        actualstr :: String
actualstr   = AmountFormat -> Amount -> String
showAmountWith AmountFormat
fmt Amount
actualcommbalcostless
        diffstr :: String
diffstr     = AmountFormat -> Amount -> String
showAmountWith AmountFormat
fmt (Amount -> String) -> Amount -> String
forall a b. (a -> b) -> a -> b
$ Amount
assertedcommbalcostless Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
- Amount
actualcommbalcostless
        pad :: String -> CommoditySymbol
pad = Maybe Int
-> Maybe Int -> Bool -> Bool -> CommoditySymbol -> CommoditySymbol
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w) Maybe Int
forall a. Maybe a
Nothing Bool
False Bool
False (CommoditySymbol -> CommoditySymbol)
-> (String -> CommoditySymbol) -> String -> CommoditySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CommoditySymbol
T.pack where w :: Int
w = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
assertedstr) (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
actualstr)


  Bool -> Balancing s () -> Balancing s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
pass (Balancing s () -> Balancing s ())
-> Balancing s () -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ String -> Balancing s ()
forall a.
String -> ReaderT (BalancingState s) (ExceptT String (ST s)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
errmsg
{- XXX
When the posting amount has a cost, the highlight region expands to the full line:

*** Exception: Error: /Users/simon/src/hledger/2024-01-21.j:12:69:
   | 2023-12-31 closing balances
12 |     assets:cash:petty:saved:rent       -4.00 EUR @ 2 UAH == 0.00 EUR
   |     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
   |     equity:opening/closing balances                8 UAH

Maybe it's better than the normal region ?

*** Exception: Error: /Users/simon/src/hledger/2024-01-21.j:12:61:
   | 2023-12-31 closing balances
12 |     assets:cash:petty:saved:rent          -4.00 EUR == 0.00 EUR @ 3 UAH
   |                                                     ^^^^^^^^^^^^^^^^^^^
   |     equity:opening/closing balances        4.00 EUR

If changed also check flycheck-hledger, which currently highlights the equals:

    assets:cash:petty:saved:rent                  -4.00 EUR @ 2 UAH == 0.00 EUR @ 3 UAH 
                                                                    --
-}

-- | 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 String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (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 String (ST s)) ()
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$
    String -> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a.
String -> ReaderT (BalancingState s) (ExceptT String (ST s)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> String -> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$ String -> String
chomp (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
       String
"Balance assignments and custom posting dates may not be combined."
      ,String
""
      ,String -> String
chomp1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CommoditySymbol -> String
T.unpack (CommoditySymbol -> String) -> CommoditySymbol -> String
forall a b. (a -> b) -> a -> b
$ CommoditySymbol
-> (Transaction -> CommoditySymbol)
-> Maybe Transaction
-> CommoditySymbol
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([CommoditySymbol] -> CommoditySymbol
T.unlines ([CommoditySymbol] -> CommoditySymbol)
-> [CommoditySymbol] -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Posting -> [CommoditySymbol]
showPostingLines Posting
p) Transaction -> CommoditySymbol
showTransaction (Maybe Transaction -> CommoditySymbol)
-> Maybe Transaction -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
      ,String
"Balance assignments may not be used on postings with a custom posting date"
      ,String
"(it makes balancing the journal impossible)."
      ,String
"Please write the posting amount explicitly (or remove the posting date)."
      ]

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

-- lenses

makeHledgerClassyLenses ''BalancingOpts

-- tests

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

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

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

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

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

    ,String -> Assertion -> TestTree
testCase String
"balance-assignment" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      let ej :: Either String Journal
ej = BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either String Journal)
-> Journal -> Either String Journal
forall a b. (a -> b) -> a -> b
$
            --2019/01/01
            --  (a)            = 1
            Journal
nulljournal{ jtxns = [
              transaction (fromGregorian 2019 01 01) [ vpost' "a" missingamt (balassert (num 1)) ]
            ]}
      Either String Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight Either String Journal
ej
      case Either String Journal
ej of Right Journal
j -> (Journal -> [Transaction]
jtxns Journal
j [Transaction] -> ([Transaction] -> Transaction) -> Transaction
forall a b. a -> (a -> b) -> b
& [Transaction] -> Transaction
forall a. HasCallStack => [a] -> a
headErr 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. HasCallStack => [a] -> a
headErr 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]  -- PARTIAL headErrs succeed because non-null txns & postings lists given
                 Left String
_  -> String -> Assertion
forall a. String -> a
error' String
"balance-assignment test: shouldn't happen"

    ,String -> Assertion -> TestTree
testCase String
"same-day-1" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      Either String Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either String Journal -> Assertion)
-> Either String Journal -> Assertion
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either String Journal)
-> Journal -> Either String Journal
forall a b. (a -> b) -> a -> b
$
            --2019/01/01
            --  (a)            = 1
            --2019/01/01
            --  (a)          1 = 2
            Journal
nulljournal{ jtxns = [
               transaction (fromGregorian 2019 01 01) [ vpost' "a" missingamt (balassert (num 1)) ]
              ,transaction (fromGregorian 2019 01 01) [ vpost' "a" (num 1)    (balassert (num 2)) ]
            ]}

    ,String -> Assertion -> TestTree
testCase String
"same-day-2" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      Either String Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either String Journal -> Assertion)
-> Either String Journal -> Assertion
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either String Journal)
-> Journal -> Either String Journal
forall a b. (a -> b) -> a -> b
$
            --2019/01/01
            --    (a)                  2 = 2
            --2019/01/01
            --    b                    1
            --    a
            --2019/01/01
            --    a                    0 = 1
            Journal
nulljournal{ jtxns = [
               transaction (fromGregorian 2019 01 01) [ vpost' "a" (num 2)    (balassert (num 2)) ]
              ,transaction (fromGregorian 2019 01 01) [
                 post' "b" (num 1)     Nothing
                ,post' "a"  missingamt Nothing
              ]
              ,transaction (fromGregorian 2019 01 01) [ post' "a" (num 0)     (balassert (num 1)) ]
            ]}

    ,String -> Assertion -> TestTree
testCase String
"out-of-order" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      Either String Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Either String Journal -> Assertion)
-> Either String Journal -> Assertion
forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions BalancingOpts
defbalancingopts (Journal -> Either String Journal)
-> Journal -> Either String Journal
forall a b. (a -> b) -> a -> b
$
            --2019/1/2
            --  (a)    1 = 2
            --2019/1/1
            --  (a)    1 = 1
            Journal
nulljournal{ jtxns = [
               transaction (fromGregorian 2019 01 02) [ vpost' "a" (num 1)    (balassert (num 2)) ]
              ,transaction (fromGregorian 2019 01 01) [ vpost' "a" (num 1)    (balassert (num 1)) ]
            ]}

    ]

    ,String -> [TestTree] -> TestTree
testGroup String
"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
      --
      String -> Assertion -> TestTree
testCase String
"1091a" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        [Amount] -> Either String (Map CommoditySymbol AmountStyle)
commodityStylesFromAmounts [
           Amount
nullamt{aquantity=1000, astyle=AmountStyle L False Nothing (Just ',') (Precision 3) NoRounding}
          ,Amount
nullamt{aquantity=1000, astyle=AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Precision 2) NoRounding}
          ]
         Either String (Map CommoditySymbol AmountStyle)
-> Either String (Map CommoditySymbol 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 CommoditySymbol AmountStyle
-> Either String (Map CommoditySymbol AmountStyle)
forall a b. b -> Either a b
Right ([(CommoditySymbol, AmountStyle)] -> Map CommoditySymbol AmountStyle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
            (CommoditySymbol
"", Side
-> Bool
-> Maybe DigitGroupStyle
-> Maybe Char
-> AmountPrecision
-> Rounding
-> AmountStyle
AmountStyle Side
L Bool
False (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3])) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.') (Word8 -> AmountPrecision
Precision Word8
3) Rounding
NoRounding)
          ])
        -- same journal, entries in reverse order
      ,String -> Assertion -> TestTree
testCase String
"1091b" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        [Amount] -> Either String (Map CommoditySymbol AmountStyle)
commodityStylesFromAmounts [
           Amount
nullamt{aquantity=1000, astyle=AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Precision 2) NoRounding}
          ,Amount
nullamt{aquantity=1000, astyle=AmountStyle L False Nothing (Just ',') (Precision 3) NoRounding}
          ]
         Either String (Map CommoditySymbol AmountStyle)
-> Either String (Map CommoditySymbol 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 CommoditySymbol AmountStyle
-> Either String (Map CommoditySymbol AmountStyle)
forall a b. b -> Either a b
Right ([(CommoditySymbol, AmountStyle)] -> Map CommoditySymbol AmountStyle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
            (CommoditySymbol
"", Side
-> Bool
-> Maybe DigitGroupStyle
-> Maybe Char
-> AmountPrecision
-> Rounding
-> AmountStyle
AmountStyle Side
L Bool
False (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3])) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.') (Word8 -> AmountPrecision
Precision Word8
3) Rounding
NoRounding)
          ])

     ]

  ]