slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

drop LedgerPosting, it's no longer needed; more rename cleanups

Browse Source
This commit is contained in:
Simon Michael 2009-12-19 05:57:54 +00:00
parent 19ff69bb83
commit 60bda57a26
17 changed files with 223 additions and 287 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
Commands/Add.hs
View File

@ -59,11 +59,11 @@ getTransaction l args = do
date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr
getpostingsandvalidate = do
ps <- getPostings bestmatchpostings []
let t = nullledgertxn{tdate=date
,tstatus=False
,tdescription=description
,tpostings=ps
}
let t = nulltransaction{tdate=date
,tstatus=False
,tdescription=description
,tpostings=ps
}
retry = do
hPutStrLn stderr $ "\n" ++ nonzerobalanceerror ++ ". Re-enter:"
getpostingsandvalidate
@ -84,9 +84,9 @@ getPostings historicalps enteredps = do
else do
amountstr <- askFor (printf "amount %d" n) defaultamount validateamount
let amount = fromparse $ parse (someamount <|> return missingamt) "" amountstr
let p = nullrawposting{paccount=stripbrackets account,
pamount=amount,
ptype=postingtype account}
let p = nullposting{paccount=stripbrackets account,
pamount=amount,
ptype=postingtype account}
getPostings historicalps $ enteredps ++ [p]
where
n = length enteredps + 1

4
Commands/Balance.hs
View File

@ -101,7 +101,7 @@ import Ledger.Utils
import Ledger.Types
import Ledger.Amount
import Ledger.AccountName
import Ledger.LedgerPosting
import Ledger.Posting
import Ledger.Ledger
import Options
import System.IO.UTF8
@ -151,7 +151,7 @@ isInteresting opts l a
emptyflag = Empty `elem` opts
acct = ledgerAccount l a
notzero = not $ isZeroMixedAmount inclbalance where inclbalance = abalance acct
notlikesub = not $ isZeroMixedAmount exclbalance where exclbalance = sumLedgerPostings $ apostings acct
notlikesub = not $ isZeroMixedAmount exclbalance where exclbalance = sumPostings $ apostings acct
numinterestingsubs = length $ filter isInterestingTree subtrees
where
isInterestingTree = treeany (isInteresting opts l . aname)

22
Commands/Histogram.hs
View File

@ -15,35 +15,31 @@ import System.IO.UTF8
barchar = '*'
-- | Print a histogram of some statistic per reporting interval, such as
-- number of transactions per day.
-- number of postings per day.
histogram :: [Opt] -> [String] -> Ledger -> IO ()
histogram opts args = putStr . showHistogram opts args
showHistogram :: [Opt] -> [String] -> Ledger -> String
showHistogram opts args l = concatMap (printDayWith countBar) daytxns
showHistogram opts args l = concatMap (printDayWith countBar) dayps
where
i = intervalFromOpts opts
interval | i == NoInterval = Daily
| otherwise = i
fullspan = journalDateSpan $ journal l
days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan
daytxns = [(s, filter (isLedgerPostingInDateSpan s) ts) | s <- days]
dayps = [(s, filter (isPostingInDateSpan s) ps) | s <- days]
-- same as Register
-- should count raw transactions, not posting transactions
ts = sortBy (comparing lpdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerLedgerPostings l
-- should count transactions, not postings ?
ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ ledgerPostings l
filterempties
| Empty `elem` opts = id
| otherwise = filter (not . isZeroMixedAmount . lpamount)
matchapats = matchpats apats . lpaccount
| otherwise = filter (not . isZeroMixedAmount . pamount)
matchapats = matchpats apats . paccount
(apats,_) = parsePatternArgs args
filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (lpaccount t) <= depth)
filterdepth | interval == NoInterval = filter (\p -> accountNameLevel (paccount p) <= depth)
| otherwise = id
depth = depthFromOpts opts
printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts)
countBar ts = replicate (length ts) barchar
total = show . sumLedgerPostings
-- totalBar ts = replicate (sumLedgerPostings ts) barchar
countBar ps = replicate (length ps) barchar

100
Commands/Register.hs
View File

@ -6,7 +6,6 @@ A ledger-compatible @register@ command.
module Commands.Register
where
import Data.Function (on)
import Prelude hiding (putStr)
import Ledger
import Options
@ -30,91 +29,92 @@ DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA
-}
showRegisterReport :: [Opt] -> [String] -> Ledger -> String
showRegisterReport opts args l
| interval == NoInterval = showlps displayedts nullledgerposting startbal
| otherwise = showlps summaryts nullledgerposting startbal
| interval == NoInterval = showps displayedps nullposting startbal
| otherwise = showps summaryps nullposting startbal
where
interval = intervalFromOpts opts
ts = sortBy (comparing lpdate) $ filterempties $ filtertxns apats $ filterdepth $ ledgerLedgerPostings l
filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (lpaccount t) <= depth)
ps = sortBy (comparing postingDate) $ filterempties $ filterPostings apats $ filterdepth $ ledgerPostings l
filterdepth | interval == NoInterval = filter (\p -> accountNameLevel (paccount p) <= depth)
| otherwise = id
filterempties
| Empty `elem` opts = id
| otherwise = filter (not . isZeroMixedAmount . lpamount)
(precedingts, ts') = break (matchdisplayopt dopt) ts
(displayedts, _) = span (matchdisplayopt dopt) ts'
startbal = sumLedgerPostings precedingts
| otherwise = filter (not . isZeroMixedAmount . pamount)
(precedingps, ps') = break (matchdisplayopt dopt) ps
(displayedps, _) = span (matchdisplayopt dopt) ps'
startbal = sumPostings precedingps
(apats,_) = parsePatternArgs args
matchdisplayopt Nothing _ = True
matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t
matchdisplayopt (Just e) p = (fromparse $ parsewith datedisplayexpr e) p
dopt = displayFromOpts opts
empty = Empty `elem` opts
depth = depthFromOpts opts
summaryts = concatMap summarisespan (zip spans [1..])
summarisespan (s,n) = summariseLedgerPostingsInDateSpan s n depth empty (transactionsinspan s)
transactionsinspan s = filter (isLedgerPostingInDateSpan s) displayedts
summaryps = concatMap summarisespan spans
summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s)
postingsinspan s = filter (isPostingInDateSpan s) displayedps
spans = splitSpan interval (ledgerDateSpan 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 showlps will render as a summary for this interval.
-- | Given a date span (representing a reporting interval) and a list of
-- postings within it: aggregate the postings so there is only one per
-- account, and adjust their date/description so that they 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.
--
-- A unique tnum value is provided so that the new transactions will be
-- grouped as one entry.
--
-- When a depth argument is present, transactions to accounts of greater
-- When a depth argument is present, postings to accounts of greater
-- depth are aggregated where possible.
--
-- The showempty flag forces the display of a zero-transaction span
-- and also zero-transaction accounts within the span.
summariseLedgerPostingsInDateSpan :: DateSpan -> Int -> Int -> Bool -> [LedgerPosting] -> [LedgerPosting]
summariseLedgerPostingsInDateSpan (DateSpan b e) tnum depth showempty ts
| null ts && showempty = [txn]
| null ts = []
| otherwise = summaryts'
-- The showempty flag forces the display of a zero-posting span
-- and also zero-posting accounts within the span.
summarisePostingsInDateSpan :: DateSpan -> Int -> Bool -> [Posting] -> [Posting]
summarisePostingsInDateSpan (DateSpan b e) depth showempty ps
| null ps && showempty = [p]
| null ps = []
| otherwise = summaryps'
where
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 . lpamount) summaryts
txnanames = sort $ nub $ map lpaccount ts
postingwithinfo date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}}
p = postingwithinfo b' ("- "++ showDate (addDays (-1) e'))
b' = fromMaybe (postingDate $ head ps) b
e' = fromMaybe (postingDate $ last ps) e
summaryps'
| showempty = summaryps
| otherwise = filter (not . isZeroMixedAmount . pamount) summaryps
anames = sort $ nub $ map paccount ps
-- aggregate balances by account, like cacheLedger, then do depth-clipping
(_,_,exclbalof,inclbalof) = groupLedgerPostings ts
clippedanames = clipAccountNames depth txnanames
(_,_,exclbalof,inclbalof) = groupPostings ps
clippedanames = clipAccountNames depth anames
isclipped a = accountNameLevel a >= depth
balancetoshowfor a =
(if isclipped a then inclbalof else exclbalof) (if null a then "top" else a)
summaryts = [txn{lpaccount=a,lpamount=balancetoshowfor a} | a <- clippedanames]
summaryps = [p{paccount=a,pamount=balancetoshowfor a} | a <- clippedanames]
clipAccountNames :: Int -> [AccountName] -> [AccountName]
clipAccountNames d as = nub $ map (clip d) as
where clip d = accountNameFromComponents . take d . accountNameComponents
-- | Show transactions one per line, with each date/description appearing
-- only once, and a running balance.
showlps [] _ _ = ""
showlps (lp:lps) lpprev bal = this ++ showlps lps lp bal'
-- | Show postings one per line, along with transaction info for the first
-- posting of each transaction, and a running balance.
showps :: [Posting] -> Posting -> MixedAmount -> String
showps [] _ _ = ""
showps (p:ps) pprev bal = this ++ showps ps p bal'
where
this = showlp (lp `issame` lpprev) lp bal'
issame = (==) `on` lptnum
bal' = bal + lpamount lp
this = showp isfirst p bal'
isfirst = ptransaction p /= ptransaction pprev
bal' = bal + pamount p
-- | Show one transaction line and balance with or without the entry details.
showlp :: Bool -> LedgerPosting -> MixedAmount -> String
showlp omitdesc lp b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n"
-- | Show one posting and running balance, with or without transaction info.
showp :: Bool -> Posting -> MixedAmount -> String
showp withtxninfo p b = concatBottomPadded [txninfo ++ pstr ++ " ", bal] ++ "\n"
where
ledger3ishlayout = False
datedescwidth = if ledger3ishlayout then 34 else 32
entrydesc = if omitdesc then replicate datedescwidth ' ' else printf "%s %s " date desc
txninfo = if withtxninfo then printf "%s %s " date desc else replicate datedescwidth ' '
date = showDate da
datewidth = 10
descwidth = datedescwidth - datewidth - 2
desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String
p = showPostingWithoutPrice $ Posting s a amt "" tt Nothing
pstr = showPostingWithoutPrice p
bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b)
LedgerPosting{lpstatus=s,lpdate=da,lpdescription=de,lpaccount=a,lpamount=amt,lptype=tt} = lp
(da,de) = case ptransaction p of Just (Transaction{tdate=da',tdescription=de'}) -> (da',de')
Nothing -> (nulldate,"")

28
Commands/UI.hs
View File

@ -260,35 +260,31 @@ accountNameAt buf lineno = accountNameFromComponents anamecomponents
-- | If on the print screen, move the cursor to highlight the specified entry
-- (or a reasonable guess). Doesn't work.
scrollToTransaction :: Transaction -> AppState -> AppState
scrollToTransaction e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a
scrollToTransaction :: Maybe Transaction -> AppState -> AppState
scrollToTransaction Nothing a = a
scrollToTransaction (Just t) a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a
where
entryfirstline = head $ lines $ showTransaction e
entryfirstline = head $ lines $ showTransaction t
halfph = pageHeight a `div` 2
y = fromMaybe 0 $ findIndex (== entryfirstline) buf
sy = max 0 $ y - halfph
cy = y - sy
-- | Get the entry containing the transaction currently highlighted by the
-- 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 lp
-- | Get the transaction containing the posting currently highlighted by
-- the cursor on the register screen (or best guess). Results undefined
-- while on other screens.
currentTransaction :: AppState -> Maybe Transaction
currentTransaction a@AppState{aledger=l,abuf=buf} = ptransaction p
where
lp = safehead nullledgerposting $ filter ismatch $ ledgerLedgerPostings l
ismatch lp = lpdate lp == parsedate (take 10 datedesc)
&& take 70 (showlp False lp nullmixedamt) == (datedesc ++ acctamt)
p = safehead nullposting $ filter ismatch $ ledgerPostings l
ismatch p = postingDate p == parsedate (take 10 datedesc)
&& take 70 (showp False p 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
(above,rest) = splitAt y buf
y = posY a
-- | Get the entry which contains the given transaction.
-- Will raise an error if there are problems.
transactionContainingLedgerPosting :: AppState -> LedgerPosting -> Transaction
transactionContainingLedgerPosting AppState{aledger=l} lp = jtxns (journal l) !! lptnum lp
-- renderers
renderScreen :: AppState -> Picture

2
Ledger.hs
View File

@ -19,7 +19,6 @@ module Ledger (
module Ledger.Journal,
module Ledger.Posting,
module Ledger.TimeLog,
module Ledger.LedgerPosting,
module Ledger.Types,
module Ledger.Utils,
)
@ -36,6 +35,5 @@ import Ledger.Parse
import Ledger.Journal
import Ledger.Posting
import Ledger.TimeLog
import Ledger.LedgerPosting
import Ledger.Types
import Ledger.Utils

3
Ledger/Account.hs
View File

@ -4,8 +4,7 @@ A compound data type for efficiency. An 'Account' stores
- an 'AccountName',
- all 'LedgerPosting's (postings plus ledger transaction info) in the
account, excluding subaccounts
- all 'Posting's in the account, excluding subaccounts
- a 'MixedAmount' representing the account balance, including subaccounts.

2
Ledger/Dates.hs
View File

@ -422,3 +422,5 @@ justdatespan rdate = do
nulldatespan = DateSpan Nothing Nothing
mkdatespan b = DateSpan (Just $ parsedate b) . Just . parsedate
nulldate = parsedate "1900/01/01"

34
Ledger/Journal.hs
View File

@ -14,7 +14,6 @@ import Ledger.Types
import Ledger.AccountName
import Ledger.Amount
import Ledger.Transaction (ledgerTransactionWithDate)
import Ledger.LedgerPosting
import Ledger.Posting
import Ledger.TimeLog
@ -55,12 +54,11 @@ addHistoricalPrice h l0 = l0 { historical_prices = h : historical_prices l0 }
addTimeLogEntry :: TimeLogEntry -> Journal -> Journal
addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 }
journalLedgerPostings :: Journal -> [LedgerPosting]
journalLedgerPostings = txnsof . jtxns
where txnsof ts = concatMap flattenTransaction $ zip ts [1..]
journalPostings :: Journal -> [Posting]
journalPostings = concatMap tpostings . jtxns
journalAccountNamesUsed :: Journal -> [AccountName]
journalAccountNamesUsed = accountNamesFromLedgerPostings . journalLedgerPostings
journalAccountNamesUsed = accountNamesFromPostings . journalPostings
journalAccountNames :: Journal -> [AccountName]
journalAccountNames = sort . expandAccountNames . journalAccountNamesUsed
@ -96,7 +94,7 @@ filterJournalTransactionsByDate (DateSpan begin end) (Journal ms ps ts tls hs f
-- | 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 Nothing j = j
filterJournalPostingsByClearedStatus (Just val) (Journal ms ps ts tls hs f fp ft) =
Journal ms ps (filter ((==val).tstatus) ts) tls hs f fp ft
@ -124,9 +122,9 @@ filterJournalPostingsByAccount apats (Journal ms ps 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{jtxns=map (ledgerTransactionWithDate EffectiveDate) $ jtxns rl}
journalSelectingDate ActualDate j = j
journalSelectingDate EffectiveDate j =
j{jtxns=map (ledgerTransactionWithDate EffectiveDate) $ jtxns j}
-- | Give all a ledger's amounts their canonical display settings. That
-- is, in each commodity, amounts will use the display settings of the
@ -136,7 +134,7 @@ journalSelectingDate EffectiveDate rl =
-- Also, amounts are converted to cost basis if that flag is active.
-- XXX refactor
canonicaliseAmounts :: Bool -> Journal -> Journal
canonicaliseAmounts costbasis rl@(Journal ms ps ts tls hs f fp ft) = Journal ms ps (map fixledgertransaction ts) tls hs f fp ft
canonicaliseAmounts costbasis j@(Journal ms ps ts tls hs f fp ft) = Journal ms ps (map fixledgertransaction ts) tls hs f fp ft
where
fixledgertransaction (Transaction d ed s c de co ts pr) = Transaction d ed s c de co (map fixrawposting ts) pr
where
@ -153,17 +151,17 @@ 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 . lpamount) (journalLedgerPostings rl)
++ concatMap (amounts . hamount) (historical_prices rl))
commodities = map commodity (concatMap (amounts . pamount) (journalPostings j)
++ concatMap (amounts . hamount) (historical_prices j))
fixprice :: Amount -> Amount
fixprice a@Amount{price=Just _} = a
fixprice a@Amount{commodity=c} = a{price=journalHistoricalPriceFor rl d c}
fixprice a@Amount{commodity=c} = a{price=journalHistoricalPriceFor j d c}
-- | Get the price for a commodity on the specified day from the price database, if known.
-- Does only one lookup step, ie will not look up the price of a price.
journalHistoricalPriceFor :: Journal -> Day -> Commodity -> Maybe MixedAmount
journalHistoricalPriceFor rl d Commodity{symbol=s} = do
let ps = reverse $ filter ((<= d).hdate) $ filter ((s==).hsymbol) $ sortBy (comparing hdate) $ historical_prices rl
journalHistoricalPriceFor j d Commodity{symbol=s} = do
let ps = reverse $ filter ((<= d).hdate) $ filter ((s==).hsymbol) $ sortBy (comparing hdate) $ historical_prices j
case ps of (HistoricalPrice{hamount=a}:_) -> Just $ canonicaliseCommodities a
_ -> Nothing
where
@ -173,7 +171,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 lpamount . journalLedgerPostings
journalAmounts = map pamount . journalPostings
-- | Get just the ammount commodities from a ledger, in the order parsed.
journalCommodities :: Journal -> [Commodity]
@ -193,11 +191,11 @@ journalConvertTimeLog t l0 = l0 { jtxns = convertedTimeLog ++ jtxns l0
-- | The (fully specified) date span containing all the raw ledger's transactions,
-- or DateSpan Nothing Nothing if there are none.
journalDateSpan :: Journal -> DateSpan
journalDateSpan rl
journalDateSpan j
| null ts = DateSpan Nothing Nothing
| otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts)
where
ts = sortBy (comparing tdate) $ jtxns rl
ts = sortBy (comparing tdate) $ jtxns j
-- | Check if a set of ledger account/description patterns matches the
-- given account name or entry description. Patterns are case-insensitive

76
Ledger/Ledger.hs
View File

@ -59,8 +59,8 @@ import Ledger.Utils
import Ledger.Types
import Ledger.Account ()
import Ledger.AccountName
import Ledger.LedgerPosting
import Ledger.Journal
import Ledger.Posting
instance Show Ledger where
@ -73,61 +73,55 @@ instance Show Ledger where
-- | Convert a raw ledger to a more efficient cached type, described above.
cacheLedger :: [String] -> Journal -> Ledger
cacheLedger apats l = Ledger{journaltext="",journal=l,accountnametree=ant,accountmap=acctmap}
cacheLedger apats j = Ledger{journaltext="",journal=j,accountnametree=ant,accountmap=acctmap}
where
(ant,txnsof,_,inclbalof) = groupLedgerPostings $ filtertxns apats $ journalLedgerPostings l
(ant,psof,_,inclbalof) = groupPostings $ filterPostings apats $ journalPostings j
acctmap = Map.fromList [(a, mkacct a) | a <- flatten ant]
where mkacct a = Account a (txnsof a) (inclbalof a)
where mkacct a = Account a (psof a) (inclbalof a)
-- | Given a list of transactions, return an account name tree and three
-- query functions that fetch transactions, balance, and
-- subaccount-including balance by account name.
-- This is to factor out common logic from cacheLedger and
-- summariseLedgerPostingsInDateSpan.
groupLedgerPostings :: [LedgerPosting] -> (Tree AccountName,
(AccountName -> [LedgerPosting]),
(AccountName -> MixedAmount),
(AccountName -> MixedAmount))
groupLedgerPostings ts = (ant,txnsof,exclbalof,inclbalof)
-- summarisePostingsInDateSpan.
groupPostings :: [Posting] -> (Tree AccountName,
(AccountName -> [Posting]),
(AccountName -> MixedAmount),
(AccountName -> MixedAmount))
groupPostings ps = (ant,psof,exclbalof,inclbalof)
where
txnanames = sort $ nub $ map lpaccount ts
ant = accountNameTreeFrom $ expandAccountNames txnanames
anames = sort $ nub $ map paccount ps
ant = accountNameTreeFrom $ expandAccountNames anames
allanames = flatten ant
txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- allanames])
balmap = Map.fromList $ flatten $ calculateBalances ant txnsof
txnsof = (txnmap !)
pmap = Map.union (postingsByAccount ps) (Map.fromList [(a,[]) | a <- allanames])
psof = (pmap !)
balmap = Map.fromList $ flatten $ calculateBalances ant psof
exclbalof = fst . (balmap !)
inclbalof = snd . (balmap !)
-- debug
-- txnsof a = (txnmap ! (trace ("ts "++a) a))
-- exclbalof a = fst $ (balmap ! (trace ("eb "++a) a))
-- inclbalof a = snd $ (balmap ! (trace ("ib "++a) a))
-- | Add subaccount-excluding and subaccount-including balances to a tree
-- of account names somewhat efficiently, given a function that looks up
-- transactions by account name.
calculateBalances :: Tree AccountName -> (AccountName -> [LedgerPosting]) -> Tree (AccountName, (MixedAmount, MixedAmount))
calculateBalances ant txnsof = addbalances ant
calculateBalances :: Tree AccountName -> (AccountName -> [Posting]) -> Tree (AccountName, (MixedAmount, MixedAmount))
calculateBalances ant psof = addbalances ant
where
addbalances (Node a subs) = Node (a,(bal,bal+subsbal)) subs'
where
bal = sumLedgerPostings $ txnsof a
bal = sumPostings $ psof a
subsbal = sum $ map (snd . snd . root) subs'
subs' = map addbalances subs
-- | Convert a list of transactions to a map from account name to the list
-- of all transactions in that account.
transactionsByAccount :: [LedgerPosting] -> Map.Map AccountName [LedgerPosting]
transactionsByAccount ts = m'
-- | Convert a list of postings to a map from account name to that
-- account's postings.
postingsByAccount :: [Posting] -> Map.Map AccountName [Posting]
postingsByAccount ps = m'
where
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
sortedps = sortBy (comparing paccount) ps
groupedps = groupBy (\p1 p2 -> paccount p1 == paccount p2) sortedps
m' = Map.fromList [(paccount $ head g, g) | g <- groupedps]
filtertxns :: [String] -> [LedgerPosting] -> [LedgerPosting]
filtertxns apats = filter (matchpats apats . lpaccount)
filterPostings :: [String] -> [Posting] -> [Posting]
filterPostings apats = filter (matchpats apats . paccount)
-- | List a ledger's account names.
ledgerAccountNames :: Ledger -> [AccountName]
@ -154,9 +148,9 @@ ledgerSubAccounts :: Ledger -> Account -> [Account]
ledgerSubAccounts l Account{aname=a} =
map (ledgerAccount l) $ filter (`isSubAccountNameOf` a) $ accountnames l
-- | List a ledger's "transactions", ie postings with transaction info attached.
ledgerLedgerPostings :: Ledger -> [LedgerPosting]
ledgerLedgerPostings = journalLedgerPostings . journal
-- | List a ledger's postings, in the order parsed.
ledgerPostings :: Ledger -> [Posting]
ledgerPostings = journalPostings . journal
-- | Get a ledger's tree of accounts to the specified depth.
ledgerAccountTree :: Int -> Ledger -> Tree Account
@ -170,10 +164,10 @@ ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l
-- or DateSpan Nothing Nothing if there are none.
ledgerDateSpan :: Ledger -> DateSpan
ledgerDateSpan l
| null ts = DateSpan Nothing Nothing
| otherwise = DateSpan (Just $ lpdate $ head ts) (Just $ addDays 1 $ lpdate $ last ts)
| null ps = DateSpan Nothing Nothing
| otherwise = DateSpan (Just $ postingDate $ head ps) (Just $ addDays 1 $ postingDate $ last ps)
where
ts = sortBy (comparing lpdate) $ ledgerLedgerPostings l
ps = sortBy (comparing postingDate) $ ledgerPostings l
-- | Convenience aliases.
accountnames :: Ledger -> [AccountName]
@ -194,8 +188,8 @@ accountsmatching = ledgerAccountsMatching
subaccounts :: Ledger -> Account -> [Account]
subaccounts = ledgerSubAccounts
transactions :: Ledger -> [LedgerPosting]
transactions = ledgerLedgerPostings
postings :: Ledger -> [Posting]
postings = ledgerPostings
commodities :: Ledger -> [Commodity]
commodities = nub . journalCommodities . journal

48
Ledger/LedgerPosting.hs
View File

@ -1,48 +0,0 @@
{-|
A 'LedgerPosting' is a 'Posting' with its parent 'Transaction' \'s date
and description attached. We flatten Transactions into these, since they
are usually simpler to work with.
-}
module Ledger.LedgerPosting
where
import Ledger.Dates
import Ledger.Utils
import Ledger.Types
import Ledger.Transaction (showAccountName)
import Ledger.Amount
instance Show LedgerPosting where show=showLedgerPosting
showLedgerPosting :: LedgerPosting -> String
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 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
-- be unique per entry.
flattenTransaction :: (Transaction, Int) -> [LedgerPosting]
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 lpaccount
sumLedgerPostings :: [LedgerPosting] -> MixedAmount
sumLedgerPostings = sum . map lpamount
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{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

6
Ledger/Parse.hs
View File

@ -557,8 +557,8 @@ timelogentry = do
-- misc parsing
-- | Parse a --display expression which is a simple date predicate, like
-- "d>[DATE]" or "d<=[DATE]", and return a transaction-matching predicate.
datedisplayexpr :: GenParser Char st (LedgerPosting -> Bool)
-- "d>[DATE]" or "d<=[DATE]", and return a posting-matching predicate.
datedisplayexpr :: GenParser Char st (Posting -> Bool)
datedisplayexpr = do
char 'd'
op <- compareop
@ -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) . lpdate
test op = return $ (`op` date) . postingDate
case op of
"<" -> test (<)
"<=" -> test (<=)

26
Ledger/Posting.hs
View File

@ -1,11 +1,9 @@
{-|
A 'Posting' represents a 'MixedAmount' being added to or subtracted from a
single 'Account'. Each 'Transaction' contains two or more postings
which should add up to 0.
Generally, we use these with the ledger transaction's date and description
added, which we call a 'LedgerPosting'.
single 'Account'. Each 'Transaction' contains two or more postings which
should add up to 0. Postings also reference their parent transaction, so
we can get a date or description for a posting (from the transaction).
-}
@ -15,11 +13,12 @@ import Ledger.Utils
import Ledger.Types
import Ledger.Amount
import Ledger.AccountName
import Ledger.Dates (nulldate)
instance Show Posting where show = showPosting
nullrawposting = Posting False "" nullmixedamt "" RegularPosting Nothing
nullposting = Posting False "" nullmixedamt "" RegularPosting Nothing
showPosting :: Posting -> String
showPosting (Posting{paccount=a,pamount=amt,pcomment=com,ptype=t}) =
@ -65,3 +64,18 @@ postingTypeFromAccountName a
| head a == '(' && last a == ')' = VirtualPosting
| otherwise = RegularPosting
accountNamesFromPostings :: [Posting] -> [AccountName]
accountNamesFromPostings = nub . map paccount
sumPostings :: [Posting] -> MixedAmount
sumPostings = sum . map pamount
postingDate :: Posting -> Day
postingDate p = maybe nulldate tdate $ ptransaction p
-- | Does this posting fall within the given date span ?
isPostingInDateSpan :: DateSpan -> Posting -> Bool
isPostingInDateSpan (DateSpan Nothing Nothing) _ = True
isPostingInDateSpan (DateSpan Nothing (Just e)) p = postingDate p < e
isPostingInDateSpan (DateSpan (Just b) Nothing) p = postingDate p >= b
isPostingInDateSpan (DateSpan (Just b) (Just e)) p = d >= b && d < e where d = postingDate p

22
Ledger/Transaction.hs
View File

@ -22,17 +22,17 @@ instance Show ModifierTransaction where
instance Show PeriodicTransaction where
show t = "~ " ++ ptperiodicexpr t ++ "\n" ++ unlines (map show (ptpostings t))
nullledgertxn :: Transaction
nullledgertxn = Transaction {
tdate=parsedate "1900/1/1",
teffectivedate=Nothing,
tstatus=False,
tcode="",
tdescription="",
tcomment="",
tpostings=[],
tpreceding_comment_lines=""
}
nulltransaction :: Transaction
nulltransaction = Transaction {
tdate=nulldate,
teffectivedate=Nothing,
tstatus=False,
tcode="",
tdescription="",
tcomment="",
tpostings=[],
tpreceding_comment_lines=""
}
{-|
Show a ledger entry, formatted for the print command. ledger 2.x's

49
Ledger/Types.hs
View File

@ -2,19 +2,18 @@
{-|
Most data types are defined here to avoid import cycles.
Here is an overview of the hledger data model as of 0.8:
Here is an overview of the hledger data model:
> Ledger -- hledger's ledger is a journal file plus cached/derived data
> Journal -- a representation of the journal file, containing..
> [Transaction] -- ..journal transactions, which have date, description and..
> [Posting] -- ..two or more account postings
> [LedgerPosting] -- all postings with their transaction's info attached
> Tree AccountName -- the tree of all account names
> Map AccountName Account -- per-account ledger postings and balances for easy lookup
> [Transaction] -- ..journal transactions, which have date, status, code, description and..
> [Posting] -- ..two or more account postings (account name and amount)
> Tree AccountName -- all account names as a tree
> Map AccountName Account -- a map from account name to account info (postings and balances)
For more detailed documentation on each type, see the corresponding modules.
Here's how some of the terminology has evolved:
Terminology has been in flux:
- ledger 2 had entries containing transactions.
@ -24,7 +23,7 @@ Here's how some of the terminology has evolved:
- hledger 0.5 had LedgerTransactions containing Postings, which were flattened to Transactions.
- hledger 0.8 has Transactions containing Postings, which are flattened to LedgerPostings.
- hledger 0.8 has Transactions containing Postings, and no flattened type.
-}
@ -79,16 +78,6 @@ data Posting = Posting {
-- Tying this knot gets tedious, Maybe makes it easier/optional.
} deriving (Eq)
data ModifierTransaction = ModifierTransaction {
mtvalueexpr :: String,
mtpostings :: [Posting]
} deriving (Eq)
data PeriodicTransaction = PeriodicTransaction {
ptperiodicexpr :: String,
ptpostings :: [Posting]
} deriving (Eq)
data Transaction = Transaction {
tdate :: Day,
teffectivedate :: Maybe Day,
@ -100,6 +89,16 @@ data Transaction = Transaction {
tpreceding_comment_lines :: String
} deriving (Eq)
data ModifierTransaction = ModifierTransaction {
mtvalueexpr :: String,
mtpostings :: [Posting]
} deriving (Eq)
data PeriodicTransaction = PeriodicTransaction {
ptperiodicexpr :: String,
ptpostings :: [Posting]
} deriving (Eq)
data TimeLogCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord)
data TimeLogEntry = TimeLogEntry {
@ -136,20 +135,10 @@ data FilterSpec = FilterSpec {
,whichdate :: WhichDate -- ^ which dates to use (transaction or effective)
}
data LedgerPosting = LedgerPosting {
lptnum :: Int, -- ^ internal transaction reference number
lpstatus :: Bool, -- ^ posting status
lpdate :: Day, -- ^ transaction date
lpdescription :: String, -- ^ transaction description
lpaccount :: AccountName, -- ^ posting account
lpamount :: MixedAmount, -- ^ posting amount
lptype :: PostingType -- ^ posting type
} deriving (Eq)
data Account = Account {
aname :: AccountName,
apostings :: [LedgerPosting], -- ^ transactions in this account
abalance :: MixedAmount -- ^ sum of transactions in this account and subaccounts
apostings :: [Posting], -- ^ transactions in this account
abalance :: MixedAmount -- ^ sum of transactions in this account and subaccounts
}
data Ledger = Ledger {

70
Tests.hs
View File

@ -793,40 +793,40 @@ tests = [
let a = ledgerAccount l "assets"
map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
,"summariseLedgerPostingsInDateSpan" ~: do
let gives (b,e,lpnum,depth,showempty,ts) =
(summariseLedgerPostingsInDateSpan (mkdatespan b e) lpnum depth showempty ts `is`)
let ts =
[
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`
[
nullledgerposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31"}
]
("2008/01/01","2009/01/01",0,9999,False,ts) `gives`
[
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`
[
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`
[
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`
[
nullledgerposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [dollars 15]}
]
-- ,"summarisePostingsInDateSpan" ~: do
-- let gives (b,e,depth,showempty,ps) =
-- (summarisePostingsInDateSpan (mkdatespan b e) depth showempty ps `is`)
-- let ps =
-- [
-- nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]}
-- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 2]}
-- ,nullposting{lpdescription="desc",lpaccount="expenses:food", lpamount=Mixed [dollars 4]}
-- ,nullposting{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`
-- [
-- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31"}
-- ]
-- ("2008/01/01","2009/01/01",0,9999,False,ts) `gives`
-- [
-- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food", lpamount=Mixed [dollars 4]}
-- ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 10]}
-- ,nullposting{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`
-- [
-- nullposting{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`
-- [
-- nullposting{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`
-- [
-- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [dollars 15]}
-- ]
,"postingamount" ~: do
parseWithCtx emptyCtx postingamount " $47.18" `parseis` Mixed [dollars 47.18]
@ -1258,7 +1258,7 @@ journalWithAmounts as =
Journal
[]
[]
[t | a <- as, let t = nullledgertxn{tdescription=a,tpostings=[nullrawposting{pamount=parse a,ptransaction=Just t}]}]
[t | a <- as, let t = nulltransaction{tdescription=a,tpostings=[nullposting{pamount=parse a,ptransaction=Just t}]}]
[]
[]
""

2
hledger.cabal
View File

@ -56,7 +56,6 @@ library
Ledger.Posting
Ledger.Parse
Ledger.TimeLog
Ledger.LedgerPosting
Ledger.Types
Ledger.Utils
Build-Depends:
@ -95,7 +94,6 @@ executable hledger
Ledger.Journal
Ledger.Posting
Ledger.TimeLog
Ledger.LedgerPosting
Ledger.Types
Ledger.Utils
Options