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

4
Commands/Balance.hs
View File

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

22
Commands/Histogram.hs
View File

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

100
Commands/Register.hs
View File

@ -6,7 +6,6 @@ A ledger-compatible @register@ command.
module Commands.Register module Commands.Register
where where
import Data.Function (on)
import Prelude hiding (putStr) import Prelude hiding (putStr)
import Ledger import Ledger
import Options import Options
@ -30,91 +29,92 @@ DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA
-} -}
showRegisterReport :: [Opt] -> [String] -> Ledger -> String showRegisterReport :: [Opt] -> [String] -> Ledger -> String
showRegisterReport opts args l showRegisterReport opts args l
| interval == NoInterval = showlps displayedts nullledgerposting startbal | interval == NoInterval = showps displayedps nullposting startbal
| otherwise = showlps summaryts nullledgerposting startbal | otherwise = showps summaryps nullposting startbal
where where
interval = intervalFromOpts opts interval = intervalFromOpts opts
ts = sortBy (comparing lpdate) $ filterempties $ filtertxns apats $ filterdepth $ ledgerLedgerPostings l ps = sortBy (comparing postingDate) $ filterempties $ filterPostings apats $ filterdepth $ ledgerPostings l
filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (lpaccount t) <= depth) filterdepth | interval == NoInterval = filter (\p -> accountNameLevel (paccount p) <= depth)
| otherwise = id | otherwise = id
filterempties filterempties
| Empty `elem` opts = id | Empty `elem` opts = id
| otherwise = filter (not . isZeroMixedAmount . lpamount) | otherwise = filter (not . isZeroMixedAmount . pamount)
(precedingts, ts') = break (matchdisplayopt dopt) ts (precedingps, ps') = break (matchdisplayopt dopt) ps
(displayedts, _) = span (matchdisplayopt dopt) ts' (displayedps, _) = span (matchdisplayopt dopt) ps'
startbal = sumLedgerPostings precedingts startbal = sumPostings precedingps
(apats,_) = parsePatternArgs args (apats,_) = parsePatternArgs args
matchdisplayopt Nothing _ = True matchdisplayopt Nothing _ = True
matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t matchdisplayopt (Just e) p = (fromparse $ parsewith datedisplayexpr e) p
dopt = displayFromOpts opts dopt = displayFromOpts opts
empty = Empty `elem` opts empty = Empty `elem` opts
depth = depthFromOpts opts depth = depthFromOpts opts
summaryts = concatMap summarisespan (zip spans [1..]) summaryps = concatMap summarisespan spans
summarisespan (s,n) = summariseLedgerPostingsInDateSpan s n depth empty (transactionsinspan s) summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s)
transactionsinspan s = filter (isLedgerPostingInDateSpan s) displayedts postingsinspan s = filter (isPostingInDateSpan s) displayedps
spans = splitSpan interval (ledgerDateSpan l) spans = splitSpan interval (ledgerDateSpan l)
-- | Convert a date span (representing a reporting interval) and a list of -- | Given a date span (representing a reporting interval) and a list of
-- transactions within it to a new list of transactions aggregated by -- postings within it: aggregate the postings so there is only one per
-- account, which showlps will render as a summary for this interval. -- 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 -- As usual with date spans the end date is exclusive, but for display
-- purposes we show the previous day as end date, like ledger. -- purposes we show the previous day as end date, like ledger.
-- --
-- A unique tnum value is provided so that the new transactions will be -- When a depth argument is present, postings to accounts of greater
-- grouped as one entry.
--
-- When a depth argument is present, transactions to accounts of greater
-- depth are aggregated where possible. -- depth are aggregated where possible.
-- --
-- The showempty flag forces the display of a zero-transaction span -- The showempty flag forces the display of a zero-posting span
-- and also zero-transaction accounts within the span. -- and also zero-posting accounts within the span.
summariseLedgerPostingsInDateSpan :: DateSpan -> Int -> Int -> Bool -> [LedgerPosting] -> [LedgerPosting] summarisePostingsInDateSpan :: DateSpan -> Int -> Bool -> [Posting] -> [Posting]
summariseLedgerPostingsInDateSpan (DateSpan b e) tnum depth showempty ts summarisePostingsInDateSpan (DateSpan b e) depth showempty ps
| null ts && showempty = [txn] | null ps && showempty = [p]
| null ts = [] | null ps = []
| otherwise = summaryts' | otherwise = summaryps'
where where
txn = nullledgerposting{lptnum=tnum, lpdate=b', lpdescription="- "++ showDate (addDays (-1) e')} postingwithinfo date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}}
b' = fromMaybe (lpdate $ head ts) b p = postingwithinfo b' ("- "++ showDate (addDays (-1) e'))
e' = fromMaybe (lpdate $ last ts) e b' = fromMaybe (postingDate $ head ps) b
summaryts' e' = fromMaybe (postingDate $ last ps) e
| showempty = summaryts summaryps'
| otherwise = filter (not . isZeroMixedAmount . lpamount) summaryts | showempty = summaryps
txnanames = sort $ nub $ map lpaccount ts | otherwise = filter (not . isZeroMixedAmount . pamount) summaryps
anames = sort $ nub $ map paccount ps
-- aggregate balances by account, like cacheLedger, then do depth-clipping -- aggregate balances by account, like cacheLedger, then do depth-clipping
(_,_,exclbalof,inclbalof) = groupLedgerPostings ts (_,_,exclbalof,inclbalof) = groupPostings ps
clippedanames = clipAccountNames depth txnanames clippedanames = clipAccountNames depth anames
isclipped a = accountNameLevel a >= depth isclipped a = accountNameLevel a >= depth
balancetoshowfor a = balancetoshowfor a =
(if isclipped a then inclbalof else exclbalof) (if null a then "top" else 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 :: Int -> [AccountName] -> [AccountName]
clipAccountNames d as = nub $ map (clip d) as clipAccountNames d as = nub $ map (clip d) as
where clip d = accountNameFromComponents . take d . accountNameComponents where clip d = accountNameFromComponents . take d . accountNameComponents
-- | Show transactions one per line, with each date/description appearing -- | Show postings one per line, along with transaction info for the first
-- only once, and a running balance. -- posting of each transaction, and a running balance.
showlps [] _ _ = "" showps :: [Posting] -> Posting -> MixedAmount -> String
showlps (lp:lps) lpprev bal = this ++ showlps lps lp bal' showps [] _ _ = ""
showps (p:ps) pprev bal = this ++ showps ps p bal'
where where
this = showlp (lp `issame` lpprev) lp bal' this = showp isfirst p bal'
issame = (==) `on` lptnum isfirst = ptransaction p /= ptransaction pprev
bal' = bal + lpamount lp bal' = bal + pamount p
-- | Show one transaction line and balance with or without the entry details. -- | Show one posting and running balance, with or without transaction info.
showlp :: Bool -> LedgerPosting -> MixedAmount -> String showp :: Bool -> Posting -> MixedAmount -> String
showlp omitdesc lp b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n" showp withtxninfo p b = concatBottomPadded [txninfo ++ pstr ++ " ", bal] ++ "\n"
where where
ledger3ishlayout = False ledger3ishlayout = False
datedescwidth = if ledger3ishlayout then 34 else 32 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 date = showDate da
datewidth = 10 datewidth = 10
descwidth = datedescwidth - datewidth - 2 descwidth = datedescwidth - datewidth - 2
desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String 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) 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 -- | If on the print screen, move the cursor to highlight the specified entry
-- (or a reasonable guess). Doesn't work. -- (or a reasonable guess). Doesn't work.
scrollToTransaction :: Transaction -> AppState -> AppState scrollToTransaction :: Maybe Transaction -> AppState -> AppState
scrollToTransaction e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a scrollToTransaction Nothing a = a
scrollToTransaction (Just t) a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a
where where
entryfirstline = head $ lines $ showTransaction e entryfirstline = head $ lines $ showTransaction t
halfph = pageHeight a `div` 2 halfph = pageHeight a `div` 2
y = fromMaybe 0 $ findIndex (== entryfirstline) buf y = fromMaybe 0 $ findIndex (== entryfirstline) buf
sy = max 0 $ y - halfph sy = max 0 $ y - halfph
cy = y - sy cy = y - sy
-- | Get the entry containing the transaction currently highlighted by the -- | Get the transaction containing the posting currently highlighted by
-- cursor on the register screen (or best guess). Results undefined while -- the cursor on the register screen (or best guess). Results undefined
-- on other screens. Doesn't work. -- while on other screens.
currentTransaction :: AppState -> Transaction currentTransaction :: AppState -> Maybe Transaction
currentTransaction a@AppState{aledger=l,abuf=buf} = transactionContainingLedgerPosting a lp currentTransaction a@AppState{aledger=l,abuf=buf} = ptransaction p
where where
lp = safehead nullledgerposting $ filter ismatch $ ledgerLedgerPostings l p = safehead nullposting $ filter ismatch $ ledgerPostings l
ismatch lp = lpdate lp == parsedate (take 10 datedesc) ismatch p = postingDate p == parsedate (take 10 datedesc)
&& take 70 (showlp False lp nullmixedamt) == (datedesc ++ acctamt) && take 70 (showp False p nullmixedamt) == (datedesc ++ acctamt)
datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ safehead "" rest : reverse above datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ safehead "" rest : reverse above
acctamt = drop 32 $ safehead "" rest acctamt = drop 32 $ safehead "" rest
safehead d ls = if null ls then d else head ls safehead d ls = if null ls then d else head ls
(above,rest) = splitAt y buf (above,rest) = splitAt y buf
y = posY a 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 -- renderers
renderScreen :: AppState -> Picture renderScreen :: AppState -> Picture

2
Ledger.hs
View File

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

3
Ledger/Account.hs
View File

@ -4,8 +4,7 @@ A compound data type for efficiency. An 'Account' stores
- an 'AccountName', - an 'AccountName',
- all 'LedgerPosting's (postings plus ledger transaction info) in the - all 'Posting's in the account, excluding subaccounts
account, excluding subaccounts
- a 'MixedAmount' representing the account balance, including 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 nulldatespan = DateSpan Nothing Nothing
mkdatespan b = DateSpan (Just $ parsedate b) . Just . parsedate 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.AccountName
import Ledger.Amount import Ledger.Amount
import Ledger.Transaction (ledgerTransactionWithDate) import Ledger.Transaction (ledgerTransactionWithDate)
import Ledger.LedgerPosting
import Ledger.Posting import Ledger.Posting
import Ledger.TimeLog import Ledger.TimeLog
@ -55,12 +54,11 @@ addHistoricalPrice h l0 = l0 { historical_prices = h : historical_prices l0 }
addTimeLogEntry :: TimeLogEntry -> Journal -> Journal addTimeLogEntry :: TimeLogEntry -> Journal -> Journal
addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 } addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 }
journalLedgerPostings :: Journal -> [LedgerPosting] journalPostings :: Journal -> [Posting]
journalLedgerPostings = txnsof . jtxns journalPostings = concatMap tpostings . jtxns
where txnsof ts = concatMap flattenTransaction $ zip ts [1..]
journalAccountNamesUsed :: Journal -> [AccountName] journalAccountNamesUsed :: Journal -> [AccountName]
journalAccountNamesUsed = accountNamesFromLedgerPostings . journalLedgerPostings journalAccountNamesUsed = accountNamesFromPostings . journalPostings
journalAccountNames :: Journal -> [AccountName] journalAccountNames :: Journal -> [AccountName]
journalAccountNames = sort . expandAccountNames . journalAccountNamesUsed 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 -- | Keep only ledger transactions which have the requested
-- cleared/uncleared status, if there is one. -- cleared/uncleared status, if there is one.
filterJournalPostingsByClearedStatus :: Maybe Bool -> Journal -> Journal 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) = filterJournalPostingsByClearedStatus (Just val) (Journal ms ps ts tls hs f fp ft) =
Journal ms ps (filter ((==val).tstatus) 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 -- | Convert this ledger's transactions' primary date to either their
-- actual or effective date. -- actual or effective date.
journalSelectingDate :: WhichDate -> Journal -> Journal journalSelectingDate :: WhichDate -> Journal -> Journal
journalSelectingDate ActualDate rl = rl journalSelectingDate ActualDate j = j
journalSelectingDate EffectiveDate rl = journalSelectingDate EffectiveDate j =
rl{jtxns=map (ledgerTransactionWithDate EffectiveDate) $ jtxns rl} j{jtxns=map (ledgerTransactionWithDate EffectiveDate) $ jtxns j}
-- | Give all a ledger's amounts their canonical display settings. That -- | Give all a ledger's amounts their canonical display settings. That
-- is, in each commodity, amounts will use the display settings of the -- 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. -- Also, amounts are converted to cost basis if that flag is active.
-- XXX refactor -- XXX refactor
canonicaliseAmounts :: Bool -> Journal -> Journal 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 where
fixledgertransaction (Transaction d ed s c de co ts pr) = Transaction d ed s c de co (map fixrawposting ts) pr fixledgertransaction (Transaction d ed s c de co ts pr) = Transaction d ed s c de co (map fixrawposting ts) pr
where 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] commoditymap = Map.fromList [(s,commoditieswithsymbol s) | s <- commoditysymbols]
commoditieswithsymbol s = filter ((s==) . symbol) commodities commoditieswithsymbol s = filter ((s==) . symbol) commodities
commoditysymbols = nub $ map symbol commodities commoditysymbols = nub $ map symbol commodities
commodities = map commodity (concatMap (amounts . lpamount) (journalLedgerPostings rl) commodities = map commodity (concatMap (amounts . pamount) (journalPostings j)
++ concatMap (amounts . hamount) (historical_prices rl)) ++ concatMap (amounts . hamount) (historical_prices j))
fixprice :: Amount -> Amount fixprice :: Amount -> Amount
fixprice a@Amount{price=Just _} = a 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. -- | 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. -- Does only one lookup step, ie will not look up the price of a price.
journalHistoricalPriceFor :: Journal -> Day -> Commodity -> Maybe MixedAmount journalHistoricalPriceFor :: Journal -> Day -> Commodity -> Maybe MixedAmount
journalHistoricalPriceFor rl d Commodity{symbol=s} = do journalHistoricalPriceFor j d Commodity{symbol=s} = do
let ps = reverse $ filter ((<= d).hdate) $ filter ((s==).hsymbol) $ sortBy (comparing hdate) $ historical_prices rl let ps = reverse $ filter ((<= d).hdate) $ filter ((s==).hsymbol) $ sortBy (comparing hdate) $ historical_prices j
case ps of (HistoricalPrice{hamount=a}:_) -> Just $ canonicaliseCommodities a case ps of (HistoricalPrice{hamount=a}:_) -> Just $ canonicaliseCommodities a
_ -> Nothing _ -> Nothing
where 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. -- | Get just the amounts from a ledger, in the order parsed.
journalAmounts :: Journal -> [MixedAmount] journalAmounts :: Journal -> [MixedAmount]
journalAmounts = map lpamount . journalLedgerPostings journalAmounts = map pamount . journalPostings
-- | Get just the ammount commodities from a ledger, in the order parsed. -- | Get just the ammount commodities from a ledger, in the order parsed.
journalCommodities :: Journal -> [Commodity] 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, -- | The (fully specified) date span containing all the raw ledger's transactions,
-- or DateSpan Nothing Nothing if there are none. -- or DateSpan Nothing Nothing if there are none.
journalDateSpan :: Journal -> DateSpan journalDateSpan :: Journal -> DateSpan
journalDateSpan rl journalDateSpan j
| null ts = DateSpan Nothing Nothing | null ts = DateSpan Nothing Nothing
| otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts) | otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts)
where where
ts = sortBy (comparing tdate) $ jtxns rl ts = sortBy (comparing tdate) $ jtxns j
-- | Check if a set of ledger account/description patterns matches the -- | Check if a set of ledger account/description patterns matches the
-- given account name or entry description. Patterns are case-insensitive -- 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.Types
import Ledger.Account () import Ledger.Account ()
import Ledger.AccountName import Ledger.AccountName
import Ledger.LedgerPosting
import Ledger.Journal import Ledger.Journal
import Ledger.Posting
instance Show Ledger where instance Show Ledger where
@ -73,61 +73,55 @@ instance Show Ledger where
-- | Convert a raw ledger to a more efficient cached type, described above. -- | Convert a raw ledger to a more efficient cached type, described above.
cacheLedger :: [String] -> Journal -> Ledger 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 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] 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 -- | Given a list of transactions, return an account name tree and three
-- query functions that fetch transactions, balance, and -- query functions that fetch transactions, balance, and
-- subaccount-including balance by account name. -- subaccount-including balance by account name.
-- This is to factor out common logic from cacheLedger and -- This is to factor out common logic from cacheLedger and
-- summariseLedgerPostingsInDateSpan. -- summarisePostingsInDateSpan.
groupLedgerPostings :: [LedgerPosting] -> (Tree AccountName, groupPostings :: [Posting] -> (Tree AccountName,
(AccountName -> [LedgerPosting]), (AccountName -> [Posting]),
(AccountName -> MixedAmount), (AccountName -> MixedAmount),
(AccountName -> MixedAmount)) (AccountName -> MixedAmount))
groupLedgerPostings ts = (ant,txnsof,exclbalof,inclbalof) groupPostings ps = (ant,psof,exclbalof,inclbalof)
where where
txnanames = sort $ nub $ map lpaccount ts anames = sort $ nub $ map paccount ps
ant = accountNameTreeFrom $ expandAccountNames txnanames ant = accountNameTreeFrom $ expandAccountNames anames
allanames = flatten ant allanames = flatten ant
txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- allanames]) pmap = Map.union (postingsByAccount ps) (Map.fromList [(a,[]) | a <- allanames])
balmap = Map.fromList $ flatten $ calculateBalances ant txnsof psof = (pmap !)
txnsof = (txnmap !) balmap = Map.fromList $ flatten $ calculateBalances ant psof
exclbalof = fst . (balmap !) exclbalof = fst . (balmap !)
inclbalof = snd . (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 -- | Add subaccount-excluding and subaccount-including balances to a tree
-- of account names somewhat efficiently, given a function that looks up -- of account names somewhat efficiently, given a function that looks up
-- transactions by account name. -- transactions by account name.
calculateBalances :: Tree AccountName -> (AccountName -> [LedgerPosting]) -> Tree (AccountName, (MixedAmount, MixedAmount)) calculateBalances :: Tree AccountName -> (AccountName -> [Posting]) -> Tree (AccountName, (MixedAmount, MixedAmount))
calculateBalances ant txnsof = addbalances ant calculateBalances ant psof = addbalances ant
where where
addbalances (Node a subs) = Node (a,(bal,bal+subsbal)) subs' addbalances (Node a subs) = Node (a,(bal,bal+subsbal)) subs'
where where
bal = sumLedgerPostings $ txnsof a bal = sumPostings $ psof a
subsbal = sum $ map (snd . snd . root) subs' subsbal = sum $ map (snd . snd . root) subs'
subs' = map addbalances subs subs' = map addbalances subs
-- | Convert a list of transactions to a map from account name to the list -- | Convert a list of postings to a map from account name to that
-- of all transactions in that account. -- account's postings.
transactionsByAccount :: [LedgerPosting] -> Map.Map AccountName [LedgerPosting] postingsByAccount :: [Posting] -> Map.Map AccountName [Posting]
transactionsByAccount ts = m' postingsByAccount ps = m'
where where
sortedts = sortBy (comparing lpaccount) ts sortedps = sortBy (comparing paccount) ps
groupedts = groupBy (\t1 t2 -> lpaccount t1 == lpaccount t2) sortedts groupedps = groupBy (\p1 p2 -> paccount p1 == paccount p2) sortedps
m' = Map.fromList [(lpaccount $ head g, g) | g <- groupedts] m' = Map.fromList [(paccount $ head g, g) | g <- groupedps]
-- The special account name "top" can be used to look up all transactions. ?
-- m' = Map.insert "top" sortedts m
filtertxns :: [String] -> [LedgerPosting] -> [LedgerPosting] filterPostings :: [String] -> [Posting] -> [Posting]
filtertxns apats = filter (matchpats apats . lpaccount) filterPostings apats = filter (matchpats apats . paccount)
-- | List a ledger's account names. -- | List a ledger's account names.
ledgerAccountNames :: Ledger -> [AccountName] ledgerAccountNames :: Ledger -> [AccountName]
@ -154,9 +148,9 @@ ledgerSubAccounts :: Ledger -> Account -> [Account]
ledgerSubAccounts l Account{aname=a} = ledgerSubAccounts l Account{aname=a} =
map (ledgerAccount l) $ filter (`isSubAccountNameOf` a) $ accountnames l map (ledgerAccount l) $ filter (`isSubAccountNameOf` a) $ accountnames l
-- | List a ledger's "transactions", ie postings with transaction info attached. -- | List a ledger's postings, in the order parsed.
ledgerLedgerPostings :: Ledger -> [LedgerPosting] ledgerPostings :: Ledger -> [Posting]
ledgerLedgerPostings = journalLedgerPostings . journal ledgerPostings = journalPostings . journal
-- | Get a ledger's tree of accounts to the specified depth. -- | Get a ledger's tree of accounts to the specified depth.
ledgerAccountTree :: Int -> Ledger -> Tree Account 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. -- or DateSpan Nothing Nothing if there are none.
ledgerDateSpan :: Ledger -> DateSpan ledgerDateSpan :: Ledger -> DateSpan
ledgerDateSpan l ledgerDateSpan l
| null ts = DateSpan Nothing Nothing | null ps = DateSpan Nothing Nothing
| otherwise = DateSpan (Just $ lpdate $ head ts) (Just $ addDays 1 $ lpdate $ last ts) | otherwise = DateSpan (Just $ postingDate $ head ps) (Just $ addDays 1 $ postingDate $ last ps)
where where
ts = sortBy (comparing lpdate) $ ledgerLedgerPostings l ps = sortBy (comparing postingDate) $ ledgerPostings l
-- | Convenience aliases. -- | Convenience aliases.
accountnames :: Ledger -> [AccountName] accountnames :: Ledger -> [AccountName]
@ -194,8 +188,8 @@ accountsmatching = ledgerAccountsMatching
subaccounts :: Ledger -> Account -> [Account] subaccounts :: Ledger -> Account -> [Account]
subaccounts = ledgerSubAccounts subaccounts = ledgerSubAccounts
transactions :: Ledger -> [LedgerPosting] postings :: Ledger -> [Posting]
transactions = ledgerLedgerPostings postings = ledgerPostings
commodities :: Ledger -> [Commodity] commodities :: Ledger -> [Commodity]
commodities = nub . journalCommodities . journal 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 -- misc parsing
-- | Parse a --display expression which is a simple date predicate, like -- | Parse a --display expression which is a simple date predicate, like
-- "d>[DATE]" or "d<=[DATE]", and return a transaction-matching predicate. -- "d>[DATE]" or "d<=[DATE]", and return a posting-matching predicate.
datedisplayexpr :: GenParser Char st (LedgerPosting -> Bool) datedisplayexpr :: GenParser Char st (Posting -> Bool)
datedisplayexpr = do datedisplayexpr = do
char 'd' char 'd'
op <- compareop op <- compareop
@ -566,7 +566,7 @@ datedisplayexpr = do
(y,m,d) <- smartdate (y,m,d) <- smartdate
char ']' char ']'
let date = parsedate $ printf "%04s/%02s/%02s" y m d 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 case op of
"<" -> test (<) "<" -> test (<)
"<=" -> test (<=) "<=" -> test (<=)

26
Ledger/Posting.hs
View File

@ -1,11 +1,9 @@
{-| {-|
A 'Posting' represents a 'MixedAmount' being added to or subtracted from a A 'Posting' represents a 'MixedAmount' being added to or subtracted from a
single 'Account'. Each 'Transaction' contains two or more postings single 'Account'. Each 'Transaction' contains two or more postings which
which should add up to 0. 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).
Generally, we use these with the ledger transaction's date and description
added, which we call a 'LedgerPosting'.
-} -}
@ -15,11 +13,12 @@ import Ledger.Utils
import Ledger.Types import Ledger.Types
import Ledger.Amount import Ledger.Amount
import Ledger.AccountName import Ledger.AccountName
import Ledger.Dates (nulldate)
instance Show Posting where show = showPosting instance Show Posting where show = showPosting
nullrawposting = Posting False "" nullmixedamt "" RegularPosting Nothing nullposting = Posting False "" nullmixedamt "" RegularPosting Nothing
showPosting :: Posting -> String showPosting :: Posting -> String
showPosting (Posting{paccount=a,pamount=amt,pcomment=com,ptype=t}) = showPosting (Posting{paccount=a,pamount=amt,pcomment=com,ptype=t}) =
@ -65,3 +64,18 @@ postingTypeFromAccountName a
| head a == '(' && last a == ')' = VirtualPosting | head a == '(' && last a == ')' = VirtualPosting
| otherwise = RegularPosting | 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 instance Show PeriodicTransaction where
show t = "~ " ++ ptperiodicexpr t ++ "\n" ++ unlines (map show (ptpostings t)) show t = "~ " ++ ptperiodicexpr t ++ "\n" ++ unlines (map show (ptpostings t))
nullledgertxn :: Transaction nulltransaction :: Transaction
nullledgertxn = Transaction { nulltransaction = Transaction {
tdate=parsedate "1900/1/1", tdate=nulldate,
teffectivedate=Nothing, teffectivedate=Nothing,
tstatus=False, tstatus=False,
tcode="", tcode="",
tdescription="", tdescription="",
tcomment="", tcomment="",
tpostings=[], tpostings=[],
tpreceding_comment_lines="" tpreceding_comment_lines=""
} }
{-| {-|
Show a ledger entry, formatted for the print command. ledger 2.x's 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. 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 > Ledger -- hledger's ledger is a journal file plus cached/derived data
> Journal -- a representation of the journal file, containing.. > Journal -- a representation of the journal file, containing..
> [Transaction] -- ..journal transactions, which have date, description and.. > [Transaction] -- ..journal transactions, which have date, status, code, description and..
> [Posting] -- ..two or more account postings > [Posting] -- ..two or more account postings (account name and amount)
> [LedgerPosting] -- all postings with their transaction's info attached > Tree AccountName -- all account names as a tree
> Tree AccountName -- the tree of all account names > Map AccountName Account -- a map from account name to account info (postings and balances)
> Map AccountName Account -- per-account ledger postings and balances for easy lookup
For more detailed documentation on each type, see the corresponding modules. 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. - 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.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. -- Tying this knot gets tedious, Maybe makes it easier/optional.
} deriving (Eq) } deriving (Eq)
data ModifierTransaction = ModifierTransaction {
mtvalueexpr :: String,
mtpostings :: [Posting]
} deriving (Eq)
data PeriodicTransaction = PeriodicTransaction {
ptperiodicexpr :: String,
ptpostings :: [Posting]
} deriving (Eq)
data Transaction = Transaction { data Transaction = Transaction {
tdate :: Day, tdate :: Day,
teffectivedate :: Maybe Day, teffectivedate :: Maybe Day,
@ -100,6 +89,16 @@ data Transaction = Transaction {
tpreceding_comment_lines :: String tpreceding_comment_lines :: String
} deriving (Eq) } 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 TimeLogCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord)
data TimeLogEntry = TimeLogEntry { data TimeLogEntry = TimeLogEntry {
@ -136,20 +135,10 @@ data FilterSpec = FilterSpec {
,whichdate :: WhichDate -- ^ which dates to use (transaction or effective) ,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 { data Account = Account {
aname :: AccountName, aname :: AccountName,
apostings :: [LedgerPosting], -- ^ transactions in this account apostings :: [Posting], -- ^ transactions in this account
abalance :: MixedAmount -- ^ sum of transactions in this account and subaccounts abalance :: MixedAmount -- ^ sum of transactions in this account and subaccounts
} }
data Ledger = Ledger { data Ledger = Ledger {

70
Tests.hs
View File

@ -793,40 +793,40 @@ tests = [
let a = ledgerAccount l "assets" let a = ledgerAccount l "assets"
map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"] map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
,"summariseLedgerPostingsInDateSpan" ~: do -- ,"summarisePostingsInDateSpan" ~: do
let gives (b,e,lpnum,depth,showempty,ts) = -- let gives (b,e,depth,showempty,ps) =
(summariseLedgerPostingsInDateSpan (mkdatespan b e) lpnum depth showempty ts `is`) -- (summarisePostingsInDateSpan (mkdatespan b e) depth showempty ps `is`)
let ts = -- let ps =
[ -- [
nullledgerposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]} -- nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]}
,nullledgerposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 2]} -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 2]}
,nullledgerposting{lpdescription="desc",lpaccount="expenses:food", lpamount=Mixed [dollars 4]} -- ,nullposting{lpdescription="desc",lpaccount="expenses:food", lpamount=Mixed [dollars 4]}
,nullledgerposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 8]} -- ,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,False,[]) `gives`
[] -- []
("2008/01/01","2009/01/01",0,9999,True,[]) `gives` -- ("2008/01/01","2009/01/01",0,9999,True,[]) `gives`
[ -- [
nullledgerposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31"} -- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31"}
] -- ]
("2008/01/01","2009/01/01",0,9999,False,ts) `gives` -- ("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]} -- nullposting{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]} -- ,nullposting{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]} -- ,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` -- ("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]} -- 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` -- ("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]} -- 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` -- ("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]} -- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [dollars 15]}
] -- ]
,"postingamount" ~: do ,"postingamount" ~: do
parseWithCtx emptyCtx postingamount " $47.18" `parseis` Mixed [dollars 47.18] parseWithCtx emptyCtx postingamount " $47.18" `parseis` Mixed [dollars 47.18]
@ -1258,7 +1258,7 @@ journalWithAmounts as =
Journal 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.Posting
Ledger.Parse Ledger.Parse
Ledger.TimeLog Ledger.TimeLog
Ledger.LedgerPosting
Ledger.Types Ledger.Types
Ledger.Utils Ledger.Utils
Build-Depends: Build-Depends:
@ -95,7 +94,6 @@ executable hledger
Ledger.Journal Ledger.Journal
Ledger.Posting Ledger.Posting
Ledger.TimeLog Ledger.TimeLog
Ledger.LedgerPosting
Ledger.Types Ledger.Types
Ledger.Utils Ledger.Utils
Options Options