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

reorg, split types into separate modules

Browse Source
This commit is contained in:
Simon Michael 2007-02-16 09:00:17 +00:00
parent 7b32caa0aa
commit ba40fbf733
13 changed files with 451 additions and 299 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Account.hs
View File

@ -1,5 +1,5 @@
module Account --
module Account
where
import Debug.Trace

44
BasicTypes.hs Normal file
View File

@ -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

65
Entry.hs Normal file
View File

@ -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))

82
EntryTransaction.hs Normal file
View File

@ -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)

69
Ledger.hs Normal file
View File

@ -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 = []

2
Makefile
View File

@ -1,5 +1,5 @@
build: Tags
ghc --make -O2 hledger.hs
ghc --make hledger.hs
Tags:
hasktags *hs

315
Models.hs
View File

@ -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

12
Options.hs
View File

@ -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

16
TODO
View File

@ -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

45
Tests.hs
View File

@ -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

52
Transaction.hs Normal file
View File

@ -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]

29
Utils.hs Normal file
View File

@ -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

17
hledger.hs
View File

@ -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]