basic support for a comments-preserving print command.

Preserves most inter-entry comment lines and whitespace (but not yet a
comment immediately after an entry, or whitespace/comments after the last
entry.) Whitespace and comment lines are stored as part of the following
entry. Lines after the last entry are stored as an extra ledger file field.
Inspired by Nafai on #ledger.
This commit is contained in:
Simon Michael 2008-06-28 04:44:33 +00:00
parent 34ebd9e3df
commit 0eceeb5542
7 changed files with 39 additions and 31 deletions

View File

@ -64,8 +64,8 @@ cacheLedger pats l =
-- filter entries by description and whether any transactions match account patterns -- filter entries by description and whether any transactions match account patterns
filterLedgerEntries :: FilterPatterns -> LedgerFile -> LedgerFile filterLedgerEntries :: FilterPatterns -> LedgerFile -> LedgerFile
filterLedgerEntries (acctpat,descpat) (LedgerFile ms ps es) = filterLedgerEntries (acctpat,descpat) (LedgerFile ms ps es f) =
LedgerFile ms ps (filter matchdesc $ filter (any matchtxn . etransactions) es) LedgerFile ms ps (filter matchdesc $ filter (any matchtxn . etransactions) es) f
where where
matchtxn t = case matchRegex (wilddefault acctpat) (taccount t) of matchtxn t = case matchRegex (wilddefault acctpat) (taccount t) of
Nothing -> False Nothing -> False
@ -77,10 +77,10 @@ filterLedgerEntries (acctpat,descpat) (LedgerFile ms ps es) =
-- filter transactions in each ledger entry by account patterns -- filter transactions in each ledger entry by account patterns
-- this may unbalance entries -- this may unbalance entries
filterLedgerTransactions :: FilterPatterns -> LedgerFile -> LedgerFile filterLedgerTransactions :: FilterPatterns -> LedgerFile -> LedgerFile
filterLedgerTransactions (acctpat,descpat) (LedgerFile ms ps es) = filterLedgerTransactions (acctpat,descpat) (LedgerFile ms ps es f) =
LedgerFile ms ps (map filterentrytxns es) LedgerFile ms ps (map filterentrytxns es) f
where where
filterentrytxns l@(LedgerEntry _ _ _ _ _ ts) = l{etransactions=filter matchtxn ts} filterentrytxns l@(LedgerEntry _ _ _ _ _ ts _) = l{etransactions=filter matchtxn ts}
matchtxn t = case matchRegex (wilddefault acctpat) (taccount t) of matchtxn t = case matchRegex (wilddefault acctpat) (taccount t) of
Nothing -> False Nothing -> False
otherwise -> True otherwise -> True

View File

@ -30,7 +30,7 @@ isEntryBalanced :: LedgerEntry -> Bool
isEntryBalanced = ((0::Double)==) . read . printf "%0.8f" . quantity . sumLedgerTransactions . etransactions isEntryBalanced = ((0::Double)==) . read . printf "%0.8f" . quantity . sumLedgerTransactions . etransactions
autofillEntry :: LedgerEntry -> LedgerEntry autofillEntry :: LedgerEntry -> LedgerEntry
autofillEntry e@(LedgerEntry _ _ _ _ _ ts) = autofillEntry e@(LedgerEntry _ _ _ _ _ ts _) =
let e' = e{etransactions=autofillTransactions ts} in let e' = e{etransactions=autofillTransactions ts} in
case (isEntryBalanced e') of case (isEntryBalanced e') of
True -> e' True -> e'
@ -50,8 +50,9 @@ autofillEntry e@(LedgerEntry _ _ _ _ _ ts) =
showEntry :: LedgerEntry -> String showEntry :: LedgerEntry -> String
showEntry e = showEntry e =
unlines $ ["", description] ++ (showtxns $ etransactions e) "\n" ++ precedingcomment ++ description ++ unlines (showtxns $ etransactions e)
where where
precedingcomment = epreceding_comment_lines e
description = concat [date, status, code, desc] -- , comment] description = concat [date, status, code, desc] -- , comment]
date = showDate $ edate e date = showDate $ edate e
status = if estatus e then " *" else "" status = if estatus e then " *" else ""
@ -71,8 +72,8 @@ showEntries :: [LedgerEntry] -> String
showEntries = concatMap showEntry showEntries = concatMap showEntry
entrySetPrecision :: Int -> LedgerEntry -> LedgerEntry entrySetPrecision :: Int -> LedgerEntry -> LedgerEntry
entrySetPrecision p (LedgerEntry d s c desc comm ts) = entrySetPrecision p (LedgerEntry d s c desc comm ts prec) =
LedgerEntry d s c desc comm $ map (ledgerTransactionSetPrecision p) ts LedgerEntry d s c desc comm (map (ledgerTransactionSetPrecision p) ts) prec
-- modifier & periodic entries -- modifier & periodic entries

View File

@ -142,14 +142,14 @@ ledgerfile = ledger <|> ledgerfromtimelog
ledger :: Parser LedgerFile ledger :: Parser LedgerFile
ledger = do ledger = do
ledgernondatalines
-- for now these must come first, unlike ledger -- for now these must come first, unlike ledger
modifier_entries <- many ledgermodifierentry modifier_entries <- many ledgermodifierentry
periodic_entries <- many ledgerperiodicentry periodic_entries <- many ledgerperiodicentry
-- --
entries <- (many ledgerentry) <?> "entry" entries <- (many ledgerentry) <?> "entry"
final_comment_lines <- ledgernondatalines
eof eof
return $ LedgerFile modifier_entries periodic_entries entries return $ LedgerFile modifier_entries periodic_entries entries (unlines final_comment_lines)
ledgernondatalines :: Parser [String] ledgernondatalines :: Parser [String]
ledgernondatalines = many (ledgerdirective <|> ledgercommentline <|> do {whiteSpace1; return []}) ledgernondatalines = many (ledgerdirective <|> ledgercommentline <|> do {whiteSpace1; return []})
@ -157,8 +157,8 @@ ledgernondatalines = many (ledgerdirective <|> ledgercommentline <|> do {whiteSp
ledgercommentline :: Parser String ledgercommentline :: Parser String
ledgercommentline = do ledgercommentline = do
char ';' char ';'
many spacenonewline l <- restofline <?> "comment line"
restofline <?> "comment line" return $ ";" ++ l
ledgercomment :: Parser String ledgercomment :: Parser String
ledgercomment = ledgercomment =
@ -178,7 +178,6 @@ ledgermodifierentry = do
many spacenonewline many spacenonewline
valueexpr <- restofline valueexpr <- restofline
transactions <- ledgertransactions transactions <- ledgertransactions
ledgernondatalines
return (ModifierEntry valueexpr transactions) return (ModifierEntry valueexpr transactions)
ledgerperiodicentry :: Parser PeriodicEntry ledgerperiodicentry :: Parser PeriodicEntry
@ -187,11 +186,11 @@ ledgerperiodicentry = do
many spacenonewline many spacenonewline
periodexpr <- restofline periodexpr <- restofline
transactions <- ledgertransactions transactions <- ledgertransactions
ledgernondatalines
return (PeriodicEntry periodexpr transactions) return (PeriodicEntry periodexpr transactions)
ledgerentry :: Parser LedgerEntry ledgerentry :: Parser LedgerEntry
ledgerentry = do ledgerentry = do
preceding <- ledgernondatalines
date <- ledgerdate date <- ledgerdate
status <- ledgerstatus status <- ledgerstatus
code <- ledgercode code <- ledgercode
@ -202,8 +201,7 @@ ledgerentry = do
comment <- ledgercomment comment <- ledgercomment
restofline restofline
transactions <- ledgertransactions transactions <- ledgertransactions
ledgernondatalines return $ autofillEntry $ LedgerEntry date status code description comment transactions (unlines preceding)
return $ autofillEntry $ LedgerEntry date status code description comment transactions
ledgerdate :: Parser String ledgerdate :: Parser String
ledgerdate = do ledgerdate = do
@ -232,7 +230,6 @@ ledgertransaction = do
many spacenonewline many spacenonewline
comment <- ledgercomment comment <- ledgercomment
restofline restofline
many ledgercommentline
return (LedgerTransaction account amount comment) return (LedgerTransaction account amount comment)
-- account names may have single spaces in them, and are terminated by two or more spaces -- account names may have single spaces in them, and are terminated by two or more spaces

View File

@ -70,7 +70,7 @@ entry1_str = "\
entry1 = entry1 =
(LedgerEntry "2007/01/28" False "" "coopportunity" "" (LedgerEntry "2007/01/28" False "" "coopportunity" ""
[LedgerTransaction "expenses:food:groceries" (Amount (getcurrency "$") 47.18 2) "", [LedgerTransaction "expenses:food:groceries" (Amount (getcurrency "$") 47.18 2) "",
LedgerTransaction "assets:checking" (Amount (getcurrency "$") (-47.18) 2) ""]) LedgerTransaction "assets:checking" (Amount (getcurrency "$") (-47.18) 2) ""] "")
entry2_str = "\ entry2_str = "\
\2007/01/27 * joes diner\n\ \2007/01/27 * joes diner\n\
@ -213,7 +213,8 @@ ledger7 = LedgerFile
LedgerTransaction {taccount="equity:opening balances", LedgerTransaction {taccount="equity:opening balances",
tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82), precision=2}, tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82), precision=2},
tcomment=""} tcomment=""}
] ],
epreceding_comment_lines=""
} }
, ,
LedgerEntry { LedgerEntry {
@ -225,7 +226,8 @@ ledger7 = LedgerFile
LedgerTransaction {taccount="assets:checking", LedgerTransaction {taccount="assets:checking",
tamount=Amount {currency=(getcurrency "$"), quantity=(-179.92), precision=2}, tamount=Amount {currency=(getcurrency "$"), quantity=(-179.92), precision=2},
tcomment=""} tcomment=""}
] ],
epreceding_comment_lines=""
} }
, ,
LedgerEntry { LedgerEntry {
@ -237,7 +239,8 @@ ledger7 = LedgerFile
LedgerTransaction {taccount="assets:checking", LedgerTransaction {taccount="assets:checking",
tamount=Amount {currency=(getcurrency "$"), quantity=(-200), precision=2}, tamount=Amount {currency=(getcurrency "$"), quantity=(-200), precision=2},
tcomment=""} tcomment=""}
] ],
epreceding_comment_lines=""
} }
, ,
LedgerEntry { LedgerEntry {
@ -249,7 +252,8 @@ ledger7 = LedgerFile
LedgerTransaction {taccount="assets:cash", LedgerTransaction {taccount="assets:cash",
tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82), precision=2}, tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82), precision=2},
tcomment=""} tcomment=""}
] ],
epreceding_comment_lines=""
} }
, ,
LedgerEntry { LedgerEntry {
@ -261,7 +265,8 @@ ledger7 = LedgerFile
LedgerTransaction {taccount="assets:checking", LedgerTransaction {taccount="assets:checking",
tamount=Amount {currency=(getcurrency "$"), quantity=(-95.11), precision=2}, tamount=Amount {currency=(getcurrency "$"), quantity=(-95.11), precision=2},
tcomment=""} tcomment=""}
] ],
epreceding_comment_lines=""
} }
, ,
LedgerEntry { LedgerEntry {
@ -273,9 +278,11 @@ ledger7 = LedgerFile
LedgerTransaction {taccount="assets:checking", LedgerTransaction {taccount="assets:checking",
tamount=Amount {currency=(getcurrency "$"), quantity=(-80), precision=2}, tamount=Amount {currency=(getcurrency "$"), quantity=(-80), precision=2},
tcomment=""} tcomment=""}
] ],
epreceding_comment_lines=""
} }
] ]
""
l7 = cacheLedger (argpats [] []) ledger7 l7 = cacheLedger (argpats [] []) ledger7

View File

@ -16,7 +16,7 @@ instance Show TimeLog where
ledgerFromTimeLog :: TimeLog -> LedgerFile ledgerFromTimeLog :: TimeLog -> LedgerFile
ledgerFromTimeLog tl = ledgerFromTimeLog tl =
LedgerFile [] [] (entriesFromTimeLogEntries $ timelog_entries tl) LedgerFile [] [] (entriesFromTimeLogEntries $ timelog_entries tl) ""
entriesFromTimeLogEntries :: [TimeLogEntry] -> [LedgerEntry] entriesFromTimeLogEntries :: [TimeLogEntry] -> [LedgerEntry]
@ -34,7 +34,8 @@ entriesFromTimeLogEntries [clockin,clockout] =
etransactions = [ etransactions = [
LedgerTransaction accountname amount "", LedgerTransaction accountname amount "",
LedgerTransaction "TIME" (-amount) "" LedgerTransaction "TIME" (-amount) ""
]} ],
epreceding_comment_lines=""}
] ]
where where
accountname = tlcomment clockin accountname = tlcomment clockin

View File

@ -15,7 +15,7 @@ instance Show Transaction where
-- we use the entry number e to remember the grouping of txns -- we use the entry number e to remember the grouping of txns
flattenEntry :: (LedgerEntry, Int) -> [Transaction] flattenEntry :: (LedgerEntry, Int) -> [Transaction]
flattenEntry (LedgerEntry d _ _ desc _ ts, e) = flattenEntry (LedgerEntry d _ _ desc _ ts _, e) =
[Transaction e d desc (taccount t) (tamount t) | t <- ts] [Transaction e d desc (taccount t) (tamount t) | t <- ts]
transactionSetPrecision :: Int -> Transaction -> Transaction transactionSetPrecision :: Int -> Transaction -> Transaction
@ -47,7 +47,7 @@ showTransactionsWithBalances ts b =
showTransactionDescriptionAndBalance :: Transaction -> Amount -> String showTransactionDescriptionAndBalance :: Transaction -> Amount -> String
showTransactionDescriptionAndBalance t b = showTransactionDescriptionAndBalance t b =
(showEntryDescription $ LedgerEntry (date t) False "" (description t) "" []) (showEntryDescription $ LedgerEntry (date t) False "" (description t) "" [] "")
++ (showLedgerTransaction $ LedgerTransaction (account t) (amount t) "") ++ (showBalance b) ++ (showLedgerTransaction $ LedgerTransaction (account t) (amount t) "") ++ (showBalance b)
showTransactionAndBalance :: Transaction -> Amount -> String showTransactionAndBalance :: Transaction -> Amount -> String

View File

@ -67,7 +67,8 @@ data LedgerEntry = LedgerEntry {
ecode :: String, ecode :: String,
edescription :: String, edescription :: String,
ecomment :: String, ecomment :: String,
etransactions :: [LedgerTransaction] etransactions :: [LedgerTransaction],
epreceding_comment_lines :: String
} deriving (Eq) } deriving (Eq)
-- an automated ledger entry -- an automated ledger entry
@ -97,7 +98,8 @@ data TimeLog = TimeLog {
data LedgerFile = LedgerFile { data LedgerFile = LedgerFile {
modifier_entries :: [ModifierEntry], modifier_entries :: [ModifierEntry],
periodic_entries :: [PeriodicEntry], periodic_entries :: [PeriodicEntry],
entries :: [LedgerEntry] entries :: [LedgerEntry],
final_comment_lines :: String
} deriving (Eq) } deriving (Eq)
-- we flatten LedgerEntries and LedgerTransactions into Transactions, -- we flatten LedgerEntries and LedgerTransactions into Transactions,