diff --git a/Account.hs b/Account.hs index 9b8e1d2cd..8cf0175f2 100644 --- a/Account.hs +++ b/Account.hs @@ -1,5 +1,5 @@ -module Account -- +module Account where import Debug.Trace diff --git a/BasicTypes.hs b/BasicTypes.hs new file mode 100644 index 000000000..fecc11123 --- /dev/null +++ b/BasicTypes.hs @@ -0,0 +1,44 @@ + +module BasicTypes +where + +import Debug.Trace +import Text.Printf +import Text.Regex +import Data.List + +import Utils + + +type Date = String +type Status = Bool + +-- amounts +-- amount arithmetic currently ignores currency conversion + +data Amount = Amount { + currency :: String, + quantity :: Double + } deriving (Eq,Ord) + +instance Num Amount where + abs (Amount c q) = Amount c (abs q) + signum (Amount c q) = Amount c (signum q) + fromInteger i = Amount "$" (fromInteger i) + (+) = amountAdd + (-) = amountSub + (*) = amountMult +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) + +instance Show Amount where show = amountRoundedOrZero + +amountRoundedOrZero :: Amount -> String +amountRoundedOrZero (Amount cur qty) = + let rounded = printf "%.2f" qty in + case rounded of + "0.00" -> "0" + "-0.00" -> "0" + otherwise -> cur ++ rounded + diff --git a/Entry.hs b/Entry.hs new file mode 100644 index 000000000..15561cb27 --- /dev/null +++ b/Entry.hs @@ -0,0 +1,65 @@ + +module Entry +where + +import Debug.Trace +import Text.Printf +import Text.Regex +import Data.List + +import Utils +import BasicTypes +import Transaction + + +-- a register entry is displayed as two or more lines like this: +-- date description account amount balance +-- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA +-- aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA +-- ... ... ... +-- dateWidth = 10 +-- descWidth = 20 +-- acctWidth = 22 +-- amtWidth = 11 +-- balWidth = 12 + +data Entry = Entry { + edate :: Date, + estatus :: Status, + ecode :: String, + edescription :: String, + etransactions :: [Transaction] + } deriving (Eq,Ord) + +instance Show Entry where show = showEntry + +showEntry e = (showDate $ edate e) ++ " " ++ (showDescription $ edescription e) ++ " " +showDate d = printf "%-10s" d +showDescription s = printf "%-20s" (elideRight 20 s) + +isEntryBalanced :: Entry -> Bool +isEntryBalanced e = (sumTransactions . etransactions) e == 0 + +autofillEntry :: Entry -> Entry +autofillEntry e = + Entry (edate e) (estatus e) (ecode e) (edescription e) + (autofillTransactions (etransactions e)) + +-- 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)) + diff --git a/EntryTransaction.hs b/EntryTransaction.hs new file mode 100644 index 000000000..cfbdf76a2 --- /dev/null +++ b/EntryTransaction.hs @@ -0,0 +1,82 @@ + +module EntryTransaction +where + +import Debug.Trace +import Text.Printf +import Text.Regex +import Data.List + +import Utils +import BasicTypes +import Account +import Entry +import Transaction + + +-- We parse Entries containing Transactions and flatten them into +-- (entry,transaction) pairs (entrytransactions, hereafter referred to as +-- "transactions") for easier processing. (So far, these types have +-- morphed through E->T; (T,E); ET; E<->T; (E,T)). + +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 + +sumEntryTransactions :: [EntryTransaction] -> Amount +sumEntryTransactions ets = + sumTransactions $ map transaction ets + +accountNamesFromTransactions :: [EntryTransaction] -> [AccountName] +accountNamesFromTransactions ts = nub $ map account ts + +matchTransactionAccount :: String -> EntryTransaction -> Bool +matchTransactionAccount s t = + case matchRegex (mkRegex s) (account t) of + Nothing -> False + otherwise -> True + +matchTransactionDescription :: String -> EntryTransaction -> Bool +matchTransactionDescription s t = + case matchRegex (mkRegex s) (description t) of + Nothing -> False + otherwise -> True + +showTransactionsWithBalances :: [EntryTransaction] -> Amount -> String +showTransactionsWithBalances [] _ = [] +showTransactionsWithBalances ts b = + unlines $ showTransactionsWithBalances' ts dummyt b + where + 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) + +showTransactionDescriptionAndBalance :: EntryTransaction -> Amount -> String +showTransactionDescriptionAndBalance t b = + (showEntry $ entry t) ++ (showTransaction $ transaction t) ++ (showBalance b) + +showTransactionAndBalance :: EntryTransaction -> Amount -> String +showTransactionAndBalance t b = + (replicate 32 ' ') ++ (showTransaction $ transaction t) ++ (showBalance b) + +showBalance :: Amount -> String +showBalance b = printf " %12s" (amountRoundedOrZero b) + diff --git a/Ledger.hs b/Ledger.hs new file mode 100644 index 000000000..640eb4a79 --- /dev/null +++ b/Ledger.hs @@ -0,0 +1,69 @@ +module Ledger +where + +import Debug.Trace +import Text.Printf +import Text.Regex +import Data.List + +import Utils +import Account +import Entry +import EntryTransaction + + +data Ledger = Ledger { + modifier_entries :: [ModifierEntry], + periodic_entries :: [PeriodicEntry], + entries :: [Entry] + } deriving (Eq) + +instance Show Ledger where + show l = printf "Ledger with %d normal, %d modifier, %d periodic entries" + (show $ length $ modifier_entries l) + (show $ length $ periodic_entries l) + (show $ length $ entries l) + +ledgerTransactions :: Ledger -> [EntryTransaction] +ledgerTransactions l = entryTransactionsFrom $ entries l + +ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction] +ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l +ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l +ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l +ledgerTransactionsMatching (acctregexps,descregexps) l = + intersect + (concat [filter (matchTransactionAccount r) ts | r <- acctregexps]) + (concat [filter (matchTransactionDescription r) ts | r <- descregexps]) + where ts = ledgerTransactions l + +ledgerAccountNamesUsed :: Ledger -> [AccountName] +ledgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l + +ledgerAccountNames :: Ledger -> [AccountName] +ledgerAccountNames = sort . expandAccountNames . ledgerAccountNamesUsed + +ledgerTopAccountNames :: Ledger -> [AccountName] +ledgerTopAccountNames l = filter (notElem ':') (ledgerAccountNames l) + +ledgerAccountNamesMatching :: [String] -> Ledger -> [AccountName] +ledgerAccountNamesMatching [] l = ledgerAccountNamesMatching [".*"] l +ledgerAccountNamesMatching acctregexps l = + concat [filter (matchAccountName r) accountNames | r <- acctregexps] + where accountNames = ledgerTopAccountNames l + +ledgerAccounts :: Ledger -> Tree AccountName +ledgerAccounts l = accountFrom $ ledgerAccountNames l + +showLedgerAccounts :: Ledger -> [String] -> Int -> String +showLedgerAccounts l acctpats depth = + showAccountsWithBalances l accounts depth + where + accounts = ledgerAccountsMatching l acctpats + +showAccountsWithBalances :: Ledger -> [Account] -> Int -> String +showAccountsWithBalances l accts depth = + "" + +ledgerAccountsMatching :: Ledger -> [String] -> [Account] +ledgerAccountsMatching l acctpats = [] diff --git a/Makefile b/Makefile index c7a83d753..eac0f922d 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ build: Tags - ghc --make -O2 hledger.hs + ghc --make hledger.hs Tags: hasktags *hs diff --git a/Models.hs b/Models.hs index 058e040a5..4e703f872 100644 --- a/Models.hs +++ b/Models.hs @@ -1,5 +1,13 @@ - -module Models -- data types & behaviours +-- data types & behaviours +module Models ( + module Models, + module Ledger, + module EntryTransaction, + module Transaction, + module Entry, + module Account, + module BasicTypes, + ) where import Debug.Trace @@ -8,234 +16,24 @@ import Text.Regex import Data.List import Utils +import BasicTypes import Account +import Entry +import Transaction +import EntryTransaction +import Ledger --- basic types -type Date = String -type Status = Bool +-- any top-level stuff that mixed up the other types --- amounts --- amount arithmetic currently ignores currency conversion -data Amount = Amount { - currency :: String, - quantity :: Double - } deriving (Eq,Ord) +-- showAccountNamesWithBalances :: [(AccountName,String)] -> Ledger -> String +-- showAccountNamesWithBalances as l = +-- unlines $ map (showAccountNameAndBalance l) as -instance Num Amount where - abs (Amount c q) = Amount c (abs q) - signum (Amount c q) = Amount c (signum q) - fromInteger i = Amount "$" (fromInteger i) - (+) = amountAdd - (-) = amountSub - (*) = amountMult -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) - -instance Show Amount where show = amountRoundedOrZero - -amountRoundedOrZero :: Amount -> String -amountRoundedOrZero (Amount cur qty) = - let rounded = printf "%.2f" qty in - case rounded of - "0.00" -> "0" - "-0.00" -> "0" - otherwise -> cur ++ rounded - --- 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)) - --- entries --- a register entry is displayed as two or more lines like this: --- date description account amount balance --- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA --- aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA --- ... ... ... --- dateWidth = 10 --- descWidth = 20 --- acctWidth = 22 --- amtWidth = 11 --- balWidth = 12 - -data Entry = Entry { - edate :: Date, - estatus :: Status, - ecode :: String, - edescription :: String, - etransactions :: [Transaction] - } deriving (Eq,Ord) - -instance Show Entry where show = showEntry - -showEntry e = (showDate $ edate e) ++ " " ++ (showDescription $ edescription e) ++ " " -showDate d = printf "%-10s" d -showDescription s = printf "%-20s" (elideRight 20 s) - -isEntryBalanced :: Entry -> Bool -isEntryBalanced e = (sumTransactions . etransactions) e == 0 - -autofillEntry :: Entry -> Entry -autofillEntry e = - Entry (edate e) (estatus e) (ecode e) (edescription e) - (autofillTransactions (etransactions e)) - --- transactions - -data Transaction = Transaction { - taccount :: AccountName, - tamount :: Amount - } deriving (Eq,Ord) - -instance Show Transaction where show = showTransaction - -showTransaction t = (showAccountName $ taccount t) ++ " " ++ (showAmount $ tamount t) -showAmount amt = printf "%11s" (show amt) -showAccountName s = printf "%-22s" (elideRight 22 s) - -elideRight width s = - case length s > width of - True -> take (width - 2) s ++ ".." - False -> s - --- elideAccountRight width abbrevlen a = --- case length a > width of --- False -> a --- True -> abbreviateAccountComponent abbrevlen a - --- abbreviateAccountComponent abbrevlen a = --- let components = splitAtElement ':' a in --- case - -autofillTransactions :: [Transaction] -> [Transaction] -autofillTransactions ts = - let (ns, as) = partition isNormal ts - where isNormal t = (currency $ tamount t) /= "AUTO" in - case (length as) of - 0 -> ns - 1 -> ns ++ [balanceTransaction $ head as] - where balanceTransaction t = t{tamount = -(sumTransactions ns)} - otherwise -> error "too many blank transactions in this entry" - -sumTransactions :: [Transaction] -> Amount -sumTransactions ts = sum [tamount t | t <- ts] - --- entrytransactions --- We parse Entries containing Transactions and flatten them into --- (entry,transaction) pairs (entrytransactions, hereafter referred to as --- "transactions") for easier processing. (So far, these types have --- morphed through E->T; (T,E); ET; E<->T; (E,T)). - -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 - -sumEntryTransactions :: [EntryTransaction] -> Amount -sumEntryTransactions ets = - sumTransactions $ map transaction ets - -matchTransactionAccount :: String -> EntryTransaction -> Bool -matchTransactionAccount s t = - case matchRegex (mkRegex s) (account t) of - Nothing -> False - otherwise -> True - -matchTransactionDescription :: String -> EntryTransaction -> Bool -matchTransactionDescription s t = - case matchRegex (mkRegex s) (description t) of - Nothing -> False - otherwise -> True - -showTransactionsWithBalances :: [EntryTransaction] -> Amount -> String -showTransactionsWithBalances [] _ = [] -showTransactionsWithBalances ts b = - unlines $ showTransactionsWithBalances' ts dummyt b - where - 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) - -showTransactionDescriptionAndBalance :: EntryTransaction -> Amount -> String -showTransactionDescriptionAndBalance t b = - (showEntry $ entry t) ++ (showTransaction $ transaction t) ++ (showBalance b) - -showTransactionAndBalance :: EntryTransaction -> Amount -> String -showTransactionAndBalance t b = - (replicate 32 ' ') ++ (showTransaction $ transaction t) ++ (showBalance b) - -showBalance :: Amount -> String -showBalance b = printf " %12s" (amountRoundedOrZero b) - --- more account functions - -accountNamesFromTransactions :: [EntryTransaction] -> [AccountName] -accountNamesFromTransactions ts = nub $ map account ts - --- like expandAccountNames, but goes from the top down and elides accountNames --- with only one child and no transactions. Returns accountNames paired with --- the appropriate indented name. Eg --- [("assets","assets"),("assets:cash:gifts"," cash:gifts"),("assets:checking"," checking")] -expandAccountNamesMostly :: Ledger -> [AccountName] -> [(AccountName, String)] -expandAccountNamesMostly l as = concat $ map (expandAccountNameMostly l) as - where - expandAccountNameMostly :: Ledger -> AccountName -> [(AccountName, String)] - expandAccountNameMostly l a = - [(acct, acctname)] ++ (concat $ map (expandAccountNameMostly l) subs) - where - subs = subAccountNames l a - txns = accountTransactionsNoSubs l a - (acct, acctname) = - case (length subs == 1) && (length txns == 0) of - False -> (a, indentAccountName a) - True -> (a, indentAccountName a ++ ":" ++ subname) - where - sub = head subs - subname = (reverse . takeWhile (/= ':') . reverse) sub - -subAccountNames :: Ledger -> AccountName -> [AccountName] -subAccountNames l a = [a' | a' <- ledgerAccountNames l, a `isSubAccountNameOf` a'] - -showAccountNamesWithBalances :: [(AccountName,String)] -> Ledger -> String -showAccountNamesWithBalances as l = - unlines $ map (showAccountNameAndBalance l) as - -showAccountNameAndBalance :: Ledger -> (AccountName, String) -> String -showAccountNameAndBalance l (a, adisplay) = - printf "%20s %s" (showBalance $ accountBalance l a) adisplay +-- showAccountNameAndBalance :: Ledger -> (AccountName, String) -> String +-- showAccountNameAndBalance l (a, adisplay) = +-- printf "%20s %s" (showBalance $ accountBalance l a) adisplay accountBalance :: Ledger -> AccountName -> Amount accountBalance l a = @@ -255,10 +53,10 @@ addDataToAccounts :: Ledger -> (Tree AccountName) -> (Tree AccountData) addDataToAccounts l acct = Tree (acctdata, map (addDataToAccounts l) (atsubs acct)) where + acctdata = (aname, atxns, abal) aname = atacct acct atxns = accountTransactionsNoSubs l aname abal = accountBalance l aname - acctdata = (aname, atxns, abal) -- an AccountData tree adds some other things we want to cache for -- convenience, like the account's balance and transactions. @@ -295,7 +93,7 @@ adamt (_,_,amt) = amt -- $5 b -- $5 c -- $0 d -showAccountWithBalances :: Ledger -> (Tree AccountData) -> String +showAccountWithBalances :: Ledger -> Tree AccountData -> String showAccountWithBalances l adt = (showAccountsWithBalance l) (adtsubs adt) showAccountsWithBalance :: Ledger -> [Tree AccountData] -> String @@ -304,9 +102,10 @@ showAccountsWithBalance l adts = where showAccountDataBranch :: Tree AccountData -> String showAccountDataBranch adt = - case boring of - True -> - False -> topacct ++ "\n" ++ subs + topacct ++ "\n" ++ subs +-- case boring of +-- True -> +-- False -> where topacct = (showAmount abal) ++ " " ++ (indentAccountName aname) showAmount amt = printf "%11s" (show amt) @@ -316,61 +115,9 @@ showAccountsWithBalance l adts = subs = (showAccountsWithBalance l) $ adtsubs adt boring = (length atxns == 0) && ((length subs) == 1) - - - --- 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 - -ledgerTransactions :: Ledger -> [EntryTransaction] -ledgerTransactions l = entryTransactionsFrom $ entries l - -ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction] -ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l -ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l -ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l -ledgerTransactionsMatching (acctregexps,descregexps) l = - intersect - (concat [filter (matchTransactionAccount r) ts | r <- acctregexps]) - (concat [filter (matchTransactionDescription r) ts | r <- descregexps]) - where ts = ledgerTransactions l - -ledgerAccountNamesUsed :: Ledger -> [AccountName] -ledgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l - -ledgerAccountNames :: Ledger -> [AccountName] -ledgerAccountNames = sort . expandAccountNames . ledgerAccountNamesUsed - -ledgerTopAccountNames :: Ledger -> [AccountName] -ledgerTopAccountNames l = filter (notElem ':') (ledgerAccountNames l) - -ledgerAccountNamesMatching :: [String] -> Ledger -> [AccountName] -ledgerAccountNamesMatching [] l = ledgerAccountNamesMatching [".*"] l -ledgerAccountNamesMatching acctregexps l = - concat [filter (matchAccountName r) accountNames | r <- acctregexps] - where accountNames = ledgerTopAccountNames l - -ledgerAccounts :: Ledger -> Tree AccountName -ledgerAccounts l = accountFrom $ ledgerAccountNames l - ledgerAccountsData :: Ledger -> Tree AccountData ledgerAccountsData l = addDataToAccounts l (ledgerAccounts l) -showLedgerAccountsWithBalances :: Ledger -> String -showLedgerAccountsWithBalances l = - showAccountWithBalances l (ledgerAccountsData l) +showLedgerAccountsWithBalances :: Ledger -> Tree AccountData -> String +showLedgerAccountsWithBalances l adt = + showAccountWithBalances l adt diff --git a/Options.hs b/Options.hs index 6269f26a7..17f77534b 100644 --- a/Options.hs +++ b/Options.hs @@ -1,5 +1,5 @@ -module Options +module Options (module Options, usageInfo) where import System.Console.GetOpt @@ -15,7 +15,7 @@ options :: [OptDescr Flag] options = [ Option ['v'] ["version"] (NoArg Version) "show version number" , Option ['f'] ["file"] (OptArg inp "FILE") "ledger file, or - to read stdin" - , Option ['s'] ["subtotal"] (NoArg ShowSubs) "balance: show sub-accounts; other: show subtotals" +-- , Option ['s'] ["subtotal"] (NoArg ShowSubs) "balance: show sub-accounts; register: show subtotals" ] inp :: Maybe String -> Flag @@ -25,8 +25,9 @@ getOptions :: [String] -> IO ([Flag], [String]) getOptions argv = case getOpt RequireOrder options argv of (o,n,[] ) -> return (o,n) - (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options)) - where header = "Usage: hledger [OPTIONS]" + (_,_,errs) -> ioError (userError (concat errs ++ usageInfo usageHeader options)) + +usageHeader = "Usage: hledger [OPTIONS] register|balance [MATCHARGS]" get_content :: Flag -> Maybe String get_content (File s) = Just s @@ -45,3 +46,6 @@ ledgerPatternArgs args = case "--" `elem` args of True -> ((takeWhile (/= "--") args), tail $ (dropWhile (/= "--") args)) False -> (args,[]) + +depthOption :: [Flag] -> Int +depthOption opts = 1 diff --git a/TODO b/TODO index f82ebadf3..cdb09ea69 100644 --- a/TODO +++ b/TODO @@ -1,3 +1,17 @@ +cleanup/reorganize +hledger + Options + Tests + Parse + Models + Ledger + EntryTransaction + Entry + Transaction + Account + BasicTypes + Utils + basic features balance show balances with new tree structures @@ -21,6 +35,8 @@ more features new features graph automation smart data entry + incorporate timeclock features + timelog simple amount entries tests better use of quickcheck/smallcheck diff --git a/Tests.hs b/Tests.hs index 81a80ae88..e2dc1dd2d 100644 --- a/Tests.hs +++ b/Tests.hs @@ -11,7 +11,6 @@ import Test.HUnit import Options import Models -import Account import Parse -- sample data @@ -155,6 +154,7 @@ ledger7_str = "\ \ assets:checking \n\ \\n" --" +l = ledger7 ledger7 = Ledger [] [] @@ -167,7 +167,8 @@ ledger7 = Ledger Transaction {taccount="equity:opening balances", tamount=Amount {currency="$", quantity=(-4.82)}} ] - }, + } + , Entry { edate="2007/02/01", estatus=False, ecode="*", edescription="ayres suites", etransactions=[ @@ -177,6 +178,46 @@ ledger7 = Ledger tamount=Amount {currency="$", quantity=(-179.92)}} ] } + , + Entry { + edate="2007/01/02", estatus=False, ecode="*", edescription="auto transfer to savings", + etransactions=[ + Transaction {taccount="assets:saving", + tamount=Amount {currency="$", quantity=200}}, + Transaction {taccount="assets:checking", + tamount=Amount {currency="$", quantity=(-200)}} + ] + } + , + Entry { + edate="2007/01/03", estatus=False, ecode="*", edescription="poquito mas", + etransactions=[ + Transaction {taccount="expenses:food:dining", + tamount=Amount {currency="$", quantity=4.82}}, + Transaction {taccount="assets:cash", + tamount=Amount {currency="$", quantity=(-4.82)}} + ] + } + , + Entry { + edate="2007/01/03", estatus=False, ecode="*", edescription="verizon", + etransactions=[ + Transaction {taccount="expenses:phone", + tamount=Amount {currency="$", quantity=95.11}}, + Transaction {taccount="assets:checking", + tamount=Amount {currency="$", quantity=(-95.11)}} + ] + } + , + Entry { + edate="2007/01/03", estatus=False, ecode="*", edescription="discover", + etransactions=[ + Transaction {taccount="liabilities:credit cards:discover", + tamount=Amount {currency="$", quantity=80}}, + Transaction {taccount="assets:checking", + tamount=Amount {currency="$", quantity=(-80)}} + ] + } ] -- utils diff --git a/Transaction.hs b/Transaction.hs new file mode 100644 index 000000000..7e7558c64 --- /dev/null +++ b/Transaction.hs @@ -0,0 +1,52 @@ + +module Transaction +where + +import Debug.Trace +import Text.Printf +import Text.Regex +import Data.List + +import Utils +import BasicTypes +import Account + + +data Transaction = Transaction { + taccount :: AccountName, + tamount :: Amount + } deriving (Eq,Ord) + +instance Show Transaction where show = showTransaction + +showTransaction t = (showAccountName $ taccount t) ++ " " ++ (showAmount $ tamount t) +showAmount amt = printf "%11s" (show amt) +showAccountName s = printf "%-22s" (elideRight 22 s) + +elideRight width s = + case length s > width of + True -> take (width - 2) s ++ ".." + False -> s + +-- elideAccountRight width abbrevlen a = +-- case length a > width of +-- False -> a +-- True -> abbreviateAccountComponent abbrevlen a + +-- abbreviateAccountComponent abbrevlen a = +-- let components = splitAtElement ':' a in +-- case + +autofillTransactions :: [Transaction] -> [Transaction] +autofillTransactions ts = + let (ns, as) = partition isNormal ts + where isNormal t = (currency $ tamount t) /= "AUTO" in + case (length as) of + 0 -> ns + 1 -> ns ++ [balanceTransaction $ head as] + where balanceTransaction t = t{tamount = -(sumTransactions ns)} + otherwise -> error "too many blank transactions in this entry" + +sumTransactions :: [Transaction] -> Amount +sumTransactions ts = sum [tamount t | t <- ts] + diff --git a/Utils.hs b/Utils.hs new file mode 100644 index 000000000..f4705957d --- /dev/null +++ b/Utils.hs @@ -0,0 +1,29 @@ + +module Utils +where + +import Data.List +import System.Directory + +rhead = head . reverse +rtail = reverse . tail . reverse + +splitAtElement :: Eq a => a -> [a] -> [[a]] +splitAtElement e l = + case dropWhile (e==) l of + [] -> [] + l' -> first : splitAtElement e rest + where + (first,rest) = break (e==) l' + +-- courtesy of allberry_b +tildeExpand :: FilePath -> IO FilePath +tildeExpand ('~':[]) = getHomeDirectory +tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs)) +-- ~name, requires -fvia-C or ghc 6.8 +--import System.Posix.User +-- tildeExpand ('~':xs) = do let (user, path) = span (/= '/') xs +-- pw <- getUserEntryForName user +-- return (homeDirectory pw ++ path) +tildeExpand xs = return xs + diff --git a/hledger.hs b/hledger.hs index 288b8bda2..eb36d537d 100644 --- a/hledger.hs +++ b/hledger.hs @@ -6,6 +6,7 @@ module Main -- application logic & most IO where +import System.Environment (withArgs) -- for testing in old hugs import System import Data.List import Test.HUnit (runTestTT) @@ -14,7 +15,6 @@ import Text.ParserCombinators.Parsec (parseFromFile, ParseError) import Options import Models -import Account import Parse import Tests @@ -28,7 +28,7 @@ main = do if "reg" `isPrefixOf` command then (register opts args') else if "bal" `isPrefixOf` command then balance opts args' else if "test" `isPrefixOf` command then test - else error "could not recognise your command" + else putStr $ usageInfo usageHeader options -- commands @@ -67,10 +67,13 @@ printRegister opts args ledger = do printBalance :: [Flag] -> [String] -> Ledger -> IO () printBalance opts args ledger = do - putStr $ showLedgerAccountsWithBalances ledger +-- putStr $ showAccountWithBalances ledger (ledgerAccountsData l) + putStr $ showLedgerAccounts ledger acctpats depth where (acctpats,_) = ledgerPatternArgs args - showsubs = (ShowSubs `elem` opts) - accounts = case showsubs of - True -> expandAccountNamesMostly ledger (ledgerTopAccountNames ledger) - False -> [(a,indentAccountName a) | a <- ledgerAccountNamesMatching acctpats ledger] + depth = depthOption opts + +-- showsubs = (ShowSubs `elem` opts) +-- accounts = case showsubs of +-- True -> expandAccountNamesMostly ledger (ledgerTopAccountNames ledger) +-- False -> [(a,indentAccountName a) | a <- ledgerAccountNamesMatching acctpats ledger]