{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.Data.Journal (
JournalParser,
ErroringJournalParser,
addPriceDirective,
addTransactionModifier,
addPeriodicTransaction,
addTransaction,
journalInferMarketPricesFromTransactions,
journalApplyCommodityStyles,
commodityStylesFromAmounts,
journalCommodityStyles,
journalToCost,
journalAddInferredEquityPostings,
journalInferCostsFromEquity,
journalMarkRedundantCosts,
journalReverse,
journalSetLastReadTime,
journalRenumberAccountDeclarations,
journalPivot,
filterJournalTransactions,
filterJournalPostings,
filterJournalRelatedPostings,
filterJournalAmounts,
filterTransactionAmounts,
filterTransactionPostings,
filterTransactionPostingsExtra,
filterTransactionRelatedPostings,
filterPostingAmount,
journalMapTransactions,
journalMapPostings,
journalMapPostingAmounts,
journalAccountNamesUsed,
journalAccountNamesImplied,
journalAccountNamesDeclared,
journalAccountNamesDeclaredOrUsed,
journalAccountNamesDeclaredOrImplied,
journalLeafAccountNamesDeclared,
journalAccountNames,
journalLeafAccountNames,
journalAccountNameTree,
journalAccountTags,
journalInheritedAccountTags,
journalPayeesDeclared,
journalPayeesUsed,
journalPayeesDeclaredOrUsed,
journalTagsDeclared,
journalTagsUsed,
journalTagsDeclaredOrUsed,
journalCommoditiesDeclared,
journalCommodities,
journalDateSpan,
journalDateSpanBothDates,
journalStartDate,
journalEndDate,
journalLastDay,
journalDescriptions,
journalFilePath,
journalFilePaths,
journalTransactionAt,
journalNextTransaction,
journalPrevTransaction,
journalPostings,
journalTransactionsSimilarTo,
journalAccountType,
journalAccountTypes,
journalAddAccountTypes,
journalPostingsAddAccountTags,
journalConversionAccount,
canonicalStyleFrom,
nulljournal,
journalConcat,
journalNumberTransactions,
journalNumberAndTieTransactions,
journalUntieTransactions,
journalModifyTransactions,
journalApplyAliases,
dbgJournalAcctDeclOrder,
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, foldl', sortBy, union, intercalate)
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 Text.Megaparsec.Custom (FinalParseError)
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)
type JournalParser m a = StateT Journal (ParsecT HledgerParseErrorData Text m) a
type ErroringJournalParser m a =
StateT Journal (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m)) a
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
jinferredcommodities Journal
j)
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
instance Semigroup Journal where Journal
j1 <> :: Journal -> Journal -> Journal
<> Journal
j2 = Journal
j1 Journal -> Journal -> Journal
`journalConcat` Journal
j2
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
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
,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
,jdeclaredaccounttags :: Map TagName [Tag]
jdeclaredaccounttags = Journal -> Map TagName [Tag]
jdeclaredaccounttags Journal
j1 Map TagName [Tag] -> Map TagName [Tag] -> Map TagName [Tag]
forall a. Semigroup a => a -> a -> a
<> Journal -> Map TagName [Tag]
jdeclaredaccounttags Journal
j2
,jdeclaredaccounttypes :: Map AccountType [TagName]
jdeclaredaccounttypes = Journal -> Map AccountType [TagName]
jdeclaredaccounttypes Journal
j1 Map AccountType [TagName]
-> Map AccountType [TagName] -> Map AccountType [TagName]
forall a. Semigroup a => a -> a -> a
<> Journal -> Map AccountType [TagName]
jdeclaredaccounttypes Journal
j2
,jaccounttypes :: Map TagName AccountType
jaccounttypes = Journal -> Map TagName AccountType
jaccounttypes Journal
j1 Map TagName AccountType
-> Map TagName AccountType -> Map TagName AccountType
forall a. Semigroup a => a -> a -> a
<> Journal -> Map TagName AccountType
jaccounttypes Journal
j2
,jglobalcommoditystyles :: Map TagName AmountStyle
jglobalcommoditystyles = Journal -> Map TagName AmountStyle
jglobalcommoditystyles Journal
j1 Map TagName AmountStyle
-> Map TagName AmountStyle -> Map TagName AmountStyle
forall a. Semigroup a => a -> a -> a
<> Journal -> Map TagName AmountStyle
jglobalcommoditystyles Journal
j2
,jcommodities :: Map TagName Commodity
jcommodities = Journal -> Map TagName Commodity
jcommodities Journal
j1 Map TagName Commodity
-> Map TagName Commodity -> Map TagName Commodity
forall a. Semigroup a => a -> a -> a
<> Journal -> Map TagName Commodity
jcommodities Journal
j2
,jinferredcommodities :: Map TagName AmountStyle
jinferredcommodities = Journal -> Map TagName AmountStyle
jinferredcommodities Journal
j1 Map TagName AmountStyle
-> Map TagName AmountStyle -> Map TagName AmountStyle
forall a. Semigroup a => a -> a -> a
<> Journal -> Map TagName AmountStyle
jinferredcommodities Journal
j2
,jpricedirectives :: [PriceDirective]
jpricedirectives = Journal -> [PriceDirective]
jpricedirectives Journal
j1 [PriceDirective] -> [PriceDirective] -> [PriceDirective]
forall a. Semigroup a => a -> a -> a
<> Journal -> [PriceDirective]
jpricedirectives Journal
j2
,jinferredmarketprices :: [MarketPrice]
jinferredmarketprices = Journal -> [MarketPrice]
jinferredmarketprices Journal
j1 [MarketPrice] -> [MarketPrice] -> [MarketPrice]
forall a. Semigroup a => a -> a -> a
<> Journal -> [MarketPrice]
jinferredmarketprices Journal
j2
,jtxnmodifiers :: [TransactionModifier]
jtxnmodifiers = Journal -> [TransactionModifier]
jtxnmodifiers Journal
j1 [TransactionModifier]
-> [TransactionModifier] -> [TransactionModifier]
forall a. Semigroup a => a -> a -> a
<> Journal -> [TransactionModifier]
jtxnmodifiers Journal
j2
,jperiodictxns :: [PeriodicTransaction]
jperiodictxns = Journal -> [PeriodicTransaction]
jperiodictxns Journal
j1 [PeriodicTransaction]
-> [PeriodicTransaction] -> [PeriodicTransaction]
forall a. Semigroup a => a -> a -> a
<> Journal -> [PeriodicTransaction]
jperiodictxns Journal
j2
,jtxns :: [Transaction]
jtxns = Journal -> [Transaction]
jtxns Journal
j1 [Transaction] -> [Transaction] -> [Transaction]
forall a. Semigroup a => a -> a -> a
<> Journal -> [Transaction]
jtxns Journal
j2
,jfinalcommentlines :: TagName
jfinalcommentlines = Journal -> TagName
jfinalcommentlines Journal
j2
,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)
}
journalRenumberAccountDeclarations :: Journal -> Journal
journalRenumberAccountDeclarations :: Journal -> Journal
journalRenumberAccountDeclarations Journal
j = Journal
j{jdeclaredaccounts :: [(TagName, AccountDeclarationInfo)]
jdeclaredaccounts=[(TagName, AccountDeclarationInfo)]
jdas'}
where
jdas' :: [(TagName, AccountDeclarationInfo)]
jdas' = [(TagName
a, AccountDeclarationInfo
adi{adideclarationorder :: Int
adideclarationorder=Int
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]
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 = []
,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
,jcommodities :: Map TagName Commodity
jcommodities = Map TagName Commodity
forall k a. Map k a
M.empty
,jinferredcommodities :: Map TagName AmountStyle
jinferredcommodities = 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 :: [Transaction]
jtxns = Transaction
t Transaction -> [Transaction] -> [Transaction]
forall a. a -> [a] -> [a]
: Journal -> [Transaction]
jtxns Journal
j }
addTransactionModifier :: TransactionModifier -> Journal -> Journal
addTransactionModifier :: TransactionModifier -> Journal -> Journal
addTransactionModifier TransactionModifier
mt Journal
j = Journal
j { jtxnmodifiers :: [TransactionModifier]
jtxnmodifiers = TransactionModifier
mt TransactionModifier
-> [TransactionModifier] -> [TransactionModifier]
forall a. a -> [a] -> [a]
: Journal -> [TransactionModifier]
jtxnmodifiers Journal
j }
addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal
addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal
addPeriodicTransaction PeriodicTransaction
pt Journal
j = Journal
j { jperiodictxns :: [PeriodicTransaction]
jperiodictxns = PeriodicTransaction
pt PeriodicTransaction
-> [PeriodicTransaction] -> [PeriodicTransaction]
forall a. a -> [a] -> [a]
: Journal -> [PeriodicTransaction]
jperiodictxns Journal
j }
addPriceDirective :: PriceDirective -> Journal -> Journal
addPriceDirective :: PriceDirective -> Journal -> Journal
addPriceDirective PriceDirective
h Journal
j = Journal
j { jpricedirectives :: [PriceDirective]
jpricedirectives = PriceDirective
h PriceDirective -> [PriceDirective] -> [PriceDirective]
forall a. a -> [a] -> [a]
: Journal -> [PriceDirective]
jpricedirectives Journal
j }
journalTransactionAt :: Journal -> Integer -> Maybe Transaction
journalTransactionAt :: Journal -> Integer -> Maybe Transaction
journalTransactionAt Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} Integer
i =
[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]
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)
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)
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
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
jcommodities
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
jcommodities 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
jinferredcommodities Journal
j)
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
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
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
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]
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
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
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]
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
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
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
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
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]
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]
journalAccountNames :: Journal -> [AccountName]
journalAccountNames :: Journal -> [TagName]
journalAccountNames = Journal -> [TagName]
journalAccountNamesDeclaredOrImplied
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
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
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
type DateWeightedSimilarityScore = Double
type SimilarityScore = Double
type Age = Integer
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
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
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)
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
_ = []
journalConversionAccount :: Journal -> AccountName
journalConversionAccount :: Journal -> TagName
journalConversionAccount =
TagName -> [TagName] -> TagName
forall a. a -> [a] -> a
headDef (RegexError -> TagName
T.pack RegexError
"equity:conversion")
([TagName] -> TagName)
-> (Journal -> [TagName]) -> Journal -> TagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TagName] -> AccountType -> Map AccountType [TagName] -> [TagName]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] AccountType
Conversion
(Map AccountType [TagName] -> [TagName])
-> (Journal -> Map AccountType [TagName]) -> Journal -> [TagName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Map AccountType [TagName]
jdeclaredaccounttypes
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
journalAddAccountTypes :: Journal -> Journal
journalAddAccountTypes :: Journal -> Journal
journalAddAccountTypes Journal
j = Journal
j{jaccounttypes :: Map TagName AccountType
jaccounttypes = Journal -> Map TagName AccountType
journalAccountTypes Journal
j}
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
t' :: Tree (TagName, Maybe (AccountType, Bool))
t' = Maybe (AccountType, Bool)
-> Tree TagName -> Tree (TagName, Maybe (AccountType, Bool))
settypes Maybe (AccountType, Bool)
forall a. Maybe a
Nothing Tree TagName
t :: Tree (AccountName, Maybe (AccountType, Bool))
where
settypes :: Maybe (AccountType, Bool) -> Tree AccountName -> Tree (AccountName, Maybe (AccountType, Bool))
settypes :: Maybe (AccountType, Bool)
-> Tree TagName -> Tree (TagName, Maybe (AccountType, Bool))
settypes 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)
mtype) ((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))
settypes Maybe (AccountType, Bool)
mtype) [Tree TagName]
subs)
where
mtype :: Maybe (AccountType, Bool)
mtype = 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)
declaredtypes 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)
minferred
where
declaredtypes :: Map TagName (AccountType, Bool)
declaredtypes = (,Bool
True) (AccountType -> (AccountType, Bool))
-> Map TagName AccountType -> Map TagName (AccountType, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Journal -> Map TagName AccountType
journalDeclaredAccountTypes Journal
j
minferred :: Maybe (AccountType, Bool)
minferred = if Bool
-> ((AccountType, Bool) -> Bool)
-> Maybe (AccountType, Bool)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (AccountType, Bool) -> Bool
forall a b. (a, b) -> b
snd Maybe (AccountType, Bool)
mparenttype
then Maybe (AccountType, Bool)
mparenttype
else (,Bool
False) (AccountType -> (AccountType, Bool))
-> Maybe AccountType -> Maybe (AccountType, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TagName -> Maybe AccountType
accountNameInferType TagName
a 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)
mparenttype
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]
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)
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 :: [Transaction]
jtxns=(Transaction -> Bool) -> [Transaction] -> [Transaction]
forall a. (a -> Bool) -> [a] -> [a]
filter ((TagName -> Maybe AccountType) -> Query -> Transaction -> Bool
matchesTransactionExtra (Journal -> TagName -> Maybe AccountType
journalAccountType Journal
j) Query
q) [Transaction]
jtxns}
filterJournalPostings :: Query -> Journal -> Journal
filterJournalPostings :: Query -> Journal -> Journal
filterJournalPostings Query
q j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map ((TagName -> Maybe AccountType)
-> Query -> Transaction -> Transaction
filterTransactionPostingsExtra (Journal -> TagName -> Maybe AccountType
journalAccountType Journal
j) Query
q) [Transaction]
ts}
filterJournalRelatedPostings :: Query -> Journal -> Journal
filterJournalRelatedPostings :: Query -> Journal -> Journal
filterJournalRelatedPostings Query
q j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (Query -> Transaction -> Transaction
filterTransactionRelatedPostings Query
q) [Transaction]
ts}
filterJournalAmounts :: Query -> Journal -> Journal
filterJournalAmounts :: Query -> Journal -> Journal
filterJournalAmounts Query
q j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (Query -> Transaction -> Transaction
filterTransactionAmounts Query
q) [Transaction]
ts}
filterTransactionAmounts :: Query -> Transaction -> Transaction
filterTransactionAmounts :: Query -> Transaction -> Transaction
filterTransactionAmounts Query
q t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> Maybe Posting) -> [Posting] -> [Posting]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Query -> Posting -> Maybe Posting
filterPostingAmount Query
q) [Posting]
ps}
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 :: MixedAmount
pamount=Map MixedAmountKey Amount -> MixedAmount
Mixed Map MixedAmountKey Amount
newamt}
where
Mixed Map MixedAmountKey Amount
newamt = (Amount -> Bool) -> MixedAmount -> MixedAmount
filterMixedAmount (Query
q Query -> Amount -> Bool
`matchesAmount`) MixedAmount
as
filterTransactionPostings :: Query -> Transaction -> Transaction
filterTransactionPostings :: Query -> Transaction -> Transaction
filterTransactionPostings Query
q t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query
q Query -> Posting -> Bool
`matchesPosting`) [Posting]
ps}
filterTransactionPostingsExtra :: (AccountName -> Maybe AccountType) -> Query -> Transaction -> Transaction
TagName -> Maybe AccountType
atypes Query
q t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} =
Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter ((TagName -> Maybe AccountType) -> Query -> Posting -> Bool
matchesPostingExtra TagName -> Maybe AccountType
atypes Query
q) [Posting]
ps}
filterTransactionRelatedPostings :: Query -> Transaction -> Transaction
filterTransactionRelatedPostings :: Query -> Transaction -> Transaction
filterTransactionRelatedPostings Query
q t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} =
Transaction
t{tpostings :: [Posting]
tpostings=if [Posting] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Posting]
matches then [] else [Posting]
ps [Posting] -> [Posting] -> [Posting]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Posting]
matches}
where matches :: [Posting]
matches = (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Posting -> Bool
matchesPosting Query
q) [Posting]
ps
journalMapTransactions :: (Transaction -> Transaction) -> Journal -> Journal
journalMapTransactions :: (Transaction -> Transaction) -> Journal -> Journal
journalMapTransactions Transaction -> Transaction
f j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Transaction
f [Transaction]
ts}
journalMapPostings :: (Posting -> Posting) -> Journal -> Journal
journalMapPostings :: (Posting -> Posting) -> Journal -> Journal
journalMapPostings Posting -> Posting
f j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map ((Posting -> Posting) -> Transaction -> Transaction
transactionMapPostings Posting -> Posting
f) [Transaction]
ts}
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)
journalReverse :: Journal -> Journal
journalReverse :: Journal -> Journal
journalReverse Journal
j =
Journal
j {jfiles :: [(RegexError, TagName)]
jfiles = [(RegexError, TagName)] -> [(RegexError, TagName)]
forall a. [a] -> [a]
reverse ([(RegexError, TagName)] -> [(RegexError, TagName)])
-> [(RegexError, TagName)] -> [(RegexError, TagName)]
forall a b. (a -> b) -> a -> b
$ Journal -> [(RegexError, TagName)]
jfiles Journal
j
,jdeclaredaccounts :: [(TagName, AccountDeclarationInfo)]
jdeclaredaccounts = [(TagName, AccountDeclarationInfo)]
-> [(TagName, AccountDeclarationInfo)]
forall a. [a] -> [a]
reverse ([(TagName, AccountDeclarationInfo)]
-> [(TagName, AccountDeclarationInfo)])
-> [(TagName, AccountDeclarationInfo)]
-> [(TagName, AccountDeclarationInfo)]
forall a b. (a -> b) -> a -> b
$ Journal -> [(TagName, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j
,jtxns :: [Transaction]
jtxns = [Transaction] -> [Transaction]
forall a. [a] -> [a]
reverse ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
,jtxnmodifiers :: [TransactionModifier]
jtxnmodifiers = [TransactionModifier] -> [TransactionModifier]
forall a. [a] -> [a]
reverse ([TransactionModifier] -> [TransactionModifier])
-> [TransactionModifier] -> [TransactionModifier]
forall a b. (a -> b) -> a -> b
$ Journal -> [TransactionModifier]
jtxnmodifiers Journal
j
,jperiodictxns :: [PeriodicTransaction]
jperiodictxns = [PeriodicTransaction] -> [PeriodicTransaction]
forall a. [a] -> [a]
reverse ([PeriodicTransaction] -> [PeriodicTransaction])
-> [PeriodicTransaction] -> [PeriodicTransaction]
forall a b. (a -> b) -> a -> b
$ Journal -> [PeriodicTransaction]
jperiodictxns Journal
j
,jpricedirectives :: [PriceDirective]
jpricedirectives = [PriceDirective] -> [PriceDirective]
forall a. [a] -> [a]
reverse ([PriceDirective] -> [PriceDirective])
-> [PriceDirective] -> [PriceDirective]
forall a b. (a -> b) -> a -> b
$ Journal -> [PriceDirective]
jpricedirectives Journal
j
}
journalSetLastReadTime :: POSIXTime -> Journal -> Journal
journalSetLastReadTime :: POSIXTime -> Journal -> Journal
journalSetLastReadTime POSIXTime
t Journal
j = Journal
j{ jlastreadtime :: POSIXTime
jlastreadtime = POSIXTime
t }
journalNumberAndTieTransactions :: Journal -> Journal
journalNumberAndTieTransactions = Journal -> Journal
journalTieTransactions (Journal -> Journal) -> (Journal -> Journal) -> Journal -> Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Journal
journalNumberTransactions
journalNumberTransactions :: Journal -> Journal
journalNumberTransactions :: Journal -> Journal
journalNumberTransactions j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Integer -> Transaction -> Transaction)
-> [Integer] -> [Transaction] -> [Transaction]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Integer
i Transaction
t -> Transaction
t{tindex :: Integer
tindex=Integer
i}) [Integer
1..] [Transaction]
ts}
journalTieTransactions :: Journal -> Journal
journalTieTransactions :: Journal -> Journal
journalTieTransactions j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Transaction
txnTieKnot [Transaction]
ts}
journalUntieTransactions :: Transaction -> Transaction
journalUntieTransactions :: Transaction -> Transaction
journalUntieTransactions t :: Transaction
t@Transaction{tpostings :: Transaction -> [Posting]
tpostings=[Posting]
ps} = Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (\Posting
p -> Posting
p{ptransaction :: Maybe Transaction
ptransaction=Maybe Transaction
forall a. Maybe a
Nothing}) [Posting]
ps}
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 :: [Transaction]
jtxns=[Transaction]
ts}
Left RegexError
err -> RegexError -> Either RegexError Journal
forall a b. a -> Either a b
Left RegexError
err
journalApplyCommodityStyles :: Journal -> Either String Journal
journalApplyCommodityStyles :: Journal -> Either RegexError Journal
journalApplyCommodityStyles = (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
fixjournal (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
fixjournal :: Journal -> Journal
fixjournal j :: Journal
j@Journal{jpricedirectives :: Journal -> [PriceDirective]
jpricedirectives=[PriceDirective]
pds} =
(Posting -> Posting) -> Journal -> Journal
journalMapPostings (Map TagName AmountStyle -> Posting -> Posting
postingApplyCommodityStyles Map TagName AmountStyle
styles) Journal
j{jpricedirectives :: [PriceDirective]
jpricedirectives=(PriceDirective -> PriceDirective)
-> [PriceDirective] -> [PriceDirective]
forall a b. (a -> b) -> [a] -> [b]
map PriceDirective -> PriceDirective
fixpricedirective [PriceDirective]
pds}
where
styles :: Map TagName AmountStyle
styles = Journal -> Map TagName AmountStyle
journalCommodityStyles Journal
j
fixpricedirective :: PriceDirective -> PriceDirective
fixpricedirective pd :: PriceDirective
pd@PriceDirective{pdamount :: PriceDirective -> Amount
pdamount=Amount
a} = PriceDirective
pd{pdamount :: Amount
pdamount=Map TagName AmountStyle -> Amount -> Amount
styleAmountExceptPrecision Map TagName AmountStyle
styles Amount
a}
journalCommodityStyles :: Journal -> M.Map CommoditySymbol AmountStyle
journalCommodityStyles :: Journal -> Map TagName AmountStyle
journalCommodityStyles Journal
j =
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
jcommodities 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
jinferredcommodities Journal
j
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{jinferredcommodities :: Map TagName AmountStyle
jinferredcommodities = RegexError -> Map TagName AmountStyle -> Map TagName AmountStyle
forall a. Show a => RegexError -> a -> a
dbg7 RegexError
"journalInferCommodityStyles" Map TagName AmountStyle
cs}
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
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
canonicalStyle :: AmountStyle -> AmountStyle -> AmountStyle
canonicalStyle :: AmountStyle -> AmountStyle -> AmountStyle
canonicalStyle AmountStyle
a AmountStyle
b = AmountStyle
a{asprecision :: AmountPrecision
asprecision=AmountPrecision
prec, asdecimalpoint :: Maybe Char
asdecimalpoint=Maybe Char
decmark, asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
mgrps}
where
prec :: AmountPrecision
prec = AmountPrecision -> AmountPrecision -> AmountPrecision
forall a. Ord a => a -> a -> a
max (AmountStyle -> AmountPrecision
asprecision AmountStyle
a) (AmountStyle -> AmountPrecision
asprecision AmountStyle
b)
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
defdecmark :: Char
defdecmark = case Maybe DigitGroupStyle
mgrps of
Just (DigitGroups Char
'.' [Word8]
_) -> Char
','
Maybe DigitGroupStyle
_ -> Char
'.'
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
asdecimalpoint 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
asdecimalpoint 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
journalInferMarketPricesFromTransactions :: Journal -> Journal
journalInferMarketPricesFromTransactions :: Journal -> Journal
journalInferMarketPricesFromTransactions Journal
j =
Journal
j{jinferredmarketprices :: [MarketPrice]
jinferredmarketprices =
RegexError -> [MarketPrice] -> [MarketPrice]
forall a. Show a => RegexError -> a -> a
dbg4 RegexError
"jinferredmarketprices" ([MarketPrice] -> [MarketPrice])
-> ([Posting] -> [MarketPrice]) -> [Posting] -> [MarketPrice]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(PriceDirective -> MarketPrice)
-> [PriceDirective] -> [MarketPrice]
forall a b. (a -> b) -> [a] -> [b]
map PriceDirective -> MarketPrice
priceDirectiveToMarketPrice ([PriceDirective] -> [MarketPrice])
-> ([Posting] -> [PriceDirective]) -> [Posting] -> [MarketPrice]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Posting -> [PriceDirective]) -> [Posting] -> [PriceDirective]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Posting -> [PriceDirective]
postingPriceDirectivesFromCost ([Posting] -> [MarketPrice]) -> [Posting] -> [MarketPrice]
forall a b. (a -> b) -> a -> b
$
Journal -> [Posting]
journalPostings Journal
j
}
journalToCost :: ConversionOp -> Journal -> Journal
journalToCost :: ConversionOp -> Journal -> Journal
journalToCost ConversionOp
cost j :: Journal
j@Journal{jtxns :: Journal -> [Transaction]
jtxns=[Transaction]
ts} = Journal
j{jtxns :: [Transaction]
jtxns=(Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (Map TagName AmountStyle
-> ConversionOp -> Transaction -> Transaction
transactionToCost Map TagName AmountStyle
styles ConversionOp
cost) [Transaction]
ts}
where
styles :: Map TagName AmountStyle
styles = Journal -> Map TagName AmountStyle
journalCommodityStyles Journal
j
journalAddInferredEquityPostings :: Bool -> Journal -> Journal
journalAddInferredEquityPostings :: Bool -> Journal -> Journal
journalAddInferredEquityPostings Bool
verbosetags Journal
j = (Transaction -> Transaction) -> Journal -> Journal
journalMapTransactions (Bool -> TagName -> Transaction -> Transaction
transactionAddInferredEquityPostings Bool
verbosetags TagName
equityAcct) Journal
j
where
equityAcct :: TagName
equityAcct = Journal -> TagName
journalConversionAccount Journal
j
journalInferCostsFromEquity :: Journal -> Either String Journal
journalInferCostsFromEquity :: Journal -> Either RegexError Journal
journalInferCostsFromEquity Journal
j = do
[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
-> Map TagName AccountType
-> Transaction
-> Either RegexError Transaction
transactionInferCostsFromEquity Bool
False (Map TagName AccountType
-> Transaction -> Either RegexError Transaction)
-> Map TagName AccountType
-> Transaction
-> Either RegexError Transaction
forall a b. (a -> b) -> a -> b
$ Journal -> Map TagName AccountType
jaccounttypes Journal
j) ([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 :: [Transaction]
jtxns=[Transaction]
ts}
journalMarkRedundantCosts :: Journal -> Either String Journal
journalMarkRedundantCosts :: Journal -> Either RegexError Journal
journalMarkRedundantCosts Journal
j = do
[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
-> Map TagName AccountType
-> Transaction
-> Either RegexError Transaction
transactionInferCostsFromEquity Bool
True (Map TagName AccountType
-> Transaction -> Either RegexError Transaction)
-> Map TagName AccountType
-> Transaction
-> Either RegexError Transaction
forall a b. (a -> b) -> a -> b
$ Journal -> Map TagName AccountType
jaccounttypes Journal
j) ([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 :: [Transaction]
jtxns=[Transaction]
ts}
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
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 :: TagName
acommodity=TagName
symbol,astyle :: AmountStyle
astyle=AmountStyle
style}
Maybe (TagName, AmountStyle)
Nothing -> Maybe Amount
forall a. Maybe a
Nothing
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
journalDateSpanBothDates :: Journal -> DateSpan
journalDateSpanBothDates :: Journal -> DateSpan
journalDateSpanBothDates = Maybe WhichDate -> Journal -> DateSpan
journalDateSpanHelper Maybe WhichDate
forall a. Maybe a
Nothing
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]
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
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
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
journalPivot :: Text -> Journal -> Journal
journalPivot :: TagName -> Journal -> Journal
journalPivot TagName
fieldortagname Journal
j = Journal
j{jtxns :: [Transaction]
jtxns = (Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (TagName -> Transaction -> Transaction
transactionPivot TagName
fieldortagname) ([Transaction] -> [Transaction])
-> (Journal -> [Transaction]) -> Journal -> [Transaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Transaction]
jtxns (Journal -> [Transaction]) -> Journal -> [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal
j}
transactionPivot :: Text -> Transaction -> Transaction
transactionPivot :: TagName -> Transaction -> Transaction
transactionPivot TagName
fieldortagname Transaction
t = Transaction
t{tpostings :: [Posting]
tpostings = (Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (TagName -> Posting -> Posting
postingPivot TagName
fieldortagname) ([Posting] -> [Posting])
-> (Transaction -> [Posting]) -> Transaction -> [Posting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings (Transaction -> [Posting]) -> Transaction -> [Posting]
forall a b. (a -> b) -> a -> b
$ Transaction
t}
postingPivot :: Text -> Posting -> Posting
postingPivot :: TagName -> Posting -> Posting
postingPivot TagName
fieldortagname Posting
p = Posting
p{paccount :: TagName
paccount = TagName
pivotedacct, poriginal :: Maybe Posting
poriginal = Posting -> Maybe Posting
forall a. a -> Maybe a
Just (Posting -> Maybe Posting) -> Posting -> Maybe Posting
forall a b. (a -> b) -> a -> b
$ Posting -> Posting
originalPosting Posting
p}
where
pivotedacct :: TagName
pivotedacct
| Just Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, TagName
fieldortagname TagName -> TagName -> Bool
forall a. Eq a => a -> a -> Bool
== TagName
"code" = Transaction -> TagName
tcode Transaction
t
| Just Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, TagName
fieldortagname TagName -> TagName -> Bool
forall a. Eq a => a -> a -> Bool
== TagName
"description" = Transaction -> TagName
tdescription Transaction
t
| Just Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, TagName
fieldortagname TagName -> TagName -> Bool
forall a. Eq a => a -> a -> Bool
== TagName
"payee" = Transaction -> TagName
transactionPayee Transaction
t
| Just Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, TagName
fieldortagname TagName -> TagName -> Bool
forall a. Eq a => a -> a -> Bool
== TagName
"note" = Transaction -> TagName
transactionNote Transaction
t
| Just Transaction
t <- Posting -> Maybe Transaction
ptransaction Posting
p, TagName
fieldortagname TagName -> TagName -> Bool
forall a. Eq a => a -> a -> Bool
== TagName
"status" = 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
| Just (TagName
_, TagName
value) <- TagName -> Posting -> Maybe Tag
postingFindTag TagName
fieldortagname Posting
p = TagName
value
| Bool
otherwise = 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
journalApplyAliases :: [AccountAlias] -> Journal -> Either RegexError Journal
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 :: [Transaction]
jtxns = [Transaction]
ts}
Left RegexError
err -> RegexError -> Either RegexError Journal
forall a b. a -> Either a b
Left RegexError
err
samplejournal :: Journal
samplejournal = Bool -> Journal
samplejournalMaybeExplicit Bool
True
samplejournalMaybeExplicit :: Bool -> Journal
samplejournalMaybeExplicit :: Bool -> Journal
samplejournalMaybeExplicit Bool
explicit = Journal
nulljournal
{jtxns :: [Transaction]
jtxns = [
Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction {
tindex :: Integer
tindex=Integer
0,
tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2008 Int
01 Int
01,
tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
tstatus :: Status
tstatus=Status
Unmarked,
tcode :: TagName
tcode=TagName
"",
tdescription :: TagName
tdescription=TagName
"income",
tcomment :: TagName
tcomment=TagName
"",
ttags :: [Tag]
ttags=[],
tpostings :: [Posting]
tpostings=
[TagName
"assets:bank:checking" TagName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1
,TagName
"income:salary" TagName -> Amount -> Posting
`post` if Bool
explicit then DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1) else Amount
missingamt
],
tprecedingcomment :: TagName
tprecedingcomment=TagName
""
}
,
Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction {
tindex :: Integer
tindex=Integer
0,
tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2008 Int
06 Int
01,
tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
tstatus :: Status
tstatus=Status
Unmarked,
tcode :: TagName
tcode=TagName
"",
tdescription :: TagName
tdescription=TagName
"gift",
tcomment :: TagName
tcomment=TagName
"",
ttags :: [Tag]
ttags=[],
tpostings :: [Posting]
tpostings=
[TagName
"assets:bank:checking" TagName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1
,TagName
"income:gifts" TagName -> Amount -> Posting
`post` if Bool
explicit then DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1) else Amount
missingamt
],
tprecedingcomment :: TagName
tprecedingcomment=TagName
""
}
,
Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction {
tindex :: Integer
tindex=Integer
0,
tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2008 Int
06 Int
02,
tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
tstatus :: Status
tstatus=Status
Unmarked,
tcode :: TagName
tcode=TagName
"",
tdescription :: TagName
tdescription=TagName
"save",
tcomment :: TagName
tcomment=TagName
"",
ttags :: [Tag]
ttags=[],
tpostings :: [Posting]
tpostings=
[TagName
"assets:bank:saving" TagName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1
,TagName
"assets:bank:checking" TagName -> Amount -> Posting
`post` if Bool
explicit then DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1) else Amount
missingamt
],
tprecedingcomment :: TagName
tprecedingcomment=TagName
""
}
,
Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction {
tindex :: Integer
tindex=Integer
0,
tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2008 Int
06 Int
03,
tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
tstatus :: Status
tstatus=Status
Cleared,
tcode :: TagName
tcode=TagName
"",
tdescription :: TagName
tdescription=TagName
"eat & shop",
tcomment :: TagName
tcomment=TagName
"",
ttags :: [Tag]
ttags=[],
tpostings :: [Posting]
tpostings=[TagName
"expenses:food" TagName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1
,TagName
"expenses:supplies" TagName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1
,TagName
"assets:cash" TagName -> Amount -> Posting
`post` if Bool
explicit then DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
2) else Amount
missingamt
],
tprecedingcomment :: TagName
tprecedingcomment=TagName
""
}
,
Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction {
tindex :: Integer
tindex=Integer
0,
tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2008 Int
10 Int
01,
tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
tstatus :: Status
tstatus=Status
Unmarked,
tcode :: TagName
tcode=TagName
"",
tdescription :: TagName
tdescription=TagName
"take a loan",
tcomment :: TagName
tcomment=TagName
"",
ttags :: [Tag]
ttags=[],
tpostings :: [Posting]
tpostings=[TagName
"assets:bank:checking" TagName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1
,TagName
"liabilities:debts" TagName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1)
],
tprecedingcomment :: TagName
tprecedingcomment=TagName
""
}
,
Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction {
tindex :: Integer
tindex=Integer
0,
tsourcepos :: (SourcePos, SourcePos)
tsourcepos=(SourcePos, SourcePos)
nullsourcepos,
tdate :: Day
tdate=Integer -> Int -> Int -> Day
fromGregorian Integer
2008 Int
12 Int
31,
tdate2 :: Maybe Day
tdate2=Maybe Day
forall a. Maybe a
Nothing,
tstatus :: Status
tstatus=Status
Unmarked,
tcode :: TagName
tcode=TagName
"",
tdescription :: TagName
tdescription=TagName
"pay off",
tcomment :: TagName
tcomment=TagName
"",
ttags :: [Tag]
ttags=[],
tpostings :: [Posting]
tpostings=[TagName
"liabilities:debts" TagName -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1
,TagName
"assets:bank:checking" TagName -> Amount -> Posting
`post` if Bool
explicit then DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
1) else Amount
missingamt
],
tprecedingcomment :: TagName
tprecedingcomment=TagName
""
}
]
}
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 :: [Transaction]
jtxns = [Transaction
nulltransaction{tdate :: Day
tdate = Integer -> Int -> Int -> Day
fromGregorian Integer
2014 Int
02 Int
01
,tpostings :: [Posting]
tpostings = [Posting
posting{pdate :: Maybe Day
pdate=Day -> Maybe Day
forall a. a -> Maybe a
Just (Integer -> Int -> Int -> Day
fromGregorian Integer
2014 Int
01 Int
10)}]
}
,Transaction
nulltransaction{tdate :: Day
tdate = Integer -> Int -> Int -> Day
fromGregorian Integer
2014 Int
09 Int
01
,tpostings :: [Posting]
tpostings = [Posting
posting{pdate2 :: Maybe Day
pdate2=Day -> Maybe Day
forall a. a -> Maybe a
Just (Integer -> Int -> Int -> Day
fromGregorian Integer
2014 Int
10 Int
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))
]