{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE Rank2Types          #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-|

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
  JournalParser,
  ErroringJournalParser,
  addPriceDirective,
  addTransactionModifier,
  addPeriodicTransaction,
  addTransaction,
  journalInferMarketPricesFromTransactions,
  journalApplyCommodityStyles,
  commodityStylesFromAmounts,
  journalCommodityStyles,
  journalToCost,
  journalReverse,
  journalSetLastReadTime,
  journalPivot,
  -- * Filtering
  filterJournalTransactions,
  filterJournalPostings,
  filterJournalRelatedPostings,
  filterJournalAmounts,
  filterTransactionAmounts,
  filterTransactionPostings,
  filterTransactionRelatedPostings,
  filterPostingAmount,
  -- * Mapping
  journalMapTransactions,
  journalMapPostings,
  journalMapPostingAmounts,
  -- * Querying
  journalAccountNamesUsed,
  journalAccountNamesImplied,
  journalAccountNamesDeclared,
  journalAccountNamesDeclaredOrUsed,
  journalAccountNamesDeclaredOrImplied,
  journalAccountNames,
  -- journalAmountAndPriceCommodities,
  -- journalAmountStyles,
  -- overJournalAmounts,
  -- traverseJournalAmounts,
  -- journalCanonicalCommodities,
  journalPayeesDeclared,
  journalPayeesUsed,
  journalPayeesDeclaredOrUsed,
  journalCommoditiesDeclared,
  journalCommodities,
  journalDateSpan,
  journalDateSpanBothDates,
  journalStartDate,
  journalEndDate,
  journalLastDay,
  journalDescriptions,
  journalFilePath,
  journalFilePaths,
  journalTransactionAt,
  journalNextTransaction,
  journalPrevTransaction,
  journalPostings,
  journalTransactionsSimilarTo,
  -- journalPrices,
  -- * Standard account types
  journalBalanceSheetAccountQuery,
  journalProfitAndLossAccountQuery,
  journalRevenueAccountQuery,
  journalExpenseAccountQuery,
  journalAssetAccountQuery,
  journalLiabilityAccountQuery,
  journalEquityAccountQuery,
  journalCashAccountQuery,
  -- * Misc
  canonicalStyleFrom,
  nulljournal,
  journalNumberTransactions,
  journalNumberAndTieTransactions,
  journalUntieTransactions,
  journalModifyTransactions,
  journalApplyAliases,
  -- * Tests
  samplejournal,
  samplejournalMaybeExplicit,
  tests_Journal
,journalLeafAccountNamesDeclared)
where

import Control.Applicative ((<|>))
import Control.Monad.Except (ExceptT(..))
import Control.Monad.State.Strict (StateT)
import Data.Char (toUpper, isDigit)
import Data.Default (Default(..))
import Data.Foldable (toList)
import Data.List ((\\), find, foldl', sortBy)
import Data.List.Extra (nubSort)
import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Safe (headMay, headDef, maximumMay, minimumMay)
import Data.Time.Calendar (Day, addDays, fromGregorian)
import Data.Time.Clock.POSIX (POSIXTime)
import Data.Tree (Tree, flatten)
import Text.Printf (printf)
import Text.Megaparsec (ParsecT)
import Text.Megaparsec.Custom (FinalParseError)

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


-- | A parser of text that runs in some monad, keeping a Journal as state.
type JournalParser m a = StateT Journal (ParsecT CustomErr Text m) a

-- | A parser of text that runs in some monad, keeping a Journal as
-- state, that can throw an exception to end parsing, preventing
-- further parser backtracking.
type ErroringJournalParser m a =
  StateT Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) a

-- deriving instance Show Journal
instance Show Journal where
  show :: Journal -> String
show Journal
j
    | Int
debugLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 = String -> String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"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
< Int
6 = String -> String -> Int -> Int -> ShowS
forall r. PrintfType r => String -> r
printf String
"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 String
"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
/= AccountName
"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 semigroup 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.
--
-- Note that (<>) is right-biased, so nulljournal is only a left identity.
-- In particular, this prevents Journal from being a monoid.
instance Semigroup Journal where
  Journal
j1 <> :: Journal -> Journal -> Journal
<> Journal
j2 = Journal :: Maybe Year
-> Maybe (AccountName, AmountStyle)
-> Maybe DecimalMark
-> [AccountName]
-> [AccountAlias]
-> [TimeclockEntry]
-> [String]
-> [(AccountName, PayeeDeclarationInfo)]
-> [(AccountName, AccountDeclarationInfo)]
-> Map AccountType [AccountName]
-> Map AccountName AmountStyle
-> Map AccountName Commodity
-> Map AccountName AmountStyle
-> [PriceDirective]
-> [MarketPrice]
-> [TransactionModifier]
-> [PeriodicTransaction]
-> [Transaction]
-> AccountName
-> [(String, AccountName)]
-> POSIXTime
-> Journal
Journal {
     jparsedefaultyear :: Maybe Year
jparsedefaultyear          = Journal -> Maybe Year
jparsedefaultyear          Journal
j2
    ,jparsedefaultcommodity :: Maybe (AccountName, AmountStyle)
jparsedefaultcommodity     = Journal -> Maybe (AccountName, AmountStyle)
jparsedefaultcommodity     Journal
j2
    ,jparsedecimalmark :: Maybe DecimalMark
jparsedecimalmark          = Journal -> Maybe DecimalMark
jparsedecimalmark          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
    ,jdeclaredpayees :: [(AccountName, PayeeDeclarationInfo)]
jdeclaredpayees            = Journal -> [(AccountName, PayeeDeclarationInfo)]
jdeclaredpayees            Journal
j1 [(AccountName, PayeeDeclarationInfo)]
-> [(AccountName, PayeeDeclarationInfo)]
-> [(AccountName, PayeeDeclarationInfo)]
forall a. Semigroup a => a -> a -> a
<> Journal -> [(AccountName, PayeeDeclarationInfo)]
jdeclaredpayees            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
    ,jglobalcommoditystyles :: Map AccountName AmountStyle
jglobalcommoditystyles     = Journal -> Map AccountName AmountStyle
jglobalcommoditystyles     Journal
j1 Map AccountName AmountStyle
-> Map AccountName AmountStyle -> Map AccountName AmountStyle
forall a. Semigroup a => a -> a -> a
<> Journal -> Map AccountName AmountStyle
jglobalcommoditystyles     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
    ,jinferredmarketprices :: [MarketPrice]
jinferredmarketprices      = Journal -> [MarketPrice]
jinferredmarketprices      Journal
j1 [MarketPrice] -> [MarketPrice] -> [MarketPrice]
forall a. Semigroup a => a -> a -> a
<> Journal -> [MarketPrice]
jinferredmarketprices      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 :: POSIXTime
jlastreadtime              = POSIXTime -> POSIXTime -> POSIXTime
forall a. Ord a => a -> a -> a
max (Journal -> POSIXTime
jlastreadtime Journal
j1) (Journal -> POSIXTime
jlastreadtime Journal
j2)
    }

instance Default Journal where
  def :: Journal
def = Journal
nulljournal

nulljournal :: Journal
nulljournal :: Journal
nulljournal = Journal :: Maybe Year
-> Maybe (AccountName, AmountStyle)
-> Maybe DecimalMark
-> [AccountName]
-> [AccountAlias]
-> [TimeclockEntry]
-> [String]
-> [(AccountName, PayeeDeclarationInfo)]
-> [(AccountName, AccountDeclarationInfo)]
-> Map AccountType [AccountName]
-> Map AccountName AmountStyle
-> Map AccountName Commodity
-> Map AccountName AmountStyle
-> [PriceDirective]
-> [MarketPrice]
-> [TransactionModifier]
-> [PeriodicTransaction]
-> [Transaction]
-> AccountName
-> [(String, AccountName)]
-> POSIXTime
-> 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
  ,jparsedecimalmark :: Maybe DecimalMark
jparsedecimalmark          = Maybe DecimalMark
forall a. Maybe a
Nothing
  ,jparseparentaccounts :: [AccountName]
jparseparentaccounts       = []
  ,jparsealiases :: [AccountAlias]
jparsealiases              = []
  -- ,jparsetransactioncount     = 0
  ,jparsetimeclockentries :: [TimeclockEntry]
jparsetimeclockentries     = []
  ,jincludefilestack :: [String]
jincludefilestack          = []
  ,jdeclaredpayees :: [(AccountName, PayeeDeclarationInfo)]
jdeclaredpayees            = []
  ,jdeclaredaccounts :: [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts          = []
  ,jdeclaredaccounttypes :: Map AccountType [AccountName]
jdeclaredaccounttypes      = Map AccountType [AccountName]
forall k a. Map k a
M.empty
  ,jglobalcommoditystyles :: Map AccountName AmountStyle
jglobalcommoditystyles     = Map AccountName AmountStyle
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           = []
  ,jinferredmarketprices :: [MarketPrice]
jinferredmarketprices      = []
  ,jtxnmodifiers :: [TransactionModifier]
jtxnmodifiers              = []
  ,jperiodictxns :: [PeriodicTransaction]
jperiodictxns              = []
  ,jtxns :: [Transaction]
jtxns                      = []
  ,jfinalcommentlines :: AccountName
jfinalcommentlines         = AccountName
""
  ,jfiles :: [(String, AccountName)]
jfiles                     = []
  ,jlastreadtime :: POSIXTime
jlastreadtime              = POSIXTime
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)] -> (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 Transaction
t 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 TransactionModifier
mt 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 PeriodicTransaction
pt 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 PriceDirective
h 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} 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 Journal
j Transaction
t = Journal -> Year -> Maybe Transaction
journalTransactionAt Journal
j (Transaction -> Year
tindex Transaction
t Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
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 Journal
j Transaction
t = Journal -> Year -> Maybe Transaction
journalTransactionAt Journal
j (Transaction -> Year
tindex Transaction
t Year -> Year -> Year
forall a. Num a => a -> a -> a
- Year
1)

-- | 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 commodity symbols declared by commodity directives in this journal.
journalCommoditiesDeclared :: Journal -> [CommoditySymbol]
journalCommoditiesDeclared :: Journal -> [AccountName]
journalCommoditiesDeclared = Map AccountName Commodity -> [AccountName]
forall k a. Map k a -> [k]
M.keys (Map AccountName Commodity -> [AccountName])
-> (Journal -> Map AccountName Commodity)
-> Journal
-> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Map AccountName Commodity
jcommodities

-- | Sorted unique commodity symbols declared or inferred from this journal.
journalCommodities :: Journal -> S.Set CommoditySymbol
journalCommodities :: Journal -> Set AccountName
journalCommodities Journal
j = Map AccountName Commodity -> Set AccountName
forall k a. Map k a -> Set k
M.keysSet (Journal -> Map AccountName Commodity
jcommodities Journal
j) Set AccountName -> Set AccountName -> Set AccountName
forall a. Semigroup a => a -> a -> a
<> Map AccountName AmountStyle -> Set AccountName
forall k a. Map k a -> Set k
M.keysSet (Journal -> Map AccountName AmountStyle
jinferredcommodities Journal
j)

-- | Unique transaction descriptions used in this journal.
journalDescriptions :: Journal -> [Text]
journalDescriptions :: Journal -> [AccountName]
journalDescriptions = [AccountName] -> [AccountName]
forall a. Ord a => [a] -> [a]
nubSort ([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

-- | Sorted unique payees declared by payee directives in this journal.
journalPayeesDeclared :: Journal -> [Payee]
journalPayeesDeclared :: Journal -> [AccountName]
journalPayeesDeclared = [AccountName] -> [AccountName]
forall a. Ord a => [a] -> [a]
nubSort ([AccountName] -> [AccountName])
-> (Journal -> [AccountName]) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AccountName, PayeeDeclarationInfo) -> AccountName)
-> [(AccountName, PayeeDeclarationInfo)] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName, PayeeDeclarationInfo) -> AccountName
forall a b. (a, b) -> a
fst ([(AccountName, PayeeDeclarationInfo)] -> [AccountName])
-> (Journal -> [(AccountName, PayeeDeclarationInfo)])
-> Journal
-> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [(AccountName, PayeeDeclarationInfo)]
jdeclaredpayees

-- | Sorted unique payees used by transactions in this journal.
journalPayeesUsed :: Journal -> [Payee]
journalPayeesUsed :: Journal -> [AccountName]
journalPayeesUsed = [AccountName] -> [AccountName]
forall a. Ord a => [a] -> [a]
nubSort ([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
transactionPayee ([Transaction] -> [AccountName])
-> (Journal -> [Transaction]) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Transaction]
jtxns

-- | Sorted unique payees used in transactions or declared by payee directives in this journal.
journalPayeesDeclaredOrUsed :: Journal -> [Payee]
journalPayeesDeclaredOrUsed :: Journal -> [AccountName]
journalPayeesDeclaredOrUsed Journal
j = Set AccountName -> [AccountName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set AccountName -> [AccountName])
-> Set AccountName -> [AccountName]
forall a b. (a -> b) -> a -> b
$ ([AccountName] -> Set AccountName)
-> [[AccountName]] -> Set AccountName
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [AccountName] -> Set AccountName
forall a. Ord a => [a] -> Set a
S.fromList
    [Journal -> [AccountName]
journalPayeesDeclared Journal
j, Journal -> [AccountName]
journalPayeesUsed Journal
j]

-- | 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. Ord a => [a] -> [a]
nubSort ([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 in this journal,
-- which have no children.
journalLeafAccountNamesDeclared :: Journal -> [AccountName]
journalLeafAccountNamesDeclared :: Journal -> [AccountName]
journalLeafAccountNamesDeclared = Tree AccountName -> [AccountName]
forall a. Tree a -> [a]
treeLeaves (Tree AccountName -> [AccountName])
-> (Journal -> Tree AccountName) -> Journal -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AccountName] -> Tree AccountName
accountNameTreeFrom ([AccountName] -> Tree AccountName)
-> (Journal -> [AccountName]) -> Journal -> Tree AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [AccountName]
journalAccountNamesDeclared

-- | Sorted unique account names declared by account directives or posted to
-- by transactions in this journal.
journalAccountNamesDeclaredOrUsed :: Journal -> [AccountName]
journalAccountNamesDeclaredOrUsed :: Journal -> [AccountName]
journalAccountNamesDeclaredOrUsed Journal
j = Set AccountName -> [AccountName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set AccountName -> [AccountName])
-> Set AccountName -> [AccountName]
forall a b. (a -> b) -> a -> b
$ ([AccountName] -> Set AccountName)
-> [[AccountName]] -> Set AccountName
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [AccountName] -> Set AccountName
forall a. Ord a => [a] -> Set a
S.fromList
    [Journal -> [AccountName]
journalAccountNamesDeclared Journal
j, 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 Journal
j = Set AccountName -> [AccountName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set AccountName -> [AccountName])
-> Set AccountName -> [AccountName]
forall a b. (a -> b) -> a -> b
$ ([AccountName] -> Set AccountName)
-> [[AccountName]] -> Set AccountName
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [AccountName] -> Set AccountName
forall a. Ord a => [a] -> Set a
S.fromList
    [Journal -> [AccountName]
journalAccountNamesDeclared Journal
j, [AccountName] -> [AccountName]
expandAccountNames ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ Journal -> [AccountName]
journalAccountNamesUsed 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]
journalAccountNamesDeclaredOrImplied

-- | Find up to N most similar and most recent transactions matching
-- the given transaction description and query. Transactions are
-- listed with their description's similarity score (see
-- compareDescriptions), sorted by highest score and then by date.
-- Only transactions with a similarity score greater than a minimum
-- threshold (currently 0) are returned.
journalTransactionsSimilarTo :: Journal -> Query -> Text -> Int -> [(Double,Transaction)]
journalTransactionsSimilarTo :: Journal -> Query -> AccountName -> Int -> [(Double, Transaction)]
journalTransactionsSimilarTo Journal{[Transaction]
jtxns :: [Transaction]
jtxns :: Journal -> [Transaction]
jtxns} Query
q AccountName
desc Int
n =
  Int -> [(Double, Transaction)] -> [(Double, Transaction)]
forall a. Int -> [a] -> [a]
take Int
n ([(Double, Transaction)] -> [(Double, Transaction)])
-> [(Double, Transaction)] -> [(Double, Transaction)]
forall a b. (a -> b) -> a -> b
$
  ((Double, Transaction) -> (Double, Transaction) -> Ordering)
-> [(Double, Transaction)] -> [(Double, Transaction)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Double
s1,Transaction
t1) (Double
s2,Transaction
t2) -> (Double, Day) -> (Double, Day) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Double
s2,Transaction -> Day
tdate Transaction
t2) (Double
s1,Transaction -> Day
tdate Transaction
t1)) ([(Double, Transaction)] -> [(Double, Transaction)])
-> [(Double, Transaction)] -> [(Double, Transaction)]
forall a b. (a -> b) -> a -> b
$
  ((Double, Transaction) -> Bool)
-> [(Double, Transaction)] -> [(Double, Transaction)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
threshold)(Double -> Bool)
-> ((Double, Transaction) -> Double)
-> (Double, Transaction)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Double, Transaction) -> Double
forall a b. (a, b) -> a
fst)
  [(AccountName -> AccountName -> Double
compareDescriptions AccountName
desc (AccountName -> Double) -> AccountName -> Double
forall a b. (a -> b) -> a -> b
$ Transaction -> AccountName
tdescription Transaction
t, Transaction
t) | Transaction
t <- [Transaction]
jtxns, Query
q Query -> Transaction -> Bool
`matchesTransaction` Transaction
t]
  where
    threshold :: Double
threshold = Double
0

-- | Return a similarity score from 0 to 1.5 for two transaction descriptions. 
-- This is based on compareStrings, with the following modifications:
--
-- - numbers are stripped out before measuring similarity
--
-- - if the (unstripped) first description appears in its entirety within the second,
--   the score is boosted by 0.5.
--
compareDescriptions :: Text -> Text -> Double
compareDescriptions :: AccountName -> AccountName -> Double
compareDescriptions AccountName
a AccountName
b =
  (if AccountName
a AccountName -> AccountName -> Bool
`T.isInfixOf` AccountName
b then (Double
0.5Double -> Double -> Double
forall a. Num a => a -> a -> a
+) else Double -> Double
forall a. a -> a
id) (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$
  String -> String -> Double
compareStrings (AccountName -> String
simplify AccountName
a) (AccountName -> String
simplify AccountName
b)
  where
    simplify :: AccountName -> String
simplify = AccountName -> String
T.unpack (AccountName -> String)
-> (AccountName -> AccountName) -> AccountName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DecimalMark -> Bool) -> AccountName -> AccountName
T.filter (Bool -> Bool
not(Bool -> Bool) -> (DecimalMark -> Bool) -> DecimalMark -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.DecimalMark -> Bool
isDigit)

-- | Return a similarity score from 0 to 1 for two strings.  This
-- was based on Simon White's string similarity algorithm
-- (http://www.catalysoft.com/articles/StrikeAMatch.html), later found
-- to be https://en.wikipedia.org/wiki/S%C3%B8rensen%E2%80%93Dice_coefficient,
-- and modified to handle short strings better.
-- Todo: check out http://nlp.fi.muni.cz/raslan/2008/raslan08.pdf#page=14 .
compareStrings :: String -> String -> Double
compareStrings :: String -> String -> Double
compareStrings String
"" String
"" = Double
1
compareStrings [DecimalMark
_] String
"" = Double
0
compareStrings String
"" [DecimalMark
_] = Double
0
compareStrings [DecimalMark
a] [DecimalMark
b] = if DecimalMark -> DecimalMark
toUpper DecimalMark
a DecimalMark -> DecimalMark -> Bool
forall a. Eq a => a -> a -> Bool
== DecimalMark -> DecimalMark
toUpper DecimalMark
b then Double
1 else Double
0
compareStrings String
s1 String
s2 = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
commonpairs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
totalpairs
  where
    pairs1 :: Set String
pairs1      = [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$ String -> [String]
wordLetterPairs (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ShowS
uppercase String
s1
    pairs2 :: Set String
pairs2      = [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$ String -> [String]
wordLetterPairs (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ShowS
uppercase String
s2
    commonpairs :: Double
commonpairs = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Set String -> Int
forall a. Set a -> Int
S.size (Set String -> Int) -> Set String -> Int
forall a b. (a -> b) -> a -> b
$ Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set String
pairs1 Set String
pairs2
    totalpairs :: Double
totalpairs  = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Set String -> Int
forall a. Set a -> Int
S.size Set String
pairs1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set String -> Int
forall a. Set a -> Int
S.size Set String
pairs2

wordLetterPairs :: String -> [String]
wordLetterPairs :: String -> [String]
wordLetterPairs = (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
letterPairs ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words

letterPairs :: String -> [String]
letterPairs :: String -> [String]
letterPairs (DecimalMark
a:DecimalMark
b:String
rest) = [DecimalMark
a,DecimalMark
b] String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
letterPairs (DecimalMark
bDecimalMark -> ShowS
forall a. a -> [a] -> [a]
:String
rest)
letterPairs String
_ = []

-- queries for standard account types

-- | Get a query for accounts of the specified types in this journal. 
-- Account types include Asset, Liability, Equity, Revenue, Expense, Cash.
-- For each type, if no accounts were declared with this type, the query 
-- will instead match accounts with names matched by the case-insensitive 
-- regular expression provided as a fallback.
-- The query will match all accounts which were declared as one of
-- these types (by account directives with the type: tag), plus all their 
-- subaccounts which have not been declared as some other type.
journalAccountTypeQuery :: [AccountType] -> Regexp -> Journal -> Query
journalAccountTypeQuery :: [AccountType] -> Regexp -> Journal -> Query
journalAccountTypeQuery [AccountType]
atypes Regexp
fallbackregex Journal{Map AccountType [AccountName]
jdeclaredaccounttypes :: Map AccountType [AccountName]
jdeclaredaccounttypes :: Journal -> Map AccountType [AccountName]
jdeclaredaccounttypes} =
  let
    [AccountName]
declaredacctsoftype :: [AccountName] =
      [[AccountName]] -> [AccountName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[AccountName]] -> [AccountName])
-> [[AccountName]] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ (AccountType -> Maybe [AccountName])
-> [AccountType] -> [[AccountName]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (AccountType -> Map AccountType [AccountName] -> Maybe [AccountName]
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map AccountType [AccountName]
jdeclaredaccounttypes) [AccountType]
atypes
  in case [AccountName]
declaredacctsoftype of
    [] -> Regexp -> Query
Acct Regexp
fallbackregex
    [AccountName]
as -> [Query] -> Query
And ([Query] -> Query) -> [Query] -> Query
forall a b. (a -> b) -> a -> b
$ [Query] -> Query
Or [Query]
acctnameRegexes Query -> [Query] -> [Query]
forall a. a -> [a] -> [a]
: if [Query] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Query]
differentlyTypedRegexes then [] else [ Query -> Query
Not (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ [Query] -> Query
Or [Query]
differentlyTypedRegexes ]
      where
        -- 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.
        acctnameRegexes :: [Query]
acctnameRegexes = (AccountName -> Query) -> [AccountName] -> [Query]
forall a b. (a -> b) -> [a] -> [b]
map (Regexp -> Query
Acct (Regexp -> Query)
-> (AccountName -> Regexp) -> AccountName -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> Regexp
accountNameToAccountRegex) [AccountName]
as
        differentlyTypedRegexes :: [Query]
differentlyTypedRegexes = (AccountName -> Query) -> [AccountName] -> [Query]
forall a b. (a -> b) -> [a] -> [b]
map (Regexp -> Query
Acct (Regexp -> Query)
-> (AccountName -> Regexp) -> AccountName -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> Regexp
accountNameToAccountRegex) [AccountName]
differentlytypedsubs

        differentlytypedsubs :: [AccountName]
differentlytypedsubs = [[AccountName]] -> [AccountName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [[AccountName]
subs | (AccountType
t,[AccountName]
bs) <- Map AccountType [AccountName] -> [(AccountType, [AccountName])]
forall k a. Map k a -> [(k, a)]
M.toList Map AccountType [AccountName]
jdeclaredaccounttypes
              , AccountType
t AccountType -> [AccountType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [AccountType]
atypes
              , 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 (or Cash, a subtype of 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 Journal
j = 
  [Query] -> Query
Or [
     [AccountType] -> Regexp -> Journal -> Query
journalAccountTypeQuery [AccountType
Asset] (AccountName -> Regexp
toRegexCI' AccountName
"^assets?(:|$)") Journal
j
    ,Journal -> Query
journalCashAccountOnlyQuery Journal
j
  ]

-- | A query for accounts in this journal which have been
-- declared as Asset (and not Cash) by account directives, 
-- or otherwise for accounts with names matched by the case-insensitive 
-- regular expression @^assets?(:|$)@.
journalAssetNonCashAccountQuery :: Journal -> Query
journalAssetNonCashAccountQuery :: Journal -> Query
journalAssetNonCashAccountQuery = [AccountType] -> Regexp -> Journal -> Query
journalAccountTypeQuery [AccountType
Asset] (AccountName -> Regexp
toRegexCI' AccountName
"^assets?(:|$)")

-- | A query for Cash (liquid asset) accounts in this journal, ie accounts
-- declared as Cash by account directives, or otherwise Asset accounts whose 
-- names do not include the case-insensitive regular expression 
-- @(investment|receivable|:A/R|:fixed)@.
journalCashAccountQuery  :: Journal -> Query
journalCashAccountQuery :: Journal -> Query
journalCashAccountQuery Journal
j =
  case AccountType -> Map AccountType [AccountName] -> Maybe [AccountName]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AccountType
Cash (Journal -> Map AccountType [AccountName]
jdeclaredaccounttypes Journal
j) of
    Just [AccountName]
_  -> Journal -> Query
journalCashAccountOnlyQuery Journal
j
    Maybe [AccountName]
Nothing ->
      -- no Cash accounts are declared; query for Asset accounts and exclude some of them
      [Query] -> Query
And [ Journal -> Query
journalAssetNonCashAccountQuery Journal
j, Query -> Query
Not (Query -> Query) -> (Regexp -> Query) -> Regexp -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regexp -> Query
Acct (Regexp -> Query) -> Regexp -> Query
forall a b. (a -> b) -> a -> b
$ AccountName -> Regexp
toRegexCI' AccountName
"(investment|receivable|:A/R|:fixed)" ]

-- | A query for accounts in this journal specifically declared as Cash by 
-- account directives, or otherwise the None query.
journalCashAccountOnlyQuery  :: Journal -> Query
journalCashAccountOnlyQuery :: Journal -> Query
journalCashAccountOnlyQuery Journal
j = 
  case AccountType -> Map AccountType [AccountName] -> Maybe [AccountName]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AccountType
Cash (Journal -> Map AccountType [AccountName]
jdeclaredaccounttypes Journal
j) of
    Just [AccountName]
_  -> 
      -- Cash accounts are declared; get a query for them (the fallback regex won't be used)
      [AccountType] -> Regexp -> Journal -> Query
journalAccountTypeQuery [AccountType
Cash] Regexp
forall a. a
notused Journal
j
        where notused :: a
notused = String -> a
forall a. String -> a
error' String
"journalCashAccountOnlyQuery: this should not have happened!"  -- PARTIAL:
    Maybe [AccountName]
Nothing -> Query
None

-- | 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] -> Regexp -> Journal -> Query
journalAccountTypeQuery [AccountType
Liability] (AccountName -> Regexp
toRegexCI' AccountName
"^(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] -> Regexp -> Journal -> Query
journalAccountTypeQuery [AccountType
Equity] (AccountName -> Regexp
toRegexCI' AccountName
"^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] -> Regexp -> Journal -> Query
journalAccountTypeQuery [AccountType
Revenue] (AccountName -> Regexp
toRegexCI' AccountName
"^(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
-- @^expenses?(:|$)@.
journalExpenseAccountQuery  :: Journal -> Query
journalExpenseAccountQuery :: Journal -> Query
journalExpenseAccountQuery = [AccountType] -> Regexp -> Journal -> Query
journalAccountTypeQuery [AccountType
Expense] (AccountName -> Regexp
toRegexCI' AccountName
"^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 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 Journal
j = [Query] -> Query
Or [Journal -> Query
journalRevenueAccountQuery Journal
j
                                        ,Journal -> Query
journalExpenseAccountQuery Journal
j
                                        ]

-- 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 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 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}

-- | Keep only postings which do not match the query expression, but for which a related posting does.
-- This can leave unbalanced transactions.
filterJournalRelatedPostings :: Query -> Journal -> Journal
filterJournalRelatedPostings :: Query -> Journal -> Journal
filterJournalRelatedPostings 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
filterTransactionRelatedPostings Query
q) [Transaction]
ts}

-- | Within each posting's amount, keep only the parts matching the query, and
-- remove any postings with all amounts removed.
-- This can leave unbalanced transactions.
filterJournalAmounts :: Query -> Journal -> Journal
filterJournalAmounts :: Query -> Journal -> Journal
filterJournalAmounts 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, and remove any postings with all amounts removed.
-- This can leave the transaction unbalanced.
filterTransactionAmounts :: Query -> Transaction -> Transaction
filterTransactionAmounts :: Query -> Transaction -> Transaction
filterTransactionAmounts Query
q t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> Maybe Posting) -> [Posting] -> [Posting]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Query -> Posting -> Maybe Posting
filterPostingAmount Query
q) [Posting]
ps}

-- | Filter out all parts of this posting's amount which do not match the query, and remove the posting
-- if this removes all amounts.
filterPostingAmount :: Query -> Posting -> Maybe Posting
filterPostingAmount :: Query -> Posting -> Maybe Posting
filterPostingAmount Query
q p :: Posting
p@Posting{pamount :: Posting -> MixedAmount
pamount=MixedAmount
as}
  | Map MixedAmountKey Amount -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map MixedAmountKey Amount
newamt = Maybe Posting
forall a. Maybe a
Nothing
  | Bool
otherwise   = Posting -> Maybe Posting
forall a. a -> Maybe a
Just Posting
p{pamount :: MixedAmount
pamount=Map MixedAmountKey Amount -> MixedAmount
Mixed Map MixedAmountKey Amount
newamt}
  where
    Mixed Map MixedAmountKey Amount
newamt = (Amount -> Bool) -> MixedAmount -> MixedAmount
filterMixedAmount (Query
q Query -> Amount -> Bool
`matchesAmount`) MixedAmount
as

filterTransactionPostings :: Query -> Transaction -> Transaction
filterTransactionPostings :: Query -> Transaction -> Transaction
filterTransactionPostings 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}

filterTransactionRelatedPostings :: Query -> Transaction -> Transaction
filterTransactionRelatedPostings :: Query -> Transaction -> Transaction
filterTransactionRelatedPostings Query
q t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} =
    Transaction
t{tpostings :: [Posting]
tpostings=if [Posting] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Posting]
matches then [] else [Posting]
ps [Posting] -> [Posting] -> [Posting]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Posting]
matches}
  where matches :: [Posting]
matches = (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Posting -> Bool
matchesPosting Query
q) [Posting]
ps

-- | Apply a transformation to a journal's transactions.
journalMapTransactions :: (Transaction -> Transaction) -> Journal -> Journal
journalMapTransactions :: (Transaction -> Transaction) -> Journal -> Journal
journalMapTransactions 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.
journalMapPostings :: (Posting -> Posting) -> Journal -> Journal
journalMapPostings :: (Posting -> Posting) -> Journal -> Journal
journalMapPostings 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
transactionMapPostings Posting -> Posting
f) [Transaction]
ts}

-- | Apply a transformation to a journal's posting amounts.
journalMapPostingAmounts :: (MixedAmount -> MixedAmount) -> Journal -> Journal
journalMapPostingAmounts :: (MixedAmount -> MixedAmount) -> Journal -> Journal
journalMapPostingAmounts MixedAmount -> MixedAmount
f = (Posting -> Posting) -> Journal -> Journal
journalMapPostings ((MixedAmount -> MixedAmount) -> Posting -> Posting
postingTransformAmount MixedAmount -> MixedAmount
f)

{-
-------------------------------------------------------------------------------
-- 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 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 :: POSIXTime -> Journal -> Journal
journalSetLastReadTime :: POSIXTime -> Journal -> Journal
journalSetLastReadTime POSIXTime
t Journal
j = Journal
j{ jlastreadtime :: POSIXTime
jlastreadtime = POSIXTime
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 c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Year
i Transaction
t -> Transaction
t{tindex :: Year
tindex=Year
i}) [Year
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 (\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). Or if a modifier rule fails to parse,
-- return the error message. A reference date is provided to help interpret
-- relative dates in transaction modifier queries.
journalModifyTransactions :: Day -> Journal -> Either String Journal
journalModifyTransactions :: Day -> Journal -> Either String Journal
journalModifyTransactions Day
d Journal
j =
    case Map AccountName AmountStyle
-> Day
-> [TransactionModifier]
-> [Transaction]
-> Either String [Transaction]
modifyTransactions (Journal -> Map AccountName AmountStyle
journalCommodityStyles Journal
j) Day
d (Journal -> [TransactionModifier]
jtxnmodifiers Journal
j) (Journal -> [Transaction]
jtxns Journal
j) of
      Right [Transaction]
ts -> Journal -> Either String Journal
forall a b. b -> Either a b
Right Journal
j{jtxns :: [Transaction]
jtxns=[Transaction]
ts}
      Left String
err -> String -> Either String Journal
forall a b. a -> Either a b
Left String
err

--

-- | Choose and apply a consistent display style to the posting
-- amounts in each commodity (see journalCommodityStyles).
-- Can return an error message eg if inconsistent number formats are found.
journalApplyCommodityStyles :: Journal -> Either String Journal
journalApplyCommodityStyles :: Journal -> Either String Journal
journalApplyCommodityStyles = (Journal -> Journal)
-> Either String Journal -> Either String Journal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Journal -> Journal
fixjournal (Either String Journal -> Either String Journal)
-> (Journal -> Either String Journal)
-> Journal
-> Either String Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Either String Journal
journalInferCommodityStyles
  where
    fixjournal :: Journal -> Journal
fixjournal j :: Journal
j@Journal{jpricedirectives :: Journal -> [PriceDirective]
jpricedirectives=[PriceDirective]
pds} =
        (Posting -> Posting) -> Journal -> Journal
journalMapPostings (Map AccountName AmountStyle -> Posting -> Posting
postingApplyCommodityStyles Map AccountName AmountStyle
styles) Journal
j{jpricedirectives :: [PriceDirective]
jpricedirectives=(PriceDirective -> PriceDirective)
-> [PriceDirective] -> [PriceDirective]
forall a b. (a -> b) -> [a] -> [b]
map PriceDirective -> PriceDirective
fixpricedirective [PriceDirective]
pds}
      where
        styles :: Map AccountName AmountStyle
styles = Journal -> Map AccountName AmountStyle
journalCommodityStyles Journal
j
        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 the canonical amount styles for this journal, whether (in order of precedence):
-- set globally in InputOpts,
-- declared by commodity directives, 
-- declared by a default commodity (D) directive, 
-- or inferred from posting amounts, 
-- as a map from symbol to style. 
-- Styles from directives are assumed to specify the decimal mark.
journalCommodityStyles :: Journal -> M.Map CommoditySymbol AmountStyle
journalCommodityStyles :: Journal -> Map AccountName AmountStyle
journalCommodityStyles Journal
j =
  -- XXX could be some redundancy here, cf journalStyleInfluencingAmounts
  Map AccountName AmountStyle
globalstyles Map AccountName AmountStyle
-> Map AccountName AmountStyle -> Map AccountName AmountStyle
forall a. Semigroup a => a -> a -> a
<> Map AccountName AmountStyle
declaredstyles Map AccountName AmountStyle
-> Map AccountName AmountStyle -> Map AccountName AmountStyle
forall a. Semigroup a => a -> a -> a
<> Map AccountName AmountStyle
defaultcommoditystyle Map AccountName AmountStyle
-> Map AccountName AmountStyle -> Map AccountName AmountStyle
forall a. Semigroup a => a -> a -> a
<> Map AccountName AmountStyle
inferredstyles
  where
    globalstyles :: Map AccountName AmountStyle
globalstyles          = Journal -> Map AccountName AmountStyle
jglobalcommoditystyles Journal
j
    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
    defaultcommoditystyle :: Map AccountName AmountStyle
defaultcommoditystyle = [(AccountName, AmountStyle)] -> Map AccountName AmountStyle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(AccountName, AmountStyle)] -> Map AccountName AmountStyle)
-> [(AccountName, AmountStyle)] -> Map AccountName AmountStyle
forall a b. (a -> b) -> a -> b
$ [Maybe (AccountName, AmountStyle)] -> [(AccountName, AmountStyle)]
forall a. [Maybe a] -> [a]
catMaybes [Journal -> Maybe (AccountName, AmountStyle)
jparsedefaultcommodity 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 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
$ Journal -> [Amount]
journalStyleInfluencingAmounts Journal
j of
    Left String
e   -> String -> Either String Journal
forall a b. a -> Either a b
Left String
e
    Right Map AccountName AmountStyle
cs -> Journal -> Either String Journal
forall a b. b -> Either a b
Right Journal
j{jinferredcommodities :: Map AccountName AmountStyle
jinferredcommodities = String
-> Map AccountName AmountStyle -> Map AccountName AmountStyle
forall a. Show a => String -> a -> a
dbg7 String
"journalInferCommodityStyles" Map AccountName AmountStyle
cs}

-- | Given a list of amounts, in parse order (roughly speaking; see journalStyleInfluencingAmounts),
-- 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 =
    Map AccountName AmountStyle
-> Either String (Map AccountName AmountStyle)
forall a b. b -> Either a b
Right (Map AccountName AmountStyle
 -> Either String (Map AccountName AmountStyle))
-> ([Amount] -> Map AccountName AmountStyle)
-> [Amount]
-> Either String (Map AccountName AmountStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount
 -> Map AccountName AmountStyle -> Map AccountName AmountStyle)
-> Map AccountName AmountStyle
-> [Amount]
-> Map AccountName AmountStyle
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Amount
a -> (AmountStyle -> AmountStyle -> AmountStyle)
-> AccountName
-> AmountStyle
-> Map AccountName AmountStyle
-> Map AccountName AmountStyle
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith AmountStyle -> AmountStyle -> AmountStyle
canonicalStyle (Amount -> AccountName
acommodity Amount
a) (Amount -> AmountStyle
astyle Amount
a)) Map AccountName AmountStyle
forall a. Monoid a => a
mempty

-- | Given a list of amount styles (assumed to be from parsed amounts
-- in a single commodity), in parse order, choose a canonical style.
canonicalStyleFrom :: [AmountStyle] -> AmountStyle
canonicalStyleFrom :: [AmountStyle] -> AmountStyle
canonicalStyleFrom = (AmountStyle -> AmountStyle -> AmountStyle)
-> AmountStyle -> [AmountStyle] -> AmountStyle
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' AmountStyle -> AmountStyle -> AmountStyle
canonicalStyle AmountStyle
amountstyle

-- TODO: should probably detect and report inconsistencies here.
-- Though, we don't have the info for a good error message, so maybe elsewhere.
-- | Given a pair of AmountStyles, choose a canonical style.
-- This is:
-- the general style of the first amount,
-- with the first digit group style seen,
-- with the maximum precision of all.
canonicalStyle :: AmountStyle -> AmountStyle -> AmountStyle
canonicalStyle :: AmountStyle -> AmountStyle -> AmountStyle
canonicalStyle AmountStyle
a AmountStyle
b = AmountStyle
a{asprecision :: AmountPrecision
asprecision=AmountPrecision
prec, asdecimalpoint :: Maybe DecimalMark
asdecimalpoint=Maybe DecimalMark
decmark, asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
mgrps}
  where
    -- precision is maximum of all precisions
    prec :: AmountPrecision
prec = AmountPrecision -> AmountPrecision -> AmountPrecision
forall a. Ord a => a -> a -> a
max (AmountStyle -> AmountPrecision
asprecision AmountStyle
a) (AmountStyle -> AmountPrecision
asprecision AmountStyle
b)
    -- identify the digit group mark (& group sizes)
    mgrps :: Maybe DigitGroupStyle
mgrps = AmountStyle -> Maybe DigitGroupStyle
asdigitgroups AmountStyle
a Maybe DigitGroupStyle
-> Maybe DigitGroupStyle -> Maybe DigitGroupStyle
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AmountStyle -> Maybe DigitGroupStyle
asdigitgroups AmountStyle
b
    -- 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 :: DecimalMark
defdecmark = case Maybe DigitGroupStyle
mgrps of
        Just (DigitGroups DecimalMark
'.' [Word8]
_) -> DecimalMark
','
        Maybe DigitGroupStyle
_                        -> DecimalMark
'.'
    -- 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 :: Maybe DecimalMark
decmark = case Maybe DigitGroupStyle
mgrps of
        Just DigitGroupStyle
_  -> DecimalMark -> Maybe DecimalMark
forall a. a -> Maybe a
Just DecimalMark
defdecmark
        Maybe DigitGroupStyle
Nothing -> AmountStyle -> Maybe DecimalMark
asdecimalpoint AmountStyle
a Maybe DecimalMark -> Maybe DecimalMark -> Maybe DecimalMark
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AmountStyle -> Maybe DecimalMark
asdecimalpoint AmountStyle
b Maybe DecimalMark -> Maybe DecimalMark -> Maybe DecimalMark
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DecimalMark -> Maybe DecimalMark
forall a. a -> Maybe a
Just DecimalMark
defdecmark

-- -- | 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 = mapMixedAmount fixamount
--         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

-- | Infer transaction-implied market prices from commodity-exchanging
-- transactions, if any. It's best to call this after transactions have
-- been balanced and posting amounts have appropriate prices attached.
journalInferMarketPricesFromTransactions :: Journal -> Journal
journalInferMarketPricesFromTransactions :: Journal -> Journal
journalInferMarketPricesFromTransactions Journal
j =
  Journal
j{jinferredmarketprices :: [MarketPrice]
jinferredmarketprices =
       String -> [MarketPrice] -> [MarketPrice]
forall a. Show a => String -> a -> a
dbg4 String
"jinferredmarketprices" ([MarketPrice] -> [MarketPrice]) -> [MarketPrice] -> [MarketPrice]
forall a b. (a -> b) -> a -> b
$
       (Posting -> Maybe MarketPrice) -> [Posting] -> [MarketPrice]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Posting -> Maybe MarketPrice
postingInferredmarketPrice ([Posting] -> [MarketPrice]) -> [Posting] -> [MarketPrice]
forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings Journal
j
   }

-- | Make a market price equivalent to this posting's amount's unit
-- price, if any. If the posting amount is multicommodity, only the
-- first commodity amount is considered.
postingInferredmarketPrice :: Posting -> Maybe MarketPrice
postingInferredmarketPrice :: Posting -> Maybe MarketPrice
postingInferredmarketPrice p :: Posting
p@Posting{MixedAmount
pamount :: MixedAmount
pamount :: Posting -> MixedAmount
pamount} =
    -- convert any total prices to unit prices
    case MixedAmount -> [Amount]
amountsRaw (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ MixedAmount -> MixedAmount
mixedAmountTotalPriceToUnitPrice MixedAmount
pamount of
      Amount{acommodity :: Amount -> AccountName
acommodity=AccountName
fromcomm, aprice :: Amount -> Maybe AmountPrice
aprice = Just (UnitPrice Amount{acommodity :: Amount -> AccountName
acommodity=AccountName
tocomm, aquantity :: Amount -> Quantity
aquantity=Quantity
rate})}:[Amount]
_ ->
        MarketPrice -> Maybe MarketPrice
forall a. a -> Maybe a
Just MarketPrice :: Day -> AccountName -> AccountName -> Quantity -> MarketPrice
MarketPrice {
           mpdate :: Day
mpdate = Posting -> Day
postingDate Posting
p
          ,mpfrom :: AccountName
mpfrom = AccountName
fromcomm
          ,mpto :: AccountName
mpto   = AccountName
tocomm
          ,mprate :: Quantity
mprate = Quantity
rate
          }
      [Amount]
_ -> Maybe MarketPrice
forall a. Maybe 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 amounts in this journal which can
-- influence canonical amount display styles. Those amounts are, in
-- the following order:
--
-- * amounts in market price (P) directives (in parse order)
-- * posting amounts in transactions (in parse order)
-- * the amount in the final default commodity (D) directive
--
-- Transaction price amounts (posting amounts' aprice field) are not included.
--
journalStyleInfluencingAmounts :: Journal -> [Amount]
journalStyleInfluencingAmounts :: Journal -> [Amount]
journalStyleInfluencingAmounts Journal
j =
  String -> [Amount] -> [Amount]
forall a. Show a => String -> a -> a
dbg7 String
"journalStyleInfluencingAmounts" ([Amount] -> [Amount]) -> [Amount] -> [Amount]
forall a b. (a -> b) -> a -> b
$
  [Maybe Amount] -> [Amount]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Amount] -> [Amount]) -> [Maybe Amount] -> [Amount]
forall a b. (a -> b) -> a -> b
$ [[Maybe Amount]] -> [Maybe Amount]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
   [Maybe Amount
mdefaultcommodityamt]
  ,(PriceDirective -> Maybe Amount)
-> [PriceDirective] -> [Maybe Amount]
forall a b. (a -> b) -> [a] -> [b]
map (Amount -> Maybe Amount
forall a. a -> Maybe a
Just (Amount -> Maybe Amount)
-> (PriceDirective -> Amount) -> PriceDirective -> Maybe Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PriceDirective -> Amount
pdamount) ([PriceDirective] -> [Maybe Amount])
-> [PriceDirective] -> [Maybe Amount]
forall a b. (a -> b) -> a -> b
$ Journal -> [PriceDirective]
jpricedirectives Journal
j
  ,(Amount -> Maybe Amount) -> [Amount] -> [Maybe Amount]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> Maybe Amount
forall a. a -> Maybe a
Just ([Amount] -> [Maybe Amount])
-> ([Posting] -> [Amount]) -> [Posting] -> [Maybe Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posting -> [Amount]) -> [Posting] -> [Amount]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (MixedAmount -> [Amount]
amountsRaw (MixedAmount -> [Amount])
-> (Posting -> MixedAmount) -> Posting -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> MixedAmount
pamount) ([Posting] -> [Maybe Amount]) -> [Posting] -> [Maybe Amount]
forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings Journal
j
  ]
  where
    -- D's amount style isn't actually stored as an amount, make it into one
    mdefaultcommodityamt :: Maybe Amount
mdefaultcommodityamt =
      case Journal -> Maybe (AccountName, AmountStyle)
jparsedefaultcommodity Journal
j of
        Just (AccountName
symbol,AmountStyle
style) -> Amount -> Maybe Amount
forall a. a -> Maybe a
Just Amount
nullamt{acommodity :: AccountName
acommodity=AccountName
symbol,astyle :: AmountStyle
astyle=AmountStyle
style}
        Maybe (AccountName, AmountStyle)
Nothing -> Maybe Amount
forall a. Maybe a
Nothing

-- overcomplicated/unused amount traversal stuff
--
-- | Get an ordered list of 'AmountStyle's from the amounts in this
-- journal which influence canonical amount display styles. See
-- traverseJournalAmounts.
-- journalAmounts :: Journal -> [Amount]
-- journalAmounts = getConst . traverseJournalAmounts (Const . (:[]))
--
-- | Apply a transformation to the journal amounts traversed by traverseJournalAmounts.
-- overJournalAmounts :: (Amount -> Amount) -> Journal -> Journal
-- overJournalAmounts f = runIdentity . traverseJournalAmounts (Identity . f)
--
-- | A helper that traverses over most amounts in the journal,
-- in particular the ones which influence canonical amount display styles,
-- processing them with the given applicative function.
--
-- These include, in the following order:
--
-- * the amount in the final default commodity (D) directive
-- * amounts in market price (P) directives (in parse order)
-- * posting amounts in transactions (in parse order)
--
-- Transaction price amounts, which may be embedded in posting amounts
-- (the aprice field), are left intact but not traversed/processed.
--
-- traverseJournalAmounts :: Applicative f => (Amount -> f Amount) -> Journal -> f Journal
-- traverseJournalAmounts f j =
--   recombine <$> (traverse . dcamt) f (jparsedefaultcommodity j)
--             <*> (traverse . pdamt) f (jpricedirectives j)
--             <*> (traverse . tps . traverse . pamt . amts . traverse) f (jtxns j)
--   where
--     recombine pds txns = j { jpricedirectives = pds, jtxns = txns }
--     -- a bunch of traversals
--     dcamt g pd         = (\mdc -> case mdc of Nothing -> Nothing
--                                               Just ((c,stpd{pdamount =amt}
--                          ) <$> g (pdamount pd)
--     pdamt g pd         = (\amt -> pd{pdamount =amt}) <$> g (pdamount pd)
--     tps   g t          = (\ps  -> t {tpostings=ps }) <$> g (tpostings t)
--     pamt  g p          = (\amt -> p {pamount  =amt}) <$> g (pamount p)
--     amts  g (Mixed as) = Mixed <$> g 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 Bool
False = Maybe WhichDate -> Journal -> DateSpan
journalDateSpanHelper (Maybe WhichDate -> Journal -> DateSpan)
-> Maybe WhichDate -> Journal -> DateSpan
forall a b. (a -> b) -> a -> b
$ WhichDate -> Maybe WhichDate
forall a. a -> Maybe a
Just WhichDate
PrimaryDate
journalDateSpan Bool
True  = Maybe WhichDate -> Journal -> DateSpan
journalDateSpanHelper (Maybe WhichDate -> Journal -> DateSpan)
-> Maybe WhichDate -> Journal -> DateSpan
forall a b. (a -> b) -> a -> b
$ WhichDate -> Maybe WhichDate
forall a. a -> Maybe a
Just WhichDate
SecondaryDate

-- | The fully specified date span enclosing the dates (primary and secondary)
-- of all this journal's transactions and postings, or DateSpan Nothing Nothing
-- if there are none.
journalDateSpanBothDates :: Journal -> DateSpan
journalDateSpanBothDates :: Journal -> DateSpan
journalDateSpanBothDates = Maybe WhichDate -> Journal -> DateSpan
journalDateSpanHelper Maybe WhichDate
forall a. Maybe a
Nothing

-- | A helper for journalDateSpan which takes Maybe WhichDate directly. Nothing
-- uses both primary and secondary dates.
journalDateSpanHelper :: Maybe WhichDate -> Journal -> DateSpan
journalDateSpanHelper :: Maybe WhichDate -> Journal -> DateSpan
journalDateSpanHelper Maybe WhichDate
whichdate Journal
j =
    Maybe Day -> Maybe Day -> DateSpan
DateSpan ([Day] -> Maybe Day
forall a. Ord a => [a] -> Maybe a
minimumMay [Day]
dates) (Year -> Day -> Day
addDays Year
1 (Day -> Day) -> Maybe Day -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Day] -> Maybe Day
forall a. Ord a => [a] -> Maybe a
maximumMay [Day]
dates)
  where
    dates :: [Day]
dates    = [Day]
pdates [Day] -> [Day] -> [Day]
forall a. [a] -> [a] -> [a]
++ [Day]
tdates
    tdates :: [Day]
tdates   = (Transaction -> [Day]) -> [Transaction] -> [Day]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Day]
gettdate [Transaction]
ts
    pdates :: [Day]
pdates   = (Posting -> [Day]) -> [Posting] -> [Day]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Posting -> [Day]
getpdate ([Posting] -> [Day]) -> [Posting] -> [Day]
forall a b. (a -> b) -> a -> b
$ (Transaction -> [Posting]) -> [Transaction] -> [Posting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Posting]
tpostings [Transaction]
ts
    ts :: [Transaction]
ts       = Journal -> [Transaction]
jtxns Journal
j
    gettdate :: Transaction -> [Day]
gettdate Transaction
t = case Maybe WhichDate
whichdate of
        Just WhichDate
PrimaryDate   -> [Transaction -> Day
tdate Transaction
t]
        Just WhichDate
SecondaryDate -> [Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (Transaction -> Day
tdate Transaction
t) (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ Transaction -> Maybe Day
tdate2 Transaction
t]
        Maybe WhichDate
Nothing            -> Transaction -> Day
tdate Transaction
t Day -> [Day] -> [Day]
forall a. a -> [a] -> [a]
: Maybe Day -> [Day]
forall a. Maybe a -> [a]
maybeToList (Transaction -> Maybe Day
tdate2 Transaction
t)
    getpdate :: Posting -> [Day]
getpdate Posting
p = case Maybe WhichDate
whichdate of
        Just WhichDate
PrimaryDate   -> Maybe Day -> [Day]
forall a. Maybe a -> [a]
maybeToList (Maybe Day -> [Day]) -> Maybe Day -> [Day]
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Day
pdate Posting
p
        Just WhichDate
SecondaryDate -> Maybe Day -> [Day]
forall a. Maybe a -> [a]
maybeToList (Maybe Day -> [Day]) -> Maybe Day -> [Day]
forall a b. (a -> b) -> a -> b
$ Posting -> Maybe Day
pdate2 Posting
p Maybe Day -> Maybe Day -> Maybe Day
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Posting -> Maybe Day
pdate Posting
p
        Maybe WhichDate
Nothing            -> [Maybe Day] -> [Day]
forall a. [Maybe a] -> [a]
catMaybes [Posting -> Maybe Day
pdate Posting
p, Posting -> Maybe Day
pdate2 Posting
p]

-- | 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 Bool
secondary Journal
j = Maybe Day
b where DateSpan Maybe Day
b Maybe Day
_ = Bool -> Journal -> DateSpan
journalDateSpan Bool
secondary Journal
j

-- | The "exclusive end date" of this journal: the day following its latest transaction 
-- or posting date, or Nothing if there are none.
journalEndDate :: Bool -> Journal -> Maybe Day
journalEndDate :: Bool -> Journal -> Maybe Day
journalEndDate Bool
secondary Journal
j = Maybe Day
e where DateSpan Maybe Day
_ Maybe Day
e = Bool -> Journal -> DateSpan
journalDateSpan Bool
secondary Journal
j

-- | The latest of this journal's transaction and posting dates, or
-- Nothing if there are none.
journalLastDay :: Bool -> Journal -> Maybe Day
journalLastDay :: Bool -> Journal -> Maybe Day
journalLastDay Bool
secondary Journal
j = Year -> Day -> Day
addDays (-Year
1) (Day -> Day) -> Maybe Day -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Journal -> Maybe Day
journalEndDate 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 AccountName
fieldortagname 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 AccountName
fieldortagname 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 AccountName
fieldortagname 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 Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, AccountName
fieldortagname AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== AccountName
"code"        = Transaction -> AccountName
tcode Transaction
t
      | Just Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, AccountName
fieldortagname AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== AccountName
"description" = Transaction -> AccountName
tdescription Transaction
t
      | Just Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, AccountName
fieldortagname AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== AccountName
"payee"       = Transaction -> AccountName
transactionPayee Transaction
t
      | Just Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, AccountName
fieldortagname AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== AccountName
"note"        = Transaction -> AccountName
transactionNote Transaction
t
      | Just (AccountName
_, AccountName
value) <- AccountName -> Posting -> Maybe (AccountName, AccountName)
postingFindTag AccountName
fieldortagname Posting
p        = AccountName
value
      | Bool
otherwise                                                 = AccountName
""

postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue)
postingFindTag :: AccountName -> Posting -> Maybe (AccountName, AccountName)
postingFindTag AccountName
tagname 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

-- | Apply some account aliases to all posting account names in the journal, as described by accountNameApplyAliases.
-- This can fail due to a bad replacement pattern in a regular expression alias.
journalApplyAliases :: [AccountAlias] -> Journal -> Either RegexError Journal
-- short circuit the common case, just in case there's a performance impact from txnTieKnot etc.
journalApplyAliases :: [AccountAlias] -> Journal -> Either String Journal
journalApplyAliases [] Journal
j = Journal -> Either String Journal
forall a b. b -> Either a b
Right Journal
j
journalApplyAliases [AccountAlias]
aliases Journal
j = 
  case (Transaction -> Either String Transaction)
-> [Transaction] -> Either String [Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([AccountAlias] -> Transaction -> Either String Transaction
transactionApplyAliases [AccountAlias]
aliases) ([Transaction] -> Either String [Transaction])
-> [Transaction] -> Either String [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j of
    Right [Transaction]
ts -> Journal -> Either String Journal
forall a b. b -> Either a b
Right Journal
j{jtxns :: [Transaction]
jtxns = [Transaction]
ts}
    Left String
err -> String -> Either String Journal
forall a b. a -> Either a b
Left String
err

-- -- | 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 . amountSetPrecision maxprecision) (pdamount pd
--     )
--     ]

-- 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.
-- Provide an option to either use explicit amounts or missing amounts, for testing purposes.
--
-- 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

samplejournal :: Journal
samplejournal = Bool -> Journal
samplejournalMaybeExplicit Bool
True

samplejournalMaybeExplicit :: Bool -> Journal
samplejournalMaybeExplicit :: Bool -> Journal
samplejournalMaybeExplicit Bool
explicit = Journal
nulljournal
         {jtxns :: [Transaction]
jtxns = [
           Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Year
tindex=Year
0,
             tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
             tdate :: Day
tdate=Year -> Int -> Int -> Day
fromGregorian Year
2008 Int
01 Int
01,
             tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Unmarked,
             tcode :: AccountName
tcode=AccountName
"",
             tdescription :: AccountName
tdescription=AccountName
"income",
             tcomment :: AccountName
tcomment=AccountName
"",
             ttags :: [(AccountName, AccountName)]
ttags=[],
             tpostings :: [Posting]
tpostings=
                 [AccountName
"assets:bank:checking" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd Quantity
1
                 ,AccountName
"income:salary" AccountName -> Amount -> Posting
`post` if Bool
explicit then Quantity -> Amount
usd (-Quantity
1) else Amount
missingamt
                 ],
             tprecedingcomment :: AccountName
tprecedingcomment=AccountName
""
           }
          ,
           Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Year
tindex=Year
0,
             tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
             tdate :: Day
tdate=Year -> Int -> Int -> Day
fromGregorian Year
2008 Int
06 Int
01,
             tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Unmarked,
             tcode :: AccountName
tcode=AccountName
"",
             tdescription :: AccountName
tdescription=AccountName
"gift",
             tcomment :: AccountName
tcomment=AccountName
"",
             ttags :: [(AccountName, AccountName)]
ttags=[],
             tpostings :: [Posting]
tpostings=
                 [AccountName
"assets:bank:checking" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd Quantity
1
                 ,AccountName
"income:gifts" AccountName -> Amount -> Posting
`post` if Bool
explicit then Quantity -> Amount
usd (-Quantity
1) else Amount
missingamt
                 ],
             tprecedingcomment :: AccountName
tprecedingcomment=AccountName
""
           }
          ,
           Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Year
tindex=Year
0,
             tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
             tdate :: Day
tdate=Year -> Int -> Int -> Day
fromGregorian Year
2008 Int
06 Int
02,
             tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Unmarked,
             tcode :: AccountName
tcode=AccountName
"",
             tdescription :: AccountName
tdescription=AccountName
"save",
             tcomment :: AccountName
tcomment=AccountName
"",
             ttags :: [(AccountName, AccountName)]
ttags=[],
             tpostings :: [Posting]
tpostings=
                 [AccountName
"assets:bank:saving" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd Quantity
1
                 ,AccountName
"assets:bank:checking" AccountName -> Amount -> Posting
`post` if Bool
explicit then Quantity -> Amount
usd (-Quantity
1) else Amount
missingamt
                 ],
             tprecedingcomment :: AccountName
tprecedingcomment=AccountName
""
           }
          ,
           Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Year
tindex=Year
0,
             tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
             tdate :: Day
tdate=Year -> Int -> Int -> Day
fromGregorian Year
2008 Int
06 Int
03,
             tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Cleared,
             tcode :: AccountName
tcode=AccountName
"",
             tdescription :: AccountName
tdescription=AccountName
"eat & shop",
             tcomment :: AccountName
tcomment=AccountName
"",
             ttags :: [(AccountName, AccountName)]
ttags=[],
             tpostings :: [Posting]
tpostings=[AccountName
"expenses:food" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd Quantity
1
                       ,AccountName
"expenses:supplies" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd Quantity
1
                       ,AccountName
"assets:cash" AccountName -> Amount -> Posting
`post` if Bool
explicit then Quantity -> Amount
usd (-Quantity
2) else Amount
missingamt
                       ],
             tprecedingcomment :: AccountName
tprecedingcomment=AccountName
""
           }
          ,
           Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Year
tindex=Year
0,
             tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
             tdate :: Day
tdate=Year -> Int -> Int -> Day
fromGregorian Year
2008 Int
10 Int
01,
             tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Unmarked,
             tcode :: AccountName
tcode=AccountName
"",
             tdescription :: AccountName
tdescription=AccountName
"take a loan",
             tcomment :: AccountName
tcomment=AccountName
"",
             ttags :: [(AccountName, AccountName)]
ttags=[],
             tpostings :: [Posting]
tpostings=[AccountName
"assets:bank:checking" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd Quantity
1
                       ,AccountName
"liabilities:debts" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd (-Quantity
1)
                       ],
             tprecedingcomment :: AccountName
tprecedingcomment=AccountName
""
           }
          ,
           Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction :: Year
-> AccountName
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [(AccountName, AccountName)]
-> [Posting]
-> Transaction
Transaction {
             tindex :: Year
tindex=Year
0,
             tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
             tdate :: Day
tdate=Year -> Int -> Int -> Day
fromGregorian Year
2008 Int
12 Int
31,
             tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
             tstatus :: Status
tstatus=Status
Unmarked,
             tcode :: AccountName
tcode=AccountName
"",
             tdescription :: AccountName
tdescription=AccountName
"pay off",
             tcomment :: AccountName
tcomment=AccountName
"",
             ttags :: [(AccountName, AccountName)]
ttags=[],
             tpostings :: [Posting]
tpostings=[AccountName
"liabilities:debts" AccountName -> Amount -> Posting
`post` Quantity -> Amount
usd Quantity
1
                       ,AccountName
"assets:bank:checking" AccountName -> Amount -> Posting
`post` if Bool
explicit then Quantity -> Amount
usd (-Quantity
1) else Amount
missingamt
                       ],
             tprecedingcomment :: AccountName
tprecedingcomment=AccountName
""
           }
          ]
         }

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

   String -> Assertion -> TestTree
testCase String
"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 = Year -> Int -> Int -> Day
fromGregorian Year
2014 Int
02 Int
01
                              ,tpostings :: [Posting]
tpostings = [Posting
posting{pdate :: Maybe Day
pdate=Day -> Maybe Day
forall a. a -> Maybe a
Just (Year -> Int -> Int -> Day
fromGregorian Year
2014 Int
01 Int
10)}]
                              }
              ,Transaction
nulltransaction{tdate :: Day
tdate = Year -> Int -> Int -> Day
fromGregorian Year
2014 Int
09 Int
01
                              ,tpostings :: [Posting]
tpostings = [Posting
posting{pdate2 :: Maybe Day
pdate2=Day -> Maybe Day
forall a. a -> Maybe a
Just (Year -> Int -> Int -> Day
fromGregorian Year
2014 Int
10 Int
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 Year
2014 Int
1 Int
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 Year
2014 Int
10 Int
11))

  ,String -> [TestTree] -> TestTree
testGroup String
"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 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 Journal -> Query
qfunc = Query -> Journal -> [AccountName]
journalAccountNamesMatching (Journal -> Query
qfunc Journal
j) Journal
j
    in [String -> Assertion -> TestTree
testCase String
"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 String
"" [AccountName
"assets",AccountName
"assets:bank",AccountName
"assets:bank:checking",AccountName
"assets:bank:saving",AccountName
"assets:cash"]
         ((Journal -> Query) -> [AccountName]
namesfrom Journal -> Query
journalAssetAccountQuery)
       ,String -> Assertion -> TestTree
testCase String
"cash"        (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 String
"" [AccountName
"assets",AccountName
"assets:bank",AccountName
"assets:bank:checking",AccountName
"assets:bank:saving",AccountName
"assets:cash"]
         ((Journal -> Query) -> [AccountName]
namesfrom Journal -> Query
journalCashAccountQuery)
       ,String -> Assertion -> TestTree
testCase String
"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 String
"" [AccountName
"liabilities",AccountName
"liabilities:debts"]
         ((Journal -> Query) -> [AccountName]
namesfrom Journal -> Query
journalLiabilityAccountQuery)
       ,String -> Assertion -> TestTree
testCase String
"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 String
"" []
         ((Journal -> Query) -> [AccountName]
namesfrom Journal -> Query
journalEquityAccountQuery)
       ,String -> Assertion -> TestTree
testCase String
"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 String
"" [AccountName
"income",AccountName
"income:gifts",AccountName
"income:salary"]
         ((Journal -> Query) -> [AccountName]
namesfrom Journal -> Query
journalRevenueAccountQuery)
       ,String -> Assertion -> TestTree
testCase String
"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 String
"" [AccountName
"expenses",AccountName
"expenses:food",AccountName
"expenses:supplies"]
         ((Journal -> Query) -> [AccountName]
namesfrom Journal -> Query
journalExpenseAccountQuery)
       ]
  ]