module Hledger.Data.Journal
where
import Data.List
import Data.Map (findWithDefault, (!))
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.Amount
import Hledger.Data.Commodity (canonicaliseCommodities)
import Hledger.Data.Dates (nulldatespan)
import Hledger.Data.Transaction (journalTransactionWithDate,balanceTransaction)
import Hledger.Data.Posting
import Hledger.Data.TimeLog
import Hledger.Data.Matching
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
showJournalDebug j = unlines [
show j
,show (jtxns j)
,show (jmodifiertxns j)
,show (jperiodictxns j)
,show $ open_timelog_entries j
,show $ historical_prices j
,show $ final_comment_lines j
,show $ jContext j
,show $ map fst $ files 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 = [] }
nullfilterspec :: FilterSpec
nullfilterspec = FilterSpec {
datespan=nulldatespan
,cleared=Nothing
,real=False
,empty=False
,acctpats=[]
,descpats=[]
,depth=Nothing
}
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
filterJournalPostings2 :: Matcher -> Journal -> Journal
filterJournalPostings2 m j@Journal{jtxns=ts} = j{jtxns=map filtertransactionpostings ts}
where
filtertransactionpostings t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps}
filterJournalTransactions2 :: Matcher -> Journal -> Journal
filterJournalTransactions2 m j@Journal{jtxns=ts} = j{jtxns=filter (m `matchesTransaction`) ts}
filterJournalTransactions :: FilterSpec -> Journal -> Journal
filterJournalTransactions FilterSpec{datespan=datespan
,cleared=cleared
,acctpats=apats
,descpats=dpats
,depth=depth
} =
filterJournalTransactionsByClearedStatus cleared .
filterJournalPostingsByDepth depth .
filterJournalTransactionsByAccount apats .
filterJournalTransactionsByDescription dpats .
filterJournalTransactionsByDate datespan
filterJournalPostings :: FilterSpec -> Journal -> Journal
filterJournalPostings FilterSpec{datespan=datespan
,cleared=cleared
,real=real
,empty=empty
,acctpats=apats
,descpats=dpats
,depth=depth
} =
filterJournalPostingsByRealness real .
filterJournalPostingsByClearedStatus cleared .
filterJournalPostingsByEmpty empty .
filterJournalPostingsByDepth depth .
filterJournalPostingsByAccount apats .
filterJournalTransactionsByDescription dpats .
filterJournalTransactionsByDate datespan
filterJournalTransactionsByDescription :: [String] -> Journal -> Journal
filterJournalTransactionsByDescription pats j@Journal{jtxns=ts} = j{jtxns=filter matchdesc ts}
where matchdesc = matchpats pats . tdescription
filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal
filterJournalTransactionsByDate (DateSpan begin end) j@Journal{jtxns=ts} = j{jtxns=filter match ts}
where match t = maybe True (tdate t>=) begin && maybe True (tdate t<) end
filterJournalTransactionsByClearedStatus :: Maybe Bool -> Journal -> Journal
filterJournalTransactionsByClearedStatus Nothing j = j
filterJournalTransactionsByClearedStatus (Just val) j@Journal{jtxns=ts} = j{jtxns=filter match ts}
where match = (==val).tstatus
filterJournalPostingsByClearedStatus :: Maybe Bool -> Journal -> Journal
filterJournalPostingsByClearedStatus Nothing j = j
filterJournalPostingsByClearedStatus (Just c) j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter ((==c) . postingCleared) ps}
filterJournalPostingsByRealness :: Bool -> Journal -> Journal
filterJournalPostingsByRealness False l = l
filterJournalPostingsByRealness True j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter isReal ps}
filterJournalPostingsByEmpty :: Bool -> Journal -> Journal
filterJournalPostingsByEmpty True l = l
filterJournalPostingsByEmpty False j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (not . isEmptyPosting) ps}
filterJournalTransactionsByDepth :: Maybe Int -> Journal -> Journal
filterJournalTransactionsByDepth Nothing j = j
filterJournalTransactionsByDepth (Just d) j@Journal{jtxns=ts} =
j{jtxns=(filter (any ((<= d+1) . accountNameLevel . paccount) . tpostings) ts)}
filterJournalPostingsByDepth :: Maybe Int -> Journal -> Journal
filterJournalPostingsByDepth Nothing j = j
filterJournalPostingsByDepth (Just d) j@Journal{jtxns=ts} =
j{jtxns=filter (not . null . tpostings) $ map filtertxns ts}
where filtertxns t@Transaction{tpostings=ps} =
t{tpostings=filter ((<= d) . accountNameLevel . paccount) ps}
filterJournalTransactionsByAccount :: [String] -> Journal -> Journal
filterJournalTransactionsByAccount apats j@Journal{jtxns=ts} = j{jtxns=filter tmatch ts}
where
tmatch t = (null positives || any positivepmatch ps) && (null negatives || not (any negativepmatch ps)) where ps = tpostings t
positivepmatch p = any (`amatch` a) positives where a = paccount p
negativepmatch p = any (`amatch` a) negatives where a = paccount p
amatch pat a = regexMatchesCI (abspat pat) a
(negatives,positives) = partition isnegativepat apats
filterJournalPostingsByAccount :: [String] -> Journal -> Journal
filterJournalPostingsByAccount apats j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (matchpats apats . paccount) ps}
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 $
journalApplyHistoricalPrices $
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
journalApplyHistoricalPrices :: Journal -> Journal
journalApplyHistoricalPrices j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
where
fixtransaction t@Transaction{tdate=d, tpostings=ps} = t{tpostings=map fixposting ps}
where
fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
fixmixedamount (Mixed as) = Mixed $ map fixamount as
fixamount = fixprice
fixprice a@Amount{price=Just _} = a
fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitPrice) $ journalHistoricalPriceFor j d c}
journalHistoricalPriceFor :: Journal -> Day -> Commodity -> Maybe MixedAmount
journalHistoricalPriceFor j d Commodity{symbol=s} = do
let ps = reverse $ filter ((<= d).hdate) $ filter ((s==).hsymbol) $ sortBy (comparing hdate) $ historical_prices j
case ps of (HistoricalPrice{hamount=a}:_) -> Just a
_ -> Nothing
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)
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]
traceAmountPrecision a = trace (show $ map (precision . commodity) $ amounts a) a
tracePostingsCommodities ps = trace (show $ map ((map (precision . commodity) . amounts) . pamount) ps) ps
tests_Hledger_Data_Journal = TestList [
]