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

rename LedgerTransaction to Transaction

Browse Source
This commit is contained in:
Simon Michael 2009-12-16 08:07:26 +00:00
parent 39fd143c84
commit 30b83bb105
16 changed files with 130 additions and 130 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
Commands/Add.hs
View File

@ -35,11 +35,11 @@ add _ args l
-- command-line arguments are used as the first transaction's description.
getAndAddTransactions :: Ledger -> [String] -> IO ()
getAndAddTransactions l args = do
l <- getTransaction l args >>= addTransaction l
l <- getTransaction l args >>= ledgerAddTransaction l
getAndAddTransactions l []
-- | Read a transaction from the command line, with history-aware prompting.
getTransaction :: Ledger -> [String] -> IO LedgerTransaction
getTransaction :: Ledger -> [String] -> IO Transaction
getTransaction l args = do
today <- getCurrentDay
datestr <- askFor "date"
@ -67,7 +67,7 @@ getTransaction l args = do
retry = do
hPutStrLn stderr $ "\n" ++ nonzerobalanceerror ++ ". Re-enter:"
getpostingsandvalidate
either (const retry) return $ balanceLedgerTransaction t
either (const retry) return $ balanceTransaction t
unless (null historymatches)
(do
hPutStrLn stderr "Similar transactions found, using the first for defaults:\n"
@ -125,8 +125,8 @@ askFor prompt def validator = do
-- | Append this transaction to the ledger's file. Also, to the ledger's
-- transaction list, but we don't bother updating the other fields - this
-- is enough to include new transactions in the history matching.
addTransaction :: Ledger -> LedgerTransaction -> IO Ledger
addTransaction l t = do
ledgerAddTransaction :: Ledger -> Transaction -> IO Ledger
ledgerAddTransaction l t = do
appendToLedgerFile l $ show t
putStrLn $ printf "\nAdded transaction to %s:" (filepath $ journal l)
putStrLn =<< registerFromString (show t)
@ -181,7 +181,7 @@ compareLedgerDescriptions s t = compareStrings s' t'
t' = simplify t
simplify = filter (not . (`elem` "0123456789"))
transactionsSimilarTo :: Ledger -> String -> [(Double,LedgerTransaction)]
transactionsSimilarTo :: Ledger -> String -> [(Double,Transaction)]
transactionsSimilarTo l s =
sortBy compareRelevanceAndRecency
$ filter ((> threshold).fst)

6
Commands/Convert.hs
View File

@ -6,7 +6,7 @@ format, and print it on stdout. See the manual for more details.
module Commands.Convert where
import Options (Opt(Debug))
import Version (versionstr)
import Ledger.Types (Ledger,AccountName,LedgerTransaction(..),Posting(..),PostingType(..))
import Ledger.Types (Ledger,AccountName,Transaction(..),Posting(..),PostingType(..))
import Ledger.Utils (strip, spacenonewline, restofline)
import Ledger.Parse (someamount, emptyCtx, ledgeraccountname)
import Ledger.Amount (nullmixedamt)
@ -237,7 +237,7 @@ printTxn debug rules rec = do
-- csv record conversion
transactionFromCsvRecord :: CsvRules -> CsvRecord -> LedgerTransaction
transactionFromCsvRecord :: CsvRules -> CsvRecord -> Transaction
transactionFromCsvRecord rules fields =
let
date = parsedate $ normaliseDate $ maybe "1900/1/1" (fields !!) (dateField rules)
@ -257,7 +257,7 @@ transactionFromCsvRecord rules fields =
| otherwise = "expenses:unknown"
(acct,newdesc) = identify (accountRules rules) unknownacct desc
in
LedgerTransaction {
Transaction {
ltdate=date,
lteffectivedate=Nothing,
ltstatus=status,

6
Commands/Print.hs
View File

@ -14,10 +14,10 @@ import System.IO.UTF8
-- | Print ledger transactions in standard format.
print' :: [Opt] -> [String] -> Ledger -> IO ()
print' opts args = putStr . showLedgerTransactions opts args
print' opts args = putStr . showTransactions opts args
showLedgerTransactions :: [Opt] -> [String] -> Ledger -> String
showLedgerTransactions opts args l = concatMap (showLedgerTransactionForPrint effective) txns
showTransactions :: [Opt] -> [String] -> Ledger -> String
showTransactions opts args l = concatMap (showTransactionForPrint effective) txns
where
txns = sortBy (comparing ltdate) $
ledger_txns $

18
Commands/UI.hs
View File

@ -221,7 +221,7 @@ updateData a@AppState{aopts=opts,aargs=args,aledger=l} =
case screen a of
BalanceScreen -> a{abuf=lines $ showBalanceReport opts [] l, aargs=[]}
RegisterScreen -> a{abuf=lines $ showRegisterReport opts args l}
PrintScreen -> a{abuf=lines $ showLedgerTransactions opts args l}
PrintScreen -> a{abuf=lines $ showTransactions opts args l}
backout :: AppState -> AppState
backout a | screen a == BalanceScreen = a
@ -231,9 +231,9 @@ drilldown :: AppState -> AppState
drilldown a =
case screen a of
BalanceScreen -> enter RegisterScreen a{aargs=[currentAccountName a]}
RegisterScreen -> scrollToLedgerTransaction e $ enter PrintScreen a
RegisterScreen -> scrollToTransaction e $ enter PrintScreen a
PrintScreen -> a
where e = currentLedgerTransaction a
where e = currentTransaction a
-- | Get the account name currently highlighted by the cursor on the
-- balance screen. Results undefined while on other screens.
@ -260,10 +260,10 @@ accountNameAt buf lineno = accountNameFromComponents anamecomponents
-- | If on the print screen, move the cursor to highlight the specified entry
-- (or a reasonable guess). Doesn't work.
scrollToLedgerTransaction :: LedgerTransaction -> AppState -> AppState
scrollToLedgerTransaction e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a
scrollToTransaction :: Transaction -> AppState -> AppState
scrollToTransaction e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a
where
entryfirstline = head $ lines $ showLedgerTransaction e
entryfirstline = head $ lines $ showTransaction e
halfph = pageHeight a `div` 2
y = fromMaybe 0 $ findIndex (== entryfirstline) buf
sy = max 0 $ y - halfph
@ -272,8 +272,8 @@ scrollToLedgerTransaction e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy
-- | Get the entry containing the transaction currently highlighted by the
-- cursor on the register screen (or best guess). Results undefined while
-- on other screens. Doesn't work.
currentLedgerTransaction :: AppState -> LedgerTransaction
currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = transactionContainingLedgerPosting a t
currentTransaction :: AppState -> Transaction
currentTransaction a@AppState{aledger=l,abuf=buf} = transactionContainingLedgerPosting a t
where
t = safehead nulltxn $ filter ismatch $ ledgerLedgerPostings l
ismatch t = tdate t == parsedate (take 10 datedesc)
@ -286,7 +286,7 @@ currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = transactionContainingL
-- | Get the entry which contains the given transaction.
-- Will raise an error if there are problems.
transactionContainingLedgerPosting :: AppState -> LedgerPosting -> LedgerTransaction
transactionContainingLedgerPosting :: AppState -> LedgerPosting -> Transaction
transactionContainingLedgerPosting AppState{aledger=l} t = ledger_txns (journal l) !! tnum t
-- renderers

16
Commands/Web.hs
View File

@ -36,7 +36,7 @@ import qualified Hack.Contrib.Request (inputs, params, path)
import qualified Hack.Contrib.Response (redirect)
-- import qualified Text.XHtml.Strict as H
import Commands.Add (addTransaction)
import Commands.Add (ledgerAddTransaction)
import Commands.Balance
import Commands.Histogram
import Commands.Print
@ -131,7 +131,7 @@ server opts args l =
get "/balance" $ command [] showBalanceReport -- String -> ReaderT Env (StateT Response IO) () -> State Loli ()
get "/register" $ command [] showRegisterReport
get "/histogram" $ command [] showHistogram
get "/transactions" $ ledgerpage [] l'' (showLedgerTransactions opts' args')
get "/transactions" $ ledgerpage [] l'' (showTransactions opts' args')
post "/transactions" $ handleAddform l''
get "/env" $ getenv >>= (text . show)
get "/params" $ getenv >>= (text . show . Hack.Contrib.Request.params)
@ -280,7 +280,7 @@ handleAddform l = do
d <- io getCurrentDay
handle $ validate env d
where
validate :: Hack.Env -> Day -> Failing LedgerTransaction
validate :: Hack.Env -> Day -> Failing Transaction
validate env today =
let inputs = Hack.Contrib.Request.inputs env
date = fromMaybe "" $ lookup "date" inputs
@ -302,7 +302,7 @@ handleAddform l = do
validateAmt2 _ = []
amt1' = either (const missingamt) id $ parse someamount "" amt1
amt2' = either (const missingamt) id $ parse someamount "" amt2
t = LedgerTransaction {
t = Transaction {
ltdate = parsedate $ fixSmartDateStr today date
,lteffectivedate=Nothing
,ltstatus=False
@ -315,7 +315,7 @@ handleAddform l = do
]
,ltpreceding_comment_lines=""
}
(t', berr) = case balanceLedgerTransaction t of
(t', berr) = case balanceTransaction t of
Right t'' -> (t'', [])
Left e -> (t, [e])
errs = concat [
@ -331,10 +331,10 @@ handleAddform l = do
False -> Failure errs
True -> Success t'
handle :: Failing LedgerTransaction -> AppUnit
handle :: Failing Transaction -> AppUnit
handle (Failure errs) = hsp errs addform
handle (Success t) = do
io $ addTransaction l t >> reload l
ledgerpage [msg] l (showLedgerTransactions [] [])
io $ ledgerAddTransaction l t >> reload l
ledgerpage [msg] l (showTransactions [] [])
where msg = printf "Added transaction:\n%s" (show t)

4
Ledger.hs
View File

@ -13,7 +13,7 @@ module Ledger (
module Ledger.Commodity,
module Ledger.Dates,
module Ledger.IO,
module Ledger.LedgerTransaction,
module Ledger.Transaction,
module Ledger.Ledger,
module Ledger.Parse,
module Ledger.Journal,
@ -30,7 +30,7 @@ import Ledger.Amount
import Ledger.Commodity
import Ledger.Dates
import Ledger.IO
import Ledger.LedgerTransaction
import Ledger.Transaction
import Ledger.Ledger
import Ledger.Parse
import Ledger.Journal

26
Ledger/Journal.hs
View File

@ -13,7 +13,7 @@ import Ledger.Utils
import Ledger.Types
import Ledger.AccountName
import Ledger.Amount
import Ledger.LedgerTransaction (ledgerTransactionWithDate)
import Ledger.Transaction (ledgerTransactionWithDate)
import Ledger.LedgerPosting
import Ledger.Posting
import Ledger.TimeLog
@ -40,8 +40,8 @@ journalEmpty = Journal { modifier_txns = []
, filereadtime = TOD 0 0
}
addLedgerTransaction :: LedgerTransaction -> Journal -> Journal
addLedgerTransaction t l0 = l0 { ledger_txns = t : ledger_txns l0 }
addTransaction :: Transaction -> Journal -> Journal
addTransaction t l0 = l0 { ledger_txns = t : ledger_txns l0 }
addModifierTransaction :: ModifierTransaction -> Journal -> Journal
addModifierTransaction mt l0 = l0 { modifier_txns = mt : modifier_txns l0 }
@ -57,7 +57,7 @@ addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries
journalLedgerPostings :: Journal -> [LedgerPosting]
journalLedgerPostings = txnsof . ledger_txns
where txnsof ts = concatMap flattenLedgerTransaction $ zip ts [1..]
where txnsof ts = concatMap flattenTransaction $ zip ts [1..]
journalAccountNamesUsed :: Journal -> [AccountName]
journalAccountNamesUsed = accountNamesFromLedgerPostings . journalLedgerPostings
@ -75,20 +75,20 @@ filterJournal :: DateSpan -> [String] -> Maybe Bool -> Bool -> Journal -> Journa
filterJournal span pats clearedonly realonly =
filterJournalPostingsByRealness realonly .
filterJournalPostingsByClearedStatus clearedonly .
filterJournalLedgerTransactionsByDate span .
filterJournalLedgerTransactionsByDescription pats
filterJournalTransactionsByDate span .
filterJournalTransactionsByDescription pats
-- | Keep only ledger transactions whose description matches the description patterns.
filterJournalLedgerTransactionsByDescription :: [String] -> Journal -> Journal
filterJournalLedgerTransactionsByDescription pats (Journal ms ps ts tls hs f fp ft) =
filterJournalTransactionsByDescription :: [String] -> Journal -> Journal
filterJournalTransactionsByDescription pats (Journal ms ps ts tls hs f fp ft) =
Journal ms ps (filter matchdesc ts) tls hs f fp ft
where matchdesc = matchpats pats . ltdescription
-- | Keep only ledger transactions which fall between begin and end dates.
-- We include transactions on the begin date and exclude transactions on the end
-- date, like ledger. An empty date string means no restriction.
filterJournalLedgerTransactionsByDate :: DateSpan -> Journal -> Journal
filterJournalLedgerTransactionsByDate (DateSpan begin end) (Journal ms ps ts tls hs f fp ft) =
filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal
filterJournalTransactionsByDate (DateSpan begin end) (Journal ms ps ts tls hs f fp ft) =
Journal ms ps (filter matchdate ts) tls hs f fp ft
where
matchdate t = maybe True (ltdate t>=) begin && maybe True (ltdate t<) end
@ -106,14 +106,14 @@ filterJournalPostingsByRealness :: Bool -> Journal -> Journal
filterJournalPostingsByRealness False l = l
filterJournalPostingsByRealness True (Journal mts pts ts tls hs f fp ft) =
Journal mts pts (map filtertxns ts) tls hs f fp ft
where filtertxns t@LedgerTransaction{ltpostings=ps} = t{ltpostings=filter isReal ps}
where filtertxns t@Transaction{ltpostings=ps} = t{ltpostings=filter isReal ps}
-- | Strip out any postings to accounts deeper than the specified depth
-- (and any ledger transactions which have no postings as a result).
filterJournalPostingsByDepth :: Int -> Journal -> Journal
filterJournalPostingsByDepth depth (Journal mts pts ts tls hs f fp ft) =
Journal mts pts (filter (not . null . ltpostings) $ map filtertxns ts) tls hs f fp ft
where filtertxns t@LedgerTransaction{ltpostings=ps} =
where filtertxns t@Transaction{ltpostings=ps} =
t{ltpostings=filter ((<= depth) . accountNameLevel . paccount) ps}
-- | Keep only ledger transactions which affect accounts matched by the account patterns.
@ -138,7 +138,7 @@ journalSelectingDate EffectiveDate rl =
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
where
fixledgertransaction (LedgerTransaction d ed s c de co ts pr) = LedgerTransaction 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
fixrawposting (Posting s ac a c t) = Posting s ac (fixmixedamount a) c t
fixmixedamount (Mixed as) = Mixed $ map fixamount as

2
Ledger/Ledger.hs
View File

@ -2,7 +2,7 @@
A compound data type for efficiency. A 'Ledger' caches information derived
from a 'Journal' for easier querying. Also it typically has had
uninteresting 'LedgerTransaction's and 'Posting's filtered out. It
uninteresting 'Transaction's and 'Posting's filtered out. It
contains:
- the original unfiltered 'Journal'

10
Ledger/LedgerPosting.hs
View File

@ -1,7 +1,7 @@
{-|
A compound data type for efficiency. A 'LedgerPosting' is a 'Posting' with
its parent 'LedgerTransaction' \'s date and description attached. The
its parent 'Transaction' \'s date and description attached. The
\"transaction\" term is pretty ingrained in the code, docs and with users,
so we've kept it. These are what we work with most of the time when doing
reports.
@ -13,7 +13,7 @@ where
import Ledger.Dates
import Ledger.Utils
import Ledger.Types
import Ledger.LedgerTransaction (showAccountName)
import Ledger.Transaction (showAccountName)
import Ledger.Amount
@ -25,11 +25,11 @@ showLedgerPosting (LedgerPosting _ stat d desc a amt ttype) =
where s = if stat then " *" else ""
a' = showAccountName Nothing ttype a
-- | Convert a 'LedgerTransaction' 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
-- be unique per entry.
flattenLedgerTransaction :: (LedgerTransaction, Int) -> [LedgerPosting]
flattenLedgerTransaction (LedgerTransaction d _ s _ desc _ ps _, n) =
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]

10
Ledger/Parse.hs
View File

@ -18,7 +18,7 @@ import Ledger.Types
import Ledger.Dates
import Ledger.AccountName (accountNameFromComponents,accountNameComponents)
import Ledger.Amount
import Ledger.LedgerTransaction
import Ledger.Transaction
import Ledger.Posting
import Ledger.Journal
import System.FilePath(takeDirectory,combine)
@ -86,7 +86,7 @@ ledgerFile = do items <- many ledgerItem
-- character, excepting transactions versus empty (blank or
-- comment-only) lines, can use choice w/o try
ledgerItem = choice [ ledgerDirective
, liftM (return . addLedgerTransaction) ledgerTransaction
, liftM (return . addTransaction) ledgerTransaction
, liftM (return . addModifierTransaction) ledgerModifierTransaction
, liftM (return . addPeriodicTransaction) ledgerPeriodicTransaction
, liftM (return . addHistoricalPrice) ledgerHistoricalPrice
@ -307,7 +307,7 @@ ledgerDefaultYear = do
-- | Try to parse a ledger entry. If we successfully parse an entry, ensure it is balanced,
-- and if we cannot, raise an error.
ledgerTransaction :: GenParser Char LedgerFileCtx LedgerTransaction
ledgerTransaction :: GenParser Char LedgerFileCtx Transaction
ledgerTransaction = do
date <- ledgerdate <?> "transaction"
edate <- try (ledgereffectivedate <?> "effective date") <|> return Nothing
@ -317,8 +317,8 @@ ledgerTransaction = do
comment <- ledgercomment <|> return ""
restofline
postings <- ledgerpostings
let t = LedgerTransaction date edate status code description comment postings ""
case balanceLedgerTransaction t of
let t = Transaction date edate status code description comment postings ""
case balanceTransaction t of
Right t' -> return t'
Left err -> fail err

2
Ledger/Posting.hs
View File

@ -1,7 +1,7 @@
{-|
A 'Posting' represents a 'MixedAmount' being added to or subtracted from a
single 'Account'. Each 'LedgerTransaction' contains two or more postings
single 'Account'. Each 'Transaction' contains two or more postings
which should add up to 0.
Generally, we use these with the ledger transaction's date and description

12
Ledger/TimeLog.hs
View File

@ -2,7 +2,7 @@
A 'TimeLogEntry' is a clock-in, clock-out, or other directive in a timelog
file (see timeclock.el or the command-line version). These can be
converted to 'LedgerTransactions' and queried like a ledger.
converted to 'Transactions' and queried like a ledger.
-}
@ -12,7 +12,7 @@ import Ledger.Utils
import Ledger.Types
import Ledger.Dates
import Ledger.Commodity
import Ledger.LedgerTransaction
import Ledger.Transaction
instance Show TimeLogEntry where
show t = printf "%s %s %s" (show $ tlcode t) (show $ tldatetime t) (tlcomment t)
@ -35,7 +35,7 @@ instance Read TimeLogCode where
-- | Convert time log entries to ledger transactions. When there is no
-- clockout, add one with the provided current time. Sessions crossing
-- midnight are split into days to give accurate per-day totals.
entriesFromTimeLogEntries :: LocalTime -> [TimeLogEntry] -> [LedgerTransaction]
entriesFromTimeLogEntries :: LocalTime -> [TimeLogEntry] -> [Transaction]
entriesFromTimeLogEntries _ [] = []
entriesFromTimeLogEntries now [i]
| odate > idate = entryFromTimeLogInOut i o' : entriesFromTimeLogEntries now [i',o]
@ -59,13 +59,13 @@ entriesFromTimeLogEntries now (i:o:rest)
-- | Convert a timelog clockin and clockout entry to an equivalent ledger
-- entry, representing the time expenditure. Note this entry is not balanced,
-- since we omit the \"assets:time\" transaction for simpler output.
entryFromTimeLogInOut :: TimeLogEntry -> TimeLogEntry -> LedgerTransaction
entryFromTimeLogInOut :: TimeLogEntry -> TimeLogEntry -> Transaction
entryFromTimeLogInOut i o
| otime >= itime = t
| otherwise =
error $ "clock-out time less than clock-in time in:\n" ++ showLedgerTransaction t
error $ "clock-out time less than clock-in time in:\n" ++ showTransaction t
where
t = LedgerTransaction {
t = Transaction {
ltdate = idate,
lteffectivedate = Nothing,
ltstatus = True,

42
Ledger/LedgerTransaction.hs → Ledger/Transaction.hs
View File

@ -1,11 +1,11 @@
{-|
A 'LedgerTransaction' represents a regular transaction in the ledger
A 'Transaction' represents a regular transaction in the ledger
file. It normally contains two or more balanced 'Posting's.
-}
module Ledger.LedgerTransaction
module Ledger.Transaction
where
import Ledger.Utils
import Ledger.Types
@ -14,7 +14,7 @@ import Ledger.Posting
import Ledger.Amount
instance Show LedgerTransaction where show = showLedgerTransactionUnelided
instance Show Transaction where show = showTransactionUnelided
instance Show ModifierTransaction where
show t = "= " ++ mtvalueexpr t ++ "\n" ++ unlines (map show (mtpostings t))
@ -22,8 +22,8 @@ instance Show ModifierTransaction where
instance Show PeriodicTransaction where
show t = "~ " ++ ptperiodicexpr t ++ "\n" ++ unlines (map show (ptpostings t))
nullledgertxn :: LedgerTransaction
nullledgertxn = LedgerTransaction {
nullledgertxn :: Transaction
nullledgertxn = Transaction {
ltdate=parsedate "1900/1/1",
lteffectivedate=Nothing,
ltstatus=False,
@ -50,17 +50,17 @@ pamtwidth = 11
pcommentwidth = no limit -- 22
@
-}
showLedgerTransaction :: LedgerTransaction -> String
showLedgerTransaction = showLedgerTransaction' True False
showTransaction :: Transaction -> String
showTransaction = showTransaction' True False
showLedgerTransactionUnelided :: LedgerTransaction -> String
showLedgerTransactionUnelided = showLedgerTransaction' False False
showTransactionUnelided :: Transaction -> String
showTransactionUnelided = showTransaction' False False
showLedgerTransactionForPrint :: Bool -> LedgerTransaction -> String
showLedgerTransactionForPrint effective = showLedgerTransaction' False effective
showTransactionForPrint :: Bool -> Transaction -> String
showTransactionForPrint effective = showTransaction' False effective
showLedgerTransaction' :: Bool -> Bool -> LedgerTransaction -> String
showLedgerTransaction' elide effective t =
showTransaction' :: Bool -> Bool -> Transaction -> String
showTransaction' elide effective t =
unlines $ [description] ++ showpostings (ltpostings t) ++ [""]
where
description = concat [date, status, code, desc, comment]
@ -73,7 +73,7 @@ showLedgerTransaction' elide effective t =
showdate = printf "%-10s" . showDate
showedate = printf "=%s" . showdate
showpostings ps
| elide && length ps > 1 && isLedgerTransactionBalanced t
| elide && length ps > 1 && isTransactionBalanced t
= map showposting (init ps) ++ [showpostingnoamt (last ps)]
| otherwise = map showposting ps
where
@ -97,8 +97,8 @@ showAccountName w = fmt
parenthesise s = "("++s++")"
bracket s = "["++s++"]"
isLedgerTransactionBalanced :: LedgerTransaction -> Bool
isLedgerTransactionBalanced (LedgerTransaction {ltpostings=ps}) =
isTransactionBalanced :: Transaction -> Bool
isTransactionBalanced (Transaction {ltpostings=ps}) =
all (isReallyZeroMixedAmount . costOfMixedAmount . sum . map pamount)
[filter isReal ps, filter isBalancedVirtual ps]
@ -107,10 +107,10 @@ isLedgerTransactionBalanced (LedgerTransaction {ltpostings=ps}) =
-- transaction without an amount. The auto-filled balance will be
-- converted to cost basis if possible. If the entry can not be balanced,
-- return an error message instead.
balanceLedgerTransaction :: LedgerTransaction -> Either String LedgerTransaction
balanceLedgerTransaction t@LedgerTransaction{ltpostings=ps}
balanceTransaction :: Transaction -> Either String Transaction
balanceTransaction t@Transaction{ltpostings=ps}
| length missingamounts' > 1 = Left $ printerr "could not balance this transaction, too many missing amounts"
| not $ isLedgerTransactionBalanced t' = Left $ printerr nonzerobalanceerror
| not $ isTransactionBalanced t' = Left $ printerr nonzerobalanceerror
| otherwise = Right t'
where
(withamounts, missingamounts) = partition hasAmount $ filter isReal ps
@ -122,12 +122,12 @@ balanceLedgerTransaction t@LedgerTransaction{ltpostings=ps}
balance p | isReal p && not (hasAmount p) = p{pamount = costOfMixedAmount (-otherstotal)}
| otherwise = p
where otherstotal = sum $ map pamount withamounts
printerr s = printf "%s:\n%s" s (showLedgerTransactionUnelided t)
printerr s = printf "%s:\n%s" s (showTransactionUnelided t)
nonzerobalanceerror = "could not balance this transaction, amounts do not add up to zero"
-- | Convert the primary date to either the actual or effective date.
ledgerTransactionWithDate :: WhichDate -> LedgerTransaction -> LedgerTransaction
ledgerTransactionWithDate :: WhichDate -> Transaction -> Transaction
ledgerTransactionWithDate ActualDate t = t
ledgerTransactionWithDate EffectiveDate t = t{ltdate=fromMaybe (ltdate t) (lteffectivedate t)}

8
Ledger/Types.hs
View File

@ -6,11 +6,11 @@ Here is an overview of the hledger data model as of 0.8:
Ledger -- hledger's ledger, a journal file plus various cached data
Journal -- representation of the journal file
[Transaction] (LedgerTransaction) -- journal transactions, with date, description and..
[Transaction] -- journal transactions, with date, description and..
[Posting] -- one or more journal postings
[LedgerPosting] -- all postings combined with their transaction info
Tree AccountName -- the tree of all account names
Map AccountName AccountInfo -- account info in a map for easy lookup by name
Map AccountName Account -- per-account ledger postings and balances for easy lookup
For more detailed documentation on each type, see the corresponding modules.
@ -87,7 +87,7 @@ data PeriodicTransaction = PeriodicTransaction {
ptpostings :: [Posting]
} deriving (Eq)
data LedgerTransaction = LedgerTransaction {
data Transaction = Transaction {
ltdate :: Day,
lteffectivedate :: Maybe Day,
ltstatus :: Bool,
@ -115,7 +115,7 @@ data HistoricalPrice = HistoricalPrice {
data Journal = Journal {
modifier_txns :: [ModifierTransaction],
periodic_txns :: [PeriodicTransaction],
ledger_txns :: [LedgerTransaction],
ledger_txns :: [Transaction],
open_timelog_entries :: [TimeLogEntry],
historical_prices :: [HistoricalPrice],
final_comment_lines :: String,

82
Tests.hs
View File

@ -306,20 +306,20 @@ tests = [
]
,"balanceLedgerTransaction" ~: do
,"balanceTransaction" ~: do
assertBool "detect unbalanced entry, sign error"
(isLeft $ balanceLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") Nothing False "" "test" ""
(isLeft $ balanceTransaction
(Transaction (parsedate "2007/01/28") Nothing False "" "test" ""
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting,
Posting False "b" (Mixed [dollars 1]) "" RegularPosting
] ""))
assertBool "detect unbalanced entry, multiple missing amounts"
(isLeft $ balanceLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") Nothing False "" "test" ""
(isLeft $ balanceTransaction
(Transaction (parsedate "2007/01/28") Nothing False "" "test" ""
[Posting False "a" missingamt "" RegularPosting,
Posting False "b" missingamt "" RegularPosting
] ""))
let e = balanceLedgerTransaction (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "test" ""
let e = balanceTransaction (Transaction (parsedate "2007/01/28") Nothing False "" "test" ""
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting,
Posting False "b" missingamt "" RegularPosting
] "")
@ -404,46 +404,46 @@ tests = [
"assets" `isAccountNamePrefixOf` "assets:bank:checking" `is` True
"my assets" `isAccountNamePrefixOf` "assets:bank" `is` False
,"isLedgerTransactionBalanced" ~: do
,"isTransactionBalanced" ~: do
assertBool "detect balanced"
(isLedgerTransactionBalanced
(LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" ""
(isTransactionBalanced
(Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting
] ""))
assertBool "detect unbalanced"
(not $ isLedgerTransactionBalanced
(LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" ""
(not $ isTransactionBalanced
(Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
,Posting False "c" (Mixed [dollars (-1.01)]) "" RegularPosting
] ""))
assertBool "detect unbalanced, one posting"
(not $ isLedgerTransactionBalanced
(LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" ""
(not $ isTransactionBalanced
(Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
] ""))
assertBool "one zero posting is considered balanced for now"
(isLedgerTransactionBalanced
(LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" ""
(isTransactionBalanced
(Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 0]) "" RegularPosting
] ""))
assertBool "virtual postings don't need to balance"
(isLedgerTransactionBalanced
(LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" ""
(isTransactionBalanced
(Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting
,Posting False "d" (Mixed [dollars 100]) "" VirtualPosting
] ""))
assertBool "balanced virtual postings need to balance among themselves"
(not $ isLedgerTransactionBalanced
(LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" ""
(not $ isTransactionBalanced
(Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting
,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting
] ""))
assertBool "balanced virtual postings need to balance among themselves (2)"
(isLedgerTransactionBalanced
(LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" ""
(isTransactionBalanced
(Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting
,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting
@ -508,7 +508,7 @@ tests = [
do
let args = ["expenses"]
l <- sampleledgerwithopts [] args
showLedgerTransactions [] args l `is` unlines
showTransactions [] args l `is` unlines
["2008/06/03 * eat & shop"
," expenses:food $1"
," expenses:supplies $1"
@ -519,7 +519,7 @@ tests = [
, "print report with depth arg" ~:
do
l <- sampleledger
showLedgerTransactions [Depth "2"] [] l `is` unlines
showTransactions [Depth "2"] [] l `is` unlines
["2008/01/01 income"
," income:salary $-1"
,""
@ -670,7 +670,7 @@ tests = [
,"show hours" ~: show (hours 1) ~?= "1.0h"
,"showLedgerTransaction" ~: do
,"showTransaction" ~: do
assertEqual "show a balanced transaction, eliding last amount"
(unlines
["2007/01/28 coopportunity"
@ -678,8 +678,8 @@ tests = [
," assets:checking"
,""
])
(showLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
(showTransaction
(Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting
,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting
] ""))
@ -690,8 +690,8 @@ tests = [
," assets:checking $-47.18"
,""
])
(showLedgerTransactionUnelided
(LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
(showTransactionUnelided
(Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting
,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting
] ""))
@ -703,8 +703,8 @@ tests = [
," assets:checking $-47.19"
,""
])
(showLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
(showTransaction
(Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting
,Posting False "assets:checking" (Mixed [dollars (-47.19)]) "" RegularPosting
] ""))
@ -714,8 +714,8 @@ tests = [
," expenses:food:groceries $47.18"
,""
])
(showLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
(showTransaction
(Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting
] ""))
assertEqual "show a transaction with one posting and a missing amount"
@ -724,8 +724,8 @@ tests = [
," expenses:food:groceries "
,""
])
(showLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
(showTransaction
(Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" missingamt "" RegularPosting
] ""))
@ -916,7 +916,7 @@ entry1_str = unlines
]
entry1 =
LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting,
Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting] ""
@ -1064,7 +1064,7 @@ journal7 = Journal
[]
[]
[
LedgerTransaction {
Transaction {
ltdate=parsedate "2007/01/01",
lteffectivedate=Nothing,
ltstatus=False,
@ -1090,7 +1090,7 @@ journal7 = Journal
ltpreceding_comment_lines=""
}
,
LedgerTransaction {
Transaction {
ltdate=parsedate "2007/02/01",
lteffectivedate=Nothing,
ltstatus=False,
@ -1116,7 +1116,7 @@ journal7 = Journal
ltpreceding_comment_lines=""
}
,
LedgerTransaction {
Transaction {
ltdate=parsedate "2007/01/02",
lteffectivedate=Nothing,
ltstatus=False,
@ -1142,7 +1142,7 @@ journal7 = Journal
ltpreceding_comment_lines=""
}
,
LedgerTransaction {
Transaction {
ltdate=parsedate "2007/01/03",
lteffectivedate=Nothing,
ltstatus=False,
@ -1168,7 +1168,7 @@ journal7 = Journal
ltpreceding_comment_lines=""
}
,
LedgerTransaction {
Transaction {
ltdate=parsedate "2007/01/03",
lteffectivedate=Nothing,
ltstatus=False,
@ -1194,7 +1194,7 @@ journal7 = Journal
ltpreceding_comment_lines=""
}
,
LedgerTransaction {
Transaction {
ltdate=parsedate "2007/01/03",
lteffectivedate=Nothing,
ltstatus=False,

4
hledger.cabal
View File

@ -50,7 +50,7 @@ library
Ledger.Commodity
Ledger.Dates
Ledger.IO
Ledger.LedgerTransaction
Ledger.Transaction
Ledger.Journal
Ledger.Ledger
Ledger.Posting
@ -89,7 +89,7 @@ executable hledger
Ledger.Commodity
Ledger.Dates
Ledger.IO
Ledger.LedgerTransaction
Ledger.Transaction
Ledger.Ledger
Ledger.Parse
Ledger.Journal