slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages 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 let historymatches = transactionsSimilarTo l description
bestmatch | null historymatches = Nothing bestmatch | null historymatches = Nothing
| otherwise = Just $ snd $ head historymatches | 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 date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr
getpostingsandvalidate = do getpostingsandvalidate = do
ps <- getPostings bestmatchpostings [] ps <- getPostings bestmatchpostings []
let t = nullledgertxn{ltdate=date let t = nullledgertxn{tdate=date
,ltstatus=False ,tstatus=False
,ltdescription=description ,tdescription=description
,ltpostings=ps ,tpostings=ps
} }
retry = do retry = do
hPutStrLn stderr $ "\n" ++ nonzerobalanceerror ++ ". Re-enter:" hPutStrLn stderr $ "\n" ++ nonzerobalanceerror ++ ". Re-enter:"
@ -130,9 +130,9 @@ ledgerAddTransaction l t = do
appendToLedgerFile l $ show t appendToLedgerFile l $ show t
putStrLn $ printf "\nAdded transaction to %s:" (filepath $ journal l) putStrLn $ printf "\nAdded transaction to %s:" (filepath $ journal l)
putStrLn =<< registerFromString (show t) putStrLn =<< registerFromString (show t)
return l{journal=rl{ledger_txns=ts}} return l{journal=rl{jtxns=ts}}
where rl = journal l 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 -- | Append data to the ledger's file, ensuring proper separation from any
-- existing data; or if the file is "-", dump it to stdout. -- existing data; or if the file is "-", dump it to stdout.
@ -185,9 +185,9 @@ transactionsSimilarTo :: Ledger -> String -> [(Double,Transaction)]
transactionsSimilarTo l s = transactionsSimilarTo l s =
sortBy compareRelevanceAndRecency sortBy compareRelevanceAndRecency
$ filter ((> threshold).fst) $ filter ((> threshold).fst)
[(compareLedgerDescriptions s $ ltdescription t, t) | t <- ts] [(compareLedgerDescriptions s $ tdescription t, t) | t <- ts]
where where
compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,ltdate t2) (n1,ltdate t1) compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,tdate t2) (n1,tdate t1)
ts = ledger_txns $ journal l ts = jtxns $ journal l
threshold = 0 threshold = 0

16
Commands/Convert.hs
View File

@ -258,14 +258,14 @@ transactionFromCsvRecord rules fields =
(acct,newdesc) = identify (accountRules rules) unknownacct desc (acct,newdesc) = identify (accountRules rules) unknownacct desc
in in
Transaction { Transaction {
ltdate=date, tdate=date,
lteffectivedate=Nothing, teffectivedate=Nothing,
ltstatus=status, tstatus=status,
ltcode=code, tcode=code,
ltdescription=newdesc, tdescription=newdesc,
ltcomment=comment, tcomment=comment,
ltpreceding_comment_lines=precomment, tpreceding_comment_lines=precomment,
ltpostings=[ tpostings=[
Posting { Posting {
pstatus=False, pstatus=False,
paccount=acct, 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] daytxns = [(s, filter (isLedgerPostingInDateSpan s) ts) | s <- days]
-- same as Register -- same as Register
-- should count raw transactions, not posting transactions -- 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 filterempties
| Empty `elem` opts = id | Empty `elem` opts = id
| otherwise = filter (not . isZeroMixedAmount . tamount) | otherwise = filter (not . isZeroMixedAmount . lpamount)
matchapats = matchpats apats . taccount matchapats = matchpats apats . lpaccount
(apats,_) = parsePatternArgs args (apats,_) = parsePatternArgs args
filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (taccount t) <= depth) filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (lpaccount t) <= depth)
| otherwise = id | otherwise = id
depth = depthFromOpts opts 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 :: [Opt] -> [String] -> Ledger -> String
showTransactions opts args l = concatMap (showTransactionForPrint effective) txns showTransactions opts args l = concatMap (showTransactionForPrint effective) txns
where where
txns = sortBy (comparing ltdate) $ txns = sortBy (comparing tdate) $
ledger_txns $ jtxns $
filterJournalPostingsByDepth depth $ filterJournalPostingsByDepth depth $
filterJournalPostingsByAccount apats $ filterJournalPostingsByAccount apats $
journal l journal l

40
Commands/Register.hs
View File

@ -30,16 +30,16 @@ 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 = showtxns displayedts nulltxn startbal | interval == NoInterval = showlps displayedts nullledgerposting startbal
| otherwise = showtxns summaryts nulltxn startbal | otherwise = showlps summaryts nullledgerposting startbal
where where
interval = intervalFromOpts opts interval = intervalFromOpts opts
ts = sortBy (comparing tdate) $ filterempties $ filtertxns apats $ filterdepth $ ledgerLedgerPostings l ts = sortBy (comparing lpdate) $ filterempties $ filtertxns apats $ filterdepth $ ledgerLedgerPostings l
filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (taccount t) <= depth) filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (lpaccount t) <= depth)
| otherwise = id | otherwise = id
filterempties filterempties
| Empty `elem` opts = id | Empty `elem` opts = id
| otherwise = filter (not . isZeroMixedAmount . tamount) | otherwise = filter (not . isZeroMixedAmount . lpamount)
(precedingts, ts') = break (matchdisplayopt dopt) ts (precedingts, ts') = break (matchdisplayopt dopt) ts
(displayedts, _) = span (matchdisplayopt dopt) ts' (displayedts, _) = span (matchdisplayopt dopt) ts'
startbal = sumLedgerPostings precedingts startbal = sumLedgerPostings precedingts
@ -56,7 +56,7 @@ showRegisterReport opts args l
-- | Convert a date span (representing a reporting interval) and a list of -- | Convert a date span (representing a reporting interval) and a list of
-- transactions within it to a new list of transactions aggregated by -- 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 -- 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.
@ -75,20 +75,20 @@ summariseLedgerPostingsInDateSpan (DateSpan b e) tnum depth showempty ts
| null ts = [] | null ts = []
| otherwise = summaryts' | otherwise = summaryts'
where where
txn = nulltxn{tnum=tnum, tdate=b', tdescription="- "++ showDate (addDays (-1) e')} txn = nullledgerposting{lptnum=tnum, lpdate=b', lpdescription="- "++ showDate (addDays (-1) e')}
b' = fromMaybe (tdate $ head ts) b b' = fromMaybe (lpdate $ head ts) b
e' = fromMaybe (tdate $ last ts) e e' = fromMaybe (lpdate $ last ts) e
summaryts' summaryts'
| showempty = summaryts | showempty = summaryts
| otherwise = filter (not . isZeroMixedAmount . tamount) summaryts | otherwise = filter (not . isZeroMixedAmount . lpamount) summaryts
txnanames = sort $ nub $ map taccount ts txnanames = sort $ nub $ map lpaccount ts
-- 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) = groupLedgerPostings ts
clippedanames = clipAccountNames depth txnanames clippedanames = clipAccountNames depth txnanames
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{taccount=a,tamount=balancetoshowfor a} | a <- clippedanames] summaryts = [txn{lpaccount=a,lpamount=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
@ -96,16 +96,16 @@ clipAccountNames d as = nub $ map (clip d) as
-- | Show transactions one per line, with each date/description appearing -- | Show transactions one per line, with each date/description appearing
-- only once, and a running balance. -- only once, and a running balance.
showtxns [] _ _ = "" showlps [] _ _ = ""
showtxns (t:ts) tprev bal = this ++ showtxns ts t bal' showlps (lp:lps) lpprev bal = this ++ showlps lps lp bal'
where where
this = showtxn (t `issame` tprev) t bal' this = showlp (lp `issame` lpprev) lp bal'
issame = (==) `on` tnum issame = (==) `on` lptnum
bal' = bal + tamount t bal' = bal + lpamount lp
-- | Show one transaction line and balance with or without the entry details. -- | Show one transaction line and balance with or without the entry details.
showtxn :: Bool -> LedgerPosting -> MixedAmount -> String showlp :: Bool -> LedgerPosting -> MixedAmount -> String
showtxn omitdesc t b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n" showlp omitdesc lp b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n"
where where
ledger3ishlayout = False ledger3ishlayout = False
datedescwidth = if ledger3ishlayout then 34 else 32 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 desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String
p = showPostingWithoutPrice $ Posting s a amt "" tt p = showPostingWithoutPrice $ Posting s a amt "" tt
bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b) 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) ,("Transactions last 7 days", printf "%d (%0.1f per day)" tnum7 txnrate7)
,("Last transaction", maybe "none" show lastdate ++ ,("Last transaction", maybe "none" show lastdate ++
maybe "" (printf " (%d days ago)") lastelapsed) 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) ,("Accounts", show $ length $ accounts l)
,("Commodities", show $ length $ commodities l) ,("Commodities", show $ length $ commodities l)
-- Transactions this month : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s) -- 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 -- Days since last transaction : %(recentelapsed)s
] ]
where where
ts = sortBy (comparing ltdate) $ ledger_txns $ journal l ts = sortBy (comparing tdate) $ jtxns $ journal l
lastdate | null ts = Nothing lastdate | null ts = Nothing
| otherwise = Just $ ltdate $ last ts | otherwise = Just $ tdate $ last ts
lastelapsed = maybe Nothing (Just . diffDays today) lastdate lastelapsed = maybe Nothing (Just . diffDays today) lastdate
tnum = length ts tnum = length ts
span = rawdatespan l span = rawdatespan l
@ -57,9 +57,9 @@ showStats _ _ l today =
txnrate | days==0 = 0 txnrate | days==0 = 0
| otherwise = fromIntegral tnum / fromIntegral days :: Double | otherwise = fromIntegral tnum / fromIntegral days :: Double
tnum30 = length $ filter withinlast30 ts 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 txnrate30 = fromIntegral tnum30 / 30 :: Double
tnum7 = length $ filter withinlast7 ts 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 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 -- cursor on the register screen (or best guess). Results undefined while
-- on other screens. Doesn't work. -- on other screens. Doesn't work.
currentTransaction :: AppState -> Transaction currentTransaction :: AppState -> Transaction
currentTransaction a@AppState{aledger=l,abuf=buf} = transactionContainingLedgerPosting a t currentTransaction a@AppState{aledger=l,abuf=buf} = transactionContainingLedgerPosting a lp
where where
t = safehead nulltxn $ filter ismatch $ ledgerLedgerPostings l lp = safehead nullledgerposting $ filter ismatch $ ledgerLedgerPostings l
ismatch t = tdate t == parsedate (take 10 datedesc) ismatch lp = lpdate lp == parsedate (take 10 datedesc)
&& take 70 (showtxn False t nullmixedamt) == (datedesc ++ acctamt) && take 70 (showlp False lp 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
@ -287,7 +287,7 @@ currentTransaction a@AppState{aledger=l,abuf=buf} = transactionContainingLedgerP
-- | Get the entry which contains the given transaction. -- | Get the entry which contains the given transaction.
-- Will raise an error if there are problems. -- Will raise an error if there are problems.
transactionContainingLedgerPosting :: AppState -> LedgerPosting -> Transaction 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 -- renderers

16
Commands/Web.hs
View File

@ -303,17 +303,17 @@ handleAddform l = do
amt1' = either (const missingamt) id $ parse someamount "" amt1 amt1' = either (const missingamt) id $ parse someamount "" amt1
amt2' = either (const missingamt) id $ parse someamount "" amt2 amt2' = either (const missingamt) id $ parse someamount "" amt2
t = Transaction { t = Transaction {
ltdate = parsedate $ fixSmartDateStr today date tdate = parsedate $ fixSmartDateStr today date
,lteffectivedate=Nothing ,teffectivedate=Nothing
,ltstatus=False ,tstatus=False
,ltcode="" ,tcode=""
,ltdescription=desc ,tdescription=desc
,ltcomment="" ,tcomment=""
,ltpostings=[ ,tpostings=[
Posting False acct1 amt1' "" RegularPosting Posting False acct1 amt1' "" RegularPosting
,Posting False acct2 amt2' "" RegularPosting ,Posting False acct2 amt2' "" RegularPosting
] ]
,ltpreceding_comment_lines="" ,tpreceding_comment_lines=""
} }
(t', berr) = case balanceTransaction t of (t', berr) = case balanceTransaction t of
Right t'' -> (t'', []) Right t'' -> (t'', [])

48
Ledger/Journal.hs
View File

@ -21,18 +21,18 @@ import Ledger.TimeLog
instance Show Journal where instance Show Journal where
show l = printf "Journal with %d transactions, %d accounts: %s" show l = printf "Journal with %d transactions, %d accounts: %s"
(length (ledger_txns l) + (length (jtxns l) +
length (modifier_txns l) + length (jmodifiertxns l) +
length (periodic_txns l)) length (jperiodictxns l))
(length accounts) (length accounts)
(show accounts) (show accounts)
-- ++ (show $ journalTransactions l) -- ++ (show $ journalTransactions l)
where accounts = flatten $ journalAccountNameTree l where accounts = flatten $ journalAccountNameTree l
journalEmpty :: Journal journalEmpty :: Journal
journalEmpty = Journal { modifier_txns = [] journalEmpty = Journal { jmodifiertxns = []
, periodic_txns = [] , jperiodictxns = []
, ledger_txns = [] , jtxns = []
, open_timelog_entries = [] , open_timelog_entries = []
, historical_prices = [] , historical_prices = []
, final_comment_lines = [] , final_comment_lines = []
@ -41,13 +41,13 @@ journalEmpty = Journal { modifier_txns = []
} }
addTransaction :: Transaction -> Journal -> Journal 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 :: 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 :: 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 :: HistoricalPrice -> Journal -> Journal
addHistoricalPrice h l0 = l0 { historical_prices = h : historical_prices l0 } 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 } addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 }
journalLedgerPostings :: Journal -> [LedgerPosting] journalLedgerPostings :: Journal -> [LedgerPosting]
journalLedgerPostings = txnsof . ledger_txns journalLedgerPostings = txnsof . jtxns
where txnsof ts = concatMap flattenTransaction $ zip ts [1..] where txnsof ts = concatMap flattenTransaction $ zip ts [1..]
journalAccountNamesUsed :: Journal -> [AccountName] journalAccountNamesUsed :: Journal -> [AccountName]
@ -82,7 +82,7 @@ filterJournal span pats clearedonly realonly =
filterJournalTransactionsByDescription :: [String] -> Journal -> Journal filterJournalTransactionsByDescription :: [String] -> Journal -> Journal
filterJournalTransactionsByDescription pats (Journal ms ps ts tls hs f fp ft) = filterJournalTransactionsByDescription pats (Journal ms ps ts tls hs f fp ft) =
Journal ms ps (filter matchdesc 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. -- | Keep only ledger transactions which fall between begin and end dates.
-- We include transactions on the begin date and exclude transactions on the end -- 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) = filterJournalTransactionsByDate (DateSpan begin end) (Journal ms ps ts tls hs f fp ft) =
Journal ms ps (filter matchdate ts) tls hs f fp ft Journal ms ps (filter matchdate ts) tls hs f fp ft
where 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 -- | 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 rl = rl
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).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 -- | Strip out any virtual postings, if the flag is true, otherwise do
-- no filtering. -- no filtering.
@ -106,27 +106,27 @@ filterJournalPostingsByRealness :: Bool -> Journal -> Journal
filterJournalPostingsByRealness False l = l filterJournalPostingsByRealness False l = l
filterJournalPostingsByRealness True (Journal mts pts ts tls hs f fp ft) = filterJournalPostingsByRealness True (Journal mts pts ts tls hs f fp ft) =
Journal mts pts (map filtertxns 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 -- | Strip out any postings to accounts deeper than the specified depth
-- (and any ledger transactions which have no postings as a result). -- (and any ledger transactions which have no postings as a result).
filterJournalPostingsByDepth :: Int -> Journal -> Journal filterJournalPostingsByDepth :: Int -> Journal -> Journal
filterJournalPostingsByDepth depth (Journal mts pts ts tls hs f fp ft) = 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 Journal mts pts (filter (not . null . tpostings) $ map filtertxns ts) tls hs f fp ft
where filtertxns t@Transaction{ltpostings=ps} = where filtertxns t@Transaction{tpostings=ps} =
t{ltpostings=filter ((<= depth) . accountNameLevel . paccount) ps} t{tpostings=filter ((<= depth) . accountNameLevel . paccount) ps}
-- | Keep only ledger transactions which affect accounts matched by the account patterns. -- | Keep only ledger transactions which affect accounts matched by the account patterns.
filterJournalPostingsByAccount :: [String] -> Journal -> Journal filterJournalPostingsByAccount :: [String] -> Journal -> Journal
filterJournalPostingsByAccount apats (Journal ms ps ts tls hs f fp ft) = 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 -- | 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 rl = rl
journalSelectingDate EffectiveDate 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 -- | 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
@ -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] 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 . tamount) (journalLedgerPostings rl) commodities = map commodity (concatMap (amounts . lpamount) (journalLedgerPostings rl)
++ concatMap (amounts . hamount) (historical_prices rl)) ++ concatMap (amounts . hamount) (historical_prices rl))
fixprice :: Amount -> Amount fixprice :: Amount -> Amount
fixprice a@Amount{price=Just _} = a 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. -- | Get just the amounts from a ledger, in the order parsed.
journalAmounts :: Journal -> [MixedAmount] journalAmounts :: Journal -> [MixedAmount]
journalAmounts = map tamount . journalLedgerPostings journalAmounts = map lpamount . journalLedgerPostings
-- | 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]
@ -185,7 +185,7 @@ journalPrecisions = map precision . journalCommodities
-- | Close any open timelog sessions using the provided current time. -- | Close any open timelog sessions using the provided current time.
journalConvertTimeLog :: LocalTime -> Journal -> Journal 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 = [] , open_timelog_entries = []
} }
where convertedTimeLog = entriesFromTimeLogEntries t $ open_timelog_entries l0 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 :: Journal -> DateSpan
journalDateSpan rl journalDateSpan rl
| null ts = DateSpan Nothing Nothing | 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 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 -- | 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

20
Ledger/Ledger.hs
View File

@ -65,9 +65,9 @@ import Ledger.Journal
instance Show Ledger where instance Show Ledger where
show l = printf "Ledger with %d transactions, %d accounts\n%s" show l = printf "Ledger with %d transactions, %d accounts\n%s"
(length (ledger_txns $ journal l) + (length (jtxns $ journal l) +
length (modifier_txns $ journal l) + length (jmodifiertxns $ journal l) +
length (periodic_txns $ journal l)) length (jperiodictxns $ journal l))
(length $ accountnames l) (length $ accountnames l)
(showtree $ accountnametree l) (showtree $ accountnametree l)
@ -90,7 +90,7 @@ groupLedgerPostings :: [LedgerPosting] -> (Tree AccountName,
(AccountName -> MixedAmount)) (AccountName -> MixedAmount))
groupLedgerPostings ts = (ant,txnsof,exclbalof,inclbalof) groupLedgerPostings ts = (ant,txnsof,exclbalof,inclbalof)
where where
txnanames = sort $ nub $ map taccount ts txnanames = sort $ nub $ map lpaccount ts
ant = accountNameTreeFrom $ expandAccountNames txnanames ant = accountNameTreeFrom $ expandAccountNames txnanames
allanames = flatten ant allanames = flatten ant
txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- allanames]) 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 :: [LedgerPosting] -> Map.Map AccountName [LedgerPosting]
transactionsByAccount ts = m' transactionsByAccount ts = m'
where where
sortedts = sortBy (comparing taccount) ts sortedts = sortBy (comparing lpaccount) ts
groupedts = groupBy (\t1 t2 -> taccount t1 == taccount t2) sortedts groupedts = groupBy (\t1 t2 -> lpaccount t1 == lpaccount t2) sortedts
m' = Map.fromList [(taccount $ head g, g) | g <- groupedts] m' = Map.fromList [(lpaccount $ head g, g) | g <- groupedts]
-- The special account name "top" can be used to look up all transactions. ? -- The special account name "top" can be used to look up all transactions. ?
-- m' = Map.insert "top" sortedts m -- m' = Map.insert "top" sortedts m
filtertxns :: [String] -> [LedgerPosting] -> [LedgerPosting] filtertxns :: [String] -> [LedgerPosting] -> [LedgerPosting]
filtertxns apats = filter (matchpats apats . taccount) filtertxns apats = filter (matchpats apats . lpaccount)
-- | List a ledger's account names. -- | List a ledger's account names.
ledgerAccountNames :: Ledger -> [AccountName] ledgerAccountNames :: Ledger -> [AccountName]
@ -171,9 +171,9 @@ ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l
ledgerDateSpan :: Ledger -> DateSpan ledgerDateSpan :: Ledger -> DateSpan
ledgerDateSpan l ledgerDateSpan l
| 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 $ lpdate $ head ts) (Just $ addDays 1 $ lpdate $ last ts)
where where
ts = sortBy (comparing tdate) $ ledgerLedgerPostings l ts = sortBy (comparing lpdate) $ ledgerLedgerPostings l
-- | Convenience aliases. -- | Convenience aliases.
accountnames :: Ledger -> [AccountName] accountnames :: Ledger -> [AccountName]

20
Ledger/LedgerPosting.hs
View File

@ -20,10 +20,10 @@ import Ledger.Amount
instance Show LedgerPosting where show=showLedgerPosting instance Show LedgerPosting where show=showLedgerPosting
showLedgerPosting :: LedgerPosting -> String showLedgerPosting :: LedgerPosting -> String
showLedgerPosting (LedgerPosting _ stat d desc a amt ttype) = showLedgerPosting (LedgerPosting _ stat d desc a amt lptype) =
s ++ unwords [showDate d,desc,a',show amt,show ttype] s ++ unwords [showDate d,desc,a',show amt,show lptype]
where s = if stat then " *" else "" 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 -- | Convert a 'Transaction' to two or more 'LedgerPosting's. An id number
-- is attached to the transactions to preserve their grouping - it should -- 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] [LedgerPosting n s d desc (paccount p) (pamount p) (ptype p) | p <- ps]
accountNamesFromLedgerPostings :: [LedgerPosting] -> [AccountName] accountNamesFromLedgerPostings :: [LedgerPosting] -> [AccountName]
accountNamesFromLedgerPostings = nub . map taccount accountNamesFromLedgerPostings = nub . map lpaccount
sumLedgerPostings :: [LedgerPosting] -> MixedAmount sumLedgerPostings :: [LedgerPosting] -> MixedAmount
sumLedgerPostings = sum . map tamount sumLedgerPostings = sum . map lpamount
nulltxn :: LedgerPosting nullledgerposting :: LedgerPosting
nulltxn = LedgerPosting 0 False (parsedate "1900/1/1") "" "" nullmixedamt RegularPosting nullledgerposting = LedgerPosting 0 False (parsedate "1900/1/1") "" "" nullmixedamt RegularPosting
-- | Does the given transaction fall within the given date span ? -- | Does the given transaction fall within the given date span ?
isLedgerPostingInDateSpan :: DateSpan -> LedgerPosting -> Bool isLedgerPostingInDateSpan :: DateSpan -> LedgerPosting -> Bool
isLedgerPostingInDateSpan (DateSpan Nothing Nothing) _ = True isLedgerPostingInDateSpan (DateSpan Nothing Nothing) _ = True
isLedgerPostingInDateSpan (DateSpan Nothing (Just e)) (LedgerPosting{tdate=d}) = d<e isLedgerPostingInDateSpan (DateSpan Nothing (Just e)) (LedgerPosting{lpdate=d}) = d<e
isLedgerPostingInDateSpan (DateSpan (Just b) Nothing) (LedgerPosting{tdate=d}) = d>=b isLedgerPostingInDateSpan (DateSpan (Just b) Nothing) (LedgerPosting{lpdate=d}) = d>=b
isLedgerPostingInDateSpan (DateSpan (Just b) (Just e)) (LedgerPosting{tdate=d}) = d>=b && d<e 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 (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) . tdate test op = return $ (`op` date) . lpdate
case op of case op of
"<" -> test (<) "<" -> test (<)
"<=" -> test (<=) "<=" -> test (<=)

8
Ledger/Posting.hs
View File

@ -22,26 +22,26 @@ instance Show Posting where show = showPosting
nullrawposting = Posting False "" nullmixedamt "" RegularPosting nullrawposting = Posting False "" nullmixedamt "" RegularPosting
showPosting :: Posting -> String showPosting :: Posting -> String
showPosting (Posting _ a amt com ttype) = showPosting (Posting _ a amt com lptype) =
concatTopPadded [showaccountname a ++ " ", showamount amt, comment] concatTopPadded [showaccountname a ++ " ", showamount amt, comment]
where where
ledger3ishlayout = False ledger3ishlayout = False
acctnamewidth = if ledger3ishlayout then 25 else 22 acctnamewidth = if ledger3ishlayout then 25 else 22
showaccountname = printf ("%-"++(show acctnamewidth)++"s") . bracket . elideAccountName width showaccountname = printf ("%-"++(show acctnamewidth)++"s") . bracket . elideAccountName width
(bracket,width) = case ttype of (bracket,width) = case lptype of
BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth-2) BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth-2)
VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2) VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2)
_ -> (id,acctnamewidth) _ -> (id,acctnamewidth)
showamount = padleft 12 . showMixedAmountOrZero showamount = padleft 12 . showMixedAmountOrZero
comment = if null com then "" else " ; " ++ com comment = if null com then "" else " ; " ++ com
-- XXX refactor -- XXX refactor
showPostingWithoutPrice (Posting _ a amt com ttype) = showPostingWithoutPrice (Posting _ a amt com lptype) =
concatTopPadded [showaccountname a ++ " ", showamount amt, comment] concatTopPadded [showaccountname a ++ " ", showamount amt, comment]
where where
ledger3ishlayout = False ledger3ishlayout = False
acctnamewidth = if ledger3ishlayout then 25 else 22 acctnamewidth = if ledger3ishlayout then 25 else 22
showaccountname = printf ("%-"++(show acctnamewidth)++"s") . bracket . elideAccountName width showaccountname = printf ("%-"++(show acctnamewidth)++"s") . bracket . elideAccountName width
(bracket,width) = case ttype of (bracket,width) = case lptype of
BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth-2) BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth-2)
VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2) VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2)
_ -> (id,acctnamewidth) _ -> (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 error $ "clock-out time less than clock-in time in:\n" ++ showTransaction t
where where
t = Transaction { t = Transaction {
ltdate = idate, tdate = idate,
lteffectivedate = Nothing, teffectivedate = Nothing,
ltstatus = True, tstatus = True,
ltcode = "", tcode = "",
ltdescription = showtime itod ++ "-" ++ showtime otod, tdescription = showtime itod ++ "-" ++ showtime otod,
ltcomment = "", tcomment = "",
ltpostings = ps, tpostings = ps,
ltpreceding_comment_lines="" tpreceding_comment_lines=""
} }
showtime = take 5 . show showtime = take 5 . show
acctname = tlcomment i acctname = tlcomment i

38
Ledger/Transaction.hs
View File

@ -24,14 +24,14 @@ instance Show PeriodicTransaction where
nullledgertxn :: Transaction nullledgertxn :: Transaction
nullledgertxn = Transaction { nullledgertxn = Transaction {
ltdate=parsedate "1900/1/1", tdate=parsedate "1900/1/1",
lteffectivedate=Nothing, teffectivedate=Nothing,
ltstatus=False, tstatus=False,
ltcode="", tcode="",
ltdescription="", tdescription="",
ltcomment="", tcomment="",
ltpostings=[], tpostings=[],
ltpreceding_comment_lines="" tpreceding_comment_lines=""
} }
{-| {-|
@ -61,15 +61,15 @@ showTransactionForPrint effective = showTransaction' False effective
showTransaction' :: Bool -> Bool -> Transaction -> String showTransaction' :: Bool -> Bool -> Transaction -> String
showTransaction' elide effective t = showTransaction' elide effective t =
unlines $ [description] ++ showpostings (ltpostings t) ++ [""] unlines $ [description] ++ showpostings (tpostings t) ++ [""]
where where
description = concat [date, status, code, desc, comment] description = concat [date, status, code, desc, comment]
date | effective = showdate $ fromMaybe (ltdate t) $ lteffectivedate t date | effective = showdate $ fromMaybe (tdate t) $ teffectivedate t
| otherwise = showdate (ltdate t) ++ maybe "" showedate (lteffectivedate t) | otherwise = showdate (tdate t) ++ maybe "" showedate (teffectivedate t)
status = if ltstatus t then " *" else "" status = if tstatus t then " *" else ""
code = if length (ltcode t) > 0 then printf " (%s)" $ ltcode t else "" code = if length (tcode t) > 0 then printf " (%s)" $ tcode t else ""
desc = ' ' : ltdescription t desc = ' ' : tdescription t
comment = if null com then "" else " ; " ++ com where com = ltcomment t comment = if null com then "" else " ; " ++ com where com = tcomment t
showdate = printf "%-10s" . showDate showdate = printf "%-10s" . showDate
showedate = printf "=%s" . showdate showedate = printf "=%s" . showdate
showpostings ps showpostings ps
@ -98,7 +98,7 @@ showAccountName w = fmt
bracket s = "["++s++"]" bracket s = "["++s++"]"
isTransactionBalanced :: Transaction -> Bool isTransactionBalanced :: Transaction -> Bool
isTransactionBalanced (Transaction {ltpostings=ps}) = isTransactionBalanced (Transaction {tpostings=ps}) =
all (isReallyZeroMixedAmount . costOfMixedAmount . sum . map pamount) all (isReallyZeroMixedAmount . costOfMixedAmount . sum . map pamount)
[filter isReal ps, filter isBalancedVirtual ps] [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, -- converted to cost basis if possible. If the entry can not be balanced,
-- return an error message instead. -- return an error message instead.
balanceTransaction :: Transaction -> Either String Transaction 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" | length missingamounts' > 1 = Left $ printerr "could not balance this transaction, too many missing amounts"
| not $ isTransactionBalanced t' = Left $ printerr nonzerobalanceerror | not $ isTransactionBalanced t' = Left $ printerr nonzerobalanceerror
| otherwise = Right t' | otherwise = Right t'
where where
(withamounts, missingamounts) = partition hasAmount $ filter isReal ps (withamounts, missingamounts) = partition hasAmount $ filter isReal ps
(_, missingamounts') = partition hasAmount ps (_, missingamounts') = partition hasAmount ps
t' = t{ltpostings=ps'} t' = t{tpostings=ps'}
ps' | length missingamounts == 1 = map balance ps ps' | length missingamounts == 1 = map balance ps
| otherwise = ps | otherwise = ps
where 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. -- | Convert the primary date to either the actual or effective date.
ledgerTransactionWithDate :: WhichDate -> Transaction -> Transaction ledgerTransactionWithDate :: WhichDate -> Transaction -> Transaction
ledgerTransactionWithDate ActualDate t = t 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) } deriving (Eq)
data Transaction = Transaction { data Transaction = Transaction {
ltdate :: Day, tdate :: Day,
lteffectivedate :: Maybe Day, teffectivedate :: Maybe Day,
ltstatus :: Bool, tstatus :: Bool,
ltcode :: String, tcode :: String,
ltdescription :: String, tdescription :: String,
ltcomment :: String, tcomment :: String,
ltpostings :: [Posting], tpostings :: [Posting],
ltpreceding_comment_lines :: String tpreceding_comment_lines :: String
} deriving (Eq) } deriving (Eq)
data TimeLogCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord) data TimeLogCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord)
@ -113,9 +113,9 @@ data HistoricalPrice = HistoricalPrice {
} deriving (Eq) -- & Show (in Amount.hs) } deriving (Eq) -- & Show (in Amount.hs)
data Journal = Journal { data Journal = Journal {
modifier_txns :: [ModifierTransaction], jmodifiertxns :: [ModifierTransaction],
periodic_txns :: [PeriodicTransaction], jperiodictxns :: [PeriodicTransaction],
ledger_txns :: [Transaction], jtxns :: [Transaction],
open_timelog_entries :: [TimeLogEntry], open_timelog_entries :: [TimeLogEntry],
historical_prices :: [HistoricalPrice], historical_prices :: [HistoricalPrice],
final_comment_lines :: String, final_comment_lines :: String,
@ -135,13 +135,13 @@ data FilterSpec = FilterSpec {
} }
data LedgerPosting = LedgerPosting { data LedgerPosting = LedgerPosting {
tnum :: Int, lptnum :: Int, -- ^ internal transaction reference number
tstatus :: Bool, -- ^ posting status lpstatus :: Bool, -- ^ posting status
tdate :: Day, -- ^ transaction date lpdate :: Day, -- ^ transaction date
tdescription :: String, -- ^ ledger transaction description lpdescription :: String, -- ^ ledger transaction description
taccount :: AccountName, -- ^ posting account lpaccount :: AccountName, -- ^ posting account
tamount :: MixedAmount, -- ^ posting amount lpamount :: MixedAmount, -- ^ posting amount
ttype :: PostingType -- ^ posting type lptype :: PostingType -- ^ posting type
} deriving (Eq) } deriving (Eq)
data Account = Account { data Account = Account {

170
Tests.hs
View File

@ -327,7 +327,7 @@ tests = [
assertEqual "balancing amount is added" assertEqual "balancing amount is added"
(Mixed [dollars (-1)]) (Mixed [dollars (-1)])
(case e of (case e of
Right e' -> (pamount $ last $ ltpostings e') Right e' -> (pamount $ last $ tpostings e')
Left _ -> error "should not happen") Left _ -> error "should not happen")
,"cacheLedger" ~: ,"cacheLedger" ~:
@ -365,7 +365,7 @@ tests = [
clockin = TimeLogEntry In clockin = TimeLogEntry In
mktime d = LocalTime d . fromMaybe midnight . parseTime defaultTimeLocale "%H:%M:%S" mktime d = LocalTime d . fromMaybe midnight . parseTime defaultTimeLocale "%H:%M:%S"
showtime = formatTime defaultTimeLocale "%H:%M" 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" assertEntriesGiveStrings "started yesterday, split session at midnight"
[clockin (mktime yesterday "23:00:00") ""] [clockin (mktime yesterday "23:00:00") ""]
@ -458,13 +458,13 @@ tests = [
,"default year" ~: do ,"default year" ~: do
rl <- journalFromString defaultyear_ledger_str 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 () return ()
,"ledgerFile" ~: do ,"ledgerFile" ~: do
assertBool "ledgerFile should parse an empty file" (isRight $ parseWithCtx emptyCtx ledgerFile "") assertBool "ledgerFile should parse an empty file" (isRight $ parseWithCtx emptyCtx ledgerFile "")
r <- journalFromString "" -- don't know how to get it from 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" ~: ,"ledgerHistoricalPrice" ~:
parseWithCtx emptyCtx ledgerHistoricalPrice price1_str `parseis` price1 parseWithCtx emptyCtx ledgerHistoricalPrice price1_str `parseis` price1
@ -477,7 +477,7 @@ tests = [
$ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a\n" $ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a\n"
let t = parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a ;comment\n b 1\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" assertBool "ledgerTransaction should not include a comment in the description"
$ either (const False) ((== "a") . ltdescription) t $ either (const False) ((== "a") . tdescription) t
,"ledgeraccountname" ~: do ,"ledgeraccountname" ~: do
assertBool "ledgeraccountname parses a normal accountname" (isRight $ parsewith ledgeraccountname "a:b:c") 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"] map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
,"summariseLedgerPostingsInDateSpan" ~: do ,"summariseLedgerPostingsInDateSpan" ~: do
let gives (b,e,tnum,depth,showempty,ts) = let gives (b,e,lpnum,depth,showempty,ts) =
(summariseLedgerPostingsInDateSpan (mkdatespan b e) tnum depth showempty ts `is`) (summariseLedgerPostingsInDateSpan (mkdatespan b e) lpnum depth showempty ts `is`)
let ts = let ts =
[ [
nulltxn{tdescription="desc",taccount="expenses:food:groceries",tamount=Mixed [dollars 1]} nullledgerposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]}
,nulltxn{tdescription="desc",taccount="expenses:food:dining", tamount=Mixed [dollars 2]} ,nullledgerposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 2]}
,nulltxn{tdescription="desc",taccount="expenses:food", tamount=Mixed [dollars 4]} ,nullledgerposting{lpdescription="desc",lpaccount="expenses:food", lpamount=Mixed [dollars 4]}
,nulltxn{tdescription="desc",taccount="expenses:food:dining", tamount=Mixed [dollars 8]} ,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,False,[]) `gives`
[] []
("2008/01/01","2009/01/01",0,9999,True,[]) `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` ("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]} nullledgerposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food", lpamount=Mixed [dollars 4]}
,nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food:dining", tamount=Mixed [dollars 10]} ,nullledgerposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:dining", lpamount=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: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`
[ [
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` ("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` ("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 ,"postingamount" ~: do
@ -1065,168 +1065,168 @@ journal7 = Journal
[] []
[ [
Transaction { Transaction {
ltdate=parsedate "2007/01/01", tdate=parsedate "2007/01/01",
lteffectivedate=Nothing, teffectivedate=Nothing,
ltstatus=False, tstatus=False,
ltcode="*", tcode="*",
ltdescription="opening balance", tdescription="opening balance",
ltcomment="", tcomment="",
ltpostings=[ tpostings=[
Posting { Posting {
pstatus=False, pstatus=False,
paccount="assets:cash", paccount="assets:cash",
pamount=(Mixed [dollars 4.82]), pamount=(Mixed [dollars 4.82]),
pcomment="", pcomment="",
ptype=RegularPosting ptype=RegularPosting
}, },
Posting { Posting {
pstatus=False, pstatus=False,
paccount="equity:opening balances", paccount="equity:opening balances",
pamount=(Mixed [dollars (-4.82)]), pamount=(Mixed [dollars (-4.82)]),
pcomment="", pcomment="",
ptype=RegularPosting ptype=RegularPosting
} }
], ],
ltpreceding_comment_lines="" tpreceding_comment_lines=""
} }
, ,
Transaction { Transaction {
ltdate=parsedate "2007/02/01", tdate=parsedate "2007/02/01",
lteffectivedate=Nothing, teffectivedate=Nothing,
ltstatus=False, tstatus=False,
ltcode="*", tcode="*",
ltdescription="ayres suites", tdescription="ayres suites",
ltcomment="", tcomment="",
ltpostings=[ tpostings=[
Posting { Posting {
pstatus=False, pstatus=False,
paccount="expenses:vacation", paccount="expenses:vacation",
pamount=(Mixed [dollars 179.92]), pamount=(Mixed [dollars 179.92]),
pcomment="", pcomment="",
ptype=RegularPosting ptype=RegularPosting
}, },
Posting { Posting {
pstatus=False, pstatus=False,
paccount="assets:checking", paccount="assets:checking",
pamount=(Mixed [dollars (-179.92)]), pamount=(Mixed [dollars (-179.92)]),
pcomment="", pcomment="",
ptype=RegularPosting ptype=RegularPosting
} }
], ],
ltpreceding_comment_lines="" tpreceding_comment_lines=""
} }
, ,
Transaction { Transaction {
ltdate=parsedate "2007/01/02", tdate=parsedate "2007/01/02",
lteffectivedate=Nothing, teffectivedate=Nothing,
ltstatus=False, tstatus=False,
ltcode="*", tcode="*",
ltdescription="auto transfer to savings", tdescription="auto transfer to savings",
ltcomment="", tcomment="",
ltpostings=[ tpostings=[
Posting { Posting {
pstatus=False, pstatus=False,
paccount="assets:saving", paccount="assets:saving",
pamount=(Mixed [dollars 200]), pamount=(Mixed [dollars 200]),
pcomment="", pcomment="",
ptype=RegularPosting ptype=RegularPosting
}, },
Posting { Posting {
pstatus=False, pstatus=False,
paccount="assets:checking", paccount="assets:checking",
pamount=(Mixed [dollars (-200)]), pamount=(Mixed [dollars (-200)]),
pcomment="", pcomment="",
ptype=RegularPosting ptype=RegularPosting
} }
], ],
ltpreceding_comment_lines="" tpreceding_comment_lines=""
} }
, ,
Transaction { Transaction {
ltdate=parsedate "2007/01/03", tdate=parsedate "2007/01/03",
lteffectivedate=Nothing, teffectivedate=Nothing,
ltstatus=False, tstatus=False,
ltcode="*", tcode="*",
ltdescription="poquito mas", tdescription="poquito mas",
ltcomment="", tcomment="",
ltpostings=[ tpostings=[
Posting { Posting {
pstatus=False, pstatus=False,
paccount="expenses:food:dining", paccount="expenses:food:dining",
pamount=(Mixed [dollars 4.82]), pamount=(Mixed [dollars 4.82]),
pcomment="", pcomment="",
ptype=RegularPosting ptype=RegularPosting
}, },
Posting { Posting {
pstatus=False, pstatus=False,
paccount="assets:cash", paccount="assets:cash",
pamount=(Mixed [dollars (-4.82)]), pamount=(Mixed [dollars (-4.82)]),
pcomment="", pcomment="",
ptype=RegularPosting ptype=RegularPosting
} }
], ],
ltpreceding_comment_lines="" tpreceding_comment_lines=""
} }
, ,
Transaction { Transaction {
ltdate=parsedate "2007/01/03", tdate=parsedate "2007/01/03",
lteffectivedate=Nothing, teffectivedate=Nothing,
ltstatus=False, tstatus=False,
ltcode="*", tcode="*",
ltdescription="verizon", tdescription="verizon",
ltcomment="", tcomment="",
ltpostings=[ tpostings=[
Posting { Posting {
pstatus=False, pstatus=False,
paccount="expenses:phone", paccount="expenses:phone",
pamount=(Mixed [dollars 95.11]), pamount=(Mixed [dollars 95.11]),
pcomment="", pcomment="",
ptype=RegularPosting ptype=RegularPosting
}, },
Posting { Posting {
pstatus=False, pstatus=False,
paccount="assets:checking", paccount="assets:checking",
pamount=(Mixed [dollars (-95.11)]), pamount=(Mixed [dollars (-95.11)]),
pcomment="", pcomment="",
ptype=RegularPosting ptype=RegularPosting
} }
], ],
ltpreceding_comment_lines="" tpreceding_comment_lines=""
} }
, ,
Transaction { Transaction {
ltdate=parsedate "2007/01/03", tdate=parsedate "2007/01/03",
lteffectivedate=Nothing, teffectivedate=Nothing,
ltstatus=False, tstatus=False,
ltcode="*", tcode="*",
ltdescription="discover", tdescription="discover",
ltcomment="", tcomment="",
ltpostings=[ tpostings=[
Posting { Posting {
pstatus=False, pstatus=False,
paccount="liabilities:credit cards:discover", paccount="liabilities:credit cards:discover",
pamount=(Mixed [dollars 80]), pamount=(Mixed [dollars 80]),
pcomment="", pcomment="",
ptype=RegularPosting ptype=RegularPosting
}, },
Posting { Posting {
pstatus=False, pstatus=False,
paccount="assets:checking", paccount="assets:checking",
pamount=(Mixed [dollars (-80)]), pamount=(Mixed [dollars (-80)]),
pcomment="", pcomment="",
ptype=RegularPosting ptype=RegularPosting
} }
], ],
ltpreceding_comment_lines="" tpreceding_comment_lines=""
} }
] ]
[] []
[] []
"" ""
"" ""
(TOD 0 0) (TOD 0 0)
ledger7 = cacheLedger [] journal7 ledger7 = cacheLedger [] journal7
ledger8_str = unlines ledger8_str = unlines
["2008/1/1 test " ["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 a3 = Mixed $ amounts a1 ++ amounts a2
journalWithAmounts :: [String] -> Journal journalWithAmounts :: [String] -> Journal
journalWithAmounts as = journalWithAmounts as =
Journal Journal
[] []
[] []
[nullledgertxn{ltdescription=a,ltpostings=[nullrawposting{pamount=parse a}]} | a <- as] [nullledgertxn{tdescription=a,tpostings=[nullrawposting{pamount=parse a}]} | a <- as]
[] []
[] []
"" ""