mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-18 17:57:11 +03:00
reorg, split types into separate modules
This commit is contained in:
parent
7b32caa0aa
commit
ba40fbf733
@ -1,5 +1,5 @@
|
||||
|
||||
module Account --
|
||||
module Account
|
||||
where
|
||||
|
||||
import Debug.Trace
|
||||
|
44
BasicTypes.hs
Normal file
44
BasicTypes.hs
Normal 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
65
Entry.hs
Normal 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
82
EntryTransaction.hs
Normal 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
69
Ledger.hs
Normal 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
2
Makefile
@ -1,5 +1,5 @@
|
||||
build: Tags
|
||||
ghc --make -O2 hledger.hs
|
||||
ghc --make hledger.hs
|
||||
|
||||
Tags:
|
||||
hasktags *hs
|
||||
|
315
Models.hs
315
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
|
||||
|
12
Options.hs
12
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
|
||||
|
16
TODO
16
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
|
||||
|
45
Tests.hs
45
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
|
||||
|
52
Transaction.hs
Normal file
52
Transaction.hs
Normal 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
29
Utils.hs
Normal 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
17
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]
|
||||
|
Loading…
Reference in New Issue
Block a user