simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2025-01-01 06:41:55 +03:00
Code Issues Projects Releases Wiki Activity

more LedgerTransaction/Transaction/LedgerPosting field renames

Browse Source
This commit is contained in:
Simon Michael 2009-12-16 17:58:51 +00:00
parent 30b83bb105
commit f1813fbb0e
17 changed files with 241 additions and 241 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
Commands/Add.hs
View File

@ -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

16
Commands/Convert.hs
View File

@ -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,

8
Commands/Histogram.hs
View File

@ -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

4
Commands/Print.hs
View File

@ -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

40
Commands/Register.hs
View File

@ -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

10
Commands/Stats.hs
View File

@ -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

10
Commands/UI.hs
View File

@ -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

16
Commands/Web.hs
View File

@ -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'', [])

48
Ledger/Journal.hs
View File

@ -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

20
Ledger/Ledger.hs
View File

@ -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]

20
Ledger/LedgerPosting.hs
View File

@ -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<e
isLedgerPostingInDateSpan (DateSpan (Just b) Nothing) (LedgerPosting{tdate=d}) = d>=b
isLedgerPostingInDateSpan (DateSpan (Just b) (Just e)) (LedgerPosting{tdate=d}) = d>=b && d<e
isLedgerPostingInDateSpan (DateSpan Nothing (Just e)) (LedgerPosting{lpdate=d}) = d<e
isLedgerPostingInDateSpan (DateSpan (Just b) Nothing) (LedgerPosting{lpdate=d}) = d>=b
isLedgerPostingInDateSpan (DateSpan (Just b) (Just e)) (LedgerPosting{lpdate=d}) = d>=b && d<e

2
Ledger/Parse.hs
View File

@ -566,7 +566,7 @@ datedisplayexpr = do
(y,m,d) <- smartdate
char ']'
let date = parsedate $ printf "%04s/%02s/%02s" y m d
test op = return $ (`op` date) . tdate
test op = return $ (`op` date) . lpdate
case op of
"<" -> test (<)
"<=" -> test (<=)

8
Ledger/Posting.hs
View File

@ -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)

16
Ledger/TimeLog.hs
View File

@ -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

38
Ledger/Transaction.hs
View File

@ -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)}

36
Ledger/Types.hs
View File

@ -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 {

170
Tests.hs
View File

@ -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]
[]
[]
""