diff --git a/Models.hs b/Models.hs index 130a31a2b..9a0fa7e90 100644 --- a/Models.hs +++ b/Models.hs @@ -5,42 +5,18 @@ where import Text.Printf import Data.List --- types +-- basic types -data Ledger = Ledger { - modifier_entries :: [ModifierEntry], - periodic_entries :: [PeriodicEntry], - entries :: [Entry] - } deriving (Eq) -data ModifierEntry = ModifierEntry { -- aka "automated entry" - valueexpr :: String, - m_transactions :: [Transaction] - } deriving (Eq) -data PeriodicEntry = PeriodicEntry { - periodexpr :: String, - p_transactions :: [Transaction] - } deriving (Eq) -data Entry = Entry { - date :: Date, - status :: Status, - code :: String, - description :: String, - transactions :: [Transaction] - } deriving (Eq) -data Transaction = Transaction { - account :: Account, - amount :: Amount - } deriving (Eq) -data Amount = Amount { - currency :: String, - quantity :: Double - } deriving (Eq) type Date = String type Status = Bool type Account = String --- Amount arithmetic - ignores currency conversion +data Amount = Amount { + currency :: String, + quantity :: Double + } deriving (Eq) +-- amount arithmetic, ignores currency conversion instance Num Amount where abs (Amount c q) = Amount c (abs q) signum (Amount c q) = Amount c (signum q) @@ -52,26 +28,32 @@ Amount ca qa `amountAdd` Amount cb qb = Amount ca (qa + qb) Amount ca qa `amountSub` Amount cb qb = Amount ca (qa - qb) Amount ca qa `amountMult` Amount cb qb = Amount ca (qa * qb) --- show & display methods +instance Show Amount where + show (Amount cur qty) = + let roundedqty = printf "%.2f" qty in + case roundedqty of + "0.00" -> "0" + otherwise -> cur ++ roundedqty -instance Show Ledger where - show l = "Ledger with " ++ m ++ " modifier, " ++ p ++ " periodic, " ++ e ++ " normal entries:\n" - ++ (concat $ map show (modifier_entries l)) - ++ (concat $ map show (periodic_entries l)) - ++ (concat $ map show (entries l)) - where - m = show $ length $ modifier_entries l - p = show $ length $ periodic_entries l - e = show $ length $ entries l +-- modifier & periodic entries + +data ModifierEntry = ModifierEntry { -- aka "automated entry" + valueexpr :: String, + m_transactions :: [Transaction] + } deriving (Eq) instance Show ModifierEntry where show e = "= " ++ (valueexpr e) ++ "\n" ++ unlines (map show (m_transactions e)) +data PeriodicEntry = PeriodicEntry { + periodexpr :: String, + p_transactions :: [Transaction] + } deriving (Eq) + instance Show PeriodicEntry where show e = "~ " ++ (periodexpr e) ++ "\n" ++ unlines (map show (p_transactions e)) -instance Show Entry where show = showEntry - +-- entries -- a register entry is displayed as two or more lines like this: -- date description account amount balance -- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAA AAAAAAAAAA @@ -83,63 +65,35 @@ instance Show Entry where show = showEntry -- amtWidth = 10 -- balWidth = 10 -showEntry :: Entry -> String -showEntry e = unlines $ map fst (entryLines e) +data Entry = Entry { + edate :: Date, + estatus :: Status, + ecode :: String, + edescription :: String, + etransactions :: [Transaction] + } deriving (Eq) --- convert an Entry to entry lines (string, amount pairs) -entryLines :: Entry -> [(String,Amount)] -entryLines e = - [firstline] ++ otherlines - where - t:ts = transactions e - firstline = (entrydesc e ++ (show t), amount t) - otherlines = map (\t -> (prependSpace $ show t, amount t)) ts - prependSpace = (replicate 32 ' ' ++) +instance Show Entry where show = showEntryDetails -entrydesc e = printf "%-10s %-20s " (date e) (take 20 $ description e) +showEntryDetails e = printf "%-10s %-20s " (edate e) (take 20 $ edescription e) - -instance Show Transaction where - show t = printf "%-25s %10s" (take 25 $ account t) (show $ amount t) - -instance Show Amount where - show (Amount cur qty) = - let roundedqty = printf "%.2f" qty in - case roundedqty of - "0.00" -> "0" - otherwise -> cur ++ roundedqty - --- in the register report we show entries plus a running balance - -showEntriesWithBalances :: [Entry] -> Amount -> String -showEntriesWithBalances [] _ = "" -showEntriesWithBalances (e:es) b = - showEntryWithBalances e b ++ (showEntriesWithBalances es b') - where b' = b + (entryBalance e) - -entryBalance :: Entry -> Amount -entryBalance = sumTransactions . transactions - -showEntryWithBalances :: Entry -> Amount -> String -showEntryWithBalances e b = - unlines [s | (s,a,b) <- entryLinesWithBalances (entryLines e) b] - -entryLinesWithBalances :: [(String,Amount)] -> Amount -> [(String,Amount,Amount)] -entryLinesWithBalances [] _ = [] -entryLinesWithBalances ((str,amt):els) bal = - [(str',amt,bal')] ++ entryLinesWithBalances els bal' - where - bal' = bal + amt - str' = str ++ (showBalance bal') - -showBalance b = printf " %10.2s" (show b) - --- misc +isEntryBalanced :: Entry -> Bool +isEntryBalanced e = (sumTransactions . etransactions) e == 0 autofillEntry :: Entry -> Entry autofillEntry e = - Entry (date e) (status e) (code e) (description e) - (autofillTransactions (transactions e)) + Entry (edate e) (estatus e) (ecode e) (edescription e) + (autofillTransactions (etransactions e)) + +-- transactions + +data Transaction = Transaction { + taccount :: Account, + tamount :: Amount + } deriving (Eq) + +instance Show Transaction where + show t = printf "%-25s %10s" (take 25 $ taccount t) (show $ tamount t) autofillTransactions :: [Transaction] -> [Transaction] autofillTransactions ts = @@ -147,64 +101,80 @@ autofillTransactions ts = case (length as) of 0 -> ns 1 -> ns ++ [balanceTransaction $ head as] - where balanceTransaction t = t{amount = -(sumTransactions ns)} + where balanceTransaction t = t{tamount = -(sumTransactions ns)} otherwise -> error "too many blank transactions in this entry" normalAndAutoTransactions :: [Transaction] -> ([Transaction], [Transaction]) normalAndAutoTransactions ts = partition isNormal ts - where isNormal t = (currency $ amount t) /= "AUTO" - --- transactions + where isNormal t = (currency $ tamount t) /= "AUTO" sumTransactions :: [Transaction] -> Amount -sumTransactions ts = sum [amount t | t <- ts] +sumTransactions ts = sum [tamount t | t <- ts] -transactionsFromEntries :: [Entry] -> [Transaction] -transactionsFromEntries es = concat $ map transactions es +-- entrytransactions +-- the entry/transaction types used in app-level functions have morphed +-- through E->T; (T,E); ET; E<->T; (E,T). Currently, we parse Entries +-- containing Transactions and flatten them into (Entry,Transaction) pairs +-- (hereafter referred to as "transactions") for processing -matchTransactionAccount :: String -> Transaction -> Bool +type EntryTransaction = (Entry,Transaction) + +entry (e,t) = e +transaction (e,t) = t +date (e,t) = edate e +status (e,t) = estatus e +code (e,t) = ecode e +description (e,t) = edescription e +account (e,t) = taccount t +amount (e,t) = tamount t + +flattenEntry :: Entry -> [EntryTransaction] +flattenEntry e = [(e,t) | t <- etransactions e] + +entryTransactionsFrom :: [Entry] -> [EntryTransaction] +entryTransactionsFrom es = concat $ map flattenEntry es + +matchTransactionAccount :: String -> EntryTransaction -> Bool matchTransactionAccount s t = s `isInfixOf` (account t) -transactionsWithEntries :: [Entry] -> [(Transaction,Entry)] -transactionsWithEntries es = [(t,e) | e <- es, t <- transactions e] +matchTransactionDescription :: String -> EntryTransaction -> Bool +matchTransactionDescription s t = s `isInfixOf` (description t) -showTransactionsWithBalances :: [(Transaction,Entry)] -> Amount -> String +showTransactionsWithBalances :: [EntryTransaction] -> Amount -> String showTransactionsWithBalances [] _ = [] -showTransactionsWithBalances tes b = - unlines $ showTransactionsWithBalances' tes b +showTransactionsWithBalances ts b = + unlines $ showTransactionsWithBalances' ts dummyt b where - showTransactionsWithBalances' [] _ = [] - showTransactionsWithBalances' ((t,e):rest) b = - [showTransactionWithBalance t e b'] ++ (showTransactionsWithBalances' rest b') + dummyt = (Entry "" False "" "" [], Transaction "" (Amount "" 0)) + showTransactionsWithBalances' [] _ _ = [] + showTransactionsWithBalances' (t:ts) tprev b = + (if (entry t /= (entry tprev)) + then [showTransactionDescriptionAndBalance t b'] + else [showTransactionAndBalance t b']) + ++ (showTransactionsWithBalances' ts t b') where b' = b + (amount t) -showTransactionWithBalance :: Transaction -> Entry -> Amount -> String -showTransactionWithBalance t e b = - (entrydesc e) ++ (show t) ++ (showBalance b) +showTransactionDescriptionAndBalance :: EntryTransaction -> Amount -> String +showTransactionDescriptionAndBalance t b = + (showTransactionEntryDetails t) ++ (showTransactionDetails t) ++ (showBalance b) -transactionsMatching :: String -> Ledger -> [(Transaction,Entry)] -transactionsMatching s l = filter (\(t,e) -> matchTransactionAccount s t) (transactionsWithEntries $ entries l) +showTransactionAndBalance :: EntryTransaction -> Amount -> String +showTransactionAndBalance t b = + (replicate 32 ' ') ++ (showTransactionDetails t) ++ (showBalance b) --- entries +-- like showEntryDetails +showTransactionEntryDetails t = printf "%-10s %-20s " (date t) (take 20 $ description t) -entriesMatching :: String -> Ledger -> [Entry] -entriesMatching s l = filterEntriesByAccount s (entries l) +showTransactionDetails t = printf "%-25s %10s" (take 25 $ account t) (show $ amount t) -filterEntriesByAccount :: String -> [Entry] -> [Entry] -filterEntriesByAccount s es = filter (matchEntryAccount s) es - -matchEntryAccount :: String -> Entry -> Bool -matchEntryAccount s e = any (matchTransactionAccount s) (transactions e) +showBalance b = printf " %10.2s" (show b) -- accounts -accountsFromTransactions :: [Transaction] -> [Account] +accountsFromTransactions :: [EntryTransaction] -> [Account] accountsFromTransactions ts = nub $ map account ts -accountsUsed :: Ledger -> [Account] -accountsUsed l = accountsFromTransactions $ transactionsFromEntries $ entries l - -- ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"] expandAccounts :: [Account] -> [Account] expandAccounts l = nub $ concat $ map expand l @@ -219,6 +189,33 @@ splitAtElement e l = where (first,rest) = break (e==) l' -accountTree :: Ledger -> [Account] -accountTree = sort . expandAccounts . accountsUsed +-- ledger + +data Ledger = Ledger { + modifier_entries :: [ModifierEntry], + periodic_entries :: [PeriodicEntry], + entries :: [Entry] + } deriving (Eq) + +instance Show Ledger where + show l = "Ledger with " ++ m ++ " modifier, " ++ p ++ " periodic, " ++ e ++ " normal entries:\n" + ++ (concat $ map show (modifier_entries l)) + ++ (concat $ map show (periodic_entries l)) + ++ (concat $ map show (entries l)) + where + m = show $ length $ modifier_entries l + p = show $ length $ periodic_entries l + e = show $ length $ entries l + +ledgerAccountsUsed :: Ledger -> [Account] +ledgerAccountsUsed l = accountsFromTransactions $ entryTransactionsFrom $ entries l + +ledgerAccountTree :: Ledger -> [Account] +ledgerAccountTree = sort . expandAccounts . ledgerAccountsUsed + +ledgerTransactions :: Ledger -> [EntryTransaction] +ledgerTransactions l = entryTransactionsFrom $ entries l + +ledgerTransactionsMatching :: String -> Ledger -> [EntryTransaction] +ledgerTransactionsMatching s l = filter (\t -> matchTransactionAccount s t) (ledgerTransactions l) diff --git a/Parse.hs b/Parse.hs index 24cf1b856..c26fd58e7 100644 --- a/Parse.hs +++ b/Parse.hs @@ -182,6 +182,8 @@ ledgerentry = do transactions <- ledgertransactions ledgernondatalines let entry = Entry date status code description transactions + --let entry = Entry date status code description (map (\t -> t{tentry=entry}) transactions) + return $ autofillEntry entry ledgerdate :: Parser String diff --git a/TODO b/TODO index 611224041..0a9f75cba 100644 --- a/TODO +++ b/TODO @@ -1,8 +1,5 @@ features register - account matching - don't show duplicate transaction descriptions - better transaction/entry data structure description matching regexp matching diff --git a/Tests.hs b/Tests.hs index 9c9b9ff44..deb17c82a 100644 --- a/Tests.hs +++ b/Tests.hs @@ -159,21 +159,21 @@ ledger7 = Ledger [] [ Entry { - date="2007/01/01", status=False, code="*", description="opening balance", - transactions=[ - Transaction {account="assets:cash", - amount=Amount {currency="$", quantity=4.82}}, - Transaction {account="equity:opening balances", - amount=Amount {currency="$", quantity=(-4.82)}} + edate="2007/01/01", estatus=False, ecode="*", edescription="opening balance", + etransactions=[ + Transaction {taccount="assets:cash", + tamount=Amount {currency="$", quantity=4.82}}, + Transaction {taccount="equity:opening balances", + tamount=Amount {currency="$", quantity=(-4.82)}} ] }, Entry { - date="2007/02/01", status=False, code="*", description="ayres suites", - transactions=[ - Transaction {account="expenses:vacation", - amount=Amount {currency="$", quantity=179.92}}, - Transaction {account="assets:checking", - amount=Amount {currency="$", quantity=(-179.92)}} + edate="2007/02/01", estatus=False, ecode="*", edescription="ayres suites", + etransactions=[ + Transaction {taccount="expenses:vacation", + tamount=Amount {currency="$", quantity=179.92}}, + Transaction {taccount="assets:checking", + tamount=Amount {currency="$", quantity=(-179.92)}} ] } ] @@ -261,7 +261,7 @@ test_ledgerentry = test_autofillEntry = assertEqual' (Amount "$" (-47.18)) - (amount $ last $ transactions $ autofillEntry entry1) + (tamount $ last $ etransactions $ autofillEntry entry1) test_expandAccounts = assertEqual' @@ -271,7 +271,7 @@ test_expandAccounts = test_accountTree = assertEqual' ["assets","assets:cash","assets:checking","equity","equity:opening balances","expenses","expenses:vacation"] - (accountTree ledger7) + (ledgerAccountTree ledger7) -- quickcheck properties @@ -280,6 +280,6 @@ props = parse' ledgertransaction transaction1_str `parseEquals` (Transaction "expenses:food:dining" (Amount "$" 10)) , - accountTree ledger7 == + ledgerAccountTree ledger7 == ["assets","assets:cash","assets:checking","equity","equity:opening balances","expenses","expenses:vacation"] ] diff --git a/hledger.hs b/hledger.hs index c5b56c031..3d33868da 100644 --- a/hledger.hs +++ b/hledger.hs @@ -61,4 +61,5 @@ doWithParsed a p = printRegister :: [String] -> Ledger -> IO () printRegister args ledger = - putStr $ showTransactionsWithBalances (transactionsMatching (head (args ++ [""])) ledger) 0 + putStr $ showTransactionsWithBalances (ledgerTransactionsMatching (head (args ++ [""])) ledger) 0 +