1 {-| 2 3 A 'Journal' is a set of 'Transaction's and related data, usually parsed 4 from a hledger/ledger journal file or timelog. This is the primary hledger 5 data object. 6 7 -} 8 9 module Hledger.Data.Journal 10 where 11 import Data.List 12 import Data.Map (findWithDefault, (!)) 13 import Data.Ord 14 import Data.Time.Calendar 15 import Data.Time.LocalTime 16 import Data.Tree 17 import Safe (headDef) 18 import System.Time (ClockTime(TOD)) 19 import Test.HUnit 20 import Text.Printf 21 import qualified Data.Map as Map 22 23 import Hledger.Utils 24 import Hledger.Data.Types 25 import Hledger.Data.AccountName 26 import Hledger.Data.Amount 27 import Hledger.Data.Commodity (canonicaliseCommodities) 28 import Hledger.Data.Dates (nulldatespan) 29 import Hledger.Data.Transaction (journalTransactionWithDate,balanceTransaction) 30 import Hledger.Data.Posting 31 import Hledger.Data.TimeLog 32 import Hledger.Data.Matching 33 34 35 instance Show Journal where 36 show j = printf "Journal %s with %d transactions, %d accounts: %s" 37 (journalFilePath j) 38 (length (jtxns j) + 39 length (jmodifiertxns j) + 40 length (jperiodictxns j)) 41 (length accounts) 42 (show accounts) 43 -- ++ (show $ journalTransactions l) 44 where accounts = flatten $ journalAccountNameTree j 45 46 showJournalDebug j = unlines [ 47 show j 48 ,show (jtxns j) 49 ,show (jmodifiertxns j) 50 ,show (jperiodictxns j) 51 ,show $ open_timelog_entries j 52 ,show $ historical_prices j 53 ,show $ final_comment_lines j 54 ,show $ jContext j 55 ,show $ map fst $ files j 56 ] 57 58 nulljournal :: Journal 59 nulljournal = Journal { jmodifiertxns = [] 60 , jperiodictxns = [] 61 , jtxns = [] 62 , open_timelog_entries = [] 63 , historical_prices = [] 64 , final_comment_lines = [] 65 , jContext = nullctx 66 , files = [] 67 , filereadtime = TOD 0 0 68 } 69 70 nullctx :: JournalContext 71 nullctx = Ctx { ctxYear = Nothing, ctxCommodity = Nothing, ctxAccount = [], ctxAliases = [] } 72 73 nullfilterspec :: FilterSpec 74 nullfilterspec = FilterSpec { 75 datespan=nulldatespan 76 ,cleared=Nothing 77 ,real=False 78 ,empty=False 79 ,acctpats=[] 80 ,descpats=[] 81 ,depth=Nothing 82 } 83 84 journalFilePath :: Journal -> FilePath 85 journalFilePath = fst . mainfile 86 87 journalFilePaths :: Journal -> [FilePath] 88 journalFilePaths = map fst . files 89 90 mainfile :: Journal -> (FilePath, String) 91 mainfile = headDef ("", "") . files 92 93 addTransaction :: Transaction -> Journal -> Journal 94 addTransaction t l0 = l0 { jtxns = t : jtxns l0 } 95 96 addModifierTransaction :: ModifierTransaction -> Journal -> Journal 97 addModifierTransaction mt l0 = l0 { jmodifiertxns = mt : jmodifiertxns l0 } 98 99 addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal 100 addPeriodicTransaction pt l0 = l0 { jperiodictxns = pt : jperiodictxns l0 } 101 102 addHistoricalPrice :: HistoricalPrice -> Journal -> Journal 103 addHistoricalPrice h l0 = l0 { historical_prices = h : historical_prices l0 } 104 105 addTimeLogEntry :: TimeLogEntry -> Journal -> Journal 106 addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 } 107 108 journalPostings :: Journal -> [Posting] 109 journalPostings = concatMap tpostings . jtxns 110 111 journalAccountNamesUsed :: Journal -> [AccountName] 112 journalAccountNamesUsed = sort . accountNamesFromPostings . journalPostings 113 114 journalAccountNames :: Journal -> [AccountName] 115 journalAccountNames = sort . expandAccountNames . journalAccountNamesUsed 116 117 journalAccountNameTree :: Journal -> Tree AccountName 118 journalAccountNameTree = accountNameTreeFrom . journalAccountNames 119 120 -- Various kinds of filtering on journals. We do it differently depending 121 -- on the command. 122 123 ------------------------------------------------------------------------------- 124 -- filtering V2 125 126 -- | Keep only postings matching the query expression. 127 -- This can leave unbalanced transactions. 128 filterJournalPostings2 :: Matcher -> Journal -> Journal 129 filterJournalPostings2 m j@Journal{jtxns=ts} = j{jtxns=map filtertransactionpostings ts} 130 where 131 filtertransactionpostings t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps} 132 133 -- | Keep only transactions matching the query expression. 134 filterJournalTransactions2 :: Matcher -> Journal -> Journal 135 filterJournalTransactions2 m j@Journal{jtxns=ts} = j{jtxns=filter (m `matchesTransaction`) ts} 136 137 ------------------------------------------------------------------------------- 138 -- filtering V1 139 140 -- | Keep only transactions we are interested in, as described by the 141 -- filter specification. 142 filterJournalTransactions :: FilterSpec -> Journal -> Journal 143 filterJournalTransactions FilterSpec{datespan=datespan 144 ,cleared=cleared 145 -- ,real=real 146 -- ,empty=empty 147 ,acctpats=apats 148 ,descpats=dpats 149 ,depth=depth 150 } = 151 filterJournalTransactionsByClearedStatus cleared . 152 filterJournalPostingsByDepth depth . 153 filterJournalTransactionsByAccount apats . 154 filterJournalTransactionsByDescription dpats . 155 filterJournalTransactionsByDate datespan 156 157 -- | Keep only postings we are interested in, as described by the filter 158 -- specification. This can leave unbalanced transactions. 159 filterJournalPostings :: FilterSpec -> Journal -> Journal 160 filterJournalPostings FilterSpec{datespan=datespan 161 ,cleared=cleared 162 ,real=real 163 ,empty=empty 164 ,acctpats=apats 165 ,descpats=dpats 166 ,depth=depth 167 } = 168 filterJournalPostingsByRealness real . 169 filterJournalPostingsByClearedStatus cleared . 170 filterJournalPostingsByEmpty empty . 171 filterJournalPostingsByDepth depth . 172 filterJournalPostingsByAccount apats . 173 filterJournalTransactionsByDescription dpats . 174 filterJournalTransactionsByDate datespan 175 176 -- | Keep only transactions whose description matches the description patterns. 177 filterJournalTransactionsByDescription :: [String] -> Journal -> Journal 178 filterJournalTransactionsByDescription pats j@Journal{jtxns=ts} = j{jtxns=filter matchdesc ts} 179 where matchdesc = matchpats pats . tdescription 180 181 -- | Keep only transactions which fall between begin and end dates. 182 -- We include transactions on the begin date and exclude transactions on the end 183 -- date, like ledger. An empty date string means no restriction. 184 filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal 185 filterJournalTransactionsByDate (DateSpan begin end) j@Journal{jtxns=ts} = j{jtxns=filter match ts} 186 where match t = maybe True (tdate t>=) begin && maybe True (tdate t<) end 187 188 -- | Keep only transactions which have the requested cleared/uncleared 189 -- status, if there is one. 190 filterJournalTransactionsByClearedStatus :: Maybe Bool -> Journal -> Journal 191 filterJournalTransactionsByClearedStatus Nothing j = j 192 filterJournalTransactionsByClearedStatus (Just val) j@Journal{jtxns=ts} = j{jtxns=filter match ts} 193 where match = (==val).tstatus 194 195 -- | Keep only postings which have the requested cleared/uncleared status, 196 -- if there is one. 197 filterJournalPostingsByClearedStatus :: Maybe Bool -> Journal -> Journal 198 filterJournalPostingsByClearedStatus Nothing j = j 199 filterJournalPostingsByClearedStatus (Just c) j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts} 200 where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter ((==c) . postingCleared) ps} 201 202 -- | Strip out any virtual postings, if the flag is true, otherwise do 203 -- no filtering. 204 filterJournalPostingsByRealness :: Bool -> Journal -> Journal 205 filterJournalPostingsByRealness False l = l 206 filterJournalPostingsByRealness True j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts} 207 where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter isReal ps} 208 209 -- | Strip out any postings with zero amount, unless the flag is true. 210 filterJournalPostingsByEmpty :: Bool -> Journal -> Journal 211 filterJournalPostingsByEmpty True l = l 212 filterJournalPostingsByEmpty False j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts} 213 where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (not . isEmptyPosting) ps} 214 215 -- | Keep only transactions which affect accounts deeper than the specified depth. 216 filterJournalTransactionsByDepth :: Maybe Int -> Journal -> Journal 217 filterJournalTransactionsByDepth Nothing j = j 218 filterJournalTransactionsByDepth (Just d) j@Journal{jtxns=ts} = 219 j{jtxns=(filter (any ((<= d+1) . accountNameLevel . paccount) . tpostings) ts)} 220 221 -- | Strip out any postings to accounts deeper than the specified depth 222 -- (and any transactions which have no postings as a result). 223 filterJournalPostingsByDepth :: Maybe Int -> Journal -> Journal 224 filterJournalPostingsByDepth Nothing j = j 225 filterJournalPostingsByDepth (Just d) j@Journal{jtxns=ts} = 226 j{jtxns=filter (not . null . tpostings) $ map filtertxns ts} 227 where filtertxns t@Transaction{tpostings=ps} = 228 t{tpostings=filter ((<= d) . accountNameLevel . paccount) ps} 229 230 -- | Keep only transactions which affect accounts matched by the account patterns. 231 -- More precisely: each positive account pattern excludes transactions 232 -- which do not contain a posting to a matched account, and each negative 233 -- account pattern excludes transactions containing a posting to a matched 234 -- account. 235 filterJournalTransactionsByAccount :: [String] -> Journal -> Journal 236 filterJournalTransactionsByAccount apats j@Journal{jtxns=ts} = j{jtxns=filter tmatch ts} 237 where 238 tmatch t = (null positives || any positivepmatch ps) && (null negatives || not (any negativepmatch ps)) where ps = tpostings t 239 positivepmatch p = any (`amatch` a) positives where a = paccount p 240 negativepmatch p = any (`amatch` a) negatives where a = paccount p 241 amatch pat a = regexMatchesCI (abspat pat) a 242 (negatives,positives) = partition isnegativepat apats 243 244 -- | Keep only postings which affect accounts matched by the account patterns. 245 -- This can leave transactions unbalanced. 246 filterJournalPostingsByAccount :: [String] -> Journal -> Journal 247 filterJournalPostingsByAccount apats j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts} 248 where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (matchpats apats . paccount) ps} 249 250 -- | Convert this journal's transactions' primary date to either the 251 -- actual or effective date. 252 journalSelectingDate :: WhichDate -> Journal -> Journal 253 journalSelectingDate ActualDate j = j 254 journalSelectingDate EffectiveDate j = 255 j{jtxns=map (journalTransactionWithDate EffectiveDate) $ jtxns j} 256 257 -- | Apply additional account aliases (eg from the command-line) to all postings in a journal. 258 journalApplyAliases :: [(AccountName,AccountName)] -> Journal -> Journal 259 journalApplyAliases aliases j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} 260 where 261 fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps} 262 fixposting p@Posting{paccount=a} = p{paccount=accountNameApplyAliases aliases a} 263 264 -- | Do post-parse processing on a journal, to make it ready for use. 265 journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalContext -> Journal -> Either String Journal 266 journalFinalise tclock tlocal path txt ctx j@Journal{files=fs} = 267 journalBalanceTransactions $ 268 journalCanonicaliseAmounts $ 269 journalApplyHistoricalPrices $ 270 journalCloseTimeLogEntries tlocal 271 j{files=(path,txt):fs, filereadtime=tclock, jContext=ctx} 272 273 -- | Fill in any missing amounts and check that all journal transactions 274 -- balance, or return an error message. This is done after parsing all 275 -- amounts and working out the canonical commodities, since balancing 276 -- depends on display precision. Reports only the first error encountered. 277 journalBalanceTransactions :: Journal -> Either String Journal 278 journalBalanceTransactions j@Journal{jtxns=ts} = 279 case sequence $ map balance ts of Right ts' -> Right j{jtxns=ts'} 280 Left e -> Left e 281 where balance = balanceTransaction (Just $ journalCanonicalCommodities j) 282 283 -- | Convert all the journal's amounts to their canonical display 284 -- settings. Ie, all amounts in a given commodity will use (a) the 285 -- display settings of the first, and (b) the greatest precision, of the 286 -- amounts in that commodity. Prices are canonicalised as well, so consider 287 -- calling journalApplyHistoricalPrices before this. 288 journalCanonicaliseAmounts :: Journal -> Journal 289 journalCanonicaliseAmounts j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} 290 where 291 fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps} 292 fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a} 293 fixmixedamount (Mixed as) = Mixed $ map fixamount as 294 fixamount a@Amount{commodity=c} = a{commodity=fixcommodity c} 295 fixcommodity c@Commodity{symbol=s} = findWithDefault c s canonicalcommoditymap 296 canonicalcommoditymap = journalCanonicalCommodities j 297 298 -- | Apply this journal's historical price records to unpriced amounts where possible. 299 journalApplyHistoricalPrices :: Journal -> Journal 300 journalApplyHistoricalPrices j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} 301 where 302 fixtransaction t@Transaction{tdate=d, tpostings=ps} = t{tpostings=map fixposting ps} 303 where 304 fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a} 305 fixmixedamount (Mixed as) = Mixed $ map fixamount as 306 fixamount = fixprice 307 fixprice a@Amount{price=Just _} = a 308 fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitPrice) $ journalHistoricalPriceFor j d c} 309 310 -- | Get the price for a commodity on the specified day from the price database, if known. 311 -- Does only one lookup step, ie will not look up the price of a price. 312 journalHistoricalPriceFor :: Journal -> Day -> Commodity -> Maybe MixedAmount 313 journalHistoricalPriceFor j d Commodity{symbol=s} = do 314 let ps = reverse $ filter ((<= d).hdate) $ filter ((s==).hsymbol) $ sortBy (comparing hdate) $ historical_prices j 315 case ps of (HistoricalPrice{hamount=a}:_) -> Just a 316 _ -> Nothing 317 318 -- | Close any open timelog sessions in this journal using the provided current time. 319 journalCloseTimeLogEntries :: LocalTime -> Journal -> Journal 320 journalCloseTimeLogEntries now j@Journal{jtxns=ts, open_timelog_entries=es} = 321 j{jtxns = ts ++ (timeLogEntriesToTransactions now es), open_timelog_entries = []} 322 323 -- | Convert all this journal's amounts to cost by applying their prices, if any. 324 journalConvertAmountsToCost :: Journal -> Journal 325 journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} 326 where 327 -- similar to journalCanonicaliseAmounts 328 fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps} 329 fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a} 330 fixmixedamount (Mixed as) = Mixed $ map fixamount as 331 fixamount = canonicaliseAmountCommodity (Just $ journalCanonicalCommodities j) . costOfAmount 332 333 -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol. 334 journalCanonicalCommodities :: Journal -> Map.Map String Commodity 335 journalCanonicalCommodities j = canonicaliseCommodities $ journalAmountCommodities j 336 337 -- | Get all this journal's amounts' commodities, in the order parsed. 338 journalAmountCommodities :: Journal -> [Commodity] 339 journalAmountCommodities = map commodity . concatMap amounts . journalAmounts 340 341 -- | Get all this journal's amount and price commodities, in the order parsed. 342 journalAmountAndPriceCommodities :: Journal -> [Commodity] 343 journalAmountAndPriceCommodities = concatMap amountCommodities . concatMap amounts . journalAmounts 344 345 -- | Get this amount's commodity and any commodities referenced in its price. 346 amountCommodities :: Amount -> [Commodity] 347 amountCommodities Amount{commodity=c,price=p} = 348 case p of Nothing -> [c] 349 Just (UnitPrice ma) -> c:(concatMap amountCommodities $ amounts ma) 350 Just (TotalPrice ma) -> c:(concatMap amountCommodities $ amounts ma) 351 352 -- | Get all this journal's amounts, in the order parsed. 353 journalAmounts :: Journal -> [MixedAmount] 354 journalAmounts = map pamount . journalPostings 355 356 -- | The (fully specified) date span containing this journal's transactions, 357 -- or DateSpan Nothing Nothing if there are none. 358 journalDateSpan :: Journal -> DateSpan 359 journalDateSpan j 360 | null ts = DateSpan Nothing Nothing 361 | otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts) 362 where 363 ts = sortBy (comparing tdate) $ jtxns j 364 365 -- | Check if a set of hledger account/description filter patterns matches the 366 -- given account name or entry description. Patterns are case-insensitive 367 -- regular expressions. Prefixed with not:, they become anti-patterns. 368 matchpats :: [String] -> String -> Bool 369 matchpats pats str = 370 (null positives || any match positives) && (null negatives || not (any match negatives)) 371 where 372 (negatives,positives) = partition isnegativepat pats 373 match "" = True 374 match pat = regexMatchesCI (abspat pat) str 375 376 negateprefix = "not:" 377 378 isnegativepat = (negateprefix `isPrefixOf`) 379 380 abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat 381 382 -- | Calculate the account tree and all account balances from a journal's 383 -- postings, returning the results for efficient lookup. 384 journalAccountInfo :: Journal -> (Tree AccountName, Map.Map AccountName Account) 385 journalAccountInfo j = (ant, amap) 386 where 387 (ant, psof, _, inclbalof) = (groupPostings . journalPostings) j 388 amap = Map.fromList [(a, acctinfo a) | a <- flatten ant] 389 acctinfo a = Account a (psof a) (inclbalof a) 390 391 -- | Given a list of postings, return an account name tree and three query 392 -- functions that fetch postings, subaccount-excluding-balance and 393 -- subaccount-including-balance by account name. 394 groupPostings :: [Posting] -> (Tree AccountName, 395 (AccountName -> [Posting]), 396 (AccountName -> MixedAmount), 397 (AccountName -> MixedAmount)) 398 groupPostings ps = (ant, psof, exclbalof, inclbalof) 399 where 400 anames = sort $ nub $ map paccount ps 401 ant = accountNameTreeFrom $ expandAccountNames anames 402 allanames = flatten ant 403 pmap = Map.union (postingsByAccount ps) (Map.fromList [(a,[]) | a <- allanames]) 404 psof = (pmap !) 405 balmap = Map.fromList $ flatten $ calculateBalances ant psof 406 exclbalof = fst . (balmap !) 407 inclbalof = snd . (balmap !) 408 409 -- | Add subaccount-excluding and subaccount-including balances to a tree 410 -- of account names somewhat efficiently, given a function that looks up 411 -- transactions by account name. 412 calculateBalances :: Tree AccountName -> (AccountName -> [Posting]) -> Tree (AccountName, (MixedAmount, MixedAmount)) 413 calculateBalances ant psof = addbalances ant 414 where 415 addbalances (Node a subs) = Node (a,(bal,bal+subsbal)) subs' 416 where 417 bal = sumPostings $ psof a 418 subsbal = sum $ map (snd . snd . root) subs' 419 subs' = map addbalances subs 420 421 -- | Convert a list of postings to a map from account name to that 422 -- account's postings. 423 postingsByAccount :: [Posting] -> Map.Map AccountName [Posting] 424 postingsByAccount ps = m' 425 where 426 sortedps = sortBy (comparing paccount) ps 427 groupedps = groupBy (\p1 p2 -> paccount p1 == paccount p2) sortedps 428 m' = Map.fromList [(paccount $ head g, g) | g <- groupedps] 429 430 -- debug helpers 431 traceAmountPrecision a = trace (show $ map (precision . commodity) $ amounts a) a 432 tracePostingsCommodities ps = trace (show $ map ((map (precision . commodity) . amounts) . pamount) ps) ps 433 434 tests_Hledger_Data_Journal = TestList [ 435 ] 436