{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}

{-|

A 'Journal' is a set of transactions, plus optional related data.  This is
hledger's primary data object. It is usually parsed from a journal file or
other data format (see "Hledger.Read").

-}

module Hledger.Data.Journal (
  -- * Parsing helpers
  addPriceDirective,
  addTransactionModifier,
  addPeriodicTransaction,
  addTransaction,
  journalBalanceTransactions,
  journalApplyCommodityStyles,
  commodityStylesFromAmounts,
  journalCommodityStyles,
  journalToCost,
  journalReverse,
  journalSetLastReadTime,
  journalPivot,
  -- * Filtering
  filterJournalTransactions,
  filterJournalPostings,
  filterJournalAmounts,
  filterTransactionAmounts,
  filterTransactionPostings,
  filterPostingAmount,
  -- * Mapping
  mapJournalTransactions,
  mapJournalPostings,
  mapTransactionPostings,
  -- * Querying
  journalAccountNamesUsed,
  journalAccountNamesImplied,
  journalAccountNamesDeclared,
  journalAccountNamesDeclaredOrUsed,
  journalAccountNamesDeclaredOrImplied,
  journalAccountNames,
  -- journalAmountAndPriceCommodities,
  journalAmounts,
  overJournalAmounts,
  traverseJournalAmounts,
  -- journalCanonicalCommodities,
  journalDateSpan,
  journalStartDate,
  journalEndDate,
  journalDescriptions,
  journalFilePath,
  journalFilePaths,
  journalTransactionAt,
  journalNextTransaction,
  journalPrevTransaction,
  journalPostings,
  -- journalPrices,
  -- * Standard account types
  journalBalanceSheetAccountQuery,
  journalProfitAndLossAccountQuery,
  journalRevenueAccountQuery,
  journalExpenseAccountQuery,
  journalAssetAccountQuery,
  journalLiabilityAccountQuery,
  journalEquityAccountQuery,
  journalCashAccountQuery,
  -- * Misc
  canonicalStyleFrom,
  matchpats,
  nulljournal,
  journalCheckBalanceAssertions,
  journalNumberAndTieTransactions,
  journalUntieTransactions,
  journalModifyTransactions,
  -- * Tests
  samplejournal,
  tests_Journal,
)
where
import Control.Applicative (Const(..))
import Control.Monad
import Control.Monad.Except
import Control.Monad.Extra
import Control.Monad.Reader as R
import Control.Monad.ST
import Data.Array.ST
import Data.Function ((&))
import Data.Functor.Identity (Identity(..))
import qualified Data.HashTable.ST.Cuckoo as H
import Data.List
import Data.List.Extra (groupSort)
import qualified Data.Map as M
import Data.Maybe
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
import qualified Data.Semigroup as Sem
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Safe (headMay, headDef)
import Data.Time.Calendar
import Data.Tree
import System.Time (ClockTime(TOD))
import Text.Printf

import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.AccountName
import Hledger.Data.Amount
import Hledger.Data.Dates
import Hledger.Data.Transaction
import Hledger.Data.TransactionModifier
import Hledger.Data.Posting
import Hledger.Query


-- try to make Journal ppShow-compatible
-- instance Show ClockTime where
--   show t = "<ClockTime>"
-- deriving instance Show Journal

instance Show Journal where
  show :: Journal -> String
show j :: Journal
j
    | Int
debugLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 3 = String -> String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf "Journal %s with %d transactions, %d accounts"
             (Journal -> String
journalFilePath Journal
j)
             ([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Transaction] -> Int) -> [Transaction] -> Int
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j)
             ([AccountName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AccountName]
accounts)
    | Int
debugLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 6 = String -> String -> Int -> Int -> ShowS
forall r. PrintfType r => String -> r
printf "Journal %s with %d transactions, %d accounts: %s"
             (Journal -> String
journalFilePath Journal
j)
             ([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Transaction] -> Int) -> [Transaction] -> Int
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j)
             ([AccountName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AccountName]
accounts)
             ([AccountName] -> String
forall a. Show a => a -> String
show [AccountName]
accounts)
    | Bool
otherwise = String -> String -> Int -> Int -> String -> ShowS
forall r. PrintfType r => String -> r
printf "Journal %s with %d transactions, %d accounts: %s, commodity styles: %s"
             (Journal -> String
journalFilePath Journal
j)
             ([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Transaction] -> Int) -> [Transaction] -> Int
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j)
             ([AccountName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AccountName]
accounts)
             ([AccountName] -> String
forall a. Show a => a -> String
show [AccountName]
accounts)
             (Map AccountName AmountStyle -> String
forall a. Show a => a -> String
show (Map AccountName AmountStyle -> String)
-> Map AccountName AmountStyle -> String
forall a b. (a -> b) -> a -> b
$ Journal -> Map AccountName AmountStyle
jinferredcommodities Journal
j)
             -- ++ (show $ journalTransactions l)
             where accounts :: [AccountName]
accounts = (AccountName -> Bool) -> [AccountName] -> [AccountName]
forall a. (a -> Bool) -> [a] -> [a]
filter (AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
/= "root") ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ Tree AccountName -> [AccountName]
forall a. Tree a -> [a]
flatten (Tree AccountName -> [AccountName])
-> Tree AccountName -> [AccountName]
forall a b. (a -> b) -> a -> b
$ Journal -> Tree AccountName
journalAccountNameTree Journal
j

-- showJournalDebug j = unlines [
--                       show j
--                      ,show (jtxns j)
--                      ,show (jtxnmodifiers j)
--                      ,show (jperiodictxns j)
--                      ,show $ jparsetimeclockentries j
--                      ,show $ jpricedirectives j
--                      ,show $ jfinalcommentlines j
--                      ,show $ jparsestate j
--                      ,show $ map fst $ jfiles j
--                      ]

-- The monoid instance for Journal is useful for two situations.
--
-- 1. concatenating finalised journals, eg with multiple -f options:
-- FIRST <> SECOND. The second's list fields are appended to the
-- first's, map fields are combined, transaction counts are summed,
-- the parse state of the second is kept.
--
-- 2. merging a child parsed journal, eg with the include directive:
-- CHILD <> PARENT. A parsed journal's data is in reverse order, so
-- this gives what we want.
--
instance Sem.Semigroup Journal where
  j1 :: Journal
j1 <> :: Journal -> Journal -> Journal
<> j2 :: Journal
j2 = Journal :: Maybe Year
-> Maybe (AccountName, AmountStyle)
-> [AccountName]
-> [AccountAlias]
-> [TimeclockEntry]
-> [String]
-> [(AccountName, AccountDeclarationInfo)]
-> Map AccountType [AccountName]
-> Map AccountName Commodity
-> Map AccountName AmountStyle
-> [PriceDirective]
-> [TransactionModifier]
-> [PeriodicTransaction]
-> [Transaction]
-> AccountName
-> [(String, AccountName)]
-> ClockTime
-> Journal
Journal {
     jparsedefaultyear :: Maybe Year
jparsedefaultyear          = Journal -> Maybe Year
jparsedefaultyear          Journal
j2
    ,jparsedefaultcommodity :: Maybe (AccountName, AmountStyle)
jparsedefaultcommodity     = Journal -> Maybe (AccountName, AmountStyle)
jparsedefaultcommodity     Journal
j2
    ,jparseparentaccounts :: [AccountName]
jparseparentaccounts       = Journal -> [AccountName]
jparseparentaccounts       Journal
j2
    ,jparsealiases :: [AccountAlias]
jparsealiases              = Journal -> [AccountAlias]
jparsealiases              Journal
j2
    -- ,jparsetransactioncount     = jparsetransactioncount     j1 +  jparsetransactioncount     j2
    ,jparsetimeclockentries :: [TimeclockEntry]
jparsetimeclockentries     = Journal -> [TimeclockEntry]
jparsetimeclockentries Journal
j1 [TimeclockEntry] -> [TimeclockEntry] -> [TimeclockEntry]
forall a. Semigroup a => a -> a -> a
<> Journal -> [TimeclockEntry]
jparsetimeclockentries Journal
j2
    ,jincludefilestack :: [String]
jincludefilestack          = Journal -> [String]
jincludefilestack          Journal
j2
    ,jdeclaredaccounts :: [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts          = Journal -> [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts          Journal
j1 [(AccountName, AccountDeclarationInfo)]
-> [(AccountName, AccountDeclarationInfo)]
-> [(AccountName, AccountDeclarationInfo)]
forall a. Semigroup a => a -> a -> a
<> Journal -> [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts          Journal
j2
    ,jdeclaredaccounttypes :: Map AccountType [AccountName]
jdeclaredaccounttypes      = Journal -> Map AccountType [AccountName]
jdeclaredaccounttypes      Journal
j1 Map AccountType [AccountName]
-> Map AccountType [AccountName] -> Map AccountType [AccountName]
forall a. Semigroup a => a -> a -> a
<> Journal -> Map AccountType [AccountName]
jdeclaredaccounttypes      Journal
j2
    ,jcommodities :: Map AccountName Commodity
jcommodities               = Journal -> Map AccountName Commodity
jcommodities               Journal
j1 Map AccountName Commodity
-> Map AccountName Commodity -> Map AccountName Commodity
forall a. Semigroup a => a -> a -> a
<> Journal -> Map AccountName Commodity
jcommodities               Journal
j2
    ,jinferredcommodities :: Map AccountName AmountStyle
jinferredcommodities       = Journal -> Map AccountName AmountStyle
jinferredcommodities       Journal
j1 Map AccountName AmountStyle
-> Map AccountName AmountStyle -> Map AccountName AmountStyle
forall a. Semigroup a => a -> a -> a
<> Journal -> Map AccountName AmountStyle
jinferredcommodities       Journal
j2
    ,jpricedirectives :: [PriceDirective]
jpricedirectives              = Journal -> [PriceDirective]
jpricedirectives              Journal
j1 [PriceDirective] -> [PriceDirective] -> [PriceDirective]
forall a. Semigroup a => a -> a -> a
<> Journal -> [PriceDirective]
jpricedirectives              Journal
j2
    ,jtxnmodifiers :: [TransactionModifier]
jtxnmodifiers              = Journal -> [TransactionModifier]
jtxnmodifiers              Journal
j1 [TransactionModifier]
-> [TransactionModifier] -> [TransactionModifier]
forall a. Semigroup a => a -> a -> a
<> Journal -> [TransactionModifier]
jtxnmodifiers              Journal
j2
    ,jperiodictxns :: [PeriodicTransaction]
jperiodictxns              = Journal -> [PeriodicTransaction]
jperiodictxns              Journal
j1 [PeriodicTransaction]
-> [PeriodicTransaction] -> [PeriodicTransaction]
forall a. Semigroup a => a -> a -> a
<> Journal -> [PeriodicTransaction]
jperiodictxns              Journal
j2
    ,jtxns :: [Transaction]
jtxns                      = Journal -> [Transaction]
jtxns                      Journal
j1 [Transaction] -> [Transaction] -> [Transaction]
forall a. Semigroup a => a -> a -> a
<> Journal -> [Transaction]
jtxns                      Journal
j2
    ,jfinalcommentlines :: AccountName
jfinalcommentlines         = Journal -> AccountName
jfinalcommentlines         Journal
j2  -- XXX discards j1's ?
    ,jfiles :: [(String, AccountName)]
jfiles                     = Journal -> [(String, AccountName)]
jfiles                     Journal
j1 [(String, AccountName)]
-> [(String, AccountName)] -> [(String, AccountName)]
forall a. Semigroup a => a -> a -> a
<> Journal -> [(String, AccountName)]
jfiles                     Journal
j2
    ,jlastreadtime :: ClockTime
jlastreadtime              = ClockTime -> ClockTime -> ClockTime
forall a. Ord a => a -> a -> a
max (Journal -> ClockTime
jlastreadtime Journal
j1) (Journal -> ClockTime
jlastreadtime Journal
j2)
    }

instance Monoid Journal where
  mempty :: Journal
mempty = Journal
nulljournal
#if !(MIN_VERSION_base(4,11,0))
  -- This is redundant starting with base-4.11 / GHC 8.4.
  mappend = (Sem.<>)
#endif

nulljournal :: Journal
nulljournal :: Journal
nulljournal = Journal :: Maybe Year
-> Maybe (AccountName, AmountStyle)
-> [AccountName]
-> [AccountAlias]
-> [TimeclockEntry]
-> [String]
-> [(AccountName, AccountDeclarationInfo)]
-> Map AccountType [AccountName]
-> Map AccountName Commodity
-> Map AccountName AmountStyle
-> [PriceDirective]
-> [TransactionModifier]
-> [PeriodicTransaction]
-> [Transaction]
-> AccountName
-> [(String, AccountName)]
-> ClockTime
-> Journal
Journal {
   jparsedefaultyear :: Maybe Year
jparsedefaultyear          = Maybe Year
forall a. Maybe a
Nothing
  ,jparsedefaultcommodity :: Maybe (AccountName, AmountStyle)
jparsedefaultcommodity     = Maybe (AccountName, AmountStyle)
forall a. Maybe a
Nothing
  ,jparseparentaccounts :: [AccountName]
jparseparentaccounts       = []
  ,jparsealiases :: [AccountAlias]
jparsealiases              = []
  -- ,jparsetransactioncount     = 0
  ,jparsetimeclockentries :: [TimeclockEntry]
jparsetimeclockentries     = []
  ,jincludefilestack :: [String]
jincludefilestack          = []
  ,jdeclaredaccounts :: [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts          = []
  ,jdeclaredaccounttypes :: Map AccountType [AccountName]
jdeclaredaccounttypes      = Map AccountType [AccountName]
forall k a. Map k a
M.empty
  ,jcommodities :: Map AccountName Commodity
jcommodities               = Map AccountName Commodity
forall k a. Map k a
M.empty
  ,jinferredcommodities :: Map AccountName AmountStyle
jinferredcommodities       = Map AccountName AmountStyle
forall k a. Map k a
M.empty
  ,jpricedirectives :: [PriceDirective]
jpricedirectives              = []
  ,jtxnmodifiers :: [TransactionModifier]
jtxnmodifiers              = []
  ,jperiodictxns :: [PeriodicTransaction]
jperiodictxns              = []
  ,jtxns :: [Transaction]
jtxns                      = []
  ,jfinalcommentlines :: AccountName
jfinalcommentlines         = ""
  ,jfiles :: [(String, AccountName)]
jfiles                     = []
  ,jlastreadtime :: ClockTime
jlastreadtime              = Year -> Year -> ClockTime
TOD 0 0
  }

journalFilePath :: Journal -> FilePath
journalFilePath :: Journal -> String
journalFilePath = (String, AccountName) -> String
forall a b. (a, b) -> a
fst ((String, AccountName) -> String)
-> (Journal -> (String, AccountName)) -> Journal -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> (String, AccountName)
mainfile

journalFilePaths :: Journal -> [FilePath]
journalFilePaths :: Journal -> [String]
journalFilePaths = ((String, AccountName) -> String)
-> [(String, AccountName)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, AccountName) -> String
forall a b. (a, b) -> a
fst ([(String, AccountName)] -> [String])
-> (Journal -> [(String, AccountName)]) -> Journal -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [(String, AccountName)]
jfiles

mainfile :: Journal -> (FilePath, Text)
mainfile :: Journal -> (String, AccountName)
mainfile = (String, AccountName)
-> [(String, AccountName)] -> (String, AccountName)
forall a. a -> [a] -> a
headDef ("", "") ([(String, AccountName)] -> (String, AccountName))
-> (Journal -> [(String, AccountName)])
-> Journal
-> (String, AccountName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [(String, AccountName)]
jfiles

addTransaction :: Transaction -> Journal -> Journal
addTransaction :: Transaction -> Journal -> Journal
addTransaction t :: Transaction
t j :: Journal
j = Journal
j { jtxns :: [Transaction]
jtxns = Transaction
t Transaction -> [Transaction] -> [Transaction]
forall a. a -> [a] -> [a]
: Journal -> [Transaction]
jtxns Journal
j }

addTransactionModifier :: TransactionModifier -> Journal -> Journal
addTransactionModifier :: TransactionModifier -> Journal -> Journal
addTransactionModifier mt :: TransactionModifier
mt j :: Journal
j = Journal
j { jtxnmodifiers :: [TransactionModifier]
jtxnmodifiers = TransactionModifier
mt TransactionModifier
-> [TransactionModifier] -> [TransactionModifier]
forall a. a -> [a] -> [a]
: Journal -> [TransactionModifier]
jtxnmodifiers Journal
j }

addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal
addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal
addPeriodicTransaction pt :: PeriodicTransaction
pt j :: Journal
j = Journal
j { jperiodictxns :: [PeriodicTransaction]
jperiodictxns = PeriodicTransaction
pt PeriodicTransaction
-> [PeriodicTransaction] -> [PeriodicTransaction]
forall a. a -> [a] -> [a]
: Journal -> [PeriodicTransaction]
jperiodictxns Journal
j }

addPriceDirective :: PriceDirective -> Journal -> Journal
addPriceDirective :: PriceDirective -> Journal -> Journal
addPriceDirective h :: PriceDirective
h j :: Journal
j = Journal
j { jpricedirectives :: [PriceDirective]
jpricedirectives = PriceDirective
h PriceDirective -> [PriceDirective] -> [PriceDirective]
forall a. a -> [a] -> [a]
: Journal -> [PriceDirective]
jpricedirectives Journal
j }  -- XXX #999 keep sorted

-- | Get the transaction with this index (its 1-based position in the input stream), if any.
journalTransactionAt :: Journal -> Integer -> Maybe Transaction
journalTransactionAt :: Journal -> Year -> Maybe Transaction
journalTransactionAt Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} i :: Year
i =
  -- it's probably ts !! (i+1), but we won't assume
  [Transaction] -> Maybe Transaction
forall a. [a] -> Maybe a
headMay [Transaction
t | Transaction
t <- [Transaction]
ts, Transaction -> Year
tindex Transaction
t Year -> Year -> Bool
forall a. Eq a => a -> a -> Bool
== Year
i]

-- | Get the transaction that appeared immediately after this one in the input stream, if any.
journalNextTransaction :: Journal -> Transaction -> Maybe Transaction
journalNextTransaction :: Journal -> Transaction -> Maybe Transaction
journalNextTransaction j :: Journal
j t :: Transaction
t = Journal -> Year -> Maybe Transaction
journalTransactionAt Journal
j (Transaction -> Year
tindex Transaction
t Year -> Year -> Year
forall a. Num a => a -> a -> a
+ 1)

-- | Get the transaction that appeared immediately before this one in the input stream, if any.
journalPrevTransaction :: Journal -> Transaction -> Maybe Transaction
journalPrevTransaction :: Journal -> Transaction -> Maybe Transaction
journalPrevTransaction j :: Journal
j t :: Transaction
t = Journal -> Year -> Maybe Transaction
journalTransactionAt Journal
j (Transaction -> Year
tindex Transaction
t Year -> Year -> Year
forall a. Num a => a -> a -> a
- 1)

-- | Unique transaction descriptions used in this journal.
journalDescriptions :: Journal -> [Text]
journalDescriptions :: Journal -> [AccountName]
journalDescriptions = [AccountName] -> [AccountName]
forall a. Eq a => [a] -> [a]
nub ([AccountName] -> [AccountName])
-> (Journal -> [AccountName]) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AccountName] -> [AccountName]
forall a. Ord a => [a] -> [a]
sort ([AccountName] -> [AccountName])
-> (Journal -> [AccountName]) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transaction -> AccountName) -> [Transaction] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> AccountName
tdescription ([Transaction] -> [AccountName])
-> (Journal -> [Transaction]) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Transaction]
jtxns

-- | All postings from this journal's transactions, in order.
journalPostings :: Journal -> [Posting]
journalPostings :: Journal -> [Posting]
journalPostings = (Transaction -> [Posting]) -> [Transaction] -> [Posting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Posting]
tpostings ([Transaction] -> [Posting])
-> (Journal -> [Transaction]) -> Journal -> [Posting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Transaction]
jtxns

-- | Sorted unique account names posted to by this journal's transactions.
journalAccountNamesUsed :: Journal -> [AccountName]
journalAccountNamesUsed :: Journal -> [AccountName]
journalAccountNamesUsed = [Posting] -> [AccountName]
accountNamesFromPostings ([Posting] -> [AccountName])
-> (Journal -> [Posting]) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Posting]
journalPostings

-- | Sorted unique account names implied by this journal's transactions -
-- accounts posted to and all their implied parent accounts.
journalAccountNamesImplied :: Journal -> [AccountName]
journalAccountNamesImplied :: Journal -> [AccountName]
journalAccountNamesImplied = [AccountName] -> [AccountName]
expandAccountNames ([AccountName] -> [AccountName])
-> (Journal -> [AccountName]) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [AccountName]
journalAccountNamesUsed

-- | Sorted unique account names declared by account directives in this journal.
journalAccountNamesDeclared :: Journal -> [AccountName]
journalAccountNamesDeclared :: Journal -> [AccountName]
journalAccountNamesDeclared = [AccountName] -> [AccountName]
forall a. Eq a => [a] -> [a]
nub ([AccountName] -> [AccountName])
-> (Journal -> [AccountName]) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AccountName] -> [AccountName]
forall a. Ord a => [a] -> [a]
sort ([AccountName] -> [AccountName])
-> (Journal -> [AccountName]) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AccountName, AccountDeclarationInfo) -> AccountName)
-> [(AccountName, AccountDeclarationInfo)] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName, AccountDeclarationInfo) -> AccountName
forall a b. (a, b) -> a
fst ([(AccountName, AccountDeclarationInfo)] -> [AccountName])
-> (Journal -> [(AccountName, AccountDeclarationInfo)])
-> Journal
-> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts

-- | Sorted unique account names declared by account directives or posted to
-- by transactions in this journal.
journalAccountNamesDeclaredOrUsed :: Journal -> [AccountName]
journalAccountNamesDeclaredOrUsed :: Journal -> [AccountName]
journalAccountNamesDeclaredOrUsed j :: Journal
j = [AccountName] -> [AccountName]
forall a. Eq a => [a] -> [a]
nub ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ [AccountName] -> [AccountName]
forall a. Ord a => [a] -> [a]
sort ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ Journal -> [AccountName]
journalAccountNamesDeclared Journal
j [AccountName] -> [AccountName] -> [AccountName]
forall a. [a] -> [a] -> [a]
++ Journal -> [AccountName]
journalAccountNamesUsed Journal
j

-- | Sorted unique account names declared by account directives, or posted to
-- or implied as parents by transactions in this journal.
journalAccountNamesDeclaredOrImplied :: Journal -> [AccountName]
journalAccountNamesDeclaredOrImplied :: Journal -> [AccountName]
journalAccountNamesDeclaredOrImplied j :: Journal
j = [AccountName] -> [AccountName]
forall a. Eq a => [a] -> [a]
nub ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ [AccountName] -> [AccountName]
forall a. Ord a => [a] -> [a]
sort ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ Journal -> [AccountName]
journalAccountNamesDeclared Journal
j [AccountName] -> [AccountName] -> [AccountName]
forall a. [a] -> [a] -> [a]
++ Journal -> [AccountName]
journalAccountNamesImplied Journal
j

-- | Convenience/compatibility alias for journalAccountNamesDeclaredOrImplied.
journalAccountNames :: Journal -> [AccountName]
journalAccountNames :: Journal -> [AccountName]
journalAccountNames = Journal -> [AccountName]
journalAccountNamesDeclaredOrImplied

journalAccountNameTree :: Journal -> Tree AccountName
journalAccountNameTree :: Journal -> Tree AccountName
journalAccountNameTree = [AccountName] -> Tree AccountName
accountNameTreeFrom ([AccountName] -> Tree AccountName)
-> (Journal -> [AccountName]) -> Journal -> Tree AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [AccountName]
journalAccountNames

-- queries for standard account types

-- | Get a query for accounts of a certain type (Asset, Liability..) in this journal.
-- The query will match all accounts which were declared as that type by account directives,
-- plus all their subaccounts which have not been declared as a different type.
-- If no accounts were declared as this type, the query will instead match accounts
-- with names matched by the provided case-insensitive regular expression.
journalAccountTypeQuery :: AccountType -> Regexp -> Journal -> Query
journalAccountTypeQuery :: AccountType -> String -> Journal -> Query
journalAccountTypeQuery atype :: AccountType
atype fallbackregex :: String
fallbackregex j :: Journal
j =
  case AccountType -> Map AccountType [AccountName] -> Maybe [AccountName]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AccountType
atype (Journal -> Map AccountType [AccountName]
jdeclaredaccounttypes Journal
j) of
    Nothing -> String -> Query
Acct String
fallbackregex
    Just as :: [AccountName]
as ->
      -- XXX Query isn't able to match account type since that requires extra info from the journal.
      -- So we do a hacky search by name instead.
      [Query] -> Query
And [
         [Query] -> Query
Or ([Query] -> Query) -> [Query] -> Query
forall a b. (a -> b) -> a -> b
$ (AccountName -> Query) -> [AccountName] -> [Query]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Query
Acct (String -> Query)
-> (AccountName -> String) -> AccountName -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> String
accountNameToAccountRegex) [AccountName]
as
        ,Query -> Query
Not (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ [Query] -> Query
Or ([Query] -> Query) -> [Query] -> Query
forall a b. (a -> b) -> a -> b
$ (AccountName -> Query) -> [AccountName] -> [Query]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Query
Acct (String -> Query)
-> (AccountName -> String) -> AccountName -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> String
accountNameToAccountRegex) [AccountName]
differentlytypedsubs
        ]
      where
        differentlytypedsubs :: [AccountName]
differentlytypedsubs = [[AccountName]] -> [AccountName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [[AccountName]
subs | (t :: AccountType
t,bs :: [AccountName]
bs) <- Map AccountType [AccountName] -> [(AccountType, [AccountName])]
forall k a. Map k a -> [(k, a)]
M.toList (Journal -> Map AccountType [AccountName]
jdeclaredaccounttypes Journal
j)
              , AccountType
t AccountType -> AccountType -> Bool
forall a. Eq a => a -> a -> Bool
/= AccountType
atype
              , let subs :: [AccountName]
subs = [AccountName
b | AccountName
b <- [AccountName]
bs, (AccountName -> Bool) -> [AccountName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (AccountName -> AccountName -> Bool
`isAccountNamePrefixOf` AccountName
b) [AccountName]
as]
          ]

-- | A query for accounts in this journal which have been
-- declared as Asset by account directives, or otherwise for
-- accounts with names matched by the case-insensitive regular expression
-- @^assets?(:|$)@.
journalAssetAccountQuery :: Journal -> Query
journalAssetAccountQuery :: Journal -> Query
journalAssetAccountQuery = AccountType -> String -> Journal -> Query
journalAccountTypeQuery AccountType
Asset "^assets?(:|$)"

-- | A query for accounts in this journal which have been
-- declared as Liability by account directives, or otherwise for
-- accounts with names matched by the case-insensitive regular expression
-- @^(debts?|liabilit(y|ies))(:|$)@.
journalLiabilityAccountQuery :: Journal -> Query
journalLiabilityAccountQuery :: Journal -> Query
journalLiabilityAccountQuery = AccountType -> String -> Journal -> Query
journalAccountTypeQuery AccountType
Liability "^(debts?|liabilit(y|ies))(:|$)"

-- | A query for accounts in this journal which have been
-- declared as Equity by account directives, or otherwise for
-- accounts with names matched by the case-insensitive regular expression
-- @^equity(:|$)@.
journalEquityAccountQuery :: Journal -> Query
journalEquityAccountQuery :: Journal -> Query
journalEquityAccountQuery = AccountType -> String -> Journal -> Query
journalAccountTypeQuery AccountType
Equity "^equity(:|$)"

-- | A query for accounts in this journal which have been
-- declared as Revenue by account directives, or otherwise for
-- accounts with names matched by the case-insensitive regular expression
-- @^(income|revenue)s?(:|$)@.
journalRevenueAccountQuery :: Journal -> Query
journalRevenueAccountQuery :: Journal -> Query
journalRevenueAccountQuery = AccountType -> String -> Journal -> Query
journalAccountTypeQuery AccountType
Revenue "^(income|revenue)s?(:|$)"

-- | A query for accounts in this journal which have been
-- declared as Expense by account directives, or otherwise for
-- accounts with names matched by the case-insensitive regular expression
-- @^(income|revenue)s?(:|$)@.
journalExpenseAccountQuery  :: Journal -> Query
journalExpenseAccountQuery :: Journal -> Query
journalExpenseAccountQuery = AccountType -> String -> Journal -> Query
journalAccountTypeQuery AccountType
Expense "^expenses?(:|$)"

-- | A query for Asset, Liability & Equity accounts in this journal.
-- Cf <http://en.wikipedia.org/wiki/Chart_of_accounts#Balance_Sheet_Accounts>.
journalBalanceSheetAccountQuery  :: Journal -> Query
journalBalanceSheetAccountQuery :: Journal -> Query
journalBalanceSheetAccountQuery j :: Journal
j = [Query] -> Query
Or [Journal -> Query
journalAssetAccountQuery Journal
j
                                       ,Journal -> Query
journalLiabilityAccountQuery Journal
j
                                       ,Journal -> Query
journalEquityAccountQuery Journal
j
                                       ]

-- | A query for Profit & Loss accounts in this journal.
-- Cf <http://en.wikipedia.org/wiki/Chart_of_accounts#Profit_.26_Loss_accounts>.
journalProfitAndLossAccountQuery  :: Journal -> Query
journalProfitAndLossAccountQuery :: Journal -> Query
journalProfitAndLossAccountQuery j :: Journal
j = [Query] -> Query
Or [Journal -> Query
journalRevenueAccountQuery Journal
j
                                        ,Journal -> Query
journalExpenseAccountQuery Journal
j
                                        ]

-- | A query for Cash (-equivalent) accounts in this journal (ie,
-- accounts which appear on the cashflow statement.)  This is currently
-- hard-coded to be all the Asset accounts except for those with names
-- containing the case-insensitive regular expression @(receivable|:A/R|:fixed)@.
journalCashAccountQuery  :: Journal -> Query
journalCashAccountQuery :: Journal -> Query
journalCashAccountQuery j :: Journal
j = [Query] -> Query
And [Journal -> Query
journalAssetAccountQuery Journal
j, Query -> Query
Not (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ String -> Query
Acct "(receivable|:A/R|:fixed)"]

-- Various kinds of filtering on journals. We do it differently depending
-- on the command.

-------------------------------------------------------------------------------
-- filtering V2

-- | Keep only transactions matching the query expression.
filterJournalTransactions :: Query -> Journal -> Journal
filterJournalTransactions :: Query -> Journal -> Journal
filterJournalTransactions q :: Query
q j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Bool) -> [Transaction] -> [Transaction]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query
q Query -> Transaction -> Bool
`matchesTransaction`) [Transaction]
ts}

-- | Keep only postings matching the query expression.
-- This can leave unbalanced transactions.
filterJournalPostings :: Query -> Journal -> Journal
filterJournalPostings :: Query -> Journal -> Journal
filterJournalPostings q :: Query
q j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (Query -> Transaction -> Transaction
filterTransactionPostings Query
q) [Transaction]
ts}

-- | Within each posting's amount, keep only the parts matching the query.
-- This can leave unbalanced transactions.
filterJournalAmounts :: Query -> Journal -> Journal
filterJournalAmounts :: Query -> Journal -> Journal
filterJournalAmounts q :: Query
q j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (Query -> Transaction -> Transaction
filterTransactionAmounts Query
q) [Transaction]
ts}

-- | Filter out all parts of this transaction's amounts which do not match the query.
-- This can leave the transaction unbalanced.
filterTransactionAmounts :: Query -> Transaction -> Transaction
filterTransactionAmounts :: Query -> Transaction -> Transaction
filterTransactionAmounts q :: Query
q t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (Query -> Posting -> Posting
filterPostingAmount Query
q) [Posting]
ps}

-- | Filter out all parts of this posting's amount which do not match the query.
filterPostingAmount :: Query -> Posting -> Posting
filterPostingAmount :: Query -> Posting -> Posting
filterPostingAmount q :: Query
q p :: Posting
p@Posting{pamount :: Posting -> MixedAmount
pamount=Mixed as :: [Amount]
as} = Posting
p{pamount :: MixedAmount
pamount=[Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount) -> [Amount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Amount -> Bool) -> [Amount] -> [Amount]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query
q Query -> Amount -> Bool
`matchesAmount`) [Amount]
as}

filterTransactionPostings :: Query -> Transaction -> Transaction
filterTransactionPostings :: Query -> Transaction -> Transaction
filterTransactionPostings q :: Query
q t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query
q Query -> Posting -> Bool
`matchesPosting`) [Posting]
ps}

-- | Apply a transformation to a journal's transactions.
mapJournalTransactions :: (Transaction -> Transaction) -> Journal -> Journal
mapJournalTransactions :: (Transaction -> Transaction) -> Journal -> Journal
mapJournalTransactions f :: Transaction -> Transaction
f j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Transaction
f [Transaction]
ts}

-- | Apply a transformation to a journal's postings.
mapJournalPostings :: (Posting -> Posting) -> Journal -> Journal
mapJournalPostings :: (Posting -> Posting) -> Journal -> Journal
mapJournalPostings f :: Posting -> Posting
f j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map ((Posting -> Posting) -> Transaction -> Transaction
mapTransactionPostings Posting -> Posting
f) [Transaction]
ts}

-- | Apply a transformation to a transaction's postings.
mapTransactionPostings :: (Posting -> Posting) -> Transaction -> Transaction
mapTransactionPostings :: (Posting -> Posting) -> Transaction -> Transaction
mapTransactionPostings f :: Posting -> Posting
f t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Posting
f [Posting]
ps}

{-
-------------------------------------------------------------------------------
-- filtering V1

-- | Keep only transactions we are interested in, as described by the
-- filter specification.
filterJournalTransactions :: FilterSpec -> Journal -> Journal
filterJournalTransactions FilterSpec{datespan=datespan
                                    ,cleared=cleared
                                    -- ,real=real
                                    -- ,empty=empty
                                    ,acctpats=apats
                                    ,descpats=dpats
                                    ,depth=depth
                                    ,fMetadata=md
                                    } =
    filterJournalTransactionsByStatus cleared .
    filterJournalPostingsByDepth depth .
    filterJournalTransactionsByAccount apats .
    filterJournalTransactionsByMetadata md .
    filterJournalTransactionsByDescription dpats .
    filterJournalTransactionsByDate datespan

-- | Keep only postings we are interested in, as described by the filter
-- specification. This can leave unbalanced transactions.
filterJournalPostings :: FilterSpec -> Journal -> Journal
filterJournalPostings FilterSpec{datespan=datespan
                                ,cleared=cleared
                                ,real=real
                                ,empty=empty
                                ,acctpats=apats
                                ,descpats=dpats
                                ,depth=depth
                                ,fMetadata=md
                                } =
    filterJournalPostingsByRealness real .
    filterJournalPostingsByStatus cleared .
    filterJournalPostingsByEmpty empty .
    filterJournalPostingsByDepth depth .
    filterJournalPostingsByAccount apats .
    filterJournalTransactionsByMetadata md .
    filterJournalTransactionsByDescription dpats .
    filterJournalTransactionsByDate datespan

-- | Keep only transactions whose metadata matches all metadata specifications.
filterJournalTransactionsByMetadata :: [(String,String)] -> Journal -> Journal
filterJournalTransactionsByMetadata pats j@Journal{jtxns=ts} = j{jtxns=filter matchmd ts}
    where matchmd t = all (`elem` tmetadata t) pats

-- | Keep only transactions whose description matches the description patterns.
filterJournalTransactionsByDescription :: [String] -> Journal -> Journal
filterJournalTransactionsByDescription pats j@Journal{jtxns=ts} = j{jtxns=filter matchdesc ts}
    where matchdesc = matchpats pats . tdescription

-- | Keep only transactions which fall between begin and end dates.
-- We include transactions on the begin date and exclude transactions on the end
-- date, like ledger.  An empty date string means no restriction.
filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal
filterJournalTransactionsByDate (DateSpan begin end) j@Journal{jtxns=ts} = j{jtxns=filter match ts}
    where match t = maybe True (tdate t>=) begin && maybe True (tdate t<) end

-- | Keep only transactions which have the requested cleared/uncleared
-- status, if there is one.
filterJournalTransactionsByStatus :: Maybe Bool -> Journal -> Journal
filterJournalTransactionsByStatus Nothing j = j
filterJournalTransactionsByStatus (Just val) j@Journal{jtxns=ts} = j{jtxns=filter match ts}
    where match = (==val).tstatus

-- | Keep only postings which have the requested cleared/uncleared status,
-- if there is one.
filterJournalPostingsByStatus :: Maybe Bool -> Journal -> Journal
filterJournalPostingsByStatus Nothing j = j
filterJournalPostingsByStatus (Just c) j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
    where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter ((==c) . postingCleared) ps}

-- | Strip out any virtual postings, if the flag is true, otherwise do
-- no filtering.
filterJournalPostingsByRealness :: Bool -> Journal -> Journal
filterJournalPostingsByRealness False j = j
filterJournalPostingsByRealness True j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
    where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter isReal ps}

-- | Strip out any postings with zero amount, unless the flag is true.
filterJournalPostingsByEmpty :: Bool -> Journal -> Journal
filterJournalPostingsByEmpty True j = j
filterJournalPostingsByEmpty False j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
    where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (not . isEmptyPosting) ps}

-- -- | Keep only transactions which affect accounts deeper than the specified depth.
-- filterJournalTransactionsByDepth :: Maybe Int -> Journal -> Journal
-- filterJournalTransactionsByDepth Nothing j = j
-- filterJournalTransactionsByDepth (Just d) j@Journal{jtxns=ts} =
--     j{jtxns=(filter (any ((<= d+1) . accountNameLevel . paccount) . tpostings) ts)}

-- | Strip out any postings to accounts deeper than the specified depth
-- (and any transactions which have no postings as a result).
filterJournalPostingsByDepth :: Maybe Int -> Journal -> Journal
filterJournalPostingsByDepth Nothing j = j
filterJournalPostingsByDepth (Just d) j@Journal{jtxns=ts} =
    j{jtxns=filter (not . null . tpostings) $ map filtertxns ts}
    where filtertxns t@Transaction{tpostings=ps} =
              t{tpostings=filter ((<= d) . accountNameLevel . paccount) ps}

-- | Keep only postings which affect accounts matched by the account patterns.
-- This can leave transactions unbalanced.
filterJournalPostingsByAccount :: [String] -> Journal -> Journal
filterJournalPostingsByAccount apats j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
    where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (matchpats apats . paccount) ps}

-- | Keep only transactions which affect accounts matched by the account patterns.
-- More precisely: each positive account pattern excludes transactions
-- which do not contain a posting to a matched account, and each negative
-- account pattern excludes transactions containing a posting to a matched
-- account.
filterJournalTransactionsByAccount :: [String] -> Journal -> Journal
filterJournalTransactionsByAccount apats j@Journal{jtxns=ts} = j{jtxns=filter tmatch ts}
    where
      tmatch t = (null positives || any positivepmatch ps) && (null negatives || not (any negativepmatch ps)) where ps = tpostings t
      positivepmatch p = any (`amatch` a) positives where a = paccount p
      negativepmatch p = any (`amatch` a) negatives where a = paccount p
      amatch pat a = regexMatchesCI (abspat pat) a
      (negatives,positives) = partition isnegativepat apats

-}

-- | Reverse all lists of parsed items, which during parsing were
-- prepended to, so that the items are in parse order. Part of
-- post-parse finalisation.
journalReverse :: Journal -> Journal
journalReverse :: Journal -> Journal
journalReverse j :: Journal
j =
  Journal
j {jfiles :: [(String, AccountName)]
jfiles            = [(String, AccountName)] -> [(String, AccountName)]
forall a. [a] -> [a]
reverse ([(String, AccountName)] -> [(String, AccountName)])
-> [(String, AccountName)] -> [(String, AccountName)]
forall a b. (a -> b) -> a -> b
$ Journal -> [(String, AccountName)]
jfiles Journal
j
    ,jdeclaredaccounts :: [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts = [(AccountName, AccountDeclarationInfo)]
-> [(AccountName, AccountDeclarationInfo)]
forall a. [a] -> [a]
reverse ([(AccountName, AccountDeclarationInfo)]
 -> [(AccountName, AccountDeclarationInfo)])
-> [(AccountName, AccountDeclarationInfo)]
-> [(AccountName, AccountDeclarationInfo)]
forall a b. (a -> b) -> a -> b
$ Journal -> [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j
    ,jtxns :: [Transaction]
jtxns             = [Transaction] -> [Transaction]
forall a. [a] -> [a]
reverse ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
    ,jtxnmodifiers :: [TransactionModifier]
jtxnmodifiers     = [TransactionModifier] -> [TransactionModifier]
forall a. [a] -> [a]
reverse ([TransactionModifier] -> [TransactionModifier])
-> [TransactionModifier] -> [TransactionModifier]
forall a b. (a -> b) -> a -> b
$ Journal -> [TransactionModifier]
jtxnmodifiers Journal
j
    ,jperiodictxns :: [PeriodicTransaction]
jperiodictxns     = [PeriodicTransaction] -> [PeriodicTransaction]
forall a. [a] -> [a]
reverse ([PeriodicTransaction] -> [PeriodicTransaction])
-> [PeriodicTransaction] -> [PeriodicTransaction]
forall a b. (a -> b) -> a -> b
$ Journal -> [PeriodicTransaction]
jperiodictxns Journal
j
    ,jpricedirectives :: [PriceDirective]
jpricedirectives     = [PriceDirective] -> [PriceDirective]
forall a. [a] -> [a]
reverse ([PriceDirective] -> [PriceDirective])
-> [PriceDirective] -> [PriceDirective]
forall a b. (a -> b) -> a -> b
$ Journal -> [PriceDirective]
jpricedirectives Journal
j
    }

-- | Set this journal's last read time, ie when its files were last read.
journalSetLastReadTime :: ClockTime -> Journal -> Journal
journalSetLastReadTime :: ClockTime -> Journal -> Journal
journalSetLastReadTime t :: ClockTime
t j :: Journal
j = Journal
j{ jlastreadtime :: ClockTime
jlastreadtime = ClockTime
t }


journalNumberAndTieTransactions :: Journal -> Journal
journalNumberAndTieTransactions = Journal -> Journal
journalTieTransactions (Journal -> Journal) -> (Journal -> Journal) -> Journal -> Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Journal
journalNumberTransactions

-- | Number (set the tindex field) this journal's transactions, counting upward from 1.
journalNumberTransactions :: Journal -> Journal
journalNumberTransactions :: Journal -> Journal
journalNumberTransactions j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=((Year, Transaction) -> Transaction)
-> [(Year, Transaction)] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (\(i :: Year
i,t :: Transaction
t) -> Transaction
t{tindex :: Year
tindex=Year
i}) ([(Year, Transaction)] -> [Transaction])
-> [(Year, Transaction)] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ [Year] -> [Transaction] -> [(Year, Transaction)]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..] [Transaction]
ts}

-- | Tie the knot in all of this journal's transactions, ensuring their postings
-- refer to them. This should be done last, after any other transaction-modifying operations.
journalTieTransactions :: Journal -> Journal
journalTieTransactions :: Journal -> Journal
journalTieTransactions j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Transaction
txnTieKnot [Transaction]
ts}

-- | Untie all transaction-posting knots in this journal, so that eg
-- recursiveSize and GHCI's :sprint can work on it.
journalUntieTransactions :: Transaction -> Transaction
journalUntieTransactions :: Transaction -> Transaction
journalUntieTransactions t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (\p :: Posting
p -> Posting
p{ptransaction :: Maybe Transaction
ptransaction=Maybe Transaction
forall a. Maybe a
Nothing}) [Posting]
ps}

-- | Apply any transaction modifier rules in the journal
-- (adding automated postings to transactions, eg).
journalModifyTransactions :: Journal -> Journal
journalModifyTransactions :: Journal -> Journal
journalModifyTransactions j :: Journal
j = Journal
j{ jtxns :: [Transaction]
jtxns = [TransactionModifier] -> [Transaction] -> [Transaction]
modifyTransactions (Journal -> [TransactionModifier]
jtxnmodifiers Journal
j) (Journal -> [Transaction]
jtxns Journal
j) }

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

-- "Transaction balancing" - inferring missing amounts and checking transaction balancedness and balance assertions

-- | 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
   BalancingState s -> Maybe (Map AccountName AmountStyle)
bsStyles       :: Maybe (M.Map CommoditySymbol AmountStyle)  -- ^ commodity display styles
  ,BalancingState s -> Set AccountName
bsUnassignable :: S.Set AccountName                          -- ^ accounts in which balance assignments may not be used
  ,BalancingState s -> Bool
bsAssrt        :: Bool                                       -- ^ whether to check balance assertions
   -- mutable
  ,BalancingState s -> HashTable s AccountName MixedAmount
bsBalances     :: H.HashTable s AccountName MixedAmount      -- ^ running account balances, initially empty
  ,BalancingState s -> STArray s Year Transaction
bsTransactions :: STArray s Integer Transaction              -- ^ the transactions being balanced
  }

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

-- | Get an account's running balance so far.
getAmountB :: AccountName -> Balancing s MixedAmount
getAmountB :: AccountName -> Balancing s MixedAmount
getAmountB acc :: AccountName
acc = (BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withB ((BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount)
-> (BalancingState s -> ST s MixedAmount)
-> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ \BalancingState{HashTable s AccountName MixedAmount
bsBalances :: HashTable s AccountName MixedAmount
bsBalances :: forall s. BalancingState s -> HashTable s AccountName MixedAmount
bsBalances} -> do
  MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe MixedAmount -> MixedAmount)
-> ST s (Maybe MixedAmount) -> ST s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashTable s AccountName MixedAmount
-> AccountName -> ST s (Maybe MixedAmount)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s AccountName MixedAmount
bsBalances AccountName
acc

-- | Add an amount to an account's running balance, and return the new running balance.
addAmountB :: AccountName -> MixedAmount -> Balancing s MixedAmount
addAmountB :: AccountName -> MixedAmount -> Balancing s MixedAmount
addAmountB acc :: AccountName
acc amt :: MixedAmount
amt = (BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withB ((BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount)
-> (BalancingState s -> ST s MixedAmount)
-> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ \BalancingState{HashTable s AccountName MixedAmount
bsBalances :: HashTable s AccountName MixedAmount
bsBalances :: forall s. BalancingState s -> HashTable s AccountName MixedAmount
bsBalances} -> do
  MixedAmount
old <- MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe MixedAmount -> MixedAmount)
-> ST s (Maybe MixedAmount) -> ST s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashTable s AccountName MixedAmount
-> AccountName -> ST s (Maybe MixedAmount)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s AccountName MixedAmount
bsBalances AccountName
acc
  let new :: MixedAmount
new = MixedAmount
old MixedAmount -> MixedAmount -> MixedAmount
forall a. Num a => a -> a -> a
+ MixedAmount
amt
  HashTable s AccountName MixedAmount
-> AccountName -> MixedAmount -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s AccountName MixedAmount
bsBalances AccountName
acc MixedAmount
new
  MixedAmount -> ST s MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return MixedAmount
new

-- | Set an account's running balance to this amount, and return the difference from the old.
setAmountB :: AccountName -> MixedAmount -> Balancing s MixedAmount
setAmountB :: AccountName -> MixedAmount -> Balancing s MixedAmount
setAmountB acc :: AccountName
acc amt :: MixedAmount
amt = (BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withB ((BalancingState s -> ST s MixedAmount) -> Balancing s MixedAmount)
-> (BalancingState s -> ST s MixedAmount)
-> Balancing s MixedAmount
forall a b. (a -> b) -> a -> b
$ \BalancingState{HashTable s AccountName MixedAmount
bsBalances :: HashTable s AccountName MixedAmount
bsBalances :: forall s. BalancingState s -> HashTable s AccountName MixedAmount
bsBalances} -> do
  MixedAmount
old <- MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe MixedAmount -> MixedAmount)
-> ST s (Maybe MixedAmount) -> ST s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashTable s AccountName MixedAmount
-> AccountName -> ST s (Maybe MixedAmount)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s AccountName MixedAmount
bsBalances AccountName
acc
  HashTable s AccountName MixedAmount
-> AccountName -> MixedAmount -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s AccountName MixedAmount
bsBalances AccountName
acc MixedAmount
amt
  MixedAmount -> ST s MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return (MixedAmount -> ST s MixedAmount)
-> MixedAmount -> ST s MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount
amt MixedAmount -> MixedAmount -> MixedAmount
forall a. Num a => a -> a -> a
- MixedAmount
old

-- | Update (overwrite) this transaction with a new one.
storeTransactionB :: Transaction -> Balancing s ()
storeTransactionB :: Transaction -> Balancing s ()
storeTransactionB t :: Transaction
t = (BalancingState s -> ST s ()) -> Balancing s ()
forall s a. (BalancingState s -> ST s a) -> Balancing s a
withB ((BalancingState s -> ST s ()) -> Balancing s ())
-> (BalancingState s -> ST s ()) -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ \BalancingState{STArray s Year Transaction
bsTransactions :: STArray s Year Transaction
bsTransactions :: forall s. BalancingState s -> STArray s Year 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 Year Transaction -> Year -> Transaction -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s Year Transaction
bsTransactions (Transaction -> Year
tindex Transaction
t) Transaction
t

-- | Infer any missing amounts (to satisfy balance assignments and
-- to balance transactions) and check that all transactions balance
-- and (optional) all balance assertions pass. Or return an error message
-- (just the first error encountered).
--
-- Assumes journalInferCommodityStyles has been called, since those affect transaction balancing.
--
-- This does multiple things because amount inferring, balance assignments,
-- balance assertions and posting dates are interdependent.
--
-- This can be simplified further. Overview as of 20190219:
-- @
-- ****** parseAndFinaliseJournal['] (Cli/Utils.hs), journalAddForecast (Common.hs), budgetJournal (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 ?
-- @
journalBalanceTransactions :: Bool -> Journal -> Either String Journal
journalBalanceTransactions :: Bool -> Journal -> Either String Journal
journalBalanceTransactions assrt :: Bool
assrt j' :: Journal
j' =
  let
    -- ensure transactions are numbered, so we can store them by number
    j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal -> Journal
journalNumberTransactions Journal
j'
    -- display precisions used in balanced checking
    styles :: Maybe (Map AccountName AmountStyle)
styles = Map AccountName AmountStyle -> Maybe (Map AccountName AmountStyle)
forall a. a -> Maybe a
Just (Map AccountName AmountStyle
 -> Maybe (Map AccountName AmountStyle))
-> Map AccountName AmountStyle
-> Maybe (Map AccountName AmountStyle)
forall a b. (a -> b) -> a -> b
$ Journal -> Map AccountName AmountStyle
journalCommodityStyles Journal
j
    -- balance assignments will not be allowed on these
    txnmodifieraccts :: Set AccountName
txnmodifieraccts = [AccountName] -> Set AccountName
forall a. Ord a => [a] -> Set a
S.fromList ([AccountName] -> Set AccountName)
-> [AccountName] -> Set AccountName
forall a b. (a -> b) -> a -> b
$ (Posting -> AccountName) -> [Posting] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> AccountName
paccount ([Posting] -> [AccountName]) -> [Posting] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ (TransactionModifier -> [Posting])
-> [TransactionModifier] -> [Posting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TransactionModifier -> [Posting]
tmpostingrules ([TransactionModifier] -> [Posting])
-> [TransactionModifier] -> [Posting]
forall a b. (a -> b) -> a -> b
$ Journal -> [TransactionModifier]
jtxnmodifiers Journal
j
  in
    (forall s. ST s (Either String Journal)) -> Either String Journal
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Either String Journal)) -> Either String Journal)
-> (forall s. ST s (Either String Journal))
-> Either String Journal
forall a b. (a -> b) -> a -> b
$ do
      -- We'll update a mutable array of transactions as we balance them,
      -- not strictly necessary but avoids a sort at the end I think.
      STArray s Year Transaction
balancedtxns <- (Year, Year) -> [Transaction] -> ST s (STArray s Year Transaction)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> [e] -> m (a i e)
newListArray (1, [Transaction] -> Year
forall i a. Num i => [a] -> i
genericLength [Transaction]
ts) [Transaction]
ts

      -- Infer missing posting amounts, check transactions are balanced,
      -- and check balance assertions. This is done in two passes:
      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

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

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

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

-- | This function is called statefully on each of a date-ordered sequence of
-- 1. fully explicit postings from already-balanced transactions and
-- 2. not-yet-balanced transactions containing balance assignments.
-- It executes balance assignments and finishes balancing the transactions,
-- and checks balance assertions on each posting as it goes.
-- An error will be thrown if a transaction can't be balanced
-- or if an illegal balance assignment is found (cf checkIllegalBalanceAssignment).
-- Transaction prices are removed, which helps eg balance-assertions.test: 15. Mix different commodities and assignments.
-- This stores the balanced transactions in case 2 but not in case 1.
balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing s ()

balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing s ()
balanceTransactionAndCheckAssertionsB (Left p :: Posting
p@Posting{}) =
  -- update the account's running balance and check the balance assertion if any
  ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
-> Balancing s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
 -> Balancing s ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
-> Balancing 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
removePrices Posting
p

balanceTransactionAndCheckAssertionsB (Right t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps}) = do
  -- make sure we can handle the balance assignments
  (Posting -> Balancing s ()) -> [Posting] -> Balancing s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Posting -> Balancing s ()
forall s. Posting -> Balancing s ()
checkIllegalBalanceAssignmentB [Posting]
ps
  -- for each posting, infer its amount from the balance assignment if applicable,
  -- update the account's running balance and check the balance assertion if any
  [Posting]
ps' <- [Posting]
-> (Posting
    -> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [Posting]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Posting]
ps ((Posting
  -> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting)
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) [Posting])
-> (Posting
    -> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) [Posting]
forall a b. (a -> b) -> a -> b
$ \p :: Posting
p -> Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Posting -> Posting
removePrices Posting
p) ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
-> (Posting
    -> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Posting
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Posting
forall s. Posting -> Balancing s Posting
addOrAssignAmountAndCheckAssertionB
  -- infer any remaining missing amounts, and make sure the transaction is now fully balanced
  Maybe (Map AccountName AmountStyle)
styles <- (BalancingState s -> Maybe (Map AccountName AmountStyle))
-> ReaderT
     (BalancingState s)
     (ExceptT String (ST s))
     (Maybe (Map AccountName AmountStyle))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Maybe (Map AccountName AmountStyle)
forall s. BalancingState s -> Maybe (Map AccountName AmountStyle)
bsStyles
  case Maybe (Map AccountName AmountStyle)
-> Transaction
-> Either String (Transaction, [(AccountName, MixedAmount)])
balanceTransactionHelper Maybe (Map AccountName AmountStyle)
styles Transaction
t{tpostings :: [Posting]
tpostings=[Posting]
ps'} of
    Left err :: String
err -> String -> Balancing s ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
err
    Right (t' :: Transaction
t', inferredacctsandamts :: [(AccountName, MixedAmount)]
inferredacctsandamts) -> do
      -- for each amount just inferred, update the running balance
      ((AccountName, MixedAmount)
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) MixedAmount)
-> [(AccountName, MixedAmount)] -> Balancing s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((AccountName
 -> MixedAmount
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) MixedAmount)
-> (AccountName, MixedAmount)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) MixedAmount
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AccountName
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
addAmountB) [(AccountName, MixedAmount)]
inferredacctsandamts
      -- and save the balanced transaction.
      Transaction -> Balancing s ()
forall s. Transaction -> Balancing s ()
storeTransactionB Transaction
t'

-- | If this posting has an explicit amount, add it to the account's running balance.
-- If it has a missing amount and a balance assignment, infer the amount from, and
-- reset the running balance to, the assigned balance.
-- If it has a missing amount and no balance assignment, leave it for later.
-- Then test the balance assertion if any.
addOrAssignAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addOrAssignAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addOrAssignAmountAndCheckAssertionB p :: Posting
p@Posting{paccount :: Posting -> AccountName
paccount=AccountName
acc, pamount :: Posting -> MixedAmount
pamount=MixedAmount
amt, pbalanceassertion :: Posting -> Maybe BalanceAssertion
pbalanceassertion=Maybe BalanceAssertion
mba}
  | Posting -> Bool
hasAmount Posting
p = do
      MixedAmount
newbal <- AccountName -> MixedAmount -> Balancing s MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
addAmountB AccountName
acc MixedAmount
amt
      ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((BalancingState s -> Bool)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Bool
forall s. BalancingState s -> Bool
bsAssrt) (ReaderT (BalancingState s) (ExceptT String (ST s)) ()
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall s. Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB Posting
p MixedAmount
newbal
      Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p
  | Just BalanceAssertion{Amount
baamount :: BalanceAssertion -> Amount
baamount :: Amount
baamount,Bool
batotal :: BalanceAssertion -> Bool
batotal :: Bool
batotal} <- Maybe BalanceAssertion
mba = do
      (diff :: MixedAmount
diff,newbal :: MixedAmount
newbal) <- case Bool
batotal of
        True  -> do
          -- a total balance assignment
          let newbal :: MixedAmount
newbal = [Amount] -> MixedAmount
Mixed [Amount
baamount]
          MixedAmount
diff <- AccountName -> MixedAmount -> Balancing s MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
setAmountB AccountName
acc MixedAmount
newbal
          (MixedAmount, MixedAmount)
-> ReaderT
     (BalancingState s)
     (ExceptT String (ST s))
     (MixedAmount, MixedAmount)
forall (m :: * -> *) a. Monad m => a -> m a
return (MixedAmount
diff,MixedAmount
newbal)
        False -> do
          -- a partial balance assignment
          MixedAmount
oldbalothercommodities <- (Amount -> Bool) -> MixedAmount -> MixedAmount
filterMixedAmount ((Amount -> AccountName
acommodity Amount
baamount AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
/=) (AccountName -> Bool) -> (Amount -> AccountName) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> AccountName
acommodity) (MixedAmount -> MixedAmount)
-> Balancing s MixedAmount -> Balancing s MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AccountName -> Balancing s MixedAmount
forall s. AccountName -> Balancing s MixedAmount
getAmountB AccountName
acc
          let assignedbalthiscommodity :: MixedAmount
assignedbalthiscommodity = [Amount] -> MixedAmount
Mixed [Amount
baamount]
              newbal :: MixedAmount
newbal = MixedAmount
oldbalothercommodities MixedAmount -> MixedAmount -> MixedAmount
forall a. Num a => a -> a -> a
+ MixedAmount
assignedbalthiscommodity
          MixedAmount
diff <- AccountName -> MixedAmount -> Balancing s MixedAmount
forall s. AccountName -> MixedAmount -> Balancing s MixedAmount
setAmountB AccountName
acc MixedAmount
newbal
          (MixedAmount, MixedAmount)
-> ReaderT
     (BalancingState s)
     (ExceptT String (ST s))
     (MixedAmount, MixedAmount)
forall (m :: * -> *) a. Monad m => a -> m a
return (MixedAmount
diff,MixedAmount
newbal)
      let p' :: Posting
p' = Posting
p{pamount :: MixedAmount
pamount=MixedAmount
diff, poriginal :: Maybe Posting
poriginal=Posting -> Maybe Posting
forall a. a -> Maybe a
Just (Posting -> Maybe Posting) -> Posting -> Maybe Posting
forall a b. (a -> b) -> a -> b
$ Posting -> Posting
originalPosting Posting
p}
      ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((BalancingState s -> Bool)
-> ReaderT (BalancingState s) (ExceptT String (ST s)) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.reader BalancingState s -> Bool
forall s. BalancingState s -> Bool
bsAssrt) (ReaderT (BalancingState s) (ExceptT String (ST s)) ()
 -> ReaderT (BalancingState s) (ExceptT String (ST s)) ())
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall a b. (a -> b) -> a -> b
$ Posting
-> MixedAmount
-> ReaderT (BalancingState s) (ExceptT String (ST s)) ()
forall s. Posting -> MixedAmount -> Balancing s ()
checkBalanceAssertionB Posting
p' MixedAmount
newbal
      Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p'
  -- no amount, no balance assertion (GHC 7 doesn't like Nothing <- mba here)
  | Bool
otherwise = Posting -> Balancing s Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
p

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

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

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

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

  Bool -> Balancing s () -> Balancing s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
pass) (Balancing s () -> Balancing s ())
-> Balancing s () -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ String -> Balancing s ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
errmsg

-- | Throw an error if this posting is trying to do an illegal balance assignment.
checkIllegalBalanceAssignmentB :: Posting -> Balancing s ()
checkIllegalBalanceAssignmentB :: Posting -> Balancing s ()
checkIllegalBalanceAssignmentB p :: 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 :: Posting -> Balancing s ()
checkBalanceAssignmentPostingDateB p :: Posting
p =
  Bool -> Balancing s () -> Balancing s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Posting -> Bool
hasBalanceAssignment Posting
p Bool -> Bool -> Bool
&& Maybe Day -> Bool
forall a. Maybe a -> Bool
isJust (Posting -> Maybe Day
pdate Posting
p)) (Balancing s () -> Balancing s ())
-> Balancing s () -> Balancing s ()
forall a b. (a -> b) -> a -> b
$
    String -> Balancing s ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Balancing s ()) -> String -> Balancing s ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
      ["postings which are balance assignments may not have a custom date."
      ,"Please write the posting amount explicitly, or remove the posting date:"
      ,""
      ,String -> (Transaction -> String) -> Maybe Transaction -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Posting -> [String]
showPostingLines Posting
p) Transaction -> String
showTransaction (Maybe Transaction -> String) -> Maybe Transaction -> String
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
      ]

-- | Throw an error if this posting is trying to do a balance assignment and
-- the account does not allow balance assignments (eg because it is referenced
-- by a transaction modifier, which might generate additional postings to it).
checkBalanceAssignmentUnassignableAccountB :: Posting -> Balancing s ()
checkBalanceAssignmentUnassignableAccountB :: Posting -> Balancing s ()
checkBalanceAssignmentUnassignableAccountB p :: Posting
p = do
  Set AccountName
unassignable <- (BalancingState s -> Set AccountName)
-> ReaderT
     (BalancingState s) (ExceptT String (ST s)) (Set AccountName)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.asks BalancingState s -> Set AccountName
forall s. BalancingState s -> Set AccountName
bsUnassignable
  Bool -> Balancing s () -> Balancing s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Posting -> Bool
hasBalanceAssignment Posting
p Bool -> Bool -> Bool
&& Posting -> AccountName
paccount Posting
p AccountName -> Set AccountName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set AccountName
unassignable) (Balancing s () -> Balancing s ())
-> Balancing s () -> Balancing s ()
forall a b. (a -> b) -> a -> b
$
    String -> Balancing s ()
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
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
      ["balance assignments cannot be used with accounts which are"
      ,"posted to by transaction modifier rules (auto postings)."
      ,"Please write the posting amount explicitly, or remove the rule."
      ,""
      ,"account: "String -> ShowS
forall a. [a] -> [a] -> [a]
++AccountName -> String
T.unpack (Posting -> AccountName
paccount Posting
p)
      ,""
      ,"transaction:"
      ,""
      ,String -> (Transaction -> String) -> Maybe Transaction -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Posting -> [String]
showPostingLines Posting
p) Transaction -> String
showTransaction (Maybe Transaction -> String) -> Maybe Transaction -> String
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Transaction
ptransaction Posting
p
      ]

--

-- | Choose and apply a consistent display format to the posting
-- amounts in each commodity. Each commodity's format is specified by
-- a commodity format directive, or otherwise inferred from posting
-- amounts as in hledger < 0.28. Can return an error message
-- eg if inconsistent number formats are found.
journalApplyCommodityStyles :: Journal -> Either String Journal
journalApplyCommodityStyles :: Journal -> Either String Journal
journalApplyCommodityStyles j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts, jpricedirectives :: Journal -> [PriceDirective]
jpricedirectives=[PriceDirective]
pds} =
  case Journal -> Either String Journal
journalInferCommodityStyles Journal
j of
    Left e :: String
e   -> String -> Either String Journal
forall a b. a -> Either a b
Left String
e
    Right j' :: Journal
j' -> Journal -> Either String Journal
forall a b. b -> Either a b
Right Journal
j''
      where
        styles :: Map AccountName AmountStyle
styles = Journal -> Map AccountName AmountStyle
journalCommodityStyles Journal
j'
        j'' :: Journal
j'' = Journal
j'{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Transaction
fixtransaction [Transaction]
ts
                ,jpricedirectives :: [PriceDirective]
jpricedirectives=(PriceDirective -> PriceDirective)
-> [PriceDirective] -> [PriceDirective]
forall a b. (a -> b) -> [a] -> [b]
map PriceDirective -> PriceDirective
fixpricedirective [PriceDirective]
pds
                }
        fixtransaction :: Transaction -> Transaction
fixtransaction t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Posting
fixposting [Posting]
ps}
        fixposting :: Posting -> Posting
fixposting p :: Posting
p = Posting
p{pamount :: MixedAmount
pamount=Map AccountName AmountStyle -> MixedAmount -> MixedAmount
styleMixedAmount Map AccountName AmountStyle
styles (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p
                        ,pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion=BalanceAssertion -> BalanceAssertion
fixbalanceassertion (BalanceAssertion -> BalanceAssertion)
-> Maybe BalanceAssertion -> Maybe BalanceAssertion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Posting -> Maybe BalanceAssertion
pbalanceassertion Posting
p}
        fixbalanceassertion :: BalanceAssertion -> BalanceAssertion
fixbalanceassertion ba :: BalanceAssertion
ba = BalanceAssertion
ba{baamount :: Amount
baamount=Map AccountName AmountStyle -> Amount -> Amount
styleAmount Map AccountName AmountStyle
styles (Amount -> Amount) -> Amount -> Amount
forall a b. (a -> b) -> a -> b
$ BalanceAssertion -> Amount
baamount BalanceAssertion
ba}
        fixpricedirective :: PriceDirective -> PriceDirective
fixpricedirective pd :: PriceDirective
pd@PriceDirective{pdamount :: PriceDirective -> Amount
pdamount=Amount
a} = PriceDirective
pd{pdamount :: Amount
pdamount=Map AccountName AmountStyle -> Amount -> Amount
styleAmountExceptPrecision Map AccountName AmountStyle
styles Amount
a}

-- | Get all the amount styles defined in this journal, either declared by
-- a commodity directive or inferred from amounts, as a map from symbol to style.
-- Styles declared by commodity directives take precedence, and these also are
-- guaranteed to know their decimal point character.
journalCommodityStyles :: Journal -> M.Map CommoditySymbol AmountStyle
journalCommodityStyles :: Journal -> Map AccountName AmountStyle
journalCommodityStyles j :: Journal
j = Map AccountName AmountStyle
declaredstyles Map AccountName AmountStyle
-> Map AccountName AmountStyle -> Map AccountName AmountStyle
forall a. Semigroup a => a -> a -> a
<> Map AccountName AmountStyle
inferredstyles
  where
    declaredstyles :: Map AccountName AmountStyle
declaredstyles = (Commodity -> Maybe AmountStyle)
-> Map AccountName Commodity -> Map AccountName AmountStyle
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe Commodity -> Maybe AmountStyle
cformat (Map AccountName Commodity -> Map AccountName AmountStyle)
-> Map AccountName Commodity -> Map AccountName AmountStyle
forall a b. (a -> b) -> a -> b
$ Journal -> Map AccountName Commodity
jcommodities Journal
j
    inferredstyles :: Map AccountName AmountStyle
inferredstyles = Journal -> Map AccountName AmountStyle
jinferredcommodities Journal
j

-- | Collect and save inferred amount styles for each commodity based on
-- the posting amounts in that commodity (excluding price amounts), ie:
-- "the format of the first amount, adjusted to the highest precision of all amounts".
-- Can return an error message eg if inconsistent number formats are found.
journalInferCommodityStyles :: Journal -> Either String Journal
journalInferCommodityStyles :: Journal -> Either String Journal
journalInferCommodityStyles j :: Journal
j =
  case
    [Amount] -> Either String (Map AccountName AmountStyle)
commodityStylesFromAmounts ([Amount] -> Either String (Map AccountName AmountStyle))
-> [Amount] -> Either String (Map AccountName AmountStyle)
forall a b. (a -> b) -> a -> b
$
    String -> [Amount] -> [Amount]
forall a. Show a => String -> a -> a
dbg8 "journalInferCommodityStyles using amounts" ([Amount] -> [Amount]) -> [Amount] -> [Amount]
forall a b. (a -> b) -> a -> b
$
    Journal -> [Amount]
journalAmounts Journal
j
  of
    Left e :: String
e   -> String -> Either String Journal
forall a b. a -> Either a b
Left String
e
    Right cs :: Map AccountName AmountStyle
cs -> Journal -> Either String Journal
forall a b. b -> Either a b
Right Journal
j{jinferredcommodities :: Map AccountName AmountStyle
jinferredcommodities = Map AccountName AmountStyle
cs}

-- | Given a list of parsed amounts, in parse order, build a map from
-- their commodity names to standard commodity display formats. Can
-- return an error message eg if inconsistent number formats are
-- found.
--
-- Though, these amounts may have come from multiple files, so we
-- shouldn't assume they use consistent number formats.
-- Currently we don't enforce that even within a single file,
-- and this function never reports an error.
--
commodityStylesFromAmounts :: [Amount] -> Either String (M.Map CommoditySymbol AmountStyle)
commodityStylesFromAmounts :: [Amount] -> Either String (Map AccountName AmountStyle)
commodityStylesFromAmounts amts :: [Amount]
amts =
  Map AccountName AmountStyle
-> Either String (Map AccountName AmountStyle)
forall a b. b -> Either a b
Right (Map AccountName AmountStyle
 -> Either String (Map AccountName AmountStyle))
-> Map AccountName AmountStyle
-> Either String (Map AccountName AmountStyle)
forall a b. (a -> b) -> a -> b
$ [(AccountName, AmountStyle)] -> Map AccountName AmountStyle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(AccountName, AmountStyle)]
commstyles
  where
    commamts :: [(AccountName, [Amount])]
commamts = [(AccountName, Amount)] -> [(AccountName, [Amount])]
forall k v. Ord k => [(k, v)] -> [(k, [v])]
groupSort [(Amount -> AccountName
acommodity Amount
as, Amount
as) | Amount
as <- [Amount]
amts]
    commstyles :: [(AccountName, AmountStyle)]
commstyles = [(AccountName
c, [AmountStyle] -> AmountStyle
canonicalStyleFrom ([AmountStyle] -> AmountStyle) -> [AmountStyle] -> AmountStyle
forall a b. (a -> b) -> a -> b
$ (Amount -> AmountStyle) -> [Amount] -> [AmountStyle]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> AmountStyle
astyle [Amount]
as) | (c :: AccountName
c,as :: [Amount]
as) <- [(AccountName, [Amount])]
commamts]

-- TODO: should probably detect and report inconsistencies here
-- | Given a list of amount styles (assumed to be from parsed amounts
-- in a single commodity), in parse order, choose a canonical style.
-- Traditionally it's "the style of the first, with the maximum precision of all".
--
canonicalStyleFrom :: [AmountStyle] -> AmountStyle
canonicalStyleFrom :: [AmountStyle] -> AmountStyle
canonicalStyleFrom [] = AmountStyle
amountstyle
canonicalStyleFrom ss :: [AmountStyle]
ss@(s :: AmountStyle
s:_) =
  AmountStyle
s{asprecision :: Int
asprecision=Int
prec, asdecimalpoint :: Maybe Char
asdecimalpoint=Char -> Maybe Char
forall a. a -> Maybe a
Just Char
decmark, asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
mgrps}
  where
    -- precision is maximum of all precisions
    prec :: Int
prec = [Int] -> Int
forall a. Ord a => [a] -> a
maximumStrict ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (AmountStyle -> Int) -> [AmountStyle] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map AmountStyle -> Int
asprecision [AmountStyle]
ss
    -- identify the digit group mark (& group sizes)
    mgrps :: Maybe DigitGroupStyle
mgrps = [DigitGroupStyle] -> Maybe DigitGroupStyle
forall a. [a] -> Maybe a
headMay ([DigitGroupStyle] -> Maybe DigitGroupStyle)
-> [DigitGroupStyle] -> Maybe DigitGroupStyle
forall a b. (a -> b) -> a -> b
$ (AmountStyle -> Maybe DigitGroupStyle)
-> [AmountStyle] -> [DigitGroupStyle]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AmountStyle -> Maybe DigitGroupStyle
asdigitgroups [AmountStyle]
ss
    -- if a digit group mark was identified above, we can rely on that;
    -- make sure the decimal mark is different. If not, default to period.
    defdecmark :: Char
defdecmark =
      case Maybe DigitGroupStyle
mgrps of
        Just (DigitGroups '.' _) -> ','
        _                        -> '.'
    -- identify the decimal mark: the first one used, or the above default,
    -- but never the same character as the digit group mark.
    -- urgh.. refactor..
    decmark :: Char
decmark = case Maybe DigitGroupStyle
mgrps of
                Just _ -> Char
defdecmark
                _      -> Char -> String -> Char
forall a. a -> [a] -> a
headDef Char
defdecmark (String -> Char) -> String -> Char
forall a b. (a -> b) -> a -> b
$ (AmountStyle -> Maybe Char) -> [AmountStyle] -> String
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AmountStyle -> Maybe Char
asdecimalpoint [AmountStyle]
ss

-- -- | Apply this journal's historical price records to unpriced amounts where possible.
-- journalApplyPriceDirectives :: Journal -> Journal
-- journalApplyPriceDirectives j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
--     where
--       fixtransaction t@Transaction{tdate=d, tpostings=ps} = t{tpostings=map fixposting ps}
--        where
--         fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
--         fixmixedamount (Mixed as) = Mixed $ map fixamount as
--         fixamount = fixprice
--         fixprice a@Amount{price=Just _} = a
--         fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitPrice) $ journalPriceDirectiveFor j d c}

-- -- | Get the price for a commodity on the specified day from the price database, if known.
-- -- Does only one lookup step, ie will not look up the price of a price.
-- journalPriceDirectiveFor :: Journal -> Day -> CommoditySymbol -> Maybe MixedAmount
-- journalPriceDirectiveFor j d CommoditySymbol{symbol=s} = do
--   let ps = reverse $ filter ((<= d).pddate) $ filter ((s==).hsymbol) $ sortBy (comparing pddate) $ jpricedirectives j
--   case ps of (PriceDirective{pdamount=a}:_) -> Just a
--              _ -> Nothing

-- | Convert all this journal's amounts to cost using the transaction prices, if any.
-- The journal's commodity styles are applied to the resulting amounts.
journalToCost :: Journal -> Journal
journalToCost :: Journal -> Journal
journalToCost j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (Map AccountName AmountStyle -> Transaction -> Transaction
transactionToCost Map AccountName AmountStyle
styles) [Transaction]
ts}
    where
      styles :: Map AccountName AmountStyle
styles = Journal -> Map AccountName AmountStyle
journalCommodityStyles Journal
j

-- -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol.
-- journalCanonicalCommodities :: Journal -> M.Map String CommoditySymbol
-- journalCanonicalCommodities j = canonicaliseCommodities $ journalAmountCommodities j

-- -- | Get all this journal's amounts' commodities, in the order parsed.
-- journalAmountCommodities :: Journal -> [CommoditySymbol]
-- journalAmountCommodities = map acommodity . concatMap amounts . journalAmounts

-- -- | Get all this journal's amount and price commodities, in the order parsed.
-- journalAmountAndPriceCommodities :: Journal -> [CommoditySymbol]
-- journalAmountAndPriceCommodities = concatMap amountCommodities . concatMap amounts . journalAmounts

-- -- | Get this amount's commodity and any commodities referenced in its price.
-- amountCommodities :: Amount -> [CommoditySymbol]
-- amountCommodities Amount{acommodity=c,aprice=p} =
--     case p of Nothing -> [c]
--               Just (UnitPrice ma)  -> c:(concatMap amountCommodities $ amounts ma)
--               Just (TotalPrice ma) -> c:(concatMap amountCommodities $ amounts ma)

-- | Get an ordered list of the amounts in this journal which will
-- influence amount style canonicalisation. These are:
--
-- * amounts in market price directives (in parse order)
-- * amounts in postings (in parse order)
--
-- Amounts in default commodity directives also influence
-- canonicalisation, but earlier, as amounts are parsed.
-- Amounts in posting prices are not used for canonicalisation.
--
journalAmounts :: Journal -> [Amount]
journalAmounts :: Journal -> [Amount]
journalAmounts = Const [Amount] Journal -> [Amount]
forall a k (b :: k). Const a b -> a
getConst (Const [Amount] Journal -> [Amount])
-> (Journal -> Const [Amount] Journal) -> Journal -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> Const [Amount] Amount)
-> Journal -> Const [Amount] Journal
forall (f :: * -> *).
Applicative f =>
(Amount -> f Amount) -> Journal -> f Journal
traverseJournalAmounts ([Amount] -> Const [Amount] Amount
forall k a (b :: k). a -> Const a b
Const ([Amount] -> Const [Amount] Amount)
-> (Amount -> [Amount]) -> Amount -> Const [Amount] Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> [Amount] -> [Amount]
forall a. a -> [a] -> [a]
:[]))

-- | Maps over all of the amounts in the journal
overJournalAmounts :: (Amount -> Amount) -> Journal -> Journal
overJournalAmounts :: (Amount -> Amount) -> Journal -> Journal
overJournalAmounts f :: Amount -> Amount
f = Identity Journal -> Journal
forall a. Identity a -> a
runIdentity (Identity Journal -> Journal)
-> (Journal -> Identity Journal) -> Journal -> Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> Identity Amount) -> Journal -> Identity Journal
forall (f :: * -> *).
Applicative f =>
(Amount -> f Amount) -> Journal -> f Journal
traverseJournalAmounts (Amount -> Identity Amount
forall a. a -> Identity a
Identity (Amount -> Identity Amount)
-> (Amount -> Amount) -> Amount -> Identity Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Amount
f)

-- | Traverses over all of the amounts in the journal, in the order
-- indicated by 'journalAmounts'.
traverseJournalAmounts
    :: Applicative f
    => (Amount -> f Amount)
    -> Journal -> f Journal
traverseJournalAmounts :: (Amount -> f Amount) -> Journal -> f Journal
traverseJournalAmounts f :: Amount -> f Amount
f j :: Journal
j =
    [PriceDirective] -> [Transaction] -> Journal
recombine ([PriceDirective] -> [Transaction] -> Journal)
-> f [PriceDirective] -> f ([Transaction] -> Journal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PriceDirective -> f PriceDirective)
-> [PriceDirective] -> f [PriceDirective]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((PriceDirective -> f PriceDirective)
 -> [PriceDirective] -> f [PriceDirective])
-> ((Amount -> f Amount) -> PriceDirective -> f PriceDirective)
-> (Amount -> f Amount)
-> [PriceDirective]
-> f [PriceDirective]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> f Amount) -> PriceDirective -> f PriceDirective
forall (f :: * -> *).
Functor f =>
(Amount -> f Amount) -> PriceDirective -> f PriceDirective
mpa) Amount -> f Amount
f (Journal -> [PriceDirective]
jpricedirectives Journal
j)
              f ([Transaction] -> Journal) -> f [Transaction] -> f Journal
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Transaction -> f Transaction) -> [Transaction] -> f [Transaction]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Transaction -> f Transaction)
 -> [Transaction] -> f [Transaction])
-> ((Amount -> f Amount) -> Transaction -> f Transaction)
-> (Amount -> f Amount)
-> [Transaction]
-> f [Transaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Posting] -> f [Posting]) -> Transaction -> f Transaction
forall (f :: * -> *).
Functor f =>
([Posting] -> f [Posting]) -> Transaction -> f Transaction
tp (([Posting] -> f [Posting]) -> Transaction -> f Transaction)
-> ((Amount -> f Amount) -> [Posting] -> f [Posting])
-> (Amount -> f Amount)
-> Transaction
-> f Transaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posting -> f Posting) -> [Posting] -> f [Posting]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Posting -> f Posting) -> [Posting] -> f [Posting])
-> ((Amount -> f Amount) -> Posting -> f Posting)
-> (Amount -> f Amount)
-> [Posting]
-> f [Posting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MixedAmount -> f MixedAmount) -> Posting -> f Posting
forall (f :: * -> *).
Functor f =>
(MixedAmount -> f MixedAmount) -> Posting -> f Posting
pamt ((MixedAmount -> f MixedAmount) -> Posting -> f Posting)
-> ((Amount -> f Amount) -> MixedAmount -> f MixedAmount)
-> (Amount -> f Amount)
-> Posting
-> f Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Amount] -> f [Amount]) -> MixedAmount -> f MixedAmount
forall (f :: * -> *).
Functor f =>
([Amount] -> f [Amount]) -> MixedAmount -> f MixedAmount
maa (([Amount] -> f [Amount]) -> MixedAmount -> f MixedAmount)
-> ((Amount -> f Amount) -> [Amount] -> f [Amount])
-> (Amount -> f Amount)
-> MixedAmount
-> f MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> f Amount) -> [Amount] -> f [Amount]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) Amount -> f Amount
f (Journal -> [Transaction]
jtxns Journal
j)
  where
    recombine :: [PriceDirective] -> [Transaction] -> Journal
recombine mps :: [PriceDirective]
mps txns :: [Transaction]
txns = Journal
j { jpricedirectives :: [PriceDirective]
jpricedirectives = [PriceDirective]
mps, jtxns :: [Transaction]
jtxns = [Transaction]
txns }
    -- a bunch of traversals
    mpa :: (Amount -> f Amount) -> PriceDirective -> f PriceDirective
mpa  g :: Amount -> f Amount
g pd :: PriceDirective
pd = (\amt :: Amount
amt -> PriceDirective
pd { pdamount :: Amount
pdamount  = Amount
amt }) (Amount -> PriceDirective) -> f Amount -> f PriceDirective
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Amount -> f Amount
g (PriceDirective -> Amount
pdamount PriceDirective
pd)
    tp :: ([Posting] -> f [Posting]) -> Transaction -> f Transaction
tp   g :: [Posting] -> f [Posting]
g t :: Transaction
t  = (\ps :: [Posting]
ps  -> Transaction
t  { tpostings :: [Posting]
tpostings = [Posting]
ps  }) ([Posting] -> Transaction) -> f [Posting] -> f Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Posting] -> f [Posting]
g (Transaction -> [Posting]
tpostings Transaction
t)
    pamt :: (MixedAmount -> f MixedAmount) -> Posting -> f Posting
pamt g :: MixedAmount -> f MixedAmount
g p :: Posting
p  = (\amt :: MixedAmount
amt -> Posting
p  { pamount :: MixedAmount
pamount   = MixedAmount
amt }) (MixedAmount -> Posting) -> f MixedAmount -> f Posting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MixedAmount -> f MixedAmount
g (Posting -> MixedAmount
pamount Posting
p)
    maa :: ([Amount] -> f [Amount]) -> MixedAmount -> f MixedAmount
maa  g :: [Amount] -> f [Amount]
g (Mixed as :: [Amount]
as) = [Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount) -> f [Amount] -> f MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Amount] -> f [Amount]
g [Amount]
as

-- | The fully specified date span enclosing the dates (primary or secondary)
-- of all this journal's transactions and postings, or DateSpan Nothing Nothing
-- if there are none.
journalDateSpan :: Bool -> Journal -> DateSpan
journalDateSpan :: Bool -> Journal -> DateSpan
journalDateSpan secondary :: Bool
secondary j :: Journal
j
    | [Transaction] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Transaction]
ts   = Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing Maybe Day
forall a. Maybe a
Nothing
    | Bool
otherwise = Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
earliest) (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Year -> Day -> Day
addDays 1 Day
latest)
    where
      earliest :: Day
earliest = [Day] -> Day
forall a. Ord a => [a] -> a
minimumStrict [Day]
dates
      latest :: Day
latest   = [Day] -> Day
forall a. Ord a => [a] -> a
maximumStrict [Day]
dates
      dates :: [Day]
dates    = [Day]
pdates [Day] -> [Day] -> [Day]
forall a. [a] -> [a] -> [a]
++ [Day]
tdates
      tdates :: [Day]
tdates   = (Transaction -> Day) -> [Transaction] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map (if Bool
secondary then Transaction -> Day
transactionDate2 else Transaction -> Day
tdate) [Transaction]
ts
      pdates :: [Day]
pdates   = (Transaction -> [Day]) -> [Transaction] -> [Day]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Posting -> Maybe Day) -> [Posting] -> [Day]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (if Bool
secondary then (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> (Posting -> Day) -> Posting -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Day
postingDate2) else Posting -> Maybe Day
pdate) ([Posting] -> [Day])
-> (Transaction -> [Posting]) -> Transaction -> [Day]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings) [Transaction]
ts
      ts :: [Transaction]
ts       = Journal -> [Transaction]
jtxns Journal
j

-- | The earliest of this journal's transaction and posting dates, or
-- Nothing if there are none.
journalStartDate :: Bool -> Journal -> Maybe Day
journalStartDate :: Bool -> Journal -> Maybe Day
journalStartDate secondary :: Bool
secondary j :: Journal
j = Maybe Day
b where DateSpan b :: Maybe Day
b _ = Bool -> Journal -> DateSpan
journalDateSpan Bool
secondary Journal
j

-- | The latest of this journal's transaction and posting dates, or
-- Nothing if there are none.
journalEndDate :: Bool -> Journal -> Maybe Day
journalEndDate :: Bool -> Journal -> Maybe Day
journalEndDate secondary :: Bool
secondary j :: Journal
j = Maybe Day
e where DateSpan _ e :: Maybe Day
e = Bool -> Journal -> DateSpan
journalDateSpan Bool
secondary Journal
j

-- | Apply the pivot transformation to all postings in a journal,
-- replacing their account name by their value for the given field or tag.
journalPivot :: Text -> Journal -> Journal
journalPivot :: AccountName -> Journal -> Journal
journalPivot fieldortagname :: AccountName
fieldortagname j :: Journal
j = Journal
j{jtxns :: [Transaction]
jtxns = (Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName -> Transaction -> Transaction
transactionPivot AccountName
fieldortagname) ([Transaction] -> [Transaction])
-> (Journal -> [Transaction]) -> Journal -> [Transaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Transaction]
jtxns (Journal -> [Transaction]) -> Journal -> [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal
j}

-- | Replace this transaction's postings' account names with the value
-- of the given field or tag, if any.
transactionPivot :: Text -> Transaction -> Transaction
transactionPivot :: AccountName -> Transaction -> Transaction
transactionPivot fieldortagname :: AccountName
fieldortagname t :: Transaction
t = Transaction
t{tpostings :: [Posting]
tpostings = (Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName -> Posting -> Posting
postingPivot AccountName
fieldortagname) ([Posting] -> [Posting])
-> (Transaction -> [Posting]) -> Transaction -> [Posting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings (Transaction -> [Posting]) -> Transaction -> [Posting]
forall a b. (a -> b) -> a -> b
$ Transaction
t}

-- | Replace this posting's account name with the value
-- of the given field or tag, if any, otherwise the empty string.
postingPivot :: Text -> Posting -> Posting
postingPivot :: AccountName -> Posting -> Posting
postingPivot fieldortagname :: AccountName
fieldortagname p :: Posting
p = Posting
p{paccount :: AccountName
paccount = AccountName
pivotedacct, poriginal :: Maybe Posting
poriginal = Posting -> Maybe Posting
forall a. a -> Maybe a
Just (Posting -> Maybe Posting) -> Posting -> Maybe Posting
forall a b. (a -> b) -> a -> b
$ Posting -> Posting
originalPosting Posting
p}
  where
    pivotedacct :: AccountName
pivotedacct
      | Just t :: Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, AccountName
fieldortagname AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== "code"        = Transaction -> AccountName
tcode Transaction
t
      | Just t :: Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, AccountName
fieldortagname AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== "description" = Transaction -> AccountName
tdescription Transaction
t
      | Just t :: Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, AccountName
fieldortagname AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== "payee"       = Transaction -> AccountName
transactionPayee Transaction
t
      | Just t :: Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, AccountName
fieldortagname AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== "note"        = Transaction -> AccountName
transactionNote Transaction
t
      | Just (_, value :: AccountName
value) <- AccountName -> Posting -> Maybe (AccountName, AccountName)
postingFindTag AccountName
fieldortagname Posting
p        = AccountName
value
      | Bool
otherwise                                                 = ""

postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue)
postingFindTag :: AccountName -> Posting -> Maybe (AccountName, AccountName)
postingFindTag tagname :: AccountName
tagname p :: Posting
p = ((AccountName, AccountName) -> Bool)
-> [(AccountName, AccountName)] -> Maybe (AccountName, AccountName)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((AccountName
tagnameAccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
==) (AccountName -> Bool)
-> ((AccountName, AccountName) -> AccountName)
-> (AccountName, AccountName)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AccountName, AccountName) -> AccountName
forall a b. (a, b) -> a
fst) ([(AccountName, AccountName)] -> Maybe (AccountName, AccountName))
-> [(AccountName, AccountName)] -> Maybe (AccountName, AccountName)
forall a b. (a -> b) -> a -> b
$ Posting -> [(AccountName, AccountName)]
postingAllTags Posting
p

-- -- | Build a database of market prices in effect on the given date,
-- -- from the journal's price directives.
-- journalPrices :: Day -> Journal -> Prices
-- journalPrices d = toPrices d . jpricedirectives

-- -- | Render a market price as a P directive.
-- showPriceDirectiveDirective :: PriceDirective -> String
-- showPriceDirectiveDirective pd = unwords
--     [ "P"
--     , showDate (pddate pd)
--     , T.unpack (pdcommodity pd)
--     , (showAmount . setAmountPrecision maxprecision) (pdamount pd
--     )
--     ]

-- Misc helpers

-- | Check if a set of hledger account/description filter patterns matches the
-- given account name or entry description.  Patterns are case-insensitive
-- regular expressions. Prefixed with not:, they become anti-patterns.
matchpats :: [String] -> String -> Bool
matchpats :: [String] -> String -> Bool
matchpats pats :: [String]
pats str :: String
str =
    ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
positives Bool -> Bool -> Bool
|| (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
match [String]
positives) Bool -> Bool -> Bool
&& ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
negatives Bool -> Bool -> Bool
|| Bool -> Bool
not ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
match [String]
negatives))
    where
      (negatives :: [String]
negatives,positives :: [String]
positives) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition String -> Bool
isnegativepat [String]
pats
      match :: String -> Bool
match "" = Bool
True
      match pat :: String
pat = String -> String -> Bool
regexMatchesCI (ShowS
abspat String
pat) String
str

negateprefix :: String
negateprefix = "not:"

isnegativepat :: String -> Bool
isnegativepat = (String
negateprefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)

abspat :: ShowS
abspat pat :: String
pat = if String -> Bool
isnegativepat String
pat then Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
negateprefix) String
pat else String
pat

-- debug helpers
-- traceAmountPrecision a = trace (show $ map (precision . acommodity) $ amounts a) a
-- tracePostingsCommodities ps = trace (show $ map ((map (precision . acommodity) . amounts) . pamount) ps) ps

-- tests

-- A sample journal for testing, similar to examples/sample.journal:
--
-- 2008/01/01 income
--     assets:bank:checking  $1
--     income:salary
--
-- 2008/06/01 gift
--     assets:bank:checking  $1
--     income:gifts
--
-- 2008/06/02 save
--     assets:bank:saving  $1
--     assets:bank:checking
--
-- 2008/06/03 * eat & shop
--     expenses:food      $1
--     expenses:supplies  $1
--     assets:cash
--
-- 2008/10/01 take a loan
--     assets:bank:checking $1
--     liabilities:debts    $-1
--
-- 2008/12/31 * pay off
--     liabilities:debts  $1
--     assets:bank:checking
--
Right samplejournal :: Journal
samplejournal = Bool -> Journal -> Either String Journal
journalBalanceTransactions Bool
False (Journal -> Either String Journal)
-> Journal -> Either String Journal
forall a b. (a -> b) -> a -> b
$
         Journal
nulljournal
         {jtxns :: [Transaction]
jtxns = [
           Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Year
tindex=0,
             tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
             tdate :: Day
tdate=String -> Day
parsedate "2008/01/01",
             tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Unmarked,
             tcode :: AccountName
tcode="",
             tdescription :: AccountName
tdescription="income",
             tcomment :: AccountName
tcomment="",
             ttags :: [(AccountName, AccountName)]
ttags=[],
             tpostings :: [Posting]
tpostings=
                 ["assets:bank:checking" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd 1
                 ,"income:salary" AccountName -> Amount -> Posting
`post` Amount
missingamt
                 ],
             tprecedingcomment :: AccountName
tprecedingcomment=""
           }
          ,
           Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Year
tindex=0,
             tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
             tdate :: Day
tdate=String -> Day
parsedate "2008/06/01",
             tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Unmarked,
             tcode :: AccountName
tcode="",
             tdescription :: AccountName
tdescription="gift",
             tcomment :: AccountName
tcomment="",
             ttags :: [(AccountName, AccountName)]
ttags=[],
             tpostings :: [Posting]
tpostings=
                 ["assets:bank:checking" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd 1
                 ,"income:gifts" AccountName -> Amount -> Posting
`post` Amount
missingamt
                 ],
             tprecedingcomment :: AccountName
tprecedingcomment=""
           }
          ,
           Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Year
tindex=0,
             tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
             tdate :: Day
tdate=String -> Day
parsedate "2008/06/02",
             tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Unmarked,
             tcode :: AccountName
tcode="",
             tdescription :: AccountName
tdescription="save",
             tcomment :: AccountName
tcomment="",
             ttags :: [(AccountName, AccountName)]
ttags=[],
             tpostings :: [Posting]
tpostings=
                 ["assets:bank:saving" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd 1
                 ,"assets:bank:checking" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd (-1)
                 ],
             tprecedingcomment :: AccountName
tprecedingcomment=""
           }
          ,
           Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Year
tindex=0,
             tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
             tdate :: Day
tdate=String -> Day
parsedate "2008/06/03",
             tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Cleared,
             tcode :: AccountName
tcode="",
             tdescription :: AccountName
tdescription="eat & shop",
             tcomment :: AccountName
tcomment="",
             ttags :: [(AccountName, AccountName)]
ttags=[],
             tpostings :: [Posting]
tpostings=["expenses:food" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd 1
                       ,"expenses:supplies" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd 1
                       ,"assets:cash" AccountName -> Amount -> Posting
`post` Amount
missingamt
                       ],
             tprecedingcomment :: AccountName
tprecedingcomment=""
           }
          ,
           Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Year
tindex=0,
             tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
             tdate :: Day
tdate=String -> Day
parsedate "2008/10/01",
             tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Unmarked,
             tcode :: AccountName
tcode="",
             tdescription :: AccountName
tdescription="take a loan",
             tcomment :: AccountName
tcomment="",
             ttags :: [(AccountName, AccountName)]
ttags=[],
             tpostings :: [Posting]
tpostings=["assets:bank:checking" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd 1
                       ,"liabilities:debts" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd (-1)
                       ],
             tprecedingcomment :: AccountName
tprecedingcomment=""
           }
          ,
           Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Year
tindex=0,
             tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
             tdate :: Day
tdate=String -> Day
parsedate "2008/12/31",
             tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Unmarked,
             tcode :: AccountName
tcode="",
             tdescription :: AccountName
tdescription="pay off",
             tcomment :: AccountName
tcomment="",
             ttags :: [(AccountName, AccountName)]
ttags=[],
             tpostings :: [Posting]
tpostings=["liabilities:debts" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd 1
                       ,"assets:bank:checking" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd (-1)
                       ],
             tprecedingcomment :: AccountName
tprecedingcomment=""
           }
          ]
         }

tests_Journal :: TestTree
tests_Journal = String -> [TestTree] -> TestTree
tests "Journal" [

   String -> Assertion -> TestTree
test "journalDateSpan" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
    Bool -> Journal -> DateSpan
journalDateSpan Bool
True Journal
nulljournal{
      jtxns :: [Transaction]
jtxns = [Transaction
nulltransaction{tdate :: Day
tdate = String -> Day
parsedate "2014/02/01"
                              ,tpostings :: [Posting]
tpostings = [Posting
posting{pdate :: Maybe Day
pdate=Day -> Maybe Day
forall a. a -> Maybe a
Just (String -> Day
parsedate "2014/01/10")}]
                              }
              ,Transaction
nulltransaction{tdate :: Day
tdate = String -> Day
parsedate "2014/09/01"
                              ,tpostings :: [Posting]
tpostings = [Posting
posting{pdate2 :: Maybe Day
pdate2=Day -> Maybe Day
forall a. a -> Maybe a
Just (String -> Day
parsedate "2014/10/10")}]
                              }
              ]
      }
    DateSpan -> DateSpan -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian 2014 1 10) (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian 2014 10 11))

  ,String -> [TestTree] -> TestTree
tests "standard account type queries" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$
    let
      j :: Journal
j = Journal
samplejournal
      journalAccountNamesMatching :: Query -> Journal -> [AccountName]
      journalAccountNamesMatching :: Query -> Journal -> [AccountName]
journalAccountNamesMatching q :: Query
q = (AccountName -> Bool) -> [AccountName] -> [AccountName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query
q Query -> AccountName -> Bool
`matchesAccount`) ([AccountName] -> [AccountName])
-> (Journal -> [AccountName]) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [AccountName]
journalAccountNames
      namesfrom :: (Journal -> Query) -> [AccountName]
namesfrom qfunc :: Journal -> Query
qfunc = Query -> Journal -> [AccountName]
journalAccountNamesMatching (Journal -> Query
qfunc Journal
j) Journal
j
    in [
       String -> Assertion -> TestTree
test "assets"      (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ String -> [AccountName] -> [AccountName] -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual "" ((Journal -> Query) -> [AccountName]
namesfrom Journal -> Query
journalAssetAccountQuery)     ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]
      ,String -> Assertion -> TestTree
test "liabilities" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ String -> [AccountName] -> [AccountName] -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual "" ((Journal -> Query) -> [AccountName]
namesfrom Journal -> Query
journalLiabilityAccountQuery) ["liabilities","liabilities:debts"]
      ,String -> Assertion -> TestTree
test "equity"      (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ String -> [AccountName] -> [AccountName] -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual "" ((Journal -> Query) -> [AccountName]
namesfrom Journal -> Query
journalEquityAccountQuery)    []
      ,String -> Assertion -> TestTree
test "income"      (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ String -> [AccountName] -> [AccountName] -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual "" ((Journal -> Query) -> [AccountName]
namesfrom Journal -> Query
journalRevenueAccountQuery)    ["income","income:gifts","income:salary"]
      ,String -> Assertion -> TestTree
test "expenses"    (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ String -> [AccountName] -> [AccountName] -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual "" ((Journal -> Query) -> [AccountName]
namesfrom Journal -> Query
journalExpenseAccountQuery)   ["expenses","expenses:food","expenses:supplies"]
    ]

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

     String -> Assertion -> TestTree
test "balance-assignment" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      let ej :: Either String Journal
ej = Bool -> Journal -> Either String Journal
journalBalanceTransactions Bool
True (Journal -> Either String Journal)
-> Journal -> Either String Journal
forall a b. (a -> b) -> a -> b
$
            --2019/01/01
            --  (a)            = 1
            Journal
nulljournal{ jtxns :: [Transaction]
jtxns = [
              String -> [Posting] -> Transaction
transaction "2019/01/01" [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' "a" Amount
missingamt (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num 1)) ]
            ]}
      Either String Journal -> Assertion
forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight Either String Journal
ej
      let Right j :: Journal
j = Either String Journal
ej
      (Journal -> [Transaction]
jtxns Journal
j [Transaction] -> ([Transaction] -> Transaction) -> Transaction
forall a b. a -> (a -> b) -> b
& [Transaction] -> Transaction
forall a. [a] -> a
head Transaction -> (Transaction -> [Posting]) -> [Posting]
forall a b. a -> (a -> b) -> b
& Transaction -> [Posting]
tpostings [Posting] -> ([Posting] -> Posting) -> Posting
forall a b. a -> (a -> b) -> b
& [Posting] -> Posting
forall a. [a] -> a
head Posting -> (Posting -> MixedAmount) -> MixedAmount
forall a b. a -> (a -> b) -> b
& Posting -> MixedAmount
pamount) MixedAmount -> MixedAmount -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Amount] -> MixedAmount
Mixed [Quantity -> Amount
num 1]

    ,String -> Assertion -> TestTree
test "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
$ Bool -> Journal -> Either String Journal
journalBalanceTransactions Bool
True (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]
jtxns = [
               String -> [Posting] -> Transaction
transaction "2019/01/01" [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' "a" Amount
missingamt (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num 1)) ]
              ,String -> [Posting] -> Transaction
transaction "2019/01/01" [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' "a" (Quantity -> Amount
num 1)    (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num 2)) ]
            ]}

    ,String -> Assertion -> TestTree
test "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
$ Bool -> Journal -> Either String Journal
journalBalanceTransactions Bool
True (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]
jtxns = [
               String -> [Posting] -> Transaction
transaction "2019/01/01" [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' "a" (Quantity -> Amount
num 2)    (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num 2)) ]
              ,String -> [Posting] -> Transaction
transaction "2019/01/01" [
                 AccountName -> Amount -> Maybe BalanceAssertion -> Posting
post' "b" (Quantity -> Amount
num 1)     Maybe BalanceAssertion
forall a. Maybe a
Nothing
                ,AccountName -> Amount -> Maybe BalanceAssertion -> Posting
post' "a"  Amount
missingamt Maybe BalanceAssertion
forall a. Maybe a
Nothing
              ]
              ,String -> [Posting] -> Transaction
transaction "2019/01/01" [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
post' "a" (Quantity -> Amount
num 0)     (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num 1)) ]
            ]}

    ,String -> Assertion -> TestTree
test "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
$ Bool -> Journal -> Either String Journal
journalBalanceTransactions Bool
True (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]
jtxns = [
               String -> [Posting] -> Transaction
transaction "2019/01/02" [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' "a" (Quantity -> Amount
num 1)    (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num 2)) ]
              ,String -> [Posting] -> Transaction
transaction "2019/01/01" [ AccountName -> Amount -> Maybe BalanceAssertion -> Posting
vpost' "a" (Quantity -> Amount
num 1)    (Amount -> Maybe BalanceAssertion
balassert (Quantity -> Amount
num 1)) ]
            ]}

    ]

    ,String -> [TestTree] -> TestTree
tests "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
test "1091a" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        [Amount] -> Either String (Map AccountName AmountStyle)
commodityStylesFromAmounts [
           Amount
nullamt{aquantity :: Quantity
aquantity=1000, astyle :: AmountStyle
astyle=Side
-> Bool
-> Int
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False 3 (Char -> Maybe Char
forall a. a -> Maybe a
Just ',') Maybe DigitGroupStyle
forall a. Maybe a
Nothing}
          ,Amount
nullamt{aquantity :: Quantity
aquantity=1000, astyle :: AmountStyle
astyle=Side
-> Bool
-> Int
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False 2 (Char -> Maybe Char
forall a. a -> Maybe a
Just '.') (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Int] -> DigitGroupStyle
DigitGroups ',' [3]))}
          ]
         Either String (Map AccountName AmountStyle)
-> Either String (Map AccountName AmountStyle) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          -- The commodity style should have period as decimal mark
          -- and comma as digit group mark.
          Map AccountName AmountStyle
-> Either String (Map AccountName AmountStyle)
forall a b. b -> Either a b
Right ([(AccountName, AmountStyle)] -> Map AccountName AmountStyle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
            ("", Side
-> Bool
-> Int
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False 3 (Char -> Maybe Char
forall a. a -> Maybe a
Just '.') (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Int] -> DigitGroupStyle
DigitGroups ',' [3])))
          ])
        -- same journal, entries in reverse order
      ,String -> Assertion -> TestTree
test "1091b" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        [Amount] -> Either String (Map AccountName AmountStyle)
commodityStylesFromAmounts [
           Amount
nullamt{aquantity :: Quantity
aquantity=1000, astyle :: AmountStyle
astyle=Side
-> Bool
-> Int
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False 2 (Char -> Maybe Char
forall a. a -> Maybe a
Just '.') (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Int] -> DigitGroupStyle
DigitGroups ',' [3]))}
          ,Amount
nullamt{aquantity :: Quantity
aquantity=1000, astyle :: AmountStyle
astyle=Side
-> Bool
-> Int
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False 3 (Char -> Maybe Char
forall a. a -> Maybe a
Just ',') Maybe DigitGroupStyle
forall a. Maybe a
Nothing}
          ]
         Either String (Map AccountName AmountStyle)
-> Either String (Map AccountName AmountStyle) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
          -- The commodity style should have period as decimal mark
          -- and comma as digit group mark.
          Map AccountName AmountStyle
-> Either String (Map AccountName AmountStyle)
forall a b. b -> Either a b
Right ([(AccountName, AmountStyle)] -> Map AccountName AmountStyle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
            ("", Side
-> Bool
-> Int
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle Side
L Bool
False 3 (Char -> Maybe Char
forall a. a -> Maybe a
Just '.') (DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (Char -> [Int] -> DigitGroupStyle
DigitGroups ',' [3])))
          ])

     ]

  ]