diff --git a/Commands/Add.hs b/Commands/Add.hs index 654b752f4..fbbd28574 100644 --- a/Commands/Add.hs +++ b/Commands/Add.hs @@ -55,14 +55,14 @@ getTransaction l args = do let historymatches = transactionsSimilarTo l description bestmatch | null historymatches = Nothing | otherwise = Just $ snd $ head historymatches - bestmatchpostings = maybe Nothing (Just . ltpostings) bestmatch + bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr getpostingsandvalidate = do ps <- getPostings bestmatchpostings [] - let t = nullledgertxn{ltdate=date - ,ltstatus=False - ,ltdescription=description - ,ltpostings=ps + let t = nullledgertxn{tdate=date + ,tstatus=False + ,tdescription=description + ,tpostings=ps } retry = do hPutStrLn stderr $ "\n" ++ nonzerobalanceerror ++ ". Re-enter:" @@ -130,9 +130,9 @@ ledgerAddTransaction l t = do appendToLedgerFile l $ show t putStrLn $ printf "\nAdded transaction to %s:" (filepath $ journal l) putStrLn =<< registerFromString (show t) - return l{journal=rl{ledger_txns=ts}} + return l{journal=rl{jtxns=ts}} where rl = journal l - ts = ledger_txns rl ++ [t] + ts = jtxns rl ++ [t] -- | Append data to the ledger's file, ensuring proper separation from any -- existing data; or if the file is "-", dump it to stdout. @@ -185,9 +185,9 @@ transactionsSimilarTo :: Ledger -> String -> [(Double,Transaction)] transactionsSimilarTo l s = sortBy compareRelevanceAndRecency $ filter ((> threshold).fst) - [(compareLedgerDescriptions s $ ltdescription t, t) | t <- ts] + [(compareLedgerDescriptions s $ tdescription t, t) | t <- ts] where - compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,ltdate t2) (n1,ltdate t1) - ts = ledger_txns $ journal l + compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,tdate t2) (n1,tdate t1) + ts = jtxns $ journal l threshold = 0 diff --git a/Commands/Convert.hs b/Commands/Convert.hs index 0bd81542f..d94f60ec9 100644 --- a/Commands/Convert.hs +++ b/Commands/Convert.hs @@ -258,14 +258,14 @@ transactionFromCsvRecord rules fields = (acct,newdesc) = identify (accountRules rules) unknownacct desc in Transaction { - ltdate=date, - lteffectivedate=Nothing, - ltstatus=status, - ltcode=code, - ltdescription=newdesc, - ltcomment=comment, - ltpreceding_comment_lines=precomment, - ltpostings=[ + tdate=date, + teffectivedate=Nothing, + tstatus=status, + tcode=code, + tdescription=newdesc, + tcomment=comment, + tpreceding_comment_lines=precomment, + tpostings=[ Posting { pstatus=False, paccount=acct, diff --git a/Commands/Histogram.hs b/Commands/Histogram.hs index 3f3837bea..aca1520e3 100644 --- a/Commands/Histogram.hs +++ b/Commands/Histogram.hs @@ -30,13 +30,13 @@ showHistogram opts args l = concatMap (printDayWith countBar) daytxns daytxns = [(s, filter (isLedgerPostingInDateSpan s) ts) | s <- days] -- same as Register -- should count raw transactions, not posting transactions - ts = sortBy (comparing tdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerLedgerPostings l + ts = sortBy (comparing lpdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerLedgerPostings l filterempties | Empty `elem` opts = id - | otherwise = filter (not . isZeroMixedAmount . tamount) - matchapats = matchpats apats . taccount + | otherwise = filter (not . isZeroMixedAmount . lpamount) + matchapats = matchpats apats . lpaccount (apats,_) = parsePatternArgs args - filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (taccount t) <= depth) + filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (lpaccount t) <= depth) | otherwise = id depth = depthFromOpts opts diff --git a/Commands/Print.hs b/Commands/Print.hs index 810e2dbe8..770f7d8d5 100644 --- a/Commands/Print.hs +++ b/Commands/Print.hs @@ -19,8 +19,8 @@ print' opts args = putStr . showTransactions opts args showTransactions :: [Opt] -> [String] -> Ledger -> String showTransactions opts args l = concatMap (showTransactionForPrint effective) txns where - txns = sortBy (comparing ltdate) $ - ledger_txns $ + txns = sortBy (comparing tdate) $ + jtxns $ filterJournalPostingsByDepth depth $ filterJournalPostingsByAccount apats $ journal l diff --git a/Commands/Register.hs b/Commands/Register.hs index aa6fa6171..120866ab5 100644 --- a/Commands/Register.hs +++ b/Commands/Register.hs @@ -30,16 +30,16 @@ DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA -} showRegisterReport :: [Opt] -> [String] -> Ledger -> String showRegisterReport opts args l - | interval == NoInterval = showtxns displayedts nulltxn startbal - | otherwise = showtxns summaryts nulltxn startbal + | interval == NoInterval = showlps displayedts nullledgerposting startbal + | otherwise = showlps summaryts nullledgerposting startbal where interval = intervalFromOpts opts - ts = sortBy (comparing tdate) $ filterempties $ filtertxns apats $ filterdepth $ ledgerLedgerPostings l - filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (taccount t) <= depth) + ts = sortBy (comparing lpdate) $ filterempties $ filtertxns apats $ filterdepth $ ledgerLedgerPostings l + filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (lpaccount t) <= depth) | otherwise = id filterempties | Empty `elem` opts = id - | otherwise = filter (not . isZeroMixedAmount . tamount) + | otherwise = filter (not . isZeroMixedAmount . lpamount) (precedingts, ts') = break (matchdisplayopt dopt) ts (displayedts, _) = span (matchdisplayopt dopt) ts' startbal = sumLedgerPostings precedingts @@ -56,7 +56,7 @@ showRegisterReport opts args l -- | Convert a date span (representing a reporting interval) and a list of -- transactions within it to a new list of transactions aggregated by --- account, which showtxns will render as a summary for this interval. +-- account, which showlps will render as a summary for this interval. -- -- As usual with date spans the end date is exclusive, but for display -- purposes we show the previous day as end date, like ledger. @@ -75,20 +75,20 @@ summariseLedgerPostingsInDateSpan (DateSpan b e) tnum depth showempty ts | null ts = [] | otherwise = summaryts' where - txn = nulltxn{tnum=tnum, tdate=b', tdescription="- "++ showDate (addDays (-1) e')} - b' = fromMaybe (tdate $ head ts) b - e' = fromMaybe (tdate $ last ts) e + txn = nullledgerposting{lptnum=tnum, lpdate=b', lpdescription="- "++ showDate (addDays (-1) e')} + b' = fromMaybe (lpdate $ head ts) b + e' = fromMaybe (lpdate $ last ts) e summaryts' | showempty = summaryts - | otherwise = filter (not . isZeroMixedAmount . tamount) summaryts - txnanames = sort $ nub $ map taccount ts + | otherwise = filter (not . isZeroMixedAmount . lpamount) summaryts + txnanames = sort $ nub $ map lpaccount ts -- aggregate balances by account, like cacheLedger, then do depth-clipping (_,_,exclbalof,inclbalof) = groupLedgerPostings ts clippedanames = clipAccountNames depth txnanames isclipped a = accountNameLevel a >= depth balancetoshowfor a = (if isclipped a then inclbalof else exclbalof) (if null a then "top" else a) - summaryts = [txn{taccount=a,tamount=balancetoshowfor a} | a <- clippedanames] + summaryts = [txn{lpaccount=a,lpamount=balancetoshowfor a} | a <- clippedanames] clipAccountNames :: Int -> [AccountName] -> [AccountName] clipAccountNames d as = nub $ map (clip d) as @@ -96,16 +96,16 @@ clipAccountNames d as = nub $ map (clip d) as -- | Show transactions one per line, with each date/description appearing -- only once, and a running balance. -showtxns [] _ _ = "" -showtxns (t:ts) tprev bal = this ++ showtxns ts t bal' +showlps [] _ _ = "" +showlps (lp:lps) lpprev bal = this ++ showlps lps lp bal' where - this = showtxn (t `issame` tprev) t bal' - issame = (==) `on` tnum - bal' = bal + tamount t + this = showlp (lp `issame` lpprev) lp bal' + issame = (==) `on` lptnum + bal' = bal + lpamount lp -- | Show one transaction line and balance with or without the entry details. -showtxn :: Bool -> LedgerPosting -> MixedAmount -> String -showtxn omitdesc t b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n" +showlp :: Bool -> LedgerPosting -> MixedAmount -> String +showlp omitdesc lp b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n" where ledger3ishlayout = False datedescwidth = if ledger3ishlayout then 34 else 32 @@ -116,5 +116,5 @@ showtxn omitdesc t b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n" desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String p = showPostingWithoutPrice $ Posting s a amt "" tt bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b) - LedgerPosting{tstatus=s,tdate=da,tdescription=de,taccount=a,tamount=amt,ttype=tt} = t + LedgerPosting{lpstatus=s,lpdate=da,lpdescription=de,lpaccount=a,lpamount=amt,lptype=tt} = lp diff --git a/Commands/Stats.hs b/Commands/Stats.hs index 5286db456..9eef04aec 100644 --- a/Commands/Stats.hs +++ b/Commands/Stats.hs @@ -34,7 +34,7 @@ showStats _ _ l today = ,("Transactions last 7 days", printf "%d (%0.1f per day)" tnum7 txnrate7) ,("Last transaction", maybe "none" show lastdate ++ maybe "" (printf " (%d days ago)") lastelapsed) --- ,("Payees/descriptions", show $ length $ nub $ map ltdescription ts) +-- ,("Payees/descriptions", show $ length $ nub $ map tdescription ts) ,("Accounts", show $ length $ accounts l) ,("Commodities", show $ length $ commodities l) -- Transactions this month : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s) @@ -43,9 +43,9 @@ showStats _ _ l today = -- Days since last transaction : %(recentelapsed)s ] where - ts = sortBy (comparing ltdate) $ ledger_txns $ journal l + ts = sortBy (comparing tdate) $ jtxns $ journal l lastdate | null ts = Nothing - | otherwise = Just $ ltdate $ last ts + | otherwise = Just $ tdate $ last ts lastelapsed = maybe Nothing (Just . diffDays today) lastdate tnum = length ts span = rawdatespan l @@ -57,9 +57,9 @@ showStats _ _ l today = txnrate | days==0 = 0 | otherwise = fromIntegral tnum / fromIntegral days :: Double tnum30 = length $ filter withinlast30 ts - withinlast30 t = d >= addDays (-30) today && (d<=today) where d = ltdate t + withinlast30 t = d >= addDays (-30) today && (d<=today) where d = tdate t txnrate30 = fromIntegral tnum30 / 30 :: Double tnum7 = length $ filter withinlast7 ts - withinlast7 t = d >= addDays (-7) today && (d<=today) where d = ltdate t + withinlast7 t = d >= addDays (-7) today && (d<=today) where d = tdate t txnrate7 = fromIntegral tnum7 / 7 :: Double diff --git a/Commands/UI.hs b/Commands/UI.hs index b4bec2139..ec6ee5c40 100644 --- a/Commands/UI.hs +++ b/Commands/UI.hs @@ -273,11 +273,11 @@ scrollToTransaction e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a -- cursor on the register screen (or best guess). Results undefined while -- on other screens. Doesn't work. currentTransaction :: AppState -> Transaction -currentTransaction a@AppState{aledger=l,abuf=buf} = transactionContainingLedgerPosting a t +currentTransaction a@AppState{aledger=l,abuf=buf} = transactionContainingLedgerPosting a lp where - t = safehead nulltxn $ filter ismatch $ ledgerLedgerPostings l - ismatch t = tdate t == parsedate (take 10 datedesc) - && take 70 (showtxn False t nullmixedamt) == (datedesc ++ acctamt) + lp = safehead nullledgerposting $ filter ismatch $ ledgerLedgerPostings l + ismatch lp = lpdate lp == parsedate (take 10 datedesc) + && take 70 (showlp False lp nullmixedamt) == (datedesc ++ acctamt) datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ safehead "" rest : reverse above acctamt = drop 32 $ safehead "" rest safehead d ls = if null ls then d else head ls @@ -287,7 +287,7 @@ currentTransaction a@AppState{aledger=l,abuf=buf} = transactionContainingLedgerP -- | Get the entry which contains the given transaction. -- Will raise an error if there are problems. transactionContainingLedgerPosting :: AppState -> LedgerPosting -> Transaction -transactionContainingLedgerPosting AppState{aledger=l} t = ledger_txns (journal l) !! tnum t +transactionContainingLedgerPosting AppState{aledger=l} lp = jtxns (journal l) !! lptnum lp -- renderers diff --git a/Commands/Web.hs b/Commands/Web.hs index c9e9ba274..ff385b82a 100644 --- a/Commands/Web.hs +++ b/Commands/Web.hs @@ -303,17 +303,17 @@ handleAddform l = do amt1' = either (const missingamt) id $ parse someamount "" amt1 amt2' = either (const missingamt) id $ parse someamount "" amt2 t = Transaction { - ltdate = parsedate $ fixSmartDateStr today date - ,lteffectivedate=Nothing - ,ltstatus=False - ,ltcode="" - ,ltdescription=desc - ,ltcomment="" - ,ltpostings=[ + tdate = parsedate $ fixSmartDateStr today date + ,teffectivedate=Nothing + ,tstatus=False + ,tcode="" + ,tdescription=desc + ,tcomment="" + ,tpostings=[ Posting False acct1 amt1' "" RegularPosting ,Posting False acct2 amt2' "" RegularPosting ] - ,ltpreceding_comment_lines="" + ,tpreceding_comment_lines="" } (t', berr) = case balanceTransaction t of Right t'' -> (t'', []) diff --git a/Ledger/Journal.hs b/Ledger/Journal.hs index fa376dcfa..b657acfc0 100644 --- a/Ledger/Journal.hs +++ b/Ledger/Journal.hs @@ -21,18 +21,18 @@ import Ledger.TimeLog instance Show Journal where show l = printf "Journal with %d transactions, %d accounts: %s" - (length (ledger_txns l) + - length (modifier_txns l) + - length (periodic_txns l)) + (length (jtxns l) + + length (jmodifiertxns l) + + length (jperiodictxns l)) (length accounts) (show accounts) -- ++ (show $ journalTransactions l) where accounts = flatten $ journalAccountNameTree l journalEmpty :: Journal -journalEmpty = Journal { modifier_txns = [] - , periodic_txns = [] - , ledger_txns = [] +journalEmpty = Journal { jmodifiertxns = [] + , jperiodictxns = [] + , jtxns = [] , open_timelog_entries = [] , historical_prices = [] , final_comment_lines = [] @@ -41,13 +41,13 @@ journalEmpty = Journal { modifier_txns = [] } addTransaction :: Transaction -> Journal -> Journal -addTransaction t l0 = l0 { ledger_txns = t : ledger_txns l0 } +addTransaction t l0 = l0 { jtxns = t : jtxns l0 } addModifierTransaction :: ModifierTransaction -> Journal -> Journal -addModifierTransaction mt l0 = l0 { modifier_txns = mt : modifier_txns l0 } +addModifierTransaction mt l0 = l0 { jmodifiertxns = mt : jmodifiertxns l0 } addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal -addPeriodicTransaction pt l0 = l0 { periodic_txns = pt : periodic_txns l0 } +addPeriodicTransaction pt l0 = l0 { jperiodictxns = pt : jperiodictxns l0 } addHistoricalPrice :: HistoricalPrice -> Journal -> Journal addHistoricalPrice h l0 = l0 { historical_prices = h : historical_prices l0 } @@ -56,7 +56,7 @@ addTimeLogEntry :: TimeLogEntry -> Journal -> Journal addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 } journalLedgerPostings :: Journal -> [LedgerPosting] -journalLedgerPostings = txnsof . ledger_txns +journalLedgerPostings = txnsof . jtxns where txnsof ts = concatMap flattenTransaction $ zip ts [1..] journalAccountNamesUsed :: Journal -> [AccountName] @@ -82,7 +82,7 @@ filterJournal span pats clearedonly realonly = filterJournalTransactionsByDescription :: [String] -> Journal -> Journal filterJournalTransactionsByDescription pats (Journal ms ps ts tls hs f fp ft) = Journal ms ps (filter matchdesc ts) tls hs f fp ft - where matchdesc = matchpats pats . ltdescription + where matchdesc = matchpats pats . tdescription -- | Keep only ledger transactions which fall between begin and end dates. -- We include transactions on the begin date and exclude transactions on the end @@ -91,14 +91,14 @@ filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal filterJournalTransactionsByDate (DateSpan begin end) (Journal ms ps ts tls hs f fp ft) = Journal ms ps (filter matchdate ts) tls hs f fp ft where - matchdate t = maybe True (ltdate t>=) begin && maybe True (ltdate t<) end + matchdate t = maybe True (tdate t>=) begin && maybe True (tdate t<) end -- | Keep only ledger transactions which have the requested -- cleared/uncleared status, if there is one. filterJournalPostingsByClearedStatus :: Maybe Bool -> Journal -> Journal filterJournalPostingsByClearedStatus Nothing rl = rl filterJournalPostingsByClearedStatus (Just val) (Journal ms ps ts tls hs f fp ft) = - Journal ms ps (filter ((==val).ltstatus) ts) tls hs f fp ft + Journal ms ps (filter ((==val).tstatus) ts) tls hs f fp ft -- | Strip out any virtual postings, if the flag is true, otherwise do -- no filtering. @@ -106,27 +106,27 @@ filterJournalPostingsByRealness :: Bool -> Journal -> Journal filterJournalPostingsByRealness False l = l filterJournalPostingsByRealness True (Journal mts pts ts tls hs f fp ft) = Journal mts pts (map filtertxns ts) tls hs f fp ft - where filtertxns t@Transaction{ltpostings=ps} = t{ltpostings=filter isReal ps} + where filtertxns t@Transaction{tpostings=ps} = t{tpostings=filter isReal ps} -- | Strip out any postings to accounts deeper than the specified depth -- (and any ledger transactions which have no postings as a result). filterJournalPostingsByDepth :: Int -> Journal -> Journal filterJournalPostingsByDepth depth (Journal mts pts ts tls hs f fp ft) = - Journal mts pts (filter (not . null . ltpostings) $ map filtertxns ts) tls hs f fp ft - where filtertxns t@Transaction{ltpostings=ps} = - t{ltpostings=filter ((<= depth) . accountNameLevel . paccount) ps} + Journal mts pts (filter (not . null . tpostings) $ map filtertxns ts) tls hs f fp ft + where filtertxns t@Transaction{tpostings=ps} = + t{tpostings=filter ((<= depth) . accountNameLevel . paccount) ps} -- | Keep only ledger transactions which affect accounts matched by the account patterns. filterJournalPostingsByAccount :: [String] -> Journal -> Journal filterJournalPostingsByAccount apats (Journal ms ps ts tls hs f fp ft) = - Journal ms ps (filter (any (matchpats apats . paccount) . ltpostings) ts) tls hs f fp ft + Journal ms ps (filter (any (matchpats apats . paccount) . tpostings) ts) tls hs f fp ft -- | Convert this ledger's transactions' primary date to either their -- actual or effective date. journalSelectingDate :: WhichDate -> Journal -> Journal journalSelectingDate ActualDate rl = rl journalSelectingDate EffectiveDate rl = - rl{ledger_txns=map (ledgerTransactionWithDate EffectiveDate) $ ledger_txns rl} + rl{jtxns=map (ledgerTransactionWithDate EffectiveDate) $ jtxns rl} -- | Give all a ledger's amounts their canonical display settings. That -- is, in each commodity, amounts will use the display settings of the @@ -153,7 +153,7 @@ canonicaliseAmounts costbasis rl@(Journal ms ps ts tls hs f fp ft) = Journal ms commoditymap = Map.fromList [(s,commoditieswithsymbol s) | s <- commoditysymbols] commoditieswithsymbol s = filter ((s==) . symbol) commodities commoditysymbols = nub $ map symbol commodities - commodities = map commodity (concatMap (amounts . tamount) (journalLedgerPostings rl) + commodities = map commodity (concatMap (amounts . lpamount) (journalLedgerPostings rl) ++ concatMap (amounts . hamount) (historical_prices rl)) fixprice :: Amount -> Amount fixprice a@Amount{price=Just _} = a @@ -173,7 +173,7 @@ canonicaliseAmounts costbasis rl@(Journal ms ps ts tls hs f fp ft) = Journal ms -- | Get just the amounts from a ledger, in the order parsed. journalAmounts :: Journal -> [MixedAmount] -journalAmounts = map tamount . journalLedgerPostings +journalAmounts = map lpamount . journalLedgerPostings -- | Get just the ammount commodities from a ledger, in the order parsed. journalCommodities :: Journal -> [Commodity] @@ -185,7 +185,7 @@ journalPrecisions = map precision . journalCommodities -- | Close any open timelog sessions using the provided current time. journalConvertTimeLog :: LocalTime -> Journal -> Journal -journalConvertTimeLog t l0 = l0 { ledger_txns = convertedTimeLog ++ ledger_txns l0 +journalConvertTimeLog t l0 = l0 { jtxns = convertedTimeLog ++ jtxns l0 , open_timelog_entries = [] } where convertedTimeLog = entriesFromTimeLogEntries t $ open_timelog_entries l0 @@ -195,9 +195,9 @@ journalConvertTimeLog t l0 = l0 { ledger_txns = convertedTimeLog ++ ledger_txns journalDateSpan :: Journal -> DateSpan journalDateSpan rl | null ts = DateSpan Nothing Nothing - | otherwise = DateSpan (Just $ ltdate $ head ts) (Just $ addDays 1 $ ltdate $ last ts) + | otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts) where - ts = sortBy (comparing ltdate) $ ledger_txns rl + ts = sortBy (comparing tdate) $ jtxns rl -- | Check if a set of ledger account/description patterns matches the -- given account name or entry description. Patterns are case-insensitive diff --git a/Ledger/Ledger.hs b/Ledger/Ledger.hs index af5deb08e..3f1919815 100644 --- a/Ledger/Ledger.hs +++ b/Ledger/Ledger.hs @@ -65,9 +65,9 @@ import Ledger.Journal instance Show Ledger where show l = printf "Ledger with %d transactions, %d accounts\n%s" - (length (ledger_txns $ journal l) + - length (modifier_txns $ journal l) + - length (periodic_txns $ journal l)) + (length (jtxns $ journal l) + + length (jmodifiertxns $ journal l) + + length (jperiodictxns $ journal l)) (length $ accountnames l) (showtree $ accountnametree l) @@ -90,7 +90,7 @@ groupLedgerPostings :: [LedgerPosting] -> (Tree AccountName, (AccountName -> MixedAmount)) groupLedgerPostings ts = (ant,txnsof,exclbalof,inclbalof) where - txnanames = sort $ nub $ map taccount ts + txnanames = sort $ nub $ map lpaccount ts ant = accountNameTreeFrom $ expandAccountNames txnanames allanames = flatten ant txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- allanames]) @@ -120,14 +120,14 @@ calculateBalances ant txnsof = addbalances ant transactionsByAccount :: [LedgerPosting] -> Map.Map AccountName [LedgerPosting] transactionsByAccount ts = m' where - sortedts = sortBy (comparing taccount) ts - groupedts = groupBy (\t1 t2 -> taccount t1 == taccount t2) sortedts - m' = Map.fromList [(taccount $ head g, g) | g <- groupedts] + sortedts = sortBy (comparing lpaccount) ts + groupedts = groupBy (\t1 t2 -> lpaccount t1 == lpaccount t2) sortedts + m' = Map.fromList [(lpaccount $ head g, g) | g <- groupedts] -- The special account name "top" can be used to look up all transactions. ? -- m' = Map.insert "top" sortedts m filtertxns :: [String] -> [LedgerPosting] -> [LedgerPosting] -filtertxns apats = filter (matchpats apats . taccount) +filtertxns apats = filter (matchpats apats . lpaccount) -- | List a ledger's account names. ledgerAccountNames :: Ledger -> [AccountName] @@ -171,9 +171,9 @@ ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l ledgerDateSpan :: Ledger -> DateSpan ledgerDateSpan l | null ts = DateSpan Nothing Nothing - | otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts) + | otherwise = DateSpan (Just $ lpdate $ head ts) (Just $ addDays 1 $ lpdate $ last ts) where - ts = sortBy (comparing tdate) $ ledgerLedgerPostings l + ts = sortBy (comparing lpdate) $ ledgerLedgerPostings l -- | Convenience aliases. accountnames :: Ledger -> [AccountName] diff --git a/Ledger/LedgerPosting.hs b/Ledger/LedgerPosting.hs index b24ff3a1e..a8bfd2ef4 100644 --- a/Ledger/LedgerPosting.hs +++ b/Ledger/LedgerPosting.hs @@ -20,10 +20,10 @@ import Ledger.Amount instance Show LedgerPosting where show=showLedgerPosting showLedgerPosting :: LedgerPosting -> String -showLedgerPosting (LedgerPosting _ stat d desc a amt ttype) = - s ++ unwords [showDate d,desc,a',show amt,show ttype] +showLedgerPosting (LedgerPosting _ stat d desc a amt lptype) = + s ++ unwords [showDate d,desc,a',show amt,show lptype] where s = if stat then " *" else "" - a' = showAccountName Nothing ttype a + a' = showAccountName Nothing lptype a -- | Convert a 'Transaction' to two or more 'LedgerPosting's. An id number -- is attached to the transactions to preserve their grouping - it should @@ -33,18 +33,18 @@ flattenTransaction (Transaction d _ s _ desc _ ps _, n) = [LedgerPosting n s d desc (paccount p) (pamount p) (ptype p) | p <- ps] accountNamesFromLedgerPostings :: [LedgerPosting] -> [AccountName] -accountNamesFromLedgerPostings = nub . map taccount +accountNamesFromLedgerPostings = nub . map lpaccount sumLedgerPostings :: [LedgerPosting] -> MixedAmount -sumLedgerPostings = sum . map tamount +sumLedgerPostings = sum . map lpamount -nulltxn :: LedgerPosting -nulltxn = LedgerPosting 0 False (parsedate "1900/1/1") "" "" nullmixedamt RegularPosting +nullledgerposting :: LedgerPosting +nullledgerposting = LedgerPosting 0 False (parsedate "1900/1/1") "" "" nullmixedamt RegularPosting -- | Does the given transaction fall within the given date span ? isLedgerPostingInDateSpan :: DateSpan -> LedgerPosting -> Bool isLedgerPostingInDateSpan (DateSpan Nothing Nothing) _ = True -isLedgerPostingInDateSpan (DateSpan Nothing (Just e)) (LedgerPosting{tdate=d}) = d=b -isLedgerPostingInDateSpan (DateSpan (Just b) (Just e)) (LedgerPosting{tdate=d}) = d>=b && d=b +isLedgerPostingInDateSpan (DateSpan (Just b) (Just e)) (LedgerPosting{lpdate=d}) = d>=b && d test (<) "<=" -> test (<=) diff --git a/Ledger/Posting.hs b/Ledger/Posting.hs index c0a705351..677f2e84b 100644 --- a/Ledger/Posting.hs +++ b/Ledger/Posting.hs @@ -22,26 +22,26 @@ instance Show Posting where show = showPosting nullrawposting = Posting False "" nullmixedamt "" RegularPosting showPosting :: Posting -> String -showPosting (Posting _ a amt com ttype) = +showPosting (Posting _ a amt com lptype) = concatTopPadded [showaccountname a ++ " ", showamount amt, comment] where ledger3ishlayout = False acctnamewidth = if ledger3ishlayout then 25 else 22 showaccountname = printf ("%-"++(show acctnamewidth)++"s") . bracket . elideAccountName width - (bracket,width) = case ttype of + (bracket,width) = case lptype of BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth-2) VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2) _ -> (id,acctnamewidth) showamount = padleft 12 . showMixedAmountOrZero comment = if null com then "" else " ; " ++ com -- XXX refactor -showPostingWithoutPrice (Posting _ a amt com ttype) = +showPostingWithoutPrice (Posting _ a amt com lptype) = concatTopPadded [showaccountname a ++ " ", showamount amt, comment] where ledger3ishlayout = False acctnamewidth = if ledger3ishlayout then 25 else 22 showaccountname = printf ("%-"++(show acctnamewidth)++"s") . bracket . elideAccountName width - (bracket,width) = case ttype of + (bracket,width) = case lptype of BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth-2) VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2) _ -> (id,acctnamewidth) diff --git a/Ledger/TimeLog.hs b/Ledger/TimeLog.hs index ef589e7ce..f81507c76 100644 --- a/Ledger/TimeLog.hs +++ b/Ledger/TimeLog.hs @@ -66,14 +66,14 @@ entryFromTimeLogInOut i o error $ "clock-out time less than clock-in time in:\n" ++ showTransaction t where t = Transaction { - ltdate = idate, - lteffectivedate = Nothing, - ltstatus = True, - ltcode = "", - ltdescription = showtime itod ++ "-" ++ showtime otod, - ltcomment = "", - ltpostings = ps, - ltpreceding_comment_lines="" + tdate = idate, + teffectivedate = Nothing, + tstatus = True, + tcode = "", + tdescription = showtime itod ++ "-" ++ showtime otod, + tcomment = "", + tpostings = ps, + tpreceding_comment_lines="" } showtime = take 5 . show acctname = tlcomment i diff --git a/Ledger/Transaction.hs b/Ledger/Transaction.hs index 1450f9c3c..be669b5a9 100644 --- a/Ledger/Transaction.hs +++ b/Ledger/Transaction.hs @@ -24,14 +24,14 @@ instance Show PeriodicTransaction where nullledgertxn :: Transaction nullledgertxn = Transaction { - ltdate=parsedate "1900/1/1", - lteffectivedate=Nothing, - ltstatus=False, - ltcode="", - ltdescription="", - ltcomment="", - ltpostings=[], - ltpreceding_comment_lines="" + tdate=parsedate "1900/1/1", + teffectivedate=Nothing, + tstatus=False, + tcode="", + tdescription="", + tcomment="", + tpostings=[], + tpreceding_comment_lines="" } {-| @@ -61,15 +61,15 @@ showTransactionForPrint effective = showTransaction' False effective showTransaction' :: Bool -> Bool -> Transaction -> String showTransaction' elide effective t = - unlines $ [description] ++ showpostings (ltpostings t) ++ [""] + unlines $ [description] ++ showpostings (tpostings t) ++ [""] where description = concat [date, status, code, desc, comment] - date | effective = showdate $ fromMaybe (ltdate t) $ lteffectivedate t - | otherwise = showdate (ltdate t) ++ maybe "" showedate (lteffectivedate t) - status = if ltstatus t then " *" else "" - code = if length (ltcode t) > 0 then printf " (%s)" $ ltcode t else "" - desc = ' ' : ltdescription t - comment = if null com then "" else " ; " ++ com where com = ltcomment t + date | effective = showdate $ fromMaybe (tdate t) $ teffectivedate t + | otherwise = showdate (tdate t) ++ maybe "" showedate (teffectivedate t) + status = if tstatus t then " *" else "" + code = if length (tcode t) > 0 then printf " (%s)" $ tcode t else "" + desc = ' ' : tdescription t + comment = if null com then "" else " ; " ++ com where com = tcomment t showdate = printf "%-10s" . showDate showedate = printf "=%s" . showdate showpostings ps @@ -98,7 +98,7 @@ showAccountName w = fmt bracket s = "["++s++"]" isTransactionBalanced :: Transaction -> Bool -isTransactionBalanced (Transaction {ltpostings=ps}) = +isTransactionBalanced (Transaction {tpostings=ps}) = all (isReallyZeroMixedAmount . costOfMixedAmount . sum . map pamount) [filter isReal ps, filter isBalancedVirtual ps] @@ -108,14 +108,14 @@ isTransactionBalanced (Transaction {ltpostings=ps}) = -- converted to cost basis if possible. If the entry can not be balanced, -- return an error message instead. balanceTransaction :: Transaction -> Either String Transaction -balanceTransaction t@Transaction{ltpostings=ps} +balanceTransaction t@Transaction{tpostings=ps} | length missingamounts' > 1 = Left $ printerr "could not balance this transaction, too many missing amounts" | not $ isTransactionBalanced t' = Left $ printerr nonzerobalanceerror | otherwise = Right t' where (withamounts, missingamounts) = partition hasAmount $ filter isReal ps (_, missingamounts') = partition hasAmount ps - t' = t{ltpostings=ps'} + t' = t{tpostings=ps'} ps' | length missingamounts == 1 = map balance ps | otherwise = ps where @@ -129,5 +129,5 @@ nonzerobalanceerror = "could not balance this transaction, amounts do not add up -- | Convert the primary date to either the actual or effective date. ledgerTransactionWithDate :: WhichDate -> Transaction -> Transaction ledgerTransactionWithDate ActualDate t = t -ledgerTransactionWithDate EffectiveDate t = t{ltdate=fromMaybe (ltdate t) (lteffectivedate t)} +ledgerTransactionWithDate EffectiveDate t = t{tdate=fromMaybe (tdate t) (teffectivedate t)} diff --git a/Ledger/Types.hs b/Ledger/Types.hs index c7579e0c5..de2777c25 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -88,14 +88,14 @@ data PeriodicTransaction = PeriodicTransaction { } deriving (Eq) data Transaction = Transaction { - ltdate :: Day, - lteffectivedate :: Maybe Day, - ltstatus :: Bool, - ltcode :: String, - ltdescription :: String, - ltcomment :: String, - ltpostings :: [Posting], - ltpreceding_comment_lines :: String + tdate :: Day, + teffectivedate :: Maybe Day, + tstatus :: Bool, + tcode :: String, + tdescription :: String, + tcomment :: String, + tpostings :: [Posting], + tpreceding_comment_lines :: String } deriving (Eq) data TimeLogCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord) @@ -113,9 +113,9 @@ data HistoricalPrice = HistoricalPrice { } deriving (Eq) -- & Show (in Amount.hs) data Journal = Journal { - modifier_txns :: [ModifierTransaction], - periodic_txns :: [PeriodicTransaction], - ledger_txns :: [Transaction], + jmodifiertxns :: [ModifierTransaction], + jperiodictxns :: [PeriodicTransaction], + jtxns :: [Transaction], open_timelog_entries :: [TimeLogEntry], historical_prices :: [HistoricalPrice], final_comment_lines :: String, @@ -135,13 +135,13 @@ data FilterSpec = FilterSpec { } data LedgerPosting = LedgerPosting { - tnum :: Int, - tstatus :: Bool, -- ^ posting status - tdate :: Day, -- ^ transaction date - tdescription :: String, -- ^ ledger transaction description - taccount :: AccountName, -- ^ posting account - tamount :: MixedAmount, -- ^ posting amount - ttype :: PostingType -- ^ posting type + lptnum :: Int, -- ^ internal transaction reference number + lpstatus :: Bool, -- ^ posting status + lpdate :: Day, -- ^ transaction date + lpdescription :: String, -- ^ ledger transaction description + lpaccount :: AccountName, -- ^ posting account + lpamount :: MixedAmount, -- ^ posting amount + lptype :: PostingType -- ^ posting type } deriving (Eq) data Account = Account { diff --git a/Tests.hs b/Tests.hs index c4dd93074..e1d34b5be 100644 --- a/Tests.hs +++ b/Tests.hs @@ -327,7 +327,7 @@ tests = [ assertEqual "balancing amount is added" (Mixed [dollars (-1)]) (case e of - Right e' -> (pamount $ last $ ltpostings e') + Right e' -> (pamount $ last $ tpostings e') Left _ -> error "should not happen") ,"cacheLedger" ~: @@ -365,7 +365,7 @@ tests = [ clockin = TimeLogEntry In mktime d = LocalTime d . fromMaybe midnight . parseTime defaultTimeLocale "%H:%M:%S" showtime = formatTime defaultTimeLocale "%H:%M" - assertEntriesGiveStrings name es ss = assertEqual name ss (map ltdescription $ entriesFromTimeLogEntries now es) + assertEntriesGiveStrings name es ss = assertEqual name ss (map tdescription $ entriesFromTimeLogEntries now es) assertEntriesGiveStrings "started yesterday, split session at midnight" [clockin (mktime yesterday "23:00:00") ""] @@ -458,13 +458,13 @@ tests = [ ,"default year" ~: do rl <- journalFromString defaultyear_ledger_str - ltdate (head $ ledger_txns rl) `is` fromGregorian 2009 1 1 + tdate (head $ jtxns rl) `is` fromGregorian 2009 1 1 return () ,"ledgerFile" ~: do assertBool "ledgerFile should parse an empty file" (isRight $ parseWithCtx emptyCtx ledgerFile "") r <- journalFromString "" -- don't know how to get it from ledgerFile - assertBool "ledgerFile parsing an empty file should give an empty ledger" $ null $ ledger_txns r + assertBool "ledgerFile parsing an empty file should give an empty ledger" $ null $ jtxns r ,"ledgerHistoricalPrice" ~: parseWithCtx emptyCtx ledgerHistoricalPrice price1_str `parseis` price1 @@ -477,7 +477,7 @@ tests = [ $ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a\n" let t = parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a ;comment\n b 1\n" assertBool "ledgerTransaction should not include a comment in the description" - $ either (const False) ((== "a") . ltdescription) t + $ either (const False) ((== "a") . tdescription) t ,"ledgeraccountname" ~: do assertBool "ledgeraccountname parses a normal accountname" (isRight $ parsewith ledgeraccountname "a:b:c") @@ -801,38 +801,38 @@ tests = [ map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"] ,"summariseLedgerPostingsInDateSpan" ~: do - let gives (b,e,tnum,depth,showempty,ts) = - (summariseLedgerPostingsInDateSpan (mkdatespan b e) tnum depth showempty ts `is`) + let gives (b,e,lpnum,depth,showempty,ts) = + (summariseLedgerPostingsInDateSpan (mkdatespan b e) lpnum depth showempty ts `is`) let ts = [ - nulltxn{tdescription="desc",taccount="expenses:food:groceries",tamount=Mixed [dollars 1]} - ,nulltxn{tdescription="desc",taccount="expenses:food:dining", tamount=Mixed [dollars 2]} - ,nulltxn{tdescription="desc",taccount="expenses:food", tamount=Mixed [dollars 4]} - ,nulltxn{tdescription="desc",taccount="expenses:food:dining", tamount=Mixed [dollars 8]} + nullledgerposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]} + ,nullledgerposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 2]} + ,nullledgerposting{lpdescription="desc",lpaccount="expenses:food", lpamount=Mixed [dollars 4]} + ,nullledgerposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 8]} ] ("2008/01/01","2009/01/01",0,9999,False,[]) `gives` [] ("2008/01/01","2009/01/01",0,9999,True,[]) `gives` [ - nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31"} + nullledgerposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31"} ] ("2008/01/01","2009/01/01",0,9999,False,ts) `gives` [ - nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food", tamount=Mixed [dollars 4]} - ,nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food:dining", tamount=Mixed [dollars 10]} - ,nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food:groceries",tamount=Mixed [dollars 1]} + nullledgerposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food", lpamount=Mixed [dollars 4]} + ,nullledgerposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 10]} + ,nullledgerposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]} ] ("2008/01/01","2009/01/01",0,2,False,ts) `gives` [ - nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food",tamount=Mixed [dollars 15]} + nullledgerposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [dollars 15]} ] ("2008/01/01","2009/01/01",0,1,False,ts) `gives` [ - nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses",tamount=Mixed [dollars 15]} + nullledgerposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [dollars 15]} ] ("2008/01/01","2009/01/01",0,0,False,ts) `gives` [ - nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="",tamount=Mixed [dollars 15]} + nullledgerposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [dollars 15]} ] ,"postingamount" ~: do @@ -1065,168 +1065,168 @@ journal7 = Journal [] [ Transaction { - ltdate=parsedate "2007/01/01", - lteffectivedate=Nothing, - ltstatus=False, - ltcode="*", - ltdescription="opening balance", - ltcomment="", - ltpostings=[ + tdate=parsedate "2007/01/01", + teffectivedate=Nothing, + tstatus=False, + tcode="*", + tdescription="opening balance", + tcomment="", + tpostings=[ Posting { pstatus=False, - paccount="assets:cash", + paccount="assets:cash", pamount=(Mixed [dollars 4.82]), pcomment="", ptype=RegularPosting }, Posting { pstatus=False, - paccount="equity:opening balances", + paccount="equity:opening balances", pamount=(Mixed [dollars (-4.82)]), pcomment="", ptype=RegularPosting } ], - ltpreceding_comment_lines="" + tpreceding_comment_lines="" } , Transaction { - ltdate=parsedate "2007/02/01", - lteffectivedate=Nothing, - ltstatus=False, - ltcode="*", - ltdescription="ayres suites", - ltcomment="", - ltpostings=[ + tdate=parsedate "2007/02/01", + teffectivedate=Nothing, + tstatus=False, + tcode="*", + tdescription="ayres suites", + tcomment="", + tpostings=[ Posting { pstatus=False, - paccount="expenses:vacation", + paccount="expenses:vacation", pamount=(Mixed [dollars 179.92]), pcomment="", ptype=RegularPosting }, Posting { pstatus=False, - paccount="assets:checking", + paccount="assets:checking", pamount=(Mixed [dollars (-179.92)]), pcomment="", ptype=RegularPosting } ], - ltpreceding_comment_lines="" + tpreceding_comment_lines="" } , Transaction { - ltdate=parsedate "2007/01/02", - lteffectivedate=Nothing, - ltstatus=False, - ltcode="*", - ltdescription="auto transfer to savings", - ltcomment="", - ltpostings=[ + tdate=parsedate "2007/01/02", + teffectivedate=Nothing, + tstatus=False, + tcode="*", + tdescription="auto transfer to savings", + tcomment="", + tpostings=[ Posting { pstatus=False, - paccount="assets:saving", + paccount="assets:saving", pamount=(Mixed [dollars 200]), pcomment="", ptype=RegularPosting }, Posting { pstatus=False, - paccount="assets:checking", + paccount="assets:checking", pamount=(Mixed [dollars (-200)]), pcomment="", ptype=RegularPosting } ], - ltpreceding_comment_lines="" + tpreceding_comment_lines="" } , Transaction { - ltdate=parsedate "2007/01/03", - lteffectivedate=Nothing, - ltstatus=False, - ltcode="*", - ltdescription="poquito mas", - ltcomment="", - ltpostings=[ + tdate=parsedate "2007/01/03", + teffectivedate=Nothing, + tstatus=False, + tcode="*", + tdescription="poquito mas", + tcomment="", + tpostings=[ Posting { pstatus=False, - paccount="expenses:food:dining", + paccount="expenses:food:dining", pamount=(Mixed [dollars 4.82]), pcomment="", ptype=RegularPosting }, Posting { pstatus=False, - paccount="assets:cash", + paccount="assets:cash", pamount=(Mixed [dollars (-4.82)]), pcomment="", ptype=RegularPosting } ], - ltpreceding_comment_lines="" + tpreceding_comment_lines="" } , Transaction { - ltdate=parsedate "2007/01/03", - lteffectivedate=Nothing, - ltstatus=False, - ltcode="*", - ltdescription="verizon", - ltcomment="", - ltpostings=[ + tdate=parsedate "2007/01/03", + teffectivedate=Nothing, + tstatus=False, + tcode="*", + tdescription="verizon", + tcomment="", + tpostings=[ Posting { pstatus=False, - paccount="expenses:phone", + paccount="expenses:phone", pamount=(Mixed [dollars 95.11]), pcomment="", ptype=RegularPosting }, Posting { pstatus=False, - paccount="assets:checking", + paccount="assets:checking", pamount=(Mixed [dollars (-95.11)]), pcomment="", ptype=RegularPosting } ], - ltpreceding_comment_lines="" + tpreceding_comment_lines="" } , Transaction { - ltdate=parsedate "2007/01/03", - lteffectivedate=Nothing, - ltstatus=False, - ltcode="*", - ltdescription="discover", - ltcomment="", - ltpostings=[ + tdate=parsedate "2007/01/03", + teffectivedate=Nothing, + tstatus=False, + tcode="*", + tdescription="discover", + tcomment="", + tpostings=[ Posting { pstatus=False, - paccount="liabilities:credit cards:discover", + paccount="liabilities:credit cards:discover", pamount=(Mixed [dollars 80]), pcomment="", ptype=RegularPosting }, Posting { pstatus=False, - paccount="assets:checking", + paccount="assets:checking", pamount=(Mixed [dollars (-80)]), pcomment="", ptype=RegularPosting } ], - ltpreceding_comment_lines="" + tpreceding_comment_lines="" } - ] + ] [] [] "" "" (TOD 0 0) -ledger7 = cacheLedger [] journal7 +ledger7 = cacheLedger [] journal7 ledger8_str = unlines ["2008/1/1 test " @@ -1249,11 +1249,11 @@ a2 = Mixed [(hours 2){price=Just $ Mixed [Amount (comm "EUR") 10 Nothing]}] a3 = Mixed $ amounts a1 ++ amounts a2 journalWithAmounts :: [String] -> Journal -journalWithAmounts as = - Journal - [] - [] - [nullledgertxn{ltdescription=a,ltpostings=[nullrawposting{pamount=parse a}]} | a <- as] +journalWithAmounts as = + Journal + [] + [] + [nullledgertxn{tdescription=a,tpostings=[nullrawposting{pamount=parse a}]} | a <- as] [] [] ""