mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-18 17:57:11 +03:00
register report now has layout, auto-fills missing transaction amounts and shows the running balance
This commit is contained in:
parent
44e302557f
commit
cf953b442d
2
Makefile
2
Makefile
@ -1,5 +1,5 @@
|
||||
build:
|
||||
ghc --make hledger.hs
|
||||
ghc --make -O2 hledger.hs
|
||||
|
||||
Tags:
|
||||
hasktags *hs
|
||||
|
11
Parse.hs
11
Parse.hs
@ -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
51
Tests.hs
@ -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
115
Types.hs
@ -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]
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user