{-# LANGUAGE CPP                 #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE Rank2Types          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE RecordWildCards     #-}

{-|

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,
  journalDbg,
  journalInferMarketPricesFromTransactions,
  journalInferCommodityStyles,
  journalStyleAmounts,
  commodityStylesFromAmounts,
  journalCommodityStyles,
  journalCommodityStylesWith,
  journalToCost,
  journalInferEquityFromCosts,
  journalTagCostsAndEquityAndMaybeInferCosts,
  journalReverse,
  journalSetLastReadTime,
  journalRenumberAccountDeclarations,
  journalPivot,
  -- * Filtering
  filterJournalTransactions,
  filterJournalPostings,
  filterJournalRelatedPostings,
  filterJournalAmounts,
  filterTransactionAmounts,
  filterTransactionPostings,
  filterTransactionPostingsExtra,
  filterTransactionRelatedPostings,
  filterPostingAmount,
  -- * Mapping
  journalMapTransactions,
  journalMapPostings,
  journalMapPostingAmounts,
  -- * Querying
  journalAccountNamesUsed,
  journalAccountNamesImplied,
  journalAccountNamesDeclared,
  journalAccountNamesDeclaredOrUsed,
  journalAccountNamesDeclaredOrImplied,
  journalLeafAccountNamesDeclared,
  journalAccountNames,
  journalLeafAccountNames,
  journalAccountNameTree,
  journalAccountTags,
  journalInheritedAccountTags,
  -- journalAmountAndPriceCommodities,
  -- journalAmountStyles,
  -- overJournalAmounts,
  -- traverseJournalAmounts,
  -- journalCanonicalCommodities,
  journalPayeesDeclared,
  journalPayeesUsed,
  journalPayeesDeclaredOrUsed,
  journalTagsDeclared,
  journalTagsUsed,
  journalTagsDeclaredOrUsed,
  journalCommoditiesDeclared,
  journalCommodities,
  journalDateSpan,
  journalDateSpanBothDates,
  journalStartDate,
  journalEndDate,
  journalLastDay,
  journalDescriptions,
  journalFilePath,
  journalFilePaths,
  journalTransactionAt,
  journalNextTransaction,
  journalPrevTransaction,
  journalPostings,
  journalPostingAmounts,
  showJournalAmountsDebug,
  journalTransactionsSimilarTo,
  -- * Account types
  journalAccountType,
  journalAccountTypes,
  journalAddAccountTypes,
  journalPostingsAddAccountTags,
  defaultBaseConversionAccount,
  -- journalPrices,
  journalBaseConversionAccount,
  journalConversionAccounts,
  -- * Misc
  canonicalStyleFrom,

  nulljournal,
  journalConcat,
  journalNumberTransactions,
  journalNumberAndTieTransactions,
  journalUntieTransactions,
  journalModifyTransactions,
  journalApplyAliases,
  dbgJournalAcctDeclOrder,
  -- * Tests
  samplejournal,
  samplejournalMaybeExplicit,
  tests_Journal
  --
)
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, sortBy, union, intercalate)
#if !MIN_VERSION_base(4,20,0)
import Data.List (foldl')
#endif
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, lastDef)
import Data.Time.Calendar (Day, addDays, fromGregorian, diffDays)
import Data.Time.Clock.POSIX (POSIXTime)
import Data.Tree (Tree(..), flatten)
import Text.Printf (printf)
import Text.Megaparsec (ParsecT)

import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.AccountName
import Hledger.Data.Amount
import Hledger.Data.Posting
import Hledger.Data.Transaction
import Hledger.Data.TransactionModifier
import Hledger.Data.Valuation
import Hledger.Query
import System.FilePath (takeFileName)
import Data.Ord (comparing)
import Hledger.Data.Dates (nulldate)
import Data.List (sort)
import Data.Function ((&))
-- import Data.Function ((&))


-- | A parser of text that runs in some monad, keeping a Journal as state.
type JournalParser m a = StateT Journal (ParsecT HledgerParseErrorData 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 HledgerParseErrorData Text (ExceptT FinalParseError m)) a

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

journalDbg :: Journal -> RegexError
journalDbg j :: Journal
j@Journal{[RegexError]
[(RegexError, TagName)]
[(TagName, AccountDeclarationInfo)]
[(TagName, TagDeclarationInfo)]
[(TagName, PayeeDeclarationInfo)]
[TagName]
[MarketPrice]
[PriceDirective]
[TimeclockEntry]
[PeriodicTransaction]
[TransactionModifier]
[Transaction]
[AccountAlias]
Maybe Char
Maybe Integer
Maybe (TagName, AmountStyle)
Map TagName [Tag]
Map TagName Commodity
Map TagName AmountStyle
Map TagName AccountType
Map AccountType [TagName]
TagName
POSIXTime
jtxns :: Journal -> [Transaction]
jinferredcommoditystyles :: Journal -> Map TagName AmountStyle
jparsedefaultyear :: Maybe Integer
jparsedefaultcommodity :: Maybe (TagName, AmountStyle)
jparsedecimalmark :: Maybe Char
jparseparentaccounts :: [TagName]
jparsealiases :: [AccountAlias]
jparsetimeclockentries :: [TimeclockEntry]
jincludefilestack :: [RegexError]
jdeclaredpayees :: [(TagName, PayeeDeclarationInfo)]
jdeclaredtags :: [(TagName, TagDeclarationInfo)]
jdeclaredaccounts :: [(TagName, AccountDeclarationInfo)]
jdeclaredaccounttags :: Map TagName [Tag]
jdeclaredaccounttypes :: Map AccountType [TagName]
jaccounttypes :: Map TagName AccountType
jdeclaredcommodities :: Map TagName Commodity
jinferredcommoditystyles :: Map TagName AmountStyle
jglobalcommoditystyles :: Map TagName AmountStyle
jpricedirectives :: [PriceDirective]
jinferredmarketprices :: [MarketPrice]
jtxnmodifiers :: [TransactionModifier]
jperiodictxns :: [PeriodicTransaction]
jtxns :: [Transaction]
jfinalcommentlines :: TagName
jfiles :: [(RegexError, TagName)]
jlastreadtime :: POSIXTime
jparsedefaultyear :: Journal -> Maybe Integer
jparsedefaultcommodity :: Journal -> Maybe (TagName, AmountStyle)
jparsedecimalmark :: Journal -> Maybe Char
jparseparentaccounts :: Journal -> [TagName]
jparsealiases :: Journal -> [AccountAlias]
jparsetimeclockentries :: Journal -> [TimeclockEntry]
jincludefilestack :: Journal -> [RegexError]
jdeclaredpayees :: Journal -> [(TagName, PayeeDeclarationInfo)]
jdeclaredtags :: Journal -> [(TagName, TagDeclarationInfo)]
jdeclaredaccounts :: Journal -> [(TagName, AccountDeclarationInfo)]
jdeclaredaccounttags :: Journal -> Map TagName [Tag]
jdeclaredaccounttypes :: Journal -> Map AccountType [TagName]
jaccounttypes :: Journal -> Map TagName AccountType
jdeclaredcommodities :: Journal -> Map TagName Commodity
jglobalcommoditystyles :: Journal -> Map TagName AmountStyle
jpricedirectives :: Journal -> [PriceDirective]
jinferredmarketprices :: Journal -> [MarketPrice]
jtxnmodifiers :: Journal -> [TransactionModifier]
jperiodictxns :: Journal -> [PeriodicTransaction]
jfinalcommentlines :: Journal -> TagName
jfiles :: Journal -> [(RegexError, TagName)]
jlastreadtime :: Journal -> POSIXTime
..} = ShowS
chomp ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [RegexError] -> RegexError
unlines ([RegexError] -> RegexError) -> [RegexError] -> RegexError
forall a b. (a -> b) -> a -> b
$
  (RegexError
"Journal " RegexError -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
takeFileName (Journal -> RegexError
journalFilePath Journal
j)RegexError -> ShowS
forall a. [a] -> [a] -> [a]
++RegexError
":") RegexError -> [RegexError] -> [RegexError]
forall a. a -> [a] -> [a]
:  --  ++ " {"
  ShowS -> [RegexError] -> [RegexError]
forall a b. (a -> b) -> [a] -> [b]
map (RegexError
" "RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>) [
   RegexError
"jparsedefaultyear: "         RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> Maybe Integer -> RegexError
forall a. Show a => a -> RegexError
shw Maybe Integer
jparsedefaultyear
  ,RegexError
"jparsedefaultcommodity: "    RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> Maybe (TagName, AmountStyle) -> RegexError
forall a. Show a => a -> RegexError
shw Maybe (TagName, AmountStyle)
jparsedefaultcommodity
  ,RegexError
"jparsedecimalmark: "         RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> Maybe Char -> RegexError
forall a. Show a => a -> RegexError
shw Maybe Char
jparsedecimalmark
  ,RegexError
"jparseparentaccounts: "      RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> [TagName] -> RegexError
forall a. Show a => a -> RegexError
shw [TagName]
jparseparentaccounts
  ,RegexError
"jparsealiases: "             RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> [AccountAlias] -> RegexError
forall a. Show a => a -> RegexError
shw [AccountAlias]
jparsealiases
  -- ,"jparsetimeclockentries: " <> shw jparsetimeclockentries
  ,RegexError
"jincludefilestack: "         RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> [RegexError] -> RegexError
forall a. Show a => a -> RegexError
shw [RegexError]
jincludefilestack
  ,RegexError
"jdeclaredpayees: "           RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> [(TagName, PayeeDeclarationInfo)] -> RegexError
forall a. Show a => a -> RegexError
shw [(TagName, PayeeDeclarationInfo)]
jdeclaredpayees
  ,RegexError
"jdeclaredtags: "             RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> [(TagName, TagDeclarationInfo)] -> RegexError
forall a. Show a => a -> RegexError
shw [(TagName, TagDeclarationInfo)]
jdeclaredtags
  ,RegexError
"jdeclaredaccounts: "         RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> [(TagName, AccountDeclarationInfo)] -> RegexError
forall a. Show a => a -> RegexError
shw [(TagName, AccountDeclarationInfo)]
jdeclaredaccounts
  ,RegexError
"jdeclaredaccounttags: "      RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> Map TagName [Tag] -> RegexError
forall a. Show a => a -> RegexError
shw Map TagName [Tag]
jdeclaredaccounttags
  ,RegexError
"jdeclaredaccounttypes: "     RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> Map AccountType [TagName] -> RegexError
forall a. Show a => a -> RegexError
shw Map AccountType [TagName]
jdeclaredaccounttypes
  ,RegexError
"jaccounttypes: "             RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> Map TagName AccountType -> RegexError
forall a. Show a => a -> RegexError
shw Map TagName AccountType
jaccounttypes
  ,RegexError
"jdeclaredcommodities: "      RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> Map TagName Commodity -> RegexError
forall a. Show a => a -> RegexError
shw Map TagName Commodity
jdeclaredcommodities
  ,RegexError
"jinferredcommoditystyles: "  RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> Map TagName AmountStyle -> RegexError
forall a. Show a => a -> RegexError
shw Map TagName AmountStyle
jinferredcommoditystyles
  ,RegexError
"jglobalcommoditystyles: "    RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> Map TagName AmountStyle -> RegexError
forall a. Show a => a -> RegexError
shw Map TagName AmountStyle
jglobalcommoditystyles
  ,RegexError
"jpricedirectives: "          RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> [PriceDirective] -> RegexError
forall a. Show a => a -> RegexError
shw [PriceDirective]
jpricedirectives
  ,RegexError
"jinferredmarketprices: "     RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> [MarketPrice] -> RegexError
forall a. Show a => a -> RegexError
shw [MarketPrice]
jinferredmarketprices
  ,RegexError
"jtxnmodifiers: "             RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> [TransactionModifier] -> RegexError
forall a. Show a => a -> RegexError
shw [TransactionModifier]
jtxnmodifiers
  -- ,"jperiodictxns: "          <> shw jperiodictxns
  ,RegexError
"jtxns: "                     RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Transaction] -> RegexError
forall a. Show a => a -> RegexError
shw [Transaction]
jtxns
  ,RegexError
"jfinalcommentlines: "        RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> TagName -> RegexError
forall a. Show a => a -> RegexError
shw TagName
jfinalcommentlines
  ,RegexError
"jfiles: "                    RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> [(RegexError, TagName)] -> RegexError
forall a. Show a => a -> RegexError
shw [(RegexError, TagName)]
jfiles
  ,RegexError
"jlastreadtime: "             RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> POSIXTime -> RegexError
forall a. Show a => a -> RegexError
shw POSIXTime
jlastreadtime
  ]
  -- ++ ["}"]
  where
    shw :: Show a => a -> String
    shw :: forall a. Show a => a -> RegexError
shw = a -> RegexError
forall a. Show a => a -> RegexError
show
    -- shw = pshow

-- The semigroup instance for Journal is useful for two situations.
--
-- 1. concatenating finalised journals, eg with multiple -f options:
-- FIRST <> SECOND.
--
-- 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
j1 Journal -> Journal -> Journal
`journalConcat` Journal
j2

-- | Merge two journals into one.
-- Transaction counts are summed, map fields are combined,
-- the second's list fields are appended to the first's,
-- the second's parse state is kept.
journalConcat :: Journal -> Journal -> Journal
journalConcat :: Journal -> Journal -> Journal
journalConcat Journal
j1 Journal
j2 =
  let
    f1 :: RegexError
f1 = ShowS
takeFileName ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Journal -> RegexError
journalFilePath Journal
j1
    f2 :: RegexError
f2 = RegexError -> ShowS -> Maybe RegexError -> RegexError
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RegexError
"(unknown)" ShowS
takeFileName (Maybe RegexError -> RegexError) -> Maybe RegexError -> RegexError
forall a b. (a -> b) -> a -> b
$ [RegexError] -> Maybe RegexError
forall a. [a] -> Maybe a
headMay ([RegexError] -> Maybe RegexError)
-> [RegexError] -> Maybe RegexError
forall a b. (a -> b) -> a -> b
$ Journal -> [RegexError]
jincludefilestack Journal
j2  -- XXX more accurate than journalFilePath for some reason
  in
    RegexError -> Journal -> Journal
dbgJournalAcctDeclOrder (RegexError
"journalConcat: " RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> RegexError
f1 RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> RegexError
" <> " RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> RegexError
f2 RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> RegexError
", acct decls renumbered: ") (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$
    Journal -> Journal
journalRenumberAccountDeclarations (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$
    RegexError -> Journal -> Journal
dbgJournalAcctDeclOrder (RegexError
"journalConcat: " RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> RegexError
f1 RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> RegexError
" <> " RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> RegexError
f2 RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> RegexError
", acct decls           : ") (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$
    Journal {
     jparsedefaultyear :: Maybe Integer
jparsedefaultyear          = Journal -> Maybe Integer
jparsedefaultyear          Journal
j2
    ,jparsedefaultcommodity :: Maybe (TagName, AmountStyle)
jparsedefaultcommodity     = Journal -> Maybe (TagName, AmountStyle)
jparsedefaultcommodity     Journal
j2
    ,jparsedecimalmark :: Maybe Char
jparsedecimalmark          = Journal -> Maybe Char
jparsedecimalmark          Journal
j2
    ,jparseparentaccounts :: [TagName]
jparseparentaccounts       = Journal -> [TagName]
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 :: [RegexError]
jincludefilestack          = Journal -> [RegexError]
jincludefilestack Journal
j2
    ,jdeclaredpayees :: [(TagName, PayeeDeclarationInfo)]
jdeclaredpayees            = Journal -> [(TagName, PayeeDeclarationInfo)]
jdeclaredpayees            Journal
j1 [(TagName, PayeeDeclarationInfo)]
-> [(TagName, PayeeDeclarationInfo)]
-> [(TagName, PayeeDeclarationInfo)]
forall a. Semigroup a => a -> a -> a
<> Journal -> [(TagName, PayeeDeclarationInfo)]
jdeclaredpayees            Journal
j2
    ,jdeclaredtags :: [(TagName, TagDeclarationInfo)]
jdeclaredtags              = Journal -> [(TagName, TagDeclarationInfo)]
jdeclaredtags              Journal
j1 [(TagName, TagDeclarationInfo)]
-> [(TagName, TagDeclarationInfo)]
-> [(TagName, TagDeclarationInfo)]
forall a. Semigroup a => a -> a -> a
<> Journal -> [(TagName, TagDeclarationInfo)]
jdeclaredtags              Journal
j2
    ,jdeclaredaccounts :: [(TagName, AccountDeclarationInfo)]
jdeclaredaccounts          = Journal -> [(TagName, AccountDeclarationInfo)]
jdeclaredaccounts          Journal
j1 [(TagName, AccountDeclarationInfo)]
-> [(TagName, AccountDeclarationInfo)]
-> [(TagName, AccountDeclarationInfo)]
forall a. Semigroup a => a -> a -> a
<> Journal -> [(TagName, AccountDeclarationInfo)]
jdeclaredaccounts          Journal
j2
    --
    -- The next six fields are Maps, which need to be merged carefully for correct semantics,
    -- especially the first two, which have list values. There may still be room for improvement here.
    --
    -- ,jdeclaredaccounttags   :: M.Map AccountName [Tag]
    -- jdeclaredaccounttags can have multiple duplicated/conflicting values for an account's tag.
    ,jdeclaredaccounttags :: Map TagName [Tag]
jdeclaredaccounttags       = ([Tag] -> [Tag] -> [Tag])
-> Map TagName [Tag] -> Map TagName [Tag] -> Map TagName [Tag]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith [Tag] -> [Tag] -> [Tag]
forall a. Semigroup a => a -> a -> a
(<>) (Journal -> Map TagName [Tag]
jdeclaredaccounttags Journal
j1) (Journal -> Map TagName [Tag]
jdeclaredaccounttags Journal
j2)
    --
    -- ,jdeclaredaccounttypes  :: M.Map AccountType [AccountName]
    -- jdeclaredaccounttypes can have multiple duplicated/conflicting values for an account's type.
    ,jdeclaredaccounttypes :: Map AccountType [TagName]
jdeclaredaccounttypes      = ([TagName] -> [TagName] -> [TagName])
-> Map AccountType [TagName]
-> Map AccountType [TagName]
-> Map AccountType [TagName]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith [TagName] -> [TagName] -> [TagName]
forall a. Semigroup a => a -> a -> a
(<>) (Journal -> Map AccountType [TagName]
jdeclaredaccounttypes Journal
j1) (Journal -> Map AccountType [TagName]
jdeclaredaccounttypes Journal
j2)
    --
    -- ,jaccounttypes          :: M.Map AccountName AccountType
    -- jaccounttypes has a single type for any given account. When it had multiple type declarations, the last/rightmost wins.
    ,jaccounttypes :: Map TagName AccountType
jaccounttypes              = (AccountType -> AccountType -> AccountType)
-> Map TagName AccountType
-> Map TagName AccountType
-> Map TagName AccountType
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith ((AccountType -> AccountType)
-> AccountType -> AccountType -> AccountType
forall a b. a -> b -> a
const AccountType -> AccountType
forall a. a -> a
id) (Journal -> Map TagName AccountType
jaccounttypes Journal
j1) (Journal -> Map TagName AccountType
jaccounttypes Journal
j2)
    --
    -- ,jglobalcommoditystyles :: M.Map CommoditySymbol AmountStyle
    ,jglobalcommoditystyles :: Map TagName AmountStyle
jglobalcommoditystyles     = Map TagName AmountStyle
-> Map TagName AmountStyle -> Map TagName AmountStyle
forall a. Semigroup a => a -> a -> a
(<>) (Journal -> Map TagName AmountStyle
jglobalcommoditystyles Journal
j1) (Journal -> Map TagName AmountStyle
jglobalcommoditystyles Journal
j2)
    --
    -- ,jdeclaredcommodities           :: M.Map CommoditySymbol Commodity
    ,jdeclaredcommodities :: Map TagName Commodity
jdeclaredcommodities               = Map TagName Commodity
-> Map TagName Commodity -> Map TagName Commodity
forall a. Semigroup a => a -> a -> a
(<>) (Journal -> Map TagName Commodity
jdeclaredcommodities Journal
j1) (Journal -> Map TagName Commodity
jdeclaredcommodities Journal
j2)
    --
    -- ,jinferredcommoditystyles   :: M.Map CommoditySymbol AmountStyle
    ,jinferredcommoditystyles :: Map TagName AmountStyle
jinferredcommoditystyles       = Map TagName AmountStyle
-> Map TagName AmountStyle -> Map TagName AmountStyle
forall a. Semigroup a => a -> a -> a
(<>) (Journal -> Map TagName AmountStyle
jinferredcommoditystyles Journal
j1) (Journal -> Map TagName AmountStyle
jinferredcommoditystyles 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 :: TagName
jfinalcommentlines         = Journal -> TagName
jfinalcommentlines Journal
j2  -- XXX discards j1's ?
    ,jfiles :: [(RegexError, TagName)]
jfiles                     = Journal -> [(RegexError, TagName)]
jfiles                     Journal
j1 [(RegexError, TagName)]
-> [(RegexError, TagName)] -> [(RegexError, TagName)]
forall a. Semigroup a => a -> a -> a
<> Journal -> [(RegexError, TagName)]
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)
    }

-- | Renumber all the account declarations. This is useful to call when
-- finalising or concatenating Journals, to give account declarations
-- a total order across files.
journalRenumberAccountDeclarations :: Journal -> Journal
journalRenumberAccountDeclarations :: Journal -> Journal
journalRenumberAccountDeclarations Journal
j = Journal
j{jdeclaredaccounts=jdas'}
  where
    jdas' :: [(TagName, AccountDeclarationInfo)]
jdas' = [(TagName
a, AccountDeclarationInfo
adi{adideclarationorder=n}) | (Int
n, (TagName
a,AccountDeclarationInfo
adi)) <- [Int]
-> [(TagName, AccountDeclarationInfo)]
-> [(Int, (TagName, AccountDeclarationInfo))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] ([(TagName, AccountDeclarationInfo)]
 -> [(Int, (TagName, AccountDeclarationInfo))])
-> [(TagName, AccountDeclarationInfo)]
-> [(Int, (TagName, AccountDeclarationInfo))]
forall a b. (a -> b) -> a -> b
$ Journal -> [(TagName, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j]
    -- the per-file declaration order saved during parsing is discarded,
    -- it seems unneeded except perhaps for debugging

-- | Debug log the ordering of a journal's account declarations
-- (at debug level 5+).
dbgJournalAcctDeclOrder :: String -> Journal -> Journal
dbgJournalAcctDeclOrder :: RegexError -> Journal -> Journal
dbgJournalAcctDeclOrder RegexError
prefix =
  Int -> (Journal -> RegexError) -> Journal -> Journal
forall a. Int -> (a -> RegexError) -> a -> a
traceOrLogAtWith Int
5 ((RegexError
prefixRegexError -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Journal -> RegexError) -> Journal -> RegexError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TagName, AccountDeclarationInfo)] -> RegexError
showAcctDeclsSummary ([(TagName, AccountDeclarationInfo)] -> RegexError)
-> (Journal -> [(TagName, AccountDeclarationInfo)])
-> Journal
-> RegexError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [(TagName, AccountDeclarationInfo)]
jdeclaredaccounts)
  where
    showAcctDeclsSummary :: [(AccountName,AccountDeclarationInfo)] -> String
    showAcctDeclsSummary :: [(TagName, AccountDeclarationInfo)] -> RegexError
showAcctDeclsSummary [(TagName, AccountDeclarationInfo)]
adis
      | [(TagName, AccountDeclarationInfo)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(TagName, AccountDeclarationInfo)]
adis Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) = RegexError
"[" RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> [(TagName, AccountDeclarationInfo)] -> RegexError
showadis [(TagName, AccountDeclarationInfo)]
adis RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> RegexError
"]"
      | Bool
otherwise =
          RegexError
"[" RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> [(TagName, AccountDeclarationInfo)] -> RegexError
showadis (Int
-> [(TagName, AccountDeclarationInfo)]
-> [(TagName, AccountDeclarationInfo)]
forall a. Int -> [a] -> [a]
take Int
n [(TagName, AccountDeclarationInfo)]
adis) RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> RegexError
" ... " RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> [(TagName, AccountDeclarationInfo)] -> RegexError
showadis (Int
-> [(TagName, AccountDeclarationInfo)]
-> [(TagName, AccountDeclarationInfo)]
forall a. Int -> [a] -> [a]
takelast Int
n [(TagName, AccountDeclarationInfo)]
adis) RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<> RegexError
"]"
      where
        n :: Int
n = Int
3
        showadis :: [(TagName, AccountDeclarationInfo)] -> RegexError
showadis = RegexError -> [RegexError] -> RegexError
forall a. [a] -> [[a]] -> [a]
intercalate RegexError
", " ([RegexError] -> RegexError)
-> ([(TagName, AccountDeclarationInfo)] -> [RegexError])
-> [(TagName, AccountDeclarationInfo)]
-> RegexError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TagName, AccountDeclarationInfo) -> RegexError)
-> [(TagName, AccountDeclarationInfo)] -> [RegexError]
forall a b. (a -> b) -> [a] -> [b]
map (TagName, AccountDeclarationInfo) -> RegexError
showadi
        showadi :: (TagName, AccountDeclarationInfo) -> RegexError
showadi (TagName
a,AccountDeclarationInfo
adi) = RegexError
"("RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>Int -> RegexError
forall a. Show a => a -> RegexError
show (AccountDeclarationInfo -> Int
adideclarationorder AccountDeclarationInfo
adi)RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>RegexError
","RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>TagName -> RegexError
T.unpack TagName
aRegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>RegexError
")"
        takelast :: Int -> [a] -> [a]
takelast Int
n' = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n' ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse

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

nulljournal :: Journal
nulljournal :: Journal
nulljournal = Journal {
   jparsedefaultyear :: Maybe Integer
jparsedefaultyear          = Maybe Integer
forall a. Maybe a
Nothing
  ,jparsedefaultcommodity :: Maybe (TagName, AmountStyle)
jparsedefaultcommodity     = Maybe (TagName, AmountStyle)
forall a. Maybe a
Nothing
  ,jparsedecimalmark :: Maybe Char
jparsedecimalmark          = Maybe Char
forall a. Maybe a
Nothing
  ,jparseparentaccounts :: [TagName]
jparseparentaccounts       = []
  ,jparsealiases :: [AccountAlias]
jparsealiases              = []
  -- ,jparsetransactioncount     = 0
  ,jparsetimeclockentries :: [TimeclockEntry]
jparsetimeclockentries     = []
  ,jincludefilestack :: [RegexError]
jincludefilestack          = []
  ,jdeclaredpayees :: [(TagName, PayeeDeclarationInfo)]
jdeclaredpayees            = []
  ,jdeclaredtags :: [(TagName, TagDeclarationInfo)]
jdeclaredtags              = []
  ,jdeclaredaccounts :: [(TagName, AccountDeclarationInfo)]
jdeclaredaccounts          = []
  ,jdeclaredaccounttags :: Map TagName [Tag]
jdeclaredaccounttags       = Map TagName [Tag]
forall k a. Map k a
M.empty
  ,jdeclaredaccounttypes :: Map AccountType [TagName]
jdeclaredaccounttypes      = Map AccountType [TagName]
forall k a. Map k a
M.empty
  ,jaccounttypes :: Map TagName AccountType
jaccounttypes              = Map TagName AccountType
forall k a. Map k a
M.empty
  ,jglobalcommoditystyles :: Map TagName AmountStyle
jglobalcommoditystyles     = Map TagName AmountStyle
forall k a. Map k a
M.empty
  ,jdeclaredcommodities :: Map TagName Commodity
jdeclaredcommodities               = Map TagName Commodity
forall k a. Map k a
M.empty
  ,jinferredcommoditystyles :: Map TagName AmountStyle
jinferredcommoditystyles       = Map TagName 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 :: TagName
jfinalcommentlines         = TagName
""
  ,jfiles :: [(RegexError, TagName)]
jfiles                     = []
  ,jlastreadtime :: POSIXTime
jlastreadtime              = POSIXTime
0
  }

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

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

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

addTransaction :: Transaction -> Journal -> Journal
addTransaction :: Transaction -> Journal -> Journal
addTransaction Transaction
t Journal
j = Journal
j { jtxns = t : jtxns j }

addTransactionModifier :: TransactionModifier -> Journal -> Journal
addTransactionModifier :: TransactionModifier -> Journal -> Journal
addTransactionModifier TransactionModifier
mt Journal
j = Journal
j { jtxnmodifiers = mt : jtxnmodifiers j }

addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal
addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal
addPeriodicTransaction PeriodicTransaction
pt Journal
j = Journal
j { jperiodictxns = pt : jperiodictxns j }

addPriceDirective :: PriceDirective -> Journal -> Journal
addPriceDirective :: PriceDirective -> Journal -> Journal
addPriceDirective PriceDirective
h Journal
j = Journal
j { jpricedirectives = h : jpricedirectives 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 -> Integer -> Maybe Transaction
journalTransactionAt Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} Integer
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 -> Integer
tindex Transaction
t Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
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 -> Integer -> Maybe Transaction
journalTransactionAt Journal
j (Transaction -> Integer
tindex Transaction
t Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
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 -> Integer -> Maybe Transaction
journalTransactionAt Journal
j (Transaction -> Integer
tindex Transaction
t Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
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

-- | All posting amounts from this journal, in order.
journalPostingAmounts :: Journal -> [MixedAmount]
journalPostingAmounts :: Journal -> [MixedAmount]
journalPostingAmounts = (Posting -> MixedAmount) -> [Posting] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> MixedAmount
pamount ([Posting] -> [MixedAmount])
-> (Journal -> [Posting]) -> Journal -> [MixedAmount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Posting]
journalPostings

-- | Show the journal amounts rendered, suitable for debug logging.
showJournalAmountsDebug :: Journal -> String
showJournalAmountsDebug :: Journal -> RegexError
showJournalAmountsDebug = [RegexError] -> RegexError
forall a. Show a => a -> RegexError
show([RegexError] -> RegexError)
-> (Journal -> [RegexError]) -> Journal -> RegexError
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MixedAmount -> RegexError) -> [MixedAmount] -> [RegexError]
forall a b. (a -> b) -> [a] -> [b]
map MixedAmount -> RegexError
showMixedAmountOneLine([MixedAmount] -> [RegexError])
-> (Journal -> [MixedAmount]) -> Journal -> [RegexError]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Journal -> [MixedAmount]
journalPostingAmounts

-- | Sorted unique commodity symbols declared by commodity directives in this journal.
journalCommoditiesDeclared :: Journal -> [CommoditySymbol]
journalCommoditiesDeclared :: Journal -> [TagName]
journalCommoditiesDeclared = Map TagName Commodity -> [TagName]
forall k a. Map k a -> [k]
M.keys (Map TagName Commodity -> [TagName])
-> (Journal -> Map TagName Commodity) -> Journal -> [TagName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Map TagName Commodity
jdeclaredcommodities

-- | Sorted unique commodity symbols mentioned in this journal.
journalCommodities :: Journal -> S.Set CommoditySymbol
journalCommodities :: Journal -> Set TagName
journalCommodities Journal
j =
     Map TagName Commodity -> Set TagName
forall k a. Map k a -> Set k
M.keysSet (Journal -> Map TagName Commodity
jdeclaredcommodities Journal
j)
  Set TagName -> Set TagName -> Set TagName
forall a. Semigroup a => a -> a -> a
<> Map TagName AmountStyle -> Set TagName
forall k a. Map k a -> Set k
M.keysSet (Journal -> Map TagName AmountStyle
jinferredcommoditystyles Journal
j)
  Set TagName -> Set TagName -> Set TagName
forall a. Semigroup a => a -> a -> a
<> [TagName] -> Set TagName
forall a. Ord a => [a] -> Set a
S.fromList ((PriceDirective -> [TagName]) -> [PriceDirective] -> [TagName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PriceDirective -> [TagName]
pdcommodities ([PriceDirective] -> [TagName]) -> [PriceDirective] -> [TagName]
forall a b. (a -> b) -> a -> b
$ Journal -> [PriceDirective]
jpricedirectives Journal
j)
      where pdcommodities :: PriceDirective -> [TagName]
pdcommodities PriceDirective
pd = [PriceDirective -> TagName
pdcommodity PriceDirective
pd, Amount -> TagName
acommodity (Amount -> TagName) -> Amount -> TagName
forall a b. (a -> b) -> a -> b
$ PriceDirective -> Amount
pdamount PriceDirective
pd]

-- | Unique transaction descriptions used in this journal.
journalDescriptions :: Journal -> [Text]
journalDescriptions :: Journal -> [TagName]
journalDescriptions = [TagName] -> [TagName]
forall a. Ord a => [a] -> [a]
nubSort ([TagName] -> [TagName])
-> (Journal -> [TagName]) -> Journal -> [TagName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transaction -> TagName) -> [Transaction] -> [TagName]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> TagName
tdescription ([Transaction] -> [TagName])
-> (Journal -> [Transaction]) -> Journal -> [TagName]
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 -> [TagName]
journalPayeesDeclared = [TagName] -> [TagName]
forall a. Ord a => [a] -> [a]
nubSort ([TagName] -> [TagName])
-> (Journal -> [TagName]) -> Journal -> [TagName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TagName, PayeeDeclarationInfo) -> TagName)
-> [(TagName, PayeeDeclarationInfo)] -> [TagName]
forall a b. (a -> b) -> [a] -> [b]
map (TagName, PayeeDeclarationInfo) -> TagName
forall a b. (a, b) -> a
fst ([(TagName, PayeeDeclarationInfo)] -> [TagName])
-> (Journal -> [(TagName, PayeeDeclarationInfo)])
-> Journal
-> [TagName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [(TagName, PayeeDeclarationInfo)]
jdeclaredpayees

-- | Sorted unique payees used by transactions in this journal.
journalPayeesUsed :: Journal -> [Payee]
journalPayeesUsed :: Journal -> [TagName]
journalPayeesUsed = [TagName] -> [TagName]
forall a. Ord a => [a] -> [a]
nubSort ([TagName] -> [TagName])
-> (Journal -> [TagName]) -> Journal -> [TagName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transaction -> TagName) -> [Transaction] -> [TagName]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> TagName
transactionPayee ([Transaction] -> [TagName])
-> (Journal -> [Transaction]) -> Journal -> [TagName]
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 -> [TagName]
journalPayeesDeclaredOrUsed Journal
j = Set TagName -> [TagName]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set TagName -> [TagName]) -> Set TagName -> [TagName]
forall a b. (a -> b) -> a -> b
$ ([TagName] -> Set TagName) -> [[TagName]] -> Set TagName
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [TagName] -> Set TagName
forall a. Ord a => [a] -> Set a
S.fromList
    [Journal -> [TagName]
journalPayeesDeclared Journal
j, Journal -> [TagName]
journalPayeesUsed Journal
j]

-- | Sorted unique tag names declared by tag directives in this journal.
journalTagsDeclared :: Journal -> [TagName]
journalTagsDeclared :: Journal -> [TagName]
journalTagsDeclared = [TagName] -> [TagName]
forall a. Ord a => [a] -> [a]
nubSort ([TagName] -> [TagName])
-> (Journal -> [TagName]) -> Journal -> [TagName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TagName, TagDeclarationInfo) -> TagName)
-> [(TagName, TagDeclarationInfo)] -> [TagName]
forall a b. (a -> b) -> [a] -> [b]
map (TagName, TagDeclarationInfo) -> TagName
forall a b. (a, b) -> a
fst ([(TagName, TagDeclarationInfo)] -> [TagName])
-> (Journal -> [(TagName, TagDeclarationInfo)])
-> Journal
-> [TagName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [(TagName, TagDeclarationInfo)]
jdeclaredtags

-- | Sorted unique tag names used in this journal (in account directives, transactions, postings..)
journalTagsUsed :: Journal -> [TagName]
journalTagsUsed :: Journal -> [TagName]
journalTagsUsed Journal
j = [TagName] -> [TagName]
forall a. Ord a => [a] -> [a]
nubSort ([TagName] -> [TagName]) -> [TagName] -> [TagName]
forall a b. (a -> b) -> a -> b
$ (Tag -> TagName) -> [Tag] -> [TagName]
forall a b. (a -> b) -> [a] -> [b]
map Tag -> TagName
forall a b. (a, b) -> a
fst ([Tag] -> [TagName]) -> [Tag] -> [TagName]
forall a b. (a -> b) -> a -> b
$ (Transaction -> [Tag]) -> [Transaction] -> [Tag]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Tag]
transactionAllTags ([Transaction] -> [Tag]) -> [Transaction] -> [Tag]
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
  -- tags used in all transactions and postings and postings' accounts

-- | Sorted unique tag names used in transactions or declared by tag directives in this journal.
journalTagsDeclaredOrUsed :: Journal -> [TagName]
journalTagsDeclaredOrUsed :: Journal -> [TagName]
journalTagsDeclaredOrUsed Journal
j = Set TagName -> [TagName]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set TagName -> [TagName]) -> Set TagName -> [TagName]
forall a b. (a -> b) -> a -> b
$ ([TagName] -> Set TagName) -> [[TagName]] -> Set TagName
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [TagName] -> Set TagName
forall a. Ord a => [a] -> Set a
S.fromList
    [Journal -> [TagName]
journalTagsDeclared Journal
j, Journal -> [TagName]
journalTagsUsed Journal
j]

-- | Sorted unique account names posted to by this journal's transactions.
journalAccountNamesUsed :: Journal -> [AccountName]
journalAccountNamesUsed :: Journal -> [TagName]
journalAccountNamesUsed = [Posting] -> [TagName]
accountNamesFromPostings ([Posting] -> [TagName])
-> (Journal -> [Posting]) -> Journal -> [TagName]
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 -> [TagName]
journalAccountNamesImplied = [TagName] -> [TagName]
expandAccountNames ([TagName] -> [TagName])
-> (Journal -> [TagName]) -> Journal -> [TagName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [TagName]
journalAccountNamesUsed

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

-- | Sorted unique account names declared by account directives in this journal,
-- which have no children.
journalLeafAccountNamesDeclared :: Journal -> [AccountName]
journalLeafAccountNamesDeclared :: Journal -> [TagName]
journalLeafAccountNamesDeclared = Tree TagName -> [TagName]
forall a. Tree a -> [a]
treeLeaves (Tree TagName -> [TagName])
-> (Journal -> Tree TagName) -> Journal -> [TagName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TagName] -> Tree TagName
accountNameTreeFrom ([TagName] -> Tree TagName)
-> (Journal -> [TagName]) -> Journal -> Tree TagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [TagName]
journalAccountNamesDeclared

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

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

-- | Sorted unique account names declared or implied in this journal
-- which have no children.
journalLeafAccountNames :: Journal -> [AccountName]
journalLeafAccountNames :: Journal -> [TagName]
journalLeafAccountNames = Tree TagName -> [TagName]
forall a. Tree a -> [a]
treeLeaves (Tree TagName -> [TagName])
-> (Journal -> Tree TagName) -> Journal -> [TagName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Tree TagName
journalAccountNameTree

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

-- | Which tags have been declared explicitly for this account, if any ?
journalAccountTags :: Journal -> AccountName -> [Tag]
journalAccountTags :: Journal -> TagName -> [Tag]
journalAccountTags Journal{Map TagName [Tag]
jdeclaredaccounttags :: Journal -> Map TagName [Tag]
jdeclaredaccounttags :: Map TagName [Tag]
jdeclaredaccounttags} TagName
a = [Tag] -> TagName -> Map TagName [Tag] -> [Tag]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] TagName
a Map TagName [Tag]
jdeclaredaccounttags

-- | Which tags are in effect for this account, including tags inherited from parent accounts ?
journalInheritedAccountTags :: Journal -> AccountName -> [Tag]
journalInheritedAccountTags :: Journal -> TagName -> [Tag]
journalInheritedAccountTags Journal
j TagName
a =
  ([Tag] -> TagName -> [Tag]) -> [Tag] -> [TagName] -> [Tag]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\[Tag]
ts TagName
a' -> [Tag]
ts [Tag] -> [Tag] -> [Tag]
forall a. Eq a => [a] -> [a] -> [a]
`union` Journal -> TagName -> [Tag]
journalAccountTags Journal
j TagName
a') [] [TagName]
as
  where
    as :: [TagName]
as = TagName
a TagName -> [TagName] -> [TagName]
forall a. a -> [a] -> [a]
: TagName -> [TagName]
parentAccountNames TagName
a
-- PERF: cache in journal ?

type DateWeightedSimilarityScore = Double
type SimilarityScore = Double
type Age = Integer

-- | Find up to N most similar and most recent transactions matching
-- the given transaction description and query and exceeding the given
-- description similarity score (0 to 1, see compareDescriptions).
-- Returns transactions along with
-- their age in days compared to the latest transaction date,
-- their description similarity score,
-- and a heuristically date-weighted variant of this that favours more recent transactions.
journalTransactionsSimilarTo :: Journal -> Text -> Query -> SimilarityScore -> Int
  -> [(DateWeightedSimilarityScore, Age, SimilarityScore, Transaction)]
journalTransactionsSimilarTo :: Journal
-> TagName
-> Query
-> Double
-> Int
-> [(Double, Integer, Double, Transaction)]
journalTransactionsSimilarTo Journal{[Transaction]
jtxns :: Journal -> [Transaction]
jtxns :: [Transaction]
jtxns} TagName
desc Query
q Double
similaritythreshold Int
n =
  Int
-> [(Double, Integer, Double, Transaction)]
-> [(Double, Integer, Double, Transaction)]
forall a. Int -> [a] -> [a]
take Int
n ([(Double, Integer, Double, Transaction)]
 -> [(Double, Integer, Double, Transaction)])
-> [(Double, Integer, Double, Transaction)]
-> [(Double, Integer, Double, Transaction)]
forall a b. (a -> b) -> a -> b
$
  ([(Double, Integer, Double, Transaction)] -> RegexError)
-> [(Double, Integer, Double, Transaction)]
-> [(Double, Integer, Double, Transaction)]
forall a. Show a => (a -> RegexError) -> a -> a
dbg1With (
    [RegexError] -> RegexError
unlines ([RegexError] -> RegexError)
-> ([(Double, Integer, Double, Transaction)] -> [RegexError])
-> [(Double, Integer, Double, Transaction)]
-> RegexError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
    (RegexError
"up to 30 transactions above description similarity threshold "RegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>Double -> RegexError
forall a. Show a => a -> RegexError
show Double
similaritythresholdRegexError -> ShowS
forall a. Semigroup a => a -> a -> a
<>RegexError
" ordered by recency-weighted similarity:"RegexError -> [RegexError] -> [RegexError]
forall a. a -> [a] -> [a]
:) ([RegexError] -> [RegexError])
-> ([(Double, Integer, Double, Transaction)] -> [RegexError])
-> [(Double, Integer, Double, Transaction)]
-> [RegexError]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Int -> [RegexError] -> [RegexError]
forall a. Int -> [a] -> [a]
take Int
30 ([RegexError] -> [RegexError])
-> ([(Double, Integer, Double, Transaction)] -> [RegexError])
-> [(Double, Integer, Double, Transaction)]
-> [RegexError]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ((Double, Integer, Double, Transaction) -> RegexError)
-> [(Double, Integer, Double, Transaction)] -> [RegexError]
forall a b. (a -> b) -> [a] -> [b]
map ( \(Double
w,Integer
a,Double
s,Transaction{Integer
[Tag]
[Posting]
Maybe Day
(SourcePos, SourcePos)
TagName
Day
Status
tindex :: Transaction -> Integer
tpostings :: Transaction -> [Posting]
tdescription :: Transaction -> TagName
tindex :: Integer
tprecedingcomment :: TagName
tsourcepos :: (SourcePos, SourcePos)
tdate :: Day
tdate2 :: Maybe Day
tstatus :: Status
tcode :: TagName
tdescription :: TagName
tcomment :: TagName
ttags :: [Tag]
tpostings :: [Posting]
tprecedingcomment :: Transaction -> TagName
tsourcepos :: Transaction -> (SourcePos, SourcePos)
tdate :: Transaction -> Day
tdate2 :: Transaction -> Maybe Day
tstatus :: Transaction -> Status
tcode :: Transaction -> TagName
tcomment :: Transaction -> TagName
ttags :: Transaction -> [Tag]
..}) -> RegexError
-> Double
-> Integer
-> Double
-> RegexError
-> TagName
-> RegexError
forall r. PrintfType r => RegexError -> r
printf RegexError
"weighted:%8.3f  age:%4d similarity:%5.3f  %s %s" Double
w Integer
a Double
s (Day -> RegexError
forall a. Show a => a -> RegexError
show Day
tdate) TagName
tdescription )) ([(Double, Integer, Double, Transaction)]
 -> [(Double, Integer, Double, Transaction)])
-> [(Double, Integer, Double, Transaction)]
-> [(Double, Integer, Double, Transaction)]
forall a b. (a -> b) -> a -> b
$
  ((Double, Integer, Double, Transaction)
 -> (Double, Integer, Double, Transaction) -> Ordering)
-> [(Double, Integer, Double, Transaction)]
-> [(Double, Integer, Double, Transaction)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Double, Integer, Double, Transaction) -> Double)
-> (Double, Integer, Double, Transaction)
-> (Double, Integer, Double, Transaction)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Double -> Double
forall a. Num a => a -> a
negate(Double -> Double)
-> ((Double, Integer, Double, Transaction) -> Double)
-> (Double, Integer, Double, Transaction)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Double, Integer, Double, Transaction) -> Double
forall {a} {b} {c} {d}. (a, b, c, d) -> a
first4)) ([(Double, Integer, Double, Transaction)]
 -> [(Double, Integer, Double, Transaction)])
-> [(Double, Integer, Double, Transaction)]
-> [(Double, Integer, Double, Transaction)]
forall a b. (a -> b) -> a -> b
$
  ((Double, Transaction) -> (Double, Integer, Double, Transaction))
-> [(Double, Transaction)]
-> [(Double, Integer, Double, Transaction)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Double
s,Transaction
t) -> ((Double, Transaction) -> Double
weightedScore (Double
s,Transaction
t), Transaction -> Integer
age Transaction
t, Double
s, Transaction
t)) ([(Double, Transaction)]
 -> [(Double, Integer, Double, Transaction)])
-> [(Double, Transaction)]
-> [(Double, Integer, 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
similaritythreshold)(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)
  [(TagName -> TagName -> Double
compareDescriptions TagName
desc (TagName -> Double) -> TagName -> Double
forall a b. (a -> b) -> a -> b
$ Transaction -> TagName
tdescription Transaction
t, Transaction
t) | Transaction
t <- [Transaction]
jtxns, Query
q Query -> Transaction -> Bool
`matchesTransaction` Transaction
t]
  where
    latest :: Day
latest = Day -> [Day] -> Day
forall a. a -> [a] -> a
lastDef Day
nulldate ([Day] -> Day) -> [Day] -> Day
forall a b. (a -> b) -> a -> b
$ [Day] -> [Day]
forall a. Ord a => [a] -> [a]
sort ([Day] -> [Day]) -> [Day] -> [Day]
forall a b. (a -> b) -> a -> b
$ (Transaction -> Day) -> [Transaction] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Day
tdate [Transaction]
jtxns
    age :: Transaction -> Integer
age = Day -> Day -> Integer
diffDays Day
latest (Day -> Integer) -> (Transaction -> Day) -> Transaction -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Day
tdate
    -- Combine similarity and recency heuristically. This gave decent results
    -- in my "find most recent invoice" use case in 2023-03,
    -- but will probably need more attention.
    weightedScore :: (Double, Transaction) -> Double
    weightedScore :: (Double, Transaction) -> Double
weightedScore (Double
s, Transaction
t) = Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
- Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Transaction -> Integer
age Transaction
t) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
4

-- | 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 :: TagName -> TagName -> Double
compareDescriptions TagName
a TagName
b =
  (if TagName
a TagName -> TagName -> Bool
`T.isInfixOf` TagName
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
$
  RegexError -> RegexError -> Double
compareStrings (TagName -> RegexError
simplify TagName
a) (TagName -> RegexError
simplify TagName
b)
  where
    simplify :: TagName -> RegexError
simplify = TagName -> RegexError
T.unpack (TagName -> RegexError)
-> (TagName -> TagName) -> TagName -> RegexError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> TagName -> TagName
T.filter (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> 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 :: RegexError -> RegexError -> Double
compareStrings RegexError
"" RegexError
"" = Double
1
compareStrings [Char
_] RegexError
"" = Double
0
compareStrings RegexError
"" [Char
_] = Double
0
compareStrings [Char
a] [Char
b] = if Char -> Char
toUpper Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toUpper Char
b then Double
1 else Double
0
compareStrings RegexError
s1 RegexError
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 RegexError
pairs1      = [RegexError] -> Set RegexError
forall a. Ord a => [a] -> Set a
S.fromList ([RegexError] -> Set RegexError) -> [RegexError] -> Set RegexError
forall a b. (a -> b) -> a -> b
$ RegexError -> [RegexError]
wordLetterPairs (RegexError -> [RegexError]) -> RegexError -> [RegexError]
forall a b. (a -> b) -> a -> b
$ ShowS
uppercase RegexError
s1
    pairs2 :: Set RegexError
pairs2      = [RegexError] -> Set RegexError
forall a. Ord a => [a] -> Set a
S.fromList ([RegexError] -> Set RegexError) -> [RegexError] -> Set RegexError
forall a b. (a -> b) -> a -> b
$ RegexError -> [RegexError]
wordLetterPairs (RegexError -> [RegexError]) -> RegexError -> [RegexError]
forall a b. (a -> b) -> a -> b
$ ShowS
uppercase RegexError
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 RegexError -> Int
forall a. Set a -> Int
S.size (Set RegexError -> Int) -> Set RegexError -> Int
forall a b. (a -> b) -> a -> b
$ Set RegexError -> Set RegexError -> Set RegexError
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set RegexError
pairs1 Set RegexError
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 RegexError -> Int
forall a. Set a -> Int
S.size Set RegexError
pairs1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set RegexError -> Int
forall a. Set a -> Int
S.size Set RegexError
pairs2

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

letterPairs :: String -> [String]
letterPairs :: RegexError -> [RegexError]
letterPairs (Char
a:Char
b:RegexError
rest) = [Char
a,Char
b] RegexError -> [RegexError] -> [RegexError]
forall a. a -> [a] -> [a]
: RegexError -> [RegexError]
letterPairs (Char
bChar -> ShowS
forall a. a -> [a] -> [a]
:RegexError
rest)
letterPairs RegexError
_ = []

-- Newer account type code.

journalAccountType :: Journal -> AccountName -> Maybe AccountType
journalAccountType :: Journal -> TagName -> Maybe AccountType
journalAccountType Journal{Map TagName AccountType
jaccounttypes :: Journal -> Map TagName AccountType
jaccounttypes :: Map TagName AccountType
jaccounttypes} = Map TagName AccountType -> TagName -> Maybe AccountType
accountNameType Map TagName AccountType
jaccounttypes

-- | Add a map of all known account types to the journal.
journalAddAccountTypes :: Journal -> Journal
journalAddAccountTypes :: Journal -> Journal
journalAddAccountTypes Journal
j = Journal
j{jaccounttypes = journalAccountTypes j}

-- | An account type inherited from the parent account(s),
-- and whether it was originally declared by an account directive (true) or inferred from an account name (false).
type ParentAccountType = (AccountType, Bool)

-- | Build a map of all known account types, explicitly declared
-- or inferred from the account's parent or name.
journalAccountTypes :: Journal -> M.Map AccountName AccountType
journalAccountTypes :: Journal -> Map TagName AccountType
journalAccountTypes Journal
j = [(TagName, AccountType)] -> Map TagName AccountType
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(TagName
a,AccountType
acctType) | (TagName
a, Just (AccountType
acctType,Bool
_)) <- Tree (TagName, Maybe (AccountType, Bool))
-> [(TagName, Maybe (AccountType, Bool))]
forall a. Tree a -> [a]
flatten Tree (TagName, Maybe (AccountType, Bool))
t']
  where
    t :: Tree TagName
t = [TagName] -> Tree TagName
accountNameTreeFrom ([TagName] -> Tree TagName) -> [TagName] -> Tree TagName
forall a b. (a -> b) -> a -> b
$ Journal -> [TagName]
journalAccountNames Journal
j :: Tree AccountName
    -- Traverse downward through the account tree, applying any explicitly declared account types,
    -- otherwise inferring account types from account names when possible, and propagating account types downward.
    -- Declared account types (possibly inherited from parent) are preferred, inferred types are used as a fallback.
    t' :: Tree (TagName, Maybe (AccountType, Bool))
t' = Maybe (AccountType, Bool)
-> Tree TagName -> Tree (TagName, Maybe (AccountType, Bool))
setTypeHereAndBelow Maybe (AccountType, Bool)
forall a. Maybe a
Nothing Tree TagName
t :: Tree (AccountName, Maybe (AccountType, Bool))
      where
        declaredtypes :: [AccountType]
declaredtypes       = Map AccountType [TagName] -> [AccountType]
forall k a. Map k a -> [k]
M.keys (Map AccountType [TagName] -> [AccountType])
-> Map AccountType [TagName] -> [AccountType]
forall a b. (a -> b) -> a -> b
$ Journal -> Map AccountType [TagName]
jdeclaredaccounttypes Journal
j
        declaredtypesbyname :: Map TagName (AccountType, Bool)
declaredtypesbyname = Journal -> Map TagName AccountType
journalDeclaredAccountTypes Journal
j Map TagName AccountType
-> (Map TagName AccountType -> Map TagName (AccountType, Bool))
-> Map TagName (AccountType, Bool)
forall a b. a -> (a -> b) -> b
& (AccountType -> (AccountType, Bool))
-> Map TagName AccountType -> Map TagName (AccountType, Bool)
forall a b. (a -> b) -> Map TagName a -> Map TagName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Bool
True)
        setTypeHereAndBelow :: Maybe ParentAccountType -> Tree AccountName -> Tree (AccountName, Maybe ParentAccountType)
        setTypeHereAndBelow :: Maybe (AccountType, Bool)
-> Tree TagName -> Tree (TagName, Maybe (AccountType, Bool))
setTypeHereAndBelow Maybe (AccountType, Bool)
mparenttype (Node TagName
a [Tree TagName]
subs) = (TagName, Maybe (AccountType, Bool))
-> [Tree (TagName, Maybe (AccountType, Bool))]
-> Tree (TagName, Maybe (AccountType, Bool))
forall a. a -> [Tree a] -> Tree a
Node (TagName
a, Maybe (AccountType, Bool)
mnewtype) ((Tree TagName -> Tree (TagName, Maybe (AccountType, Bool)))
-> [Tree TagName] -> [Tree (TagName, Maybe (AccountType, Bool))]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (AccountType, Bool)
-> Tree TagName -> Tree (TagName, Maybe (AccountType, Bool))
setTypeHereAndBelow Maybe (AccountType, Bool)
mnewtype) [Tree TagName]
subs)
          where
            mnewtype :: Maybe (AccountType, Bool)
mnewtype = Maybe (AccountType, Bool)
mthisacctdeclaredtype Maybe (AccountType, Bool)
-> Maybe (AccountType, Bool) -> Maybe (AccountType, Bool)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (AccountType, Bool)
mparentacctdeclaredtype Maybe (AccountType, Bool)
-> Maybe (AccountType, Bool) -> Maybe (AccountType, Bool)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (AccountType, Bool)
mthisacctinferredtype Maybe (AccountType, Bool)
-> Maybe (AccountType, Bool) -> Maybe (AccountType, Bool)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (AccountType, Bool)
mparentacctinferredtype
              where
                mthisacctdeclaredtype :: Maybe (AccountType, Bool)
mthisacctdeclaredtype   = TagName
-> Map TagName (AccountType, Bool) -> Maybe (AccountType, Bool)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TagName
a Map TagName (AccountType, Bool)
declaredtypesbyname
                mparentacctdeclaredtype :: Maybe (AccountType, Bool)
mparentacctdeclaredtype = if       Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (AccountType, Bool) -> Bool
forall a b. (a, b) -> b
snd ((AccountType, Bool) -> Bool)
-> Maybe (AccountType, Bool) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (AccountType, Bool)
mparenttype then Maybe (AccountType, Bool)
mparenttype else Maybe (AccountType, Bool)
forall a. Maybe a
Nothing
                mparentacctinferredtype :: Maybe (AccountType, Bool)
mparentacctinferredtype = if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True  (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (AccountType, Bool) -> Bool
forall a b. (a, b) -> b
snd ((AccountType, Bool) -> Bool)
-> Maybe (AccountType, Bool) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (AccountType, Bool)
mparenttype then Maybe (AccountType, Bool)
mparenttype else Maybe (AccountType, Bool)
forall a. Maybe a
Nothing
                mthisacctinferredtype :: Maybe (AccountType, Bool)
mthisacctinferredtype   = [AccountType] -> TagName -> Maybe AccountType
accountNameInferTypeExcept [AccountType]
declaredtypes TagName
a Maybe AccountType
-> (Maybe AccountType -> Maybe (AccountType, Bool))
-> Maybe (AccountType, Bool)
forall a b. a -> (a -> b) -> b
& (AccountType -> (AccountType, Bool))
-> Maybe AccountType -> Maybe (AccountType, Bool)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Bool
False)  -- XXX not sure about this Except logic.. but for now, tests pass

-- | Build a map from account names to explicitly declared account types.
journalDeclaredAccountTypes :: Journal -> M.Map AccountName AccountType
journalDeclaredAccountTypes :: Journal -> Map TagName AccountType
journalDeclaredAccountTypes Journal{Map AccountType [TagName]
jdeclaredaccounttypes :: Journal -> Map AccountType [TagName]
jdeclaredaccounttypes :: Map AccountType [TagName]
jdeclaredaccounttypes} =
  [(TagName, AccountType)] -> Map TagName AccountType
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(TagName, AccountType)] -> Map TagName AccountType)
-> [(TagName, AccountType)] -> Map TagName AccountType
forall a b. (a -> b) -> a -> b
$ [[(TagName, AccountType)]] -> [(TagName, AccountType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [(TagName -> (TagName, AccountType))
-> [TagName] -> [(TagName, AccountType)]
forall a b. (a -> b) -> [a] -> [b]
map (,AccountType
t) [TagName]
as | (AccountType
t,[TagName]
as) <- Map AccountType [TagName] -> [(AccountType, [TagName])]
forall k a. Map k a -> [(k, a)]
M.toList Map AccountType [TagName]
jdeclaredaccounttypes]

-- | To all postings in the journal, add any tags from their account
-- (including those inherited from parent accounts).
-- If the same tag exists on posting and account, the latter is ignored.
journalPostingsAddAccountTags :: Journal -> Journal
journalPostingsAddAccountTags :: Journal -> Journal
journalPostingsAddAccountTags Journal
j = (Posting -> Posting) -> Journal -> Journal
journalMapPostings Posting -> Posting
addtags Journal
j
  where addtags :: Posting -> Posting
addtags Posting
p = Posting
p Posting -> [Tag] -> Posting
`postingAddTags` (Journal -> TagName -> [Tag]
journalInheritedAccountTags Journal
j (TagName -> [Tag]) -> TagName -> [Tag]
forall a b. (a -> b) -> a -> b
$ Posting -> TagName
paccount Posting
p)

-- | The account name to use for conversion postings generated by --infer-equity.
-- This is the first account declared with type V/Conversion,
-- or otherwise the defaultBaseConversionAccount (equity:conversion).
journalBaseConversionAccount :: Journal -> AccountName
journalBaseConversionAccount :: Journal -> TagName
journalBaseConversionAccount = TagName -> [TagName] -> TagName
forall a. a -> [a] -> a
headDef TagName
forall {a}. IsString a => a
defaultBaseConversionAccount ([TagName] -> TagName)
-> (Journal -> [TagName]) -> Journal -> TagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [TagName]
journalConversionAccounts

-- | All the accounts in this journal which are declared or inferred as V/Conversion type.
-- This does not include new account names which might be generated by --infer-equity, currently.
journalConversionAccounts :: Journal -> [AccountName]
journalConversionAccounts :: Journal -> [TagName]
journalConversionAccounts = Map TagName AccountType -> [TagName]
forall k a. Map k a -> [k]
M.keys (Map TagName AccountType -> [TagName])
-> (Journal -> Map TagName AccountType) -> Journal -> [TagName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AccountType -> Bool)
-> Map TagName AccountType -> Map TagName AccountType
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (AccountType -> AccountType -> Bool
forall a. Eq a => a -> a -> Bool
==AccountType
Conversion) (Map TagName AccountType -> Map TagName AccountType)
-> (Journal -> Map TagName AccountType)
-> Journal
-> Map TagName AccountType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Map TagName AccountType
jaccounttypes


-- 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{[Transaction]
jtxns :: Journal -> [Transaction]
jtxns :: [Transaction]
jtxns} = Journal
j{jtxns=filter (matchesTransactionExtra (journalAccountType j) q) jtxns}

-- | 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=map (filterTransactionPostingsExtra (journalAccountType j) q) 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=map (filterTransactionRelatedPostings q) 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=map (filterTransactionAmounts q) 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=mapMaybe (filterPostingAmount q) 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 a. Map MixedAmountKey a -> 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=Mixed 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=filter (q `matchesPosting`) ps}

-- Like filterTransactionPostings, but is given the map of account types so can also filter by account type.
filterTransactionPostingsExtra :: (AccountName -> Maybe AccountType) -> Query -> Transaction -> Transaction
filterTransactionPostingsExtra :: (TagName -> Maybe AccountType)
-> Query -> Transaction -> Transaction
filterTransactionPostingsExtra TagName -> Maybe AccountType
atypes Query
q t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} =
  Transaction
t{tpostings=filter (matchesPostingExtra atypes q) 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=if null matches then [] else ps \\ 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=map f 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=map (transactionMapPostings f) 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            = reverse $ jfiles j
    ,jdeclaredaccounts = reverse $ jdeclaredaccounts j
    ,jtxns             = reverse $ jtxns j
    ,jtxnmodifiers     = reverse $ jtxnmodifiers j
    ,jperiodictxns     = reverse $ jperiodictxns j
    ,jpricedirectives  = reverse $ jpricedirectives 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 = 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=zipWith (\Integer
i Transaction
t -> Transaction
t{tindex=i}) [1..] 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=map txnTieKnot 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=map (\Posting
p -> Posting
p{ptransaction=Nothing}) 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.
-- The first argument selects whether to add visible tags to generated postings & modified transactions.
journalModifyTransactions :: Bool -> Day -> Journal -> Either String Journal
journalModifyTransactions :: Bool -> Day -> Journal -> Either RegexError Journal
journalModifyTransactions Bool
verbosetags Day
d Journal
j =
  case (TagName -> Maybe AccountType)
-> (TagName -> [Tag])
-> Map TagName AmountStyle
-> Day
-> Bool
-> [TransactionModifier]
-> [Transaction]
-> Either RegexError [Transaction]
modifyTransactions (Journal -> TagName -> Maybe AccountType
journalAccountType Journal
j) (Journal -> TagName -> [Tag]
journalInheritedAccountTags Journal
j) (Journal -> Map TagName AmountStyle
journalCommodityStyles Journal
j) Day
d Bool
verbosetags (Journal -> [TransactionModifier]
jtxnmodifiers Journal
j) (Journal -> [Transaction]
jtxns Journal
j) of
    Right [Transaction]
ts -> Journal -> Either RegexError Journal
forall a b. b -> Either a b
Right Journal
j{jtxns=ts}
    Left RegexError
err -> RegexError -> Either RegexError Journal
forall a b. a -> Either a b
Left RegexError
err

-- | Apply this journal's commodity display styles to all of its amounts.
-- This does no display rounding, keeping decimal digits as they were;
-- it is suitable for an early cleanup pass before calculations.
-- Reports may want to do additional rounding/styling at render time.
-- This can return an error message eg if inconsistent number formats are found.
journalStyleAmounts :: Journal -> Either String Journal
journalStyleAmounts :: Journal -> Either RegexError Journal
journalStyleAmounts = (Journal -> Journal)
-> Either RegexError Journal -> Either RegexError Journal
forall a b. (a -> b) -> Either RegexError a -> Either RegexError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Journal -> Journal
journalapplystyles (Either RegexError Journal -> Either RegexError Journal)
-> (Journal -> Either RegexError Journal)
-> Journal
-> Either RegexError Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Either RegexError Journal
journalInferCommodityStyles
  where
    journalapplystyles :: Journal -> Journal
journalapplystyles j :: Journal
j@Journal{jpricedirectives :: Journal -> [PriceDirective]
jpricedirectives=[PriceDirective]
pds} =
      (Posting -> Posting) -> Journal -> Journal
journalMapPostings (Map TagName AmountStyle -> Posting -> Posting
forall a. HasAmounts a => Map TagName AmountStyle -> a -> a
styleAmounts Map TagName AmountStyle
styles) Journal
j{jpricedirectives=map fixpricedirective pds}
      where
        styles :: Map TagName AmountStyle
styles = Rounding -> Journal -> Map TagName AmountStyle
journalCommodityStylesWith Rounding
NoRounding Journal
j  -- defer rounding, in case of print --round=none
        fixpricedirective :: PriceDirective -> PriceDirective
fixpricedirective pd :: PriceDirective
pd@PriceDirective{pdamount :: PriceDirective -> Amount
pdamount=Amount
a} = PriceDirective
pd{pdamount=styleAmounts styles 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 TagName AmountStyle
journalCommodityStyles Journal
j =
  -- XXX could be some redundancy here, cf journalStyleInfluencingAmounts
  Map TagName AmountStyle
globalstyles Map TagName AmountStyle
-> Map TagName AmountStyle -> Map TagName AmountStyle
forall a. Semigroup a => a -> a -> a
<> Map TagName AmountStyle
declaredstyles Map TagName AmountStyle
-> Map TagName AmountStyle -> Map TagName AmountStyle
forall a. Semigroup a => a -> a -> a
<> Map TagName AmountStyle
defaultcommoditystyle Map TagName AmountStyle
-> Map TagName AmountStyle -> Map TagName AmountStyle
forall a. Semigroup a => a -> a -> a
<> Map TagName AmountStyle
inferredstyles
  where
    globalstyles :: Map TagName AmountStyle
globalstyles          = Journal -> Map TagName AmountStyle
jglobalcommoditystyles Journal
j
    declaredstyles :: Map TagName AmountStyle
declaredstyles        = (Commodity -> Maybe AmountStyle)
-> Map TagName Commodity -> Map TagName AmountStyle
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe Commodity -> Maybe AmountStyle
cformat (Map TagName Commodity -> Map TagName AmountStyle)
-> Map TagName Commodity -> Map TagName AmountStyle
forall a b. (a -> b) -> a -> b
$ Journal -> Map TagName Commodity
jdeclaredcommodities Journal
j
    defaultcommoditystyle :: Map TagName AmountStyle
defaultcommoditystyle = [(TagName, AmountStyle)] -> Map TagName AmountStyle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(TagName, AmountStyle)] -> Map TagName AmountStyle)
-> [(TagName, AmountStyle)] -> Map TagName AmountStyle
forall a b. (a -> b) -> a -> b
$ [Maybe (TagName, AmountStyle)] -> [(TagName, AmountStyle)]
forall a. [Maybe a] -> [a]
catMaybes [Journal -> Maybe (TagName, AmountStyle)
jparsedefaultcommodity Journal
j]
    inferredstyles :: Map TagName AmountStyle
inferredstyles        = Journal -> Map TagName AmountStyle
jinferredcommoditystyles Journal
j

-- | Like journalCommodityStyles, but attach a particular rounding strategy to the styles,
-- affecting how they will affect display precisions when applied.
journalCommodityStylesWith :: Rounding -> Journal -> M.Map CommoditySymbol AmountStyle
journalCommodityStylesWith :: Rounding -> Journal -> Map TagName AmountStyle
journalCommodityStylesWith Rounding
r = Rounding -> Map TagName AmountStyle -> Map TagName AmountStyle
amountStylesSetRounding Rounding
r (Map TagName AmountStyle -> Map TagName AmountStyle)
-> (Journal -> Map TagName AmountStyle)
-> Journal
-> Map TagName AmountStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Map TagName AmountStyle
journalCommodityStyles

-- | Collect and save inferred amount styles for each commodity based on
-- the posting amounts in that commodity (excluding price amounts).
-- Can return an error message eg if inconsistent number formats are found.
journalInferCommodityStyles :: Journal -> Either String Journal
journalInferCommodityStyles :: Journal -> Either RegexError Journal
journalInferCommodityStyles Journal
j =
  case [Amount] -> Either RegexError (Map TagName AmountStyle)
commodityStylesFromAmounts ([Amount] -> Either RegexError (Map TagName AmountStyle))
-> [Amount] -> Either RegexError (Map TagName AmountStyle)
forall a b. (a -> b) -> a -> b
$ Journal -> [Amount]
journalStyleInfluencingAmounts Journal
j of
    Left RegexError
e   -> RegexError -> Either RegexError Journal
forall a b. a -> Either a b
Left RegexError
e
    Right Map TagName AmountStyle
cs -> Journal -> Either RegexError Journal
forall a b. b -> Either a b
Right Journal
j{jinferredcommoditystyles = dbg7 "journalInferCommodityStyles" 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 RegexError (Map TagName AmountStyle)
commodityStylesFromAmounts =
    Map TagName AmountStyle
-> Either RegexError (Map TagName AmountStyle)
forall a b. b -> Either a b
Right (Map TagName AmountStyle
 -> Either RegexError (Map TagName AmountStyle))
-> ([Amount] -> Map TagName AmountStyle)
-> [Amount]
-> Either RegexError (Map TagName AmountStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> Map TagName AmountStyle -> Map TagName AmountStyle)
-> Map TagName AmountStyle -> [Amount] -> Map TagName AmountStyle
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Amount
a -> (AmountStyle -> AmountStyle -> AmountStyle)
-> TagName
-> AmountStyle
-> Map TagName AmountStyle
-> Map TagName AmountStyle
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith AmountStyle -> AmountStyle -> AmountStyle
canonicalStyle (Amount -> TagName
acommodity Amount
a) (Amount -> AmountStyle
astyle Amount
a)) Map TagName 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 b a. (b -> a -> b) -> b -> [a] -> b
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=prec, asdecimalmark=decmark, asdigitgroups=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 a. Maybe a -> Maybe a -> Maybe a
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 :: Char
defdecmark = case Maybe DigitGroupStyle
mgrps of
        Just (DigitGroups Char
'.' [Word8]
_) -> Char
','
        Maybe DigitGroupStyle
_                        -> Char
'.'
    -- 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 Char
decmark = case Maybe DigitGroupStyle
mgrps of
        Just DigitGroupStyle
_  -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
defdecmark
        Maybe DigitGroupStyle
Nothing -> AmountStyle -> Maybe Char
asdecimalmark AmountStyle
a Maybe Char -> Maybe Char -> Maybe Char
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AmountStyle -> Maybe Char
asdecimalmark AmountStyle
b Maybe Char -> Maybe Char -> Maybe Char
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
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 . UnitCost) $ 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 =
       dbg4With (("jinferredmarketprices:\n"<>) . showMarketPrices) $
       map priceDirectiveToMarketPrice .
       concatMap postingPriceDirectivesFromCost $
       journalPostings j
   }

-- | Convert all this journal's amounts to cost using their attached prices, if any.
journalToCost :: ConversionOp -> Journal -> Journal
journalToCost :: ConversionOp -> Journal -> Journal
journalToCost ConversionOp
cost j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns=map (transactionToCost cost) ts}

-- | Identify and tag (1) equity conversion postings and (2) postings which have (or could have ?) redundant costs.
-- And if the addcosts flag is true, also add any costs which can be inferred from equity conversion postings.
-- This is always called before transaction balancing to tag the redundant-cost postings so they can be ignored.
-- With --infer-costs, it is called again after transaction balancing (when it has more information to work with) to infer costs from equity postings.
-- See transactionTagCostsAndEquityAndMaybeInferCosts for more details, and hledger manual > Cost reporting for more background.
journalTagCostsAndEquityAndMaybeInferCosts :: Bool -> Bool -> Journal -> Either String Journal
journalTagCostsAndEquityAndMaybeInferCosts :: Bool -> Bool -> Journal -> Either RegexError Journal
journalTagCostsAndEquityAndMaybeInferCosts Bool
verbosetags Bool
addcosts Journal
j = do
  let conversionaccts :: [TagName]
conversionaccts = Journal -> [TagName]
journalConversionAccounts Journal
j
  [Transaction]
ts <- (Transaction -> Either RegexError Transaction)
-> [Transaction] -> Either RegexError [Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Bool
-> Bool
-> [TagName]
-> Transaction
-> Either RegexError Transaction
transactionTagCostsAndEquityAndMaybeInferCosts Bool
verbosetags Bool
addcosts [TagName]
conversionaccts) ([Transaction] -> Either RegexError [Transaction])
-> [Transaction] -> Either RegexError [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
  Journal -> Either RegexError Journal
forall a. a -> Either RegexError a
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
j{jtxns=ts}

-- | Add equity postings inferred from costs, where needed and possible.
-- See hledger manual > Cost reporting.
journalInferEquityFromCosts :: Bool -> Journal -> Journal
journalInferEquityFromCosts :: Bool -> Journal -> Journal
journalInferEquityFromCosts Bool
verbosetags Journal
j =
  (Transaction -> Transaction) -> Journal -> Journal
journalMapTransactions (Bool -> TagName -> Transaction -> Transaction
transactionInferEquityPostings Bool
verbosetags TagName
equityAcct) Journal
j
  where equityAcct :: TagName
equityAcct = Journal -> TagName
journalBaseConversionAccount 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,acost=p} =
--     case p of Nothing -> [c]
--               Just (UnitCost ma)  -> c:(concatMap amountCommodities $ amounts ma)
--               Just (TotalCost 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' acost field) are not included.
--
journalStyleInfluencingAmounts :: Journal -> [Amount]
journalStyleInfluencingAmounts :: Journal -> [Amount]
journalStyleInfluencingAmounts Journal
j =
  RegexError -> [Amount] -> [Amount]
forall a. Show a => RegexError -> a -> a
dbg7 RegexError
"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 (TagName, AmountStyle)
jparsedefaultcommodity Journal
j of
        Just (TagName
symbol,AmountStyle
style) -> Amount -> Maybe Amount
forall a. a -> Maybe a
Just Amount
nullamt{acommodity=symbol,astyle=style}
        Maybe (TagName, 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 acost 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 exact 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 EFDay -> Maybe EFDay -> DateSpan
DateSpan (Day -> EFDay
Exact (Day -> EFDay) -> Maybe Day -> Maybe EFDay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Day] -> Maybe Day
forall a. Ord a => [a] -> Maybe a
minimumMay [Day]
dates) (Day -> EFDay
Exact (Day -> EFDay) -> (Day -> Day) -> Day -> EFDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Day -> Day
addDays Integer
1 (Day -> EFDay) -> Maybe Day -> Maybe EFDay
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 a. Maybe a -> Maybe a -> Maybe a
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 = EFDay -> Day
fromEFDay (EFDay -> Day) -> Maybe EFDay -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe EFDay
b where DateSpan Maybe EFDay
b Maybe EFDay
_ = 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 = EFDay -> Day
fromEFDay (EFDay -> Day) -> Maybe EFDay -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe EFDay
e where DateSpan Maybe EFDay
_ Maybe EFDay
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 = Integer -> Day -> Day
addDays (-Integer
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 :: TagName -> Journal -> Journal
journalPivot TagName
fieldortagname Journal
j = Journal
j{jtxns = map (transactionPivot fieldortagname) . jtxns $ j}

-- | Replace this transaction's postings' account names with the value
-- of the given field or tag, if any.
transactionPivot :: Text -> Transaction -> Transaction
transactionPivot :: TagName -> Transaction -> Transaction
transactionPivot TagName
fieldortagname Transaction
t = Transaction
t{tpostings = map (postingPivot fieldortagname) . tpostings $ 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 :: TagName -> Posting -> Posting
postingPivot TagName
fieldortagname Posting
p =
  Posting
p{paccount = pivotAccount fieldortagname p, poriginal = Just $ originalPosting p}

pivotAccount :: Text -> Posting -> Text
pivotAccount :: TagName -> Posting -> TagName
pivotAccount TagName
fieldortagname Posting
p =
  TagName -> [TagName] -> TagName
T.intercalate TagName
":" [TagName -> Posting -> TagName
pivotComponent TagName
x Posting
p | TagName
x <- HasCallStack => TagName -> TagName -> [TagName]
TagName -> TagName -> [TagName]
T.splitOn TagName
":" TagName
fieldortagname]

-- | Get the value of the given field or tag for this posting.
-- "comm" and "cur" are accepted as synonyms meaning the commodity symbol.
-- Pivoting on an unknown field or tag, or on commodity when there are multiple commodities, returns "".
-- Pivoting on a tag when there are multiple values for that tag, returns the first value.
pivotComponent :: Text -> Posting -> Text
pivotComponent :: TagName -> Posting -> TagName
pivotComponent TagName
fieldortagname Posting
p
  | TagName
fieldortagname TagName -> TagName -> Bool
forall a. Eq a => a -> a -> Bool
== TagName
"code",        Just Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p = Transaction -> TagName
tcode Transaction
t
  | TagName
fieldortagname TagName -> [TagName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TagName]
descnames, Just Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p = Transaction -> TagName
tdescription Transaction
t
  | TagName
fieldortagname TagName -> TagName -> Bool
forall a. Eq a => a -> a -> Bool
== TagName
"payee",       Just Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p = Transaction -> TagName
transactionPayee Transaction
t
  | TagName
fieldortagname TagName -> TagName -> Bool
forall a. Eq a => a -> a -> Bool
== TagName
"note",        Just Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p = Transaction -> TagName
transactionNote Transaction
t
  | TagName
fieldortagname TagName -> TagName -> Bool
forall a. Eq a => a -> a -> Bool
== TagName
"status",      Just Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p = RegexError -> TagName
T.pack (RegexError -> TagName)
-> (Transaction -> RegexError) -> Transaction -> TagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> RegexError
forall a. Show a => a -> RegexError
show (Status -> RegexError)
-> (Transaction -> Status) -> Transaction -> RegexError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Status
tstatus (Transaction -> TagName) -> Transaction -> TagName
forall a b. (a -> b) -> a -> b
$ Transaction
t
  | TagName
fieldortagname TagName -> TagName -> Bool
forall a. Eq a => a -> a -> Bool
== TagName
"acct"        = Posting -> TagName
paccount Posting
p
  | TagName
fieldortagname TagName -> [TagName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TagName]
commnames = case (Amount -> TagName) -> [Amount] -> [TagName]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> TagName
acommodity ([Amount] -> [TagName]) -> [Amount] -> [TagName]
forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p of [TagName
s] -> TagName
s; [TagName]
_ -> TagName
unknown
  | TagName
fieldortagname TagName -> TagName -> Bool
forall a. Eq a => a -> a -> Bool
== TagName
"amt"         = case MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p of [Amount
a] -> RegexError -> TagName
T.pack (RegexError -> TagName) -> RegexError -> TagName
forall a b. (a -> b) -> a -> b
$ Quantity -> RegexError
forall a. Show a => a -> RegexError
show (Quantity -> RegexError) -> Quantity -> RegexError
forall a b. (a -> b) -> a -> b
$ Amount -> Quantity
aquantity Amount
a; [Amount]
_ -> TagName
unknown
  | TagName
fieldortagname TagName -> TagName -> Bool
forall a. Eq a => a -> a -> Bool
== TagName
"cost"        = case MixedAmount -> [Amount]
amounts (MixedAmount -> [Amount]) -> MixedAmount -> [Amount]
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p of [a :: Amount
a@Amount{acost :: Amount -> Maybe AmountCost
acost=Just AmountCost
_}] -> RegexError -> TagName
T.pack (RegexError -> TagName) -> RegexError -> TagName
forall a b. (a -> b) -> a -> b
$ ShowS
lstrip ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Amount -> RegexError
showAmountCost Amount
a; [Amount]
_ -> TagName
unknown
  | Just (TagName
_, TagName
tagvalue) <- TagName -> Posting -> Maybe Tag
postingFindTag TagName
fieldortagname Posting
p = TagName
tagvalue
  | Bool
otherwise = TagName
unknown
  where
    descnames :: [TagName]
descnames = [TagName
"desc", TagName
"description"]   -- allow "description" for hledger <=1.30 compat
    commnames :: [TagName]
commnames = [TagName
"cur",TagName
"comm"]            -- allow either; cur is the query prefix, comm is more consistent
    unknown :: TagName
unknown   = TagName
""

postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue)
postingFindTag :: TagName -> Posting -> Maybe Tag
postingFindTag TagName
tagname Posting
p = (Tag -> Bool) -> [Tag] -> Maybe Tag
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((TagName
tagnameTagName -> TagName -> Bool
forall a. Eq a => a -> a -> Bool
==) (TagName -> Bool) -> (Tag -> TagName) -> Tag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> TagName
forall a b. (a, b) -> a
fst) ([Tag] -> Maybe Tag) -> [Tag] -> Maybe Tag
forall a b. (a -> b) -> a -> b
$ Posting -> [Tag]
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 RegexError Journal
journalApplyAliases [] Journal
j = Journal -> Either RegexError Journal
forall a b. b -> Either a b
Right Journal
j
journalApplyAliases [AccountAlias]
aliases Journal
j = 
  case (Transaction -> Either RegexError Transaction)
-> [Transaction] -> Either RegexError [Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([AccountAlias] -> Transaction -> Either RegexError Transaction
transactionApplyAliases [AccountAlias]
aliases) ([Transaction] -> Either RegexError [Transaction])
-> [Transaction] -> Either RegexError [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j of
    Right [Transaction]
ts -> Journal -> Either RegexError Journal
forall a b. b -> Either a b
Right Journal
j{jtxns = ts}
    Left RegexError
err -> RegexError -> Either RegexError Journal
forall a b. a -> Either a b
Left RegexError
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 = [
           txnTieKnot $ Transaction {
             tindex=0,
             tsourcepos=nullsourcepospair,
             tdate=fromGregorian 2008 01 01,
             tdate2=Nothing,
             tstatus=Unmarked,
             tcode="",
             tdescription="income",
             tcomment="",
             ttags=[],
             tpostings=
                 ["assets:bank:checking" `post` usd 1
                 ,"income:salary" `post` if explicit then usd (-1) else missingamt
                 ],
             tprecedingcomment=""
           }
          ,
           txnTieKnot $ Transaction {
             tindex=0,
             tsourcepos=nullsourcepospair,
             tdate=fromGregorian 2008 06 01,
             tdate2=Nothing,
             tstatus=Unmarked,
             tcode="",
             tdescription="gift",
             tcomment="",
             ttags=[],
             tpostings=
                 ["assets:bank:checking" `post` usd 1
                 ,"income:gifts" `post` if explicit then usd (-1) else missingamt
                 ],
             tprecedingcomment=""
           }
          ,
           txnTieKnot $ Transaction {
             tindex=0,
             tsourcepos=nullsourcepospair,
             tdate=fromGregorian 2008 06 02,
             tdate2=Nothing,
             tstatus=Unmarked,
             tcode="",
             tdescription="save",
             tcomment="",
             ttags=[],
             tpostings=
                 ["assets:bank:saving" `post` usd 1
                 ,"assets:bank:checking" `post` if explicit then usd (-1) else missingamt
                 ],
             tprecedingcomment=""
           }
          ,
           txnTieKnot $ Transaction {
             tindex=0,
             tsourcepos=nullsourcepospair,
             tdate=fromGregorian 2008 06 03,
             tdate2=Nothing,
             tstatus=Cleared,
             tcode="",
             tdescription="eat & shop",
             tcomment="",
             ttags=[],
             tpostings=["expenses:food" `post` usd 1
                       ,"expenses:supplies" `post` usd 1
                       ,"assets:cash" `post` if explicit then usd (-2) else missingamt
                       ],
             tprecedingcomment=""
           }
          ,
           txnTieKnot $ Transaction {
             tindex=0,
             tsourcepos=nullsourcepospair,
             tdate=fromGregorian 2008 10 01,
             tdate2=Nothing,
             tstatus=Unmarked,
             tcode="",
             tdescription="take a loan",
             tcomment="",
             ttags=[],
             tpostings=["assets:bank:checking" `post` usd 1
                       ,"liabilities:debts" `post` usd (-1)
                       ],
             tprecedingcomment=""
           }
          ,
           txnTieKnot $ Transaction {
             tindex=0,
             tsourcepos=nullsourcepospair,
             tdate=fromGregorian 2008 12 31,
             tdate2=Nothing,
             tstatus=Unmarked,
             tcode="",
             tdescription="pay off",
             tcomment="",
             ttags=[],
             tpostings=["liabilities:debts" `post` usd 1
                       ,"assets:bank:checking" `post` if explicit then usd (-1) else missingamt
                       ],
             tprecedingcomment=""
           }
          ]
         }

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

   RegexError -> Assertion -> TestTree
testCase RegexError
"journalDateSpan" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
    Bool -> Journal -> DateSpan
journalDateSpan Bool
True Journal
nulljournal{
      jtxns = [nulltransaction{tdate = fromGregorian 2014 02 01
                              ,tpostings = [posting{pdate=Just (fromGregorian 2014 01 10)}]
                              }
              ,nulltransaction{tdate = fromGregorian 2014 09 01
                              ,tpostings = [posting{pdate2=Just (fromGregorian 2014 10 10)}]
                              }
              ]
      }
    DateSpan -> DateSpan -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (EFDay -> Maybe EFDay
forall a. a -> Maybe a
Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Exact (Day -> EFDay) -> Day -> EFDay
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
2014 Int
1 Int
10) (EFDay -> Maybe EFDay
forall a. a -> Maybe a
Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Exact (Day -> EFDay) -> Day -> EFDay
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
2014 Int
10 Int
11))
  ]