module Hledger.Data.Journal (
addHistoricalPrice,
addModifierTransaction,
addPeriodicTransaction,
addTimeLogEntry,
addTransaction,
journalApplyAliases,
journalBalanceTransactions,
journalCanonicaliseAmounts,
journalConvertAmountsToCost,
journalFinalise,
journalSelectingDate,
filterJournalPostings,
filterJournalTransactions,
journalAccountInfo,
journalAccountNames,
journalAccountNamesUsed,
journalAmountAndPriceCommodities,
journalAmounts,
journalCanonicalCommodities,
journalDateSpan,
journalFilePath,
journalFilePaths,
journalPostings,
journalBalanceSheetAccountQuery,
journalProfitAndLossAccountQuery,
journalIncomeAccountQuery,
journalExpenseAccountQuery,
journalAssetAccountQuery,
journalLiabilityAccountQuery,
journalEquityAccountQuery,
journalCashAccountQuery,
groupPostings,
matchpats,
nullctx,
nulljournal,
samplejournal,
tests_Hledger_Data_Journal,
)
where
import Data.List
import Data.Map (findWithDefault, (!), toAscList)
import Data.Ord
import Data.Time.Calendar
import Data.Time.LocalTime
import Data.Tree
import Safe (headDef)
import System.Time (ClockTime(TOD))
import Test.HUnit
import Text.Printf
import qualified Data.Map as Map
import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.AccountName
import Hledger.Data.Account()
import Hledger.Data.Amount
import Hledger.Data.Commodity
import Hledger.Data.Dates
import Hledger.Data.Transaction
import Hledger.Data.Posting
import Hledger.Data.TimeLog
import Hledger.Query
instance Show Journal where
show j = printf "Journal %s with %d transactions, %d accounts: %s"
(journalFilePath j)
(length (jtxns j) +
length (jmodifiertxns j) +
length (jperiodictxns j))
(length accounts)
(show accounts)
where accounts = flatten $ journalAccountNameTree j
nulljournal :: Journal
nulljournal = Journal { jmodifiertxns = []
, jperiodictxns = []
, jtxns = []
, open_timelog_entries = []
, historical_prices = []
, final_comment_lines = []
, jContext = nullctx
, files = []
, filereadtime = TOD 0 0
}
nullctx :: JournalContext
nullctx = Ctx { ctxYear = Nothing, ctxCommodity = Nothing, ctxAccount = [], ctxAliases = [] }
journalFilePath :: Journal -> FilePath
journalFilePath = fst . mainfile
journalFilePaths :: Journal -> [FilePath]
journalFilePaths = map fst . files
mainfile :: Journal -> (FilePath, String)
mainfile = headDef ("", "") . files
addTransaction :: Transaction -> Journal -> Journal
addTransaction t l0 = l0 { jtxns = t : jtxns l0 }
addModifierTransaction :: ModifierTransaction -> Journal -> Journal
addModifierTransaction mt l0 = l0 { jmodifiertxns = mt : jmodifiertxns l0 }
addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal
addPeriodicTransaction pt l0 = l0 { jperiodictxns = pt : jperiodictxns l0 }
addHistoricalPrice :: HistoricalPrice -> Journal -> Journal
addHistoricalPrice h l0 = l0 { historical_prices = h : historical_prices l0 }
addTimeLogEntry :: TimeLogEntry -> Journal -> Journal
addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 }
journalPostings :: Journal -> [Posting]
journalPostings = concatMap tpostings . jtxns
journalAccountNamesUsed :: Journal -> [AccountName]
journalAccountNamesUsed = sort . accountNamesFromPostings . journalPostings
journalAccountNames :: Journal -> [AccountName]
journalAccountNames = sort . expandAccountNames . journalAccountNamesUsed
journalAccountNameTree :: Journal -> Tree AccountName
journalAccountNameTree = accountNameTreeFrom . journalAccountNames
journalProfitAndLossAccountQuery :: Journal -> Query
journalProfitAndLossAccountQuery j = Or [journalIncomeAccountQuery j
,journalExpenseAccountQuery j
]
journalIncomeAccountQuery :: Journal -> Query
journalIncomeAccountQuery _ = Acct "^(income|revenue)s?(:|$)"
journalExpenseAccountQuery :: Journal -> Query
journalExpenseAccountQuery _ = Acct "^expenses?(:|$)"
journalBalanceSheetAccountQuery :: Journal -> Query
journalBalanceSheetAccountQuery j = Or [journalAssetAccountQuery j
,journalLiabilityAccountQuery j
,journalEquityAccountQuery j
]
journalAssetAccountQuery :: Journal -> Query
journalAssetAccountQuery _ = Acct "^assets?(:|$)"
journalLiabilityAccountQuery :: Journal -> Query
journalLiabilityAccountQuery _ = Acct "^liabilit(y|ies)(:|$)"
journalEquityAccountQuery :: Journal -> Query
journalEquityAccountQuery _ = Acct "^equity(:|$)"
journalCashAccountQuery :: Journal -> Query
journalCashAccountQuery j = And [journalAssetAccountQuery j, Not $ Acct "(receivable|A/R)"]
filterJournalPostings :: Query -> Journal -> Journal
filterJournalPostings q j@Journal{jtxns=ts} = j{jtxns=map filtertransactionpostings ts}
where
filtertransactionpostings t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps}
filterJournalTransactions :: Query -> Journal -> Journal
filterJournalTransactions q j@Journal{jtxns=ts} = j{jtxns=filter (q `matchesTransaction`) ts}
journalSelectingDate :: WhichDate -> Journal -> Journal
journalSelectingDate ActualDate j = j
journalSelectingDate EffectiveDate j =
j{jtxns=map (journalTransactionWithDate EffectiveDate) $ jtxns j}
journalApplyAliases :: [(AccountName,AccountName)] -> Journal -> Journal
journalApplyAliases aliases j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
where
fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
fixposting p@Posting{paccount=a} = p{paccount=accountNameApplyAliases aliases a}
journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalContext -> Journal -> Either String Journal
journalFinalise tclock tlocal path txt ctx j@Journal{files=fs} =
journalBalanceTransactions $
journalCanonicaliseAmounts $
journalCloseTimeLogEntries tlocal
j{files=(path,txt):fs, filereadtime=tclock, jContext=ctx}
journalBalanceTransactions :: Journal -> Either String Journal
journalBalanceTransactions j@Journal{jtxns=ts} =
case sequence $ map balance ts of Right ts' -> Right j{jtxns=ts'}
Left e -> Left e
where balance = balanceTransaction (Just $ journalCanonicalCommodities j)
journalCanonicaliseAmounts :: Journal -> Journal
journalCanonicaliseAmounts j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
where
fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
fixmixedamount (Mixed as) = Mixed $ map fixamount as
fixamount a@Amount{commodity=c} = a{commodity=fixcommodity c}
fixcommodity c@Commodity{symbol=s} = findWithDefault c s canonicalcommoditymap
canonicalcommoditymap = journalCanonicalCommodities j
journalCloseTimeLogEntries :: LocalTime -> Journal -> Journal
journalCloseTimeLogEntries now j@Journal{jtxns=ts, open_timelog_entries=es} =
j{jtxns = ts ++ (timeLogEntriesToTransactions now es), open_timelog_entries = []}
journalConvertAmountsToCost :: Journal -> Journal
journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
where
fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
fixmixedamount (Mixed as) = Mixed $ map fixamount as
fixamount = canonicaliseAmountCommodity (Just $ journalCanonicalCommodities j) . costOfAmount
journalCanonicalCommodities :: Journal -> Map.Map String Commodity
journalCanonicalCommodities j = canonicaliseCommodities $ journalAmountCommodities j
journalAmountCommodities :: Journal -> [Commodity]
journalAmountCommodities = map commodity . concatMap amounts . journalAmounts
journalAmountAndPriceCommodities :: Journal -> [Commodity]
journalAmountAndPriceCommodities = concatMap amountCommodities . concatMap amounts . journalAmounts
amountCommodities :: Amount -> [Commodity]
amountCommodities Amount{commodity=c,price=p} =
case p of Nothing -> [c]
Just (UnitPrice ma) -> c:(concatMap amountCommodities $ amounts ma)
Just (TotalPrice ma) -> c:(concatMap amountCommodities $ amounts ma)
journalAmounts :: Journal -> [MixedAmount]
journalAmounts = map pamount . journalPostings
journalDateSpan :: Journal -> DateSpan
journalDateSpan j
| null ts = DateSpan Nothing Nothing
| otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts)
where
ts = sortBy (comparing tdate) $ jtxns j
matchpats :: [String] -> String -> Bool
matchpats pats str =
(null positives || any match positives) && (null negatives || not (any match negatives))
where
(negatives,positives) = partition isnegativepat pats
match "" = True
match pat = regexMatchesCI (abspat pat) str
negateprefix = "not:"
isnegativepat = (negateprefix `isPrefixOf`)
abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat
journalAccountInfo :: Journal -> (Tree AccountName, Map.Map AccountName Account)
journalAccountInfo j = (ant, amap)
where
(ant, psof, _, inclbalof) = (groupPostings . journalPostings) j
amap = Map.fromList [(a, acctinfo a) | a <- flatten ant]
acctinfo a = Account a (psof a) (inclbalof a)
tests_journalAccountInfo = [
"journalAccountInfo" ~: do
let (t,m) = journalAccountInfo samplejournal
assertEqual "account tree"
(Node "top" [
Node "assets" [
Node "assets:bank" [
Node "assets:bank:checking" [],
Node "assets:bank:saving" []
],
Node "assets:cash" []
],
Node "expenses" [
Node "expenses:food" [],
Node "expenses:supplies" []
],
Node "income" [
Node "income:gifts" [],
Node "income:salary" []
],
Node "liabilities" [
Node "liabilities:debts" []
]
]
)
t
mapM_
(\(e,a) -> assertEqual "" e a)
(zip [
("assets",Account "assets" [] (Mixed [dollars (1)]))
,("assets:bank",Account "assets:bank" [] (Mixed [dollars 1]))
,("assets:bank:checking",Account "assets:bank:checking" [
Posting {
pstatus=False,
paccount="assets:bank:checking",
pamount=(Mixed [dollars 1]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
},
Posting {
pstatus=False,
paccount="assets:bank:checking",
pamount=(Mixed [dollars 1]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
},
Posting {
pstatus=False,
paccount="assets:bank:checking",
pamount=(Mixed [dollars (1)]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
},
Posting {
pstatus=False,
paccount="assets:bank:checking",
pamount=(Mixed [dollars (1)]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
}
] (Mixed [nullamt]))
,("assets:bank:saving",Account "assets:bank:saving" [
Posting {
pstatus=False,
paccount="assets:bank:saving",
pamount=(Mixed [dollars 1]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
}
] (Mixed [dollars 1]))
,("assets:cash",Account "assets:cash" [
Posting {
pstatus=False,
paccount="assets:cash",
pamount=(Mixed [dollars (2)]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
}
] (Mixed [dollars (2)]))
,("expenses",Account "expenses" [] (Mixed [dollars 2]))
,("expenses:food",Account "expenses:food" [
Posting {
pstatus=False,
paccount="expenses:food",
pamount=(Mixed [dollars 1]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
}
] (Mixed [dollars 1]))
,("expenses:supplies",Account "expenses:supplies" [
Posting {
pstatus=False,
paccount="expenses:supplies",
pamount=(Mixed [dollars 1]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
}
] (Mixed [dollars 1]))
,("income",Account "income" [] (Mixed [dollars (2)]))
,("income:gifts",Account "income:gifts" [
Posting {
pstatus=False,
paccount="income:gifts",
pamount=(Mixed [dollars (1)]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
}
] (Mixed [dollars (1)]))
,("income:salary",Account "income:salary" [
Posting {
pstatus=False,
paccount="income:salary",
pamount=(Mixed [dollars (1)]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
}
] (Mixed [dollars (1)]))
,("liabilities",Account "liabilities" [] (Mixed [dollars 1]))
,("liabilities:debts",Account "liabilities:debts" [
Posting {
pstatus=False,
paccount="liabilities:debts",
pamount=(Mixed [dollars 1]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
}
] (Mixed [dollars 1]))
,("top",Account "top" [] (Mixed [nullamt]))
]
(toAscList m)
)
]
groupPostings :: [Posting] -> (Tree AccountName,
(AccountName -> [Posting]),
(AccountName -> MixedAmount),
(AccountName -> MixedAmount))
groupPostings ps = (ant, psof, exclbalof, inclbalof)
where
anames = sort $ nub $ map paccount ps
ant = accountNameTreeFrom $ expandAccountNames anames
allanames = flatten ant
pmap = Map.union (postingsByAccount ps) (Map.fromList [(a,[]) | a <- allanames])
psof = (pmap !)
balmap = Map.fromList $ flatten $ calculateBalances ant psof
exclbalof = fst . (balmap !)
inclbalof = snd . (balmap !)
calculateBalances :: Tree AccountName -> (AccountName -> [Posting]) -> Tree (AccountName, (MixedAmount, MixedAmount))
calculateBalances ant psof = addbalances ant
where
addbalances (Node a subs) = Node (a,(bal,bal+subsbal)) subs'
where
bal = sumPostings $ psof a
subsbal = sum $ map (snd . snd . root) subs'
subs' = map addbalances subs
postingsByAccount :: [Posting] -> Map.Map AccountName [Posting]
postingsByAccount ps = m'
where
sortedps = sortBy (comparing paccount) ps
groupedps = groupBy (\p1 p2 -> paccount p1 == paccount p2) sortedps
m' = Map.fromList [(paccount $ head g, g) | g <- groupedps]
Right samplejournal = journalBalanceTransactions $ Journal
[]
[]
[
txnTieKnot $ Transaction {
tdate=parsedate "2008/01/01",
teffectivedate=Nothing,
tstatus=False,
tcode="",
tdescription="income",
tcomment="",
ttags=[],
tpostings=[
Posting {
pstatus=False,
paccount="assets:bank:checking",
pamount=(Mixed [dollars 1]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
},
Posting {
pstatus=False,
paccount="income:salary",
pamount=(missingmixedamt),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
}
],
tpreceding_comment_lines=""
}
,
txnTieKnot $ Transaction {
tdate=parsedate "2008/06/01",
teffectivedate=Nothing,
tstatus=False,
tcode="",
tdescription="gift",
tcomment="",
ttags=[],
tpostings=[
Posting {
pstatus=False,
paccount="assets:bank:checking",
pamount=(Mixed [dollars 1]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
},
Posting {
pstatus=False,
paccount="income:gifts",
pamount=(missingmixedamt),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
}
],
tpreceding_comment_lines=""
}
,
txnTieKnot $ Transaction {
tdate=parsedate "2008/06/02",
teffectivedate=Nothing,
tstatus=False,
tcode="",
tdescription="save",
tcomment="",
ttags=[],
tpostings=[
Posting {
pstatus=False,
paccount="assets:bank:saving",
pamount=(Mixed [dollars 1]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
},
Posting {
pstatus=False,
paccount="assets:bank:checking",
pamount=(Mixed [dollars (1)]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
}
],
tpreceding_comment_lines=""
}
,
txnTieKnot $ Transaction {
tdate=parsedate "2008/06/03",
teffectivedate=Nothing,
tstatus=True,
tcode="",
tdescription="eat & shop",
tcomment="",
ttags=[],
tpostings=[
Posting {
pstatus=False,
paccount="expenses:food",
pamount=(Mixed [dollars 1]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
},
Posting {
pstatus=False,
paccount="expenses:supplies",
pamount=(Mixed [dollars 1]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
},
Posting {
pstatus=False,
paccount="assets:cash",
pamount=(missingmixedamt),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
}
],
tpreceding_comment_lines=""
}
,
txnTieKnot $ Transaction {
tdate=parsedate "2008/12/31",
teffectivedate=Nothing,
tstatus=False,
tcode="",
tdescription="pay off",
tcomment="",
ttags=[],
tpostings=[
Posting {
pstatus=False,
paccount="liabilities:debts",
pamount=(Mixed [dollars 1]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
},
Posting {
pstatus=False,
paccount="assets:bank:checking",
pamount=(Mixed [dollars (1)]),
pcomment="",
ptype=RegularPosting,
ptags=[],
ptransaction=Nothing
}
],
tpreceding_comment_lines=""
}
]
[]
[]
""
nullctx
[]
(TOD 0 0)
tests_Hledger_Data_Journal = TestList $
tests_journalAccountInfo