rename LedgerEntry to Entry

This commit is contained in:
Simon Michael 2008-10-03 02:37:19 +00:00
parent 9ca02e21e4
commit 3aa656ba69
10 changed files with 41 additions and 41 deletions

View File

@ -11,7 +11,7 @@ module Ledger (
module Ledger.Amount,
module Ledger.AccountName,
module Ledger.RawTransaction,
module Ledger.LedgerEntry,
module Ledger.Entry,
module Ledger.TimeLog,
module Ledger.Transaction,
-- module Ledger.RawLedger,
@ -26,7 +26,7 @@ import Ledger.Currency
import Ledger.Amount
import Ledger.AccountName
import Ledger.RawTransaction
import Ledger.LedgerEntry
import Ledger.Entry
import Ledger.TimeLog
import Ledger.Transaction
import Ledger.RawLedger

View File

@ -12,7 +12,7 @@ import Ledger.Utils
import Ledger.Types
import Ledger.AccountName
import Ledger.Amount
import Ledger.LedgerEntry
import Ledger.Entry
import Ledger.RawTransaction
import Ledger.Transaction

View File

@ -1,11 +1,11 @@
{-|
A 'LedgerEntry' represents a normal entry in the ledger file. It contains
An 'Entry' represents a normal entry in the ledger file. It contains
two or more 'RawTransaction's which balance.
-}
module Ledger.LedgerEntry
module Ledger.Entry
where
import Ledger.Utils
import Ledger.Types
@ -13,7 +13,7 @@ import Ledger.RawTransaction
import Ledger.Amount
instance Show LedgerEntry where show = showEntryDescription
instance Show Entry where show = showEntryDescription
{-
Helpers for the register report. A register entry is displayed as two
@ -38,11 +38,11 @@ showDate d = printf "%-10s" d
showDescription s = printf "%-20s" (elideRight 20 s)
-- | quick & dirty: checks entry's 0 balance only to 8 places
isEntryBalanced :: LedgerEntry -> Bool
isEntryBalanced :: Entry -> Bool
isEntryBalanced = ((0::Double)==) . read . printf "%0.8f" . quantity . sumLedgerTransactions . etransactions
autofillEntry :: LedgerEntry -> LedgerEntry
autofillEntry e@(LedgerEntry _ _ _ _ _ ts _) =
autofillEntry :: Entry -> Entry
autofillEntry e@(Entry _ _ _ _ _ ts _) =
let e' = e{etransactions=autofillTransactions ts} in
case (isEntryBalanced e') of
True -> e'
@ -64,7 +64,7 @@ pamtwidth = 11
pcommentwidth = no limit -- 22
@
-}
showEntry :: LedgerEntry -> String
showEntry :: Entry -> String
showEntry e =
unlines $ [precedingcomment ++ description] ++ (showtxns $ etransactions e) ++ [""]
where
@ -84,12 +84,12 @@ showEntry e =
showaccountname s = printf "%-34s" s
showcomment s = if (length s) > 0 then " ; "++s else ""
showEntries :: [LedgerEntry] -> String
showEntries :: [Entry] -> String
showEntries = concatMap showEntry
entrySetPrecision :: Int -> LedgerEntry -> LedgerEntry
entrySetPrecision p (LedgerEntry d s c desc comm ts prec) =
LedgerEntry d s c desc comm (map (ledgerTransactionSetPrecision p) ts) prec
entrySetPrecision :: Int -> Entry -> Entry
entrySetPrecision p (Entry d s c desc comm ts prec) =
Entry d s c desc comm (map (ledgerTransactionSetPrecision p) ts) prec
-- modifier & periodic entries

View File

@ -16,13 +16,13 @@ import Ledger.Account
import Ledger.AccountName
import Ledger.Transaction
import Ledger.RawLedger
import Ledger.LedgerEntry
import Ledger.Entry
rawLedgerTransactions :: RawLedger -> [Transaction]
rawLedgerTransactions = txns . entries
where
txns :: [LedgerEntry] -> [Transaction]
txns :: [Entry] -> [Transaction]
txns es = concat $ map flattenEntry $ zip es (iterate (+1) 1)
rawLedgerAccountNamesUsed :: RawLedger -> [AccountName]
@ -78,13 +78,13 @@ filterLedgerEntries :: (Regex,Regex) -> RawLedger -> RawLedger
filterLedgerEntries (acctpat,descpat) (RawLedger ms ps es f) =
RawLedger ms ps filteredentries f
where
filteredentries :: [LedgerEntry]
filteredentries :: [Entry]
filteredentries = (filter matchdesc $ filter (any matchtxn . etransactions) es)
matchtxn :: RawTransaction -> Bool
matchtxn t = case matchRegex acctpat (taccount t) of
Nothing -> False
otherwise -> True
matchdesc :: LedgerEntry -> Bool
matchdesc :: Entry -> Bool
matchdesc e = case matchRegex descpat (edescription e) of
Nothing -> False
otherwise -> True
@ -96,7 +96,7 @@ filterLedgerTransactions :: (Regex,Regex) -> RawLedger -> RawLedger
filterLedgerTransactions (acctpat,descpat) (RawLedger ms ps es f) =
RawLedger ms ps (map filterentrytxns es) f
where
filterentrytxns l@(LedgerEntry _ _ _ _ _ ts _) = l{etransactions=filter matchtxn ts}
filterentrytxns l@(Entry _ _ _ _ _ ts _) = l{etransactions=filter matchtxn ts}
matchtxn t = case matchRegex acctpat (taccount t) of
Nothing -> False
otherwise -> True

View File

@ -112,7 +112,7 @@ import System.IO
import Ledger.Utils
import Ledger.Types
import Ledger.LedgerEntry (autofillEntry)
import Ledger.Entry (autofillEntry)
import Ledger.Currency (getcurrency)
import Ledger.TimeLog (ledgerFromTimeLog)
@ -210,7 +210,7 @@ ledgerperiodicentry = do
transactions <- ledgertransactions
return (PeriodicEntry periodexpr transactions)
ledgerentry :: Parser LedgerEntry
ledgerentry :: Parser Entry
ledgerentry = do
preceding <- ledgernondatalines
date <- ledgerdate <?> "entry"
@ -223,7 +223,7 @@ ledgerentry = do
comment <- ledgercomment
restofline
transactions <- ledgertransactions
return $ autofillEntry $ LedgerEntry date status code description comment transactions (unlines preceding)
return $ autofillEntry $ Entry date status code description comment transactions (unlines preceding)
ledgerdate :: Parser String
ledgerdate = do

View File

@ -12,7 +12,7 @@ import qualified Data.Map as Map
import Ledger.Utils
import Ledger.Types
import Ledger.AccountName
import Ledger.LedgerEntry
import Ledger.Entry
instance Show RawLedger where

View File

@ -12,7 +12,7 @@ import Ledger.Types
import Ledger.Currency
import Ledger.Amount
import Ledger.RawTransaction
import Ledger.LedgerEntry
import Ledger.Entry
import Ledger.RawLedger
instance Show TimeLogEntry where
@ -25,14 +25,14 @@ ledgerFromTimeLog :: TimeLog -> RawLedger
ledgerFromTimeLog tl =
RawLedger [] [] (entriesFromTimeLogEntries $ timelog_entries tl) ""
entriesFromTimeLogEntries :: [TimeLogEntry] -> [LedgerEntry]
entriesFromTimeLogEntries :: [TimeLogEntry] -> [Entry]
entriesFromTimeLogEntries [clockin] =
entriesFromTimeLogEntries [clockin, clockoutNowEntry]
entriesFromTimeLogEntries [clockin,clockout] =
[
LedgerEntry {
Entry {
edate = indate,
estatus = True,
ecode = "",

View File

@ -1,6 +1,6 @@
{-|
A 'Transaction' is a 'RawTransaction' with its parent 'LedgerEntry' \'s
A 'Transaction' is a 'RawTransaction' with its parent 'Entry' \'s
date and description attached, for easier querying.
-}
@ -10,7 +10,7 @@ where
import Ledger.Utils
import Ledger.Types
import Ledger.AccountName
import Ledger.LedgerEntry
import Ledger.Entry
import Ledger.RawTransaction
import Ledger.Amount
import Ledger.Currency
@ -20,11 +20,11 @@ instance Show Transaction where
show (Transaction eno d desc a amt) =
unwords [d,desc,a,show amt]
-- | Convert a 'LedgerEntry' to two or more 'Transaction's. An id number
-- | Convert a 'Entry' to two or more 'Transaction's. An id number
-- is attached to the transactions to preserve their grouping - it should
-- be unique per entry.
flattenEntry :: (LedgerEntry, Int) -> [Transaction]
flattenEntry (LedgerEntry d _ _ desc _ ts _, e) =
flattenEntry :: (Entry, Int) -> [Transaction]
flattenEntry (Entry d _ _ desc _ ts _, e) =
[Transaction e d desc (taccount t) (tamount t) | t <- ts]
transactionSetPrecision :: Int -> Transaction -> Transaction
@ -56,7 +56,7 @@ showTransactionsWithBalances ts b =
showTransactionDescriptionAndBalance :: Transaction -> Amount -> String
showTransactionDescriptionAndBalance t b =
(showEntryDescription $ LedgerEntry (date t) False "" (description t) "" [] "")
(showEntryDescription $ Entry (date t) False "" (description t) "" [] "")
++ (showLedgerTransaction $ RawTransaction (account t) (amount t) "") ++ (showBalance b)
showTransactionAndBalance :: Transaction -> Amount -> String

View File

@ -45,7 +45,7 @@ data PeriodicEntry = PeriodicEntry {
p_transactions :: [RawTransaction]
} deriving (Eq)
data LedgerEntry = LedgerEntry {
data Entry = Entry {
edate :: Date,
estatus :: Bool,
ecode :: String,
@ -58,7 +58,7 @@ data LedgerEntry = LedgerEntry {
data RawLedger = RawLedger {
modifier_entries :: [ModifierEntry],
periodic_entries :: [PeriodicEntry],
entries :: [LedgerEntry],
entries :: [Entry],
final_comment_lines :: String
} deriving (Eq)

View File

@ -68,7 +68,7 @@ entry1_str = "\
\\n" --"
entry1 =
(LedgerEntry "2007/01/28" False "" "coopportunity" ""
(Entry "2007/01/28" False "" "coopportunity" ""
[RawTransaction "expenses:food:groceries" (Amount (getcurrency "$") 47.18 2) "",
RawTransaction "assets:checking" (Amount (getcurrency "$") (-47.18) 2) ""] "")
@ -204,7 +204,7 @@ ledger7 = RawLedger
[]
[]
[
LedgerEntry {
Entry {
edate="2007/01/01", estatus=False, ecode="*", edescription="opening balance", ecomment="",
etransactions=[
RawTransaction {taccount="assets:cash",
@ -217,7 +217,7 @@ ledger7 = RawLedger
epreceding_comment_lines=""
}
,
LedgerEntry {
Entry {
edate="2007/02/01", estatus=False, ecode="*", edescription="ayres suites", ecomment="",
etransactions=[
RawTransaction {taccount="expenses:vacation",
@ -230,7 +230,7 @@ ledger7 = RawLedger
epreceding_comment_lines=""
}
,
LedgerEntry {
Entry {
edate="2007/01/02", estatus=False, ecode="*", edescription="auto transfer to savings", ecomment="",
etransactions=[
RawTransaction {taccount="assets:saving",
@ -243,7 +243,7 @@ ledger7 = RawLedger
epreceding_comment_lines=""
}
,
LedgerEntry {
Entry {
edate="2007/01/03", estatus=False, ecode="*", edescription="poquito mas", ecomment="",
etransactions=[
RawTransaction {taccount="expenses:food:dining",
@ -256,7 +256,7 @@ ledger7 = RawLedger
epreceding_comment_lines=""
}
,
LedgerEntry {
Entry {
edate="2007/01/03", estatus=False, ecode="*", edescription="verizon", ecomment="",
etransactions=[
RawTransaction {taccount="expenses:phone",
@ -269,7 +269,7 @@ ledger7 = RawLedger
epreceding_comment_lines=""
}
,
LedgerEntry {
Entry {
edate="2007/01/03", estatus=False, ecode="*", edescription="discover", ecomment="",
etransactions=[
RawTransaction {taccount="liabilities:credit cards:discover",