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:
|
build:
|
||||||
ghc --make hledger.hs
|
ghc --make -O2 hledger.hs
|
||||||
|
|
||||||
Tags:
|
Tags:
|
||||||
hasktags *hs
|
hasktags *hs
|
||||||
|
11
Parse.hs
11
Parse.hs
@ -179,7 +179,8 @@ ledgerentry = do
|
|||||||
description <- anyChar `manyTill` ledgereol
|
description <- anyChar `manyTill` ledgereol
|
||||||
transactions <- ledgertransactions
|
transactions <- ledgertransactions
|
||||||
ledgernondatalines
|
ledgernondatalines
|
||||||
return (Entry date status code description transactions)
|
let entry = Entry date status code description transactions
|
||||||
|
return $ autofill entry
|
||||||
|
|
||||||
ledgerdate :: Parser String
|
ledgerdate :: Parser String
|
||||||
ledgerdate = do date <- many1 (digit <|> char '/'); many1 spacenonewline; return date
|
ledgerdate = do date <- many1 (digit <|> char '/'); many1 spacenonewline; return date
|
||||||
@ -212,10 +213,12 @@ ledgeramount :: Parser Amount
|
|||||||
ledgeramount = try (do
|
ledgeramount = try (do
|
||||||
many1 spacenonewline
|
many1 spacenonewline
|
||||||
currency <- many (noneOf "-.0123456789\n") <?> "currency"
|
currency <- many (noneOf "-.0123456789\n") <?> "currency"
|
||||||
quantity <- many1 (oneOf "-.0123456789") <?> "quantity"
|
quantity <- many1 (oneOf "-.,0123456789") <?> "quantity"
|
||||||
return (Amount currency (read quantity))
|
return (Amount currency (read $ stripcommas quantity))
|
||||||
) <|>
|
) <|>
|
||||||
return (Amount "" 0)
|
return (Amount "AUTO" 0)
|
||||||
|
|
||||||
|
stripcommas = filter (',' /=)
|
||||||
|
|
||||||
ledgereol :: Parser String
|
ledgereol :: Parser String
|
||||||
ledgereol = ledgercomment <|> do {newline; return []}
|
ledgereol = ledgercomment <|> do {newline; return []}
|
||||||
|
51
Tests.hs
51
Tests.hs
@ -125,6 +125,22 @@ parse' p ts = parse p "" ts
|
|||||||
|
|
||||||
-- hunit tests
|
-- 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 :: Assertion
|
||||||
test_parse_ledgertransaction =
|
test_parse_ledgertransaction =
|
||||||
assertParseEqual
|
assertParseEqual
|
||||||
@ -134,21 +150,20 @@ test_parse_ledgertransaction =
|
|||||||
entry2 =
|
entry2 =
|
||||||
(Entry "2007/01/28" False "" "coopportunity"
|
(Entry "2007/01/28" False "" "coopportunity"
|
||||||
[Transaction "expenses:food:groceries" (Amount "$" 47.18),
|
[Transaction "expenses:food:groceries" (Amount "$" 47.18),
|
||||||
Transaction "assets:checking" (Amount "" 0)])
|
Transaction "assets:checking" (Amount "$" (-47.18))])
|
||||||
|
|
||||||
test_parse_ledgerentry =
|
test_parse_ledgerentry =
|
||||||
assertParseEqual entry2 (parse' ledgerentry sample_entry2)
|
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)
|
|
||||||
|
|
||||||
|
test_autofill_entry =
|
||||||
|
assertEqual'
|
||||||
|
(Amount "$" (-47.18))
|
||||||
|
(amount $ last $ transactions $ autofill entry2)
|
||||||
|
|
||||||
hunittests = TestList [
|
hunittests = TestList [
|
||||||
test "test_parse_ledgertransaction" test_parse_ledgertransaction
|
test "test_parse_ledgertransaction" test_parse_ledgertransaction
|
||||||
, test "test_parse_ledgerentry" test_parse_ledgerentry
|
, 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
|
where test label fn = TestLabel label $ TestCase fn
|
||||||
|
|
||||||
@ -170,20 +185,6 @@ prop1 = 1 == 1
|
|||||||
test :: IO ()
|
test :: IO ()
|
||||||
test = do
|
test = do
|
||||||
runTestTT hunittests
|
runTestTT hunittests
|
||||||
runTestTT hunittests2
|
-- runTestTT hunittests2
|
||||||
quickCheck prop1
|
-- quickCheck prop1
|
||||||
parseTest ledgertransaction sample_transaction2
|
return ()
|
||||||
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
|
|
||||||
|
115
Types.hs
115
Types.hs
@ -29,12 +29,25 @@ data Transaction = Transaction {
|
|||||||
} deriving (Eq)
|
} deriving (Eq)
|
||||||
data Amount = Amount {
|
data Amount = Amount {
|
||||||
currency :: String,
|
currency :: String,
|
||||||
quantity :: Float
|
quantity :: Double
|
||||||
} deriving (Eq)
|
} deriving (Eq)
|
||||||
type Date = String
|
type Date = String
|
||||||
type Account = 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
|
instance Show Ledger where
|
||||||
show l = "Ledger with " ++ m ++ " modifier, " ++ p ++ " periodic, " ++ e ++ " normal entries:\n"
|
show l = "Ledger with " ++ m ++ " modifier, " ++ p ++ " periodic, " ++ e ++ " normal entries:\n"
|
||||||
@ -52,32 +65,98 @@ instance Show ModifierEntry where
|
|||||||
instance Show PeriodicEntry where
|
instance Show PeriodicEntry where
|
||||||
show e = "~ " ++ (periodexpr e) ++ "\n" ++ unlines (map show (p_transactions e))
|
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
|
where
|
||||||
d = description e
|
d = description e
|
||||||
s = case (status e) of {True -> "* "; False -> ""}
|
s = case (status e) of {True -> "* "; False -> ""}
|
||||||
c = case (length(code e) > 0) of {True -> (code e ++ " "); False -> ""}
|
c = case (length(code e) > 0) of {True -> (code e ++ " "); False -> ""}
|
||||||
|
|
||||||
dateWidth = 10
|
-- a register entry is displayed as two or more lines like this:
|
||||||
descWidth = 20
|
-- date description account amount balance
|
||||||
acctWidth = 25
|
|
||||||
amtWidth = 11
|
|
||||||
|
|
||||||
showEntry2 e =
|
-- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAA AAAAAAAAAA
|
||||||
unlines (
|
-- aaaaaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAA AAAAAAAAAA
|
||||||
[printf "%-10s %-20s " (date e) (take 20 $ description e)
|
-- ... ... ...
|
||||||
++ (show $ head $ transactions e)]
|
-- dateWidth = 10
|
||||||
++ map ((printf (take 32 (repeat ' ')) ++) . show) (tail $ transactions e))
|
-- 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
|
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 :: Ledger -> IO ()
|
||||||
printRegister l = do
|
printRegister l = putStr $ showRegisterEntries (entries l) 0
|
||||||
putStr $ concat $ map show $ entries l
|
|
||||||
|
-- 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 :: IO ()
|
||||||
main = do
|
main = do
|
||||||
(opts, args) <- getArgs >>= getOptions
|
(opts, args) <- getArgs >>= getOptions
|
||||||
|
test
|
||||||
if "reg" `elem` args
|
if "reg" `elem` args
|
||||||
then register
|
then register
|
||||||
else if "test" `elem` args
|
-- else if "test" `elem` args
|
||||||
then test
|
-- then test
|
||||||
else return ()
|
else return ()
|
||||||
|
|
||||||
-- commands
|
-- commands
|
||||||
|
Loading…
Reference in New Issue
Block a user