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

register report now has layout, auto-fills missing transaction amounts and shows the running balance

Browse Source
This commit is contained in:
Simon Michael 2007-02-09 15:54:18 +00:00
parent 44e302557f
commit cf953b442d
5 changed files with 134 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

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

11
Parse.hs
View File

@ -179,7 +179,8 @@ ledgerentry = do
description <- anyChar `manyTill` ledgereol
transactions <- ledgertransactions
ledgernondatalines
return (Entry date status code description transactions)
let entry = Entry date status code description transactions
return $ autofill entry
ledgerdate :: Parser String
ledgerdate = do date <- many1 (digit <|> char '/'); many1 spacenonewline; return date
@ -212,10 +213,12 @@ ledgeramount :: Parser Amount
ledgeramount = try (do
many1 spacenonewline
currency <- many (noneOf "-.0123456789\n") <?> "currency"
quantity <- many1 (oneOf "-.0123456789") <?> "quantity"
return (Amount currency (read quantity))
quantity <- many1 (oneOf "-.,0123456789") <?> "quantity"
return (Amount currency (read $ stripcommas quantity))
) <|>
return (Amount "" 0)
return (Amount "AUTO" 0)
stripcommas = filter (',' /=)
ledgereol :: Parser String
ledgereol = ledgercomment <|> do {newline; return []}

51
Tests.hs
View File

@ -125,6 +125,22 @@ parse' p ts = parse p "" ts
-- hunit tests
-- parseTest ledgertransaction sample_transaction2
-- parseTest ledgerentry sample_entry2
-- parseTest ledgerentry sample_entry3
-- parseTest ledgerperiodicentry sample_periodic_entry
-- parseTest ledgerperiodicentry sample_periodic_entry2
-- parseTest ledgerperiodicentry sample_periodic_entry3
-- parseTest ledger sample_ledger
-- parseTest ledger sample_ledger2
-- parseTest ledger sample_ledger3
-- parseTest ledger sample_ledger4
-- parseTest ledger sample_ledger5
-- parseTest ledger sample_ledger6
-- parseTest ledger sample_periodic_entry
-- parseTest ledger sample_periodic_entry2
-- parseLedgerFile ledgerFilePath >>= printParseResult
test_parse_ledgertransaction :: Assertion
test_parse_ledgertransaction =
assertParseEqual
@ -134,21 +150,20 @@ test_parse_ledgertransaction =
entry2 =
(Entry "2007/01/28" False "" "coopportunity"
[Transaction "expenses:food:groceries" (Amount "$" 47.18),
Transaction "assets:checking" (Amount "" 0)])
Transaction "assets:checking" (Amount "$" (-47.18))])
test_parse_ledgerentry =
assertParseEqual entry2 (parse' ledgerentry sample_entry2)
test_show_entry =
assertEqual'
"2007/01/28 coopportunity\n expenses:food:groceries $47.18\n assets:checking 0.0\n"
(show entry2)
assertParseEqual entry2 (parse' ledgerentry sample_entry2)
test_autofill_entry =
assertEqual'
(Amount "$" (-47.18))
(amount $ last $ transactions $ autofill entry2)
hunittests = TestList [
test "test_parse_ledgertransaction" test_parse_ledgertransaction
, test "test_parse_ledgerentry" test_parse_ledgerentry
-- , test "test_show_entry" test_show_entry
, test "test_autofill_entry" test_autofill_entry
]
where test label fn = TestLabel label $ TestCase fn
@ -170,20 +185,6 @@ prop1 = 1 == 1
test :: IO ()
test = do
runTestTT hunittests
runTestTT hunittests2
quickCheck prop1
parseTest ledgertransaction sample_transaction2
parseTest ledgerentry sample_entry2
-- parseTest ledgerentry sample_entry3
-- parseTest ledgerperiodicentry sample_periodic_entry
-- parseTest ledgerperiodicentry sample_periodic_entry2
-- parseTest ledgerperiodicentry sample_periodic_entry3
-- parseTest ledger sample_ledger
-- parseTest ledger sample_ledger2
-- parseTest ledger sample_ledger3
-- parseTest ledger sample_ledger4
-- parseTest ledger sample_ledger5
-- parseTest ledger sample_ledger6
-- parseTest ledger sample_periodic_entry
-- parseTest ledger sample_periodic_entry2
-- parseLedgerFile ledgerFilePath >>= printParseResult
-- runTestTT hunittests2
-- quickCheck prop1
return ()

115
Types.hs
View File

@ -29,12 +29,25 @@ data Transaction = Transaction {
} deriving (Eq)
data Amount = Amount {
currency :: String,
quantity :: Float
quantity :: Double
} deriving (Eq)
type Date = String
type Account = String
-- show methods
-- 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)
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)
-- show & display methods
instance Show Ledger where
show l = "Ledger with " ++ m ++ " modifier, " ++ p ++ " periodic, " ++ e ++ " normal entries:\n"
@ -52,32 +65,98 @@ instance Show ModifierEntry where
instance Show PeriodicEntry where
show e = "~ " ++ (periodexpr e) ++ "\n" ++ unlines (map show (p_transactions e))
instance Show Entry where show = showEntry2
instance Show Entry where show = showEntry
showEntry1 e = date e ++ " " ++ s ++ c ++ d ++ "\n" ++ unlines (map show (transactions e))
showEntryOld :: Entry -> String
showEntryOld e = date e ++ " " ++ s ++ c ++ d ++ "\n" ++ unlines (map show (transactions e))
where
d = description e
s = case (status e) of {True -> "* "; False -> ""}
c = case (length(code e) > 0) of {True -> (code e ++ " "); False -> ""}
dateWidth = 10
descWidth = 20
acctWidth = 25
amtWidth = 11
-- a register entry is displayed as two or more lines like this:
-- date description account amount balance
showEntry2 e =
unlines (
[printf "%-10s %-20s " (date e) (take 20 $ description e)
++ (show $ head $ transactions e)]
++ map ((printf (take 32 (repeat ' ')) ++) . show) (tail $ transactions e))
-- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAA AAAAAAAAAA
-- aaaaaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAA AAAAAAAAAA
-- ... ... ...
-- dateWidth = 10
-- descWidth = 20
-- acctWidth = 25
-- amtWidth = 10
-- balWidth = 10
-- convert an Entry to entry lines (string, amount pairs)
entryLines :: Entry -> [(String,Amount)]
entryLines e =
[(entrydesc ++ (show t), amount t)]
++ map (\t -> (prependSpace $ show t, amount t)) ts
where
t:ts = transactions e
entrydesc = printf "%-10s %-20s " (date e) (take 20 $ description e)
prependSpace = (printf (take 32 (repeat ' ')) ++)
instance Show Transaction where
show t = printf "%-25s %8.2s %8.2s" (take 25 $ account t) (show $ amount t) (show 0)
show t = printf "%-25s %10s " (take 25 $ account t) (show $ amount t)
instance Show Amount where show a = (currency a) ++ (show $ quantity a)
instance Show Amount where
show (Amount cur qty) =
let roundedqty = printf "%.2f" qty in
case roundedqty of
"0.00" -> "0"
otherwise -> cur ++ roundedqty
-- more display methods
showEntry :: Entry -> String
showEntry e = unlines $ map fst (entryLines e)
-- add balances to entry lines, given a starting balance
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 ++ (printf "%10.2s" (show bal'))
showEntryWithBalances :: Entry -> Amount -> String
showEntryWithBalances e b = unlines $
[s | (s,a,b) <- entryLinesWithBalances (entryLines e) b]
-- show register entries, keeping a running balance
showRegisterEntries :: [Entry] -> Amount -> String
showRegisterEntries [] _ = ""
showRegisterEntries (e:es) b =
showEntryWithBalances e b ++ (showRegisterEntries es b')
where b' = b + (sumTransactions (transactions e))
printRegister :: Ledger -> IO ()
printRegister l = do
putStr $ concat $ map show $ entries l
printRegister l = putStr $ showRegisterEntries (entries l) 0
-- misc
transactionsFrom :: [Entry] -> [Transaction]
transactionsFrom es = concat $ map transactions es
-- fill in missing amounts etc., as far as possible
autofill :: Entry -> Entry
autofill e = Entry (date e) (status e) (code e) (description e)
(autofillTransactions (transactions e))
autofillTransactions :: [Transaction] -> [Transaction]
autofillTransactions ts =
let (ns,as) = normalAndAutoTransactions ts in
case (length as) of
0 -> ns
1 -> let t = head as
newamt = -(sumTransactions ns)
in
ns ++ [Transaction (account t) newamt]
otherwise -> error "too many blank transactions in this entry"
normalAndAutoTransactions :: [Transaction] -> ([Transaction], [Transaction])
normalAndAutoTransactions ts =
([t | t <- ts, (currency $ amount t) /= "AUTO"],
[t | t <- ts, (currency $ amount t) == "AUTO"])
sumTransactions :: [Transaction] -> Amount
sumTransactions ts = sum [amount t | t <- ts]

5
hledger.hs
View File

@ -13,10 +13,11 @@ import Tests
main :: IO ()
main = do
(opts, args) <- getArgs >>= getOptions
test
if "reg" `elem` args
then register
else if "test" `elem` args
then test
-- else if "test" `elem` args
-- then test
else return ()
-- commands