From 37e75d610e5f4d8025caf831f10c7388d5279522 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 10 Oct 2008 08:16:55 +0000 Subject: [PATCH] more tests cleanup.. prepare for per-module tests, but consolidate in Tests where I think we will stay --- BalanceCommand.hs | 3 ++ Ledger/Account.hs | 3 ++ Ledger/AccountName.hs | 4 ++ Ledger/Amount.hs | 15 ------- Ledger/Currency.hs | 3 ++ Ledger/Entry.hs | 3 ++ Ledger/Ledger.hs | 3 ++ Ledger/Parse.hs | 9 +++-- Ledger/RawLedger.hs | 3 ++ Ledger/RawTransaction.hs | 3 ++ Ledger/TimeLog.hs | 3 ++ Ledger/Transaction.hs | 3 ++ Ledger/Utils.hs | 3 +- NOTES | 79 ++++++++++++++++++++++++++---------- PrintCommand.hs | 3 ++ RegisterCommand.hs | 3 ++ Tests.hs | 86 +++++++++++++++++++++++++--------------- hledger.hs | 2 +- 18 files changed, 159 insertions(+), 72 deletions(-) diff --git a/BalanceCommand.hs b/BalanceCommand.hs index c05ad1530..50aebbed4 100644 --- a/BalanceCommand.hs +++ b/BalanceCommand.hs @@ -107,6 +107,9 @@ import Ledger.Ledger import Options +balancecommandtests = TestList [ + ] + -- | Print a balance report. printbalance :: [Opt] -> [String] -> Ledger -> IO () printbalance opts args l = putStr $ showLedgerAccountBalances l depth diff --git a/Ledger/Account.hs b/Ledger/Account.hs index 3cca60d28..aed472b3e 100644 --- a/Ledger/Account.hs +++ b/Ledger/Account.hs @@ -13,6 +13,9 @@ import Ledger.Types import Ledger.Amount +accounttests = TestList [ + ] + instance Show Account where show (Account a ts b) = printf "Account %s with %d transactions" a $ length ts diff --git a/Ledger/AccountName.hs b/Ledger/AccountName.hs index ef40c0cf8..551186591 100644 --- a/Ledger/AccountName.hs +++ b/Ledger/AccountName.hs @@ -10,6 +10,10 @@ where import Ledger.Utils import Ledger.Types + +accountnametests = TestList [ + ] + sepchar = ':' accountNameComponents :: AccountName -> [String] diff --git a/Ledger/Amount.hs b/Ledger/Amount.hs index 64897a2b4..aeb469450 100644 --- a/Ledger/Amount.hs +++ b/Ledger/Amount.hs @@ -38,27 +38,12 @@ currencies can be converted to a simple amount. Arithmetic examples: module Ledger.Amount where -import Test.HUnit import Ledger.Utils import Ledger.Types import Ledger.Currency amounttests = TestList [ - show (dollars 1) ~?= "$1.00" - ,show (hours 1) ~?= "h1.00" -- should be 1.0h - ,"precision subtleties" ~: do - let a1 = Amount (getcurrency "$") 1.23 1 - let a2 = Amount (getcurrency "$") (-1.23) 2 - let a3 = Amount (getcurrency "$") (-1.23) 3 - assertequal (Amount (getcurrency "$") 0 1) (a1 + a2) - assertequal (Amount (getcurrency "$") 0 1) (a1 + a3) - assertequal (Amount (getcurrency "$") (-2.46) 2) (a2 + a3) - assertequal (Amount (getcurrency "$") (-2.46) 3) (a3 + a3) - -- sum adds 0, with Amount fromIntegral's default precision of 2 - assertequal (Amount (getcurrency "$") 0 1) (sum [a1,a2]) - assertequal (Amount (getcurrency "$") (-2.46) 2) (sum [a2,a3]) - assertequal (Amount (getcurrency "$") (-2.46) 2) (sum [a3,a3]) ] instance Show Amount where show = showAmountRounded diff --git a/Ledger/Currency.hs b/Ledger/Currency.hs index 4649ad187..b7f9260fe 100644 --- a/Ledger/Currency.hs +++ b/Ledger/Currency.hs @@ -12,6 +12,9 @@ import Ledger.Utils import Ledger.Types +currencytests = TestList [ + ] + currencies = [ Currency "$" 1 diff --git a/Ledger/Entry.hs b/Ledger/Entry.hs index 4d04a5759..3403f69a9 100644 --- a/Ledger/Entry.hs +++ b/Ledger/Entry.hs @@ -13,6 +13,9 @@ import Ledger.RawTransaction import Ledger.Amount +entrytests = TestList [ + ] + instance Show Entry where show = showEntryDescription {- diff --git a/Ledger/Ledger.hs b/Ledger/Ledger.hs index a7ddd9d3b..bba93e701 100644 --- a/Ledger/Ledger.hs +++ b/Ledger/Ledger.hs @@ -21,6 +21,9 @@ import Ledger.RawLedger import Ledger.Entry +ledgertests = TestList [ + ] + instance Show Ledger where show l = printf "Ledger with %d entries, %d accounts: %s" ((length $ entries $ rawledger l) + diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index 50f3edef9..e97c78540 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -12,11 +12,14 @@ import qualified Text.ParserCombinators.Parsec.Token as P import System.IO import Ledger.Utils import Ledger.Types -import Ledger.Entry (autofillEntry) -import Ledger.Currency (getcurrency) -import Ledger.TimeLog (ledgerFromTimeLog) +import Ledger.Entry +import Ledger.Currency +import Ledger.TimeLog +parsertests = TestList [ + ] + -- utils parseLedgerFile :: String -> IO (Either ParseError RawLedger) diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index e8a369c96..d6e0a0804 100644 --- a/Ledger/RawLedger.hs +++ b/Ledger/RawLedger.hs @@ -14,6 +14,9 @@ import Ledger.Entry import Ledger.Transaction +rawledgertests = TestList [ + ] + instance Show RawLedger where show l = printf "RawLedger with %d entries, %d accounts: %s" ((length $ entries l) + diff --git a/Ledger/RawTransaction.hs b/Ledger/RawTransaction.hs index 74b1688ea..fd053cb25 100644 --- a/Ledger/RawTransaction.hs +++ b/Ledger/RawTransaction.hs @@ -12,6 +12,9 @@ import Ledger.Types import Ledger.Amount +rawtransactiontests = TestList [ + ] + instance Show RawTransaction where show = showLedgerTransaction showLedgerTransaction :: RawTransaction -> String diff --git a/Ledger/TimeLog.hs b/Ledger/TimeLog.hs index b5582b4d0..c86de92a9 100644 --- a/Ledger/TimeLog.hs +++ b/Ledger/TimeLog.hs @@ -14,6 +14,9 @@ import Ledger.Currency import Ledger.Amount +timelogtests = TestList [ + ] + instance Show TimeLogEntry where show t = printf "%s %s %s" (show $ tlcode t) (tldatetime t) (tlcomment t) diff --git a/Ledger/Transaction.hs b/Ledger/Transaction.hs index 5ff75f42f..d928d76b8 100644 --- a/Ledger/Transaction.hs +++ b/Ledger/Transaction.hs @@ -14,6 +14,9 @@ import Ledger.RawTransaction import Ledger.Amount +transactiontests = TestList [ + ] + instance Show Transaction where show (Transaction eno d desc a amt) = unwords [d,desc,a,show amt] diff --git a/Ledger/Utils.hs b/Ledger/Utils.hs index 2ec8c0be9..9290cad68 100644 --- a/Ledger/Utils.hs +++ b/Ledger/Utils.hs @@ -18,6 +18,7 @@ module Ledger.Utils, module System.Locale, module Text.Printf, module Text.Regex, +module Test.HUnit, ) where import Char @@ -30,7 +31,7 @@ import Data.Time.Format (ParseTime, parseTime, formatTime) import Data.Tree import Debug.Trace import System.Locale (defaultTimeLocale) -import Test.HUnit (assertEqual) +import Test.HUnit import Test.QuickCheck hiding (test, Testable) import Text.Printf import Text.Regex diff --git a/NOTES b/NOTES index 9f3b68dcd..b443cfd7a 100644 --- a/NOTES +++ b/NOTES @@ -1,4 +1,4 @@ -hledger project notes & ideas +hledger project notes "...simplicity of design was the most essential, guiding principle. Clarity of concepts, economy of features, efficiency and reliability of @@ -8,17 +8,22 @@ implementations were its consequences." --Niklaus Wirth ** bugs *** balance reports & filtering are quirky/broken/different from ledger *** register doesn't filter +** testing +*** balance report regression tests +**** find out how http://hunit.sourceforge.net/HUnit-1.0/Guide.html +*** ledger compatibility tests +*** speed tests ** release 0.1 *** cabal upload -*** haskell-cafe/ledger announce +*** haskell-cafe/ledger-cli announce ** ledger features *** handle right-hand currency symbols *** -C *** negative patterns -*** darcs-style--version -*** ledger 2.6-style elision -*** full per-currency precision & thousands separator handling -*** handle mixed-currency amounts +*** darcs-style --version +*** ledger 2.6-style eliding +*** per-currency precision/thousands separator/symbol layout +*** mixed-currency amounts *** more speed *** other ledger 2.6 features **** !include @@ -34,30 +39,28 @@ implementations were its consequences." --Niklaus Wirth *** smart data entry *** timeclock.el features *** better layout -** testing -*** better use of quickcheck/smallcheck - http://blog.codersbase.com/2006/09/01/simple-unit-testing-in-haskell/ -*** ledger compatibility tests ** documentation -*** literate manual +*** implementation docs +*** api docs +*** user manual *** differences/issues **** ledger does not support -f- (without space) **** ledger shows description comments as part of description, we do the same **** ledger does not sort register by date **** ledger can show wrong output due to thousands separators **** ledger balance with an account pattern shows a redundant total -**** hledger does not choose symbol separation, thousands separators, and precision based on first entry of each currency - (currently: chooses precision for all currencies based on first entry) +**** hledger does not detect symbol layout/thousands separators/precision based on first entry of each currency **** hledger does not track currency/precision in as much detail **** hledger ignores automated/periodic entries -**** hledger shows .00 -* things I want to know -** time +**** hledger does not elide .00 +* misc +** things I want to know +*** time where have I been spending my time in recent weeks ? where have I spent my time today ? what is my status wrt spending plan for this week/month/year ? what is my current status wrt time spending goals ? -** money +*** money where have I been spending my money ? what is my status wrt spending plan for this week/month/year ? what is my current status wrt spending/savings goals ? @@ -65,8 +68,7 @@ what are all my current balances ? what does my balance history look like ? what does my balance future look like ? are there any cashflow, tax, budgetary problems looming ? - -** charts +*** charts [1:27pm] I have decided I am not getting enough visible day-to-day value out of my ledger, I need more of that to stay motivated [1:27pm] What do you think will help in that? [1:27pm] I think some simple self-updating charts, or even good reports in a visible place @@ -91,7 +93,6 @@ are there any cashflow, tax, budgetary problems looming ? [2:08pm] those would be a good start. How do I make those visual [2:09pm] well I guess the first step is a script to print them -* misc ** compare other languages! a parser generator and decent speed is required *** python: http://cheeseshop.python.org/pypi/ZestyParser, pysec, pyparsing *** squeak: LanguageGame, T-Gen, SmaCC @@ -103,7 +104,43 @@ are there any cashflow, tax, budgetary problems looming ? *** http://www.n-heptane.com/nhlab/repos/Decimal/ *** http://www.n-heptane.com/nhlab/repos/Decimal/Money.hs *** http://www2.hursley.ibm.com/decimal/ -*** import hierarchy + +** lispy's template haskell for quickcheck +-- find tests with template haskell +import Language.Haskell.Parser + +{-# OPTIONS_GHC -fno-warn-unused-imports -no-recomp -fth #-} +{- ghc --make Unit.hs -main-is Unit.runTests -o unit -} +runTests :: IO () +runTests = $(mkChecks props) + +mkChecks [] = undefined +mkChecks [name] = mkCheck name +mkChecks (name:ns) = [| $(mkCheck name) >> $(mkChecks ns) |] + +mkCheck name = [| putStr (name ++ ": ") >> quickCheck $(varE (mkName name)) |] + +{- | looks in Tests.hs for functions like prop_foo and returns + the list. Requires that Tests.hs be valid Haskell98. -} +props :: [String] +props = unsafePerformIO $ + do h <- openFile "Tests.hs" ReadMode + s <- hGetContents h + case parseModule s of + (ParseOk (HsModule _ _ _ _ ds)) -> return (map declName (filter isProp ds)) + (ParseFailed loc s') -> error (s' ++ " " ++ show loc) + +{- | checks if function binding name starts with @prop_@ indicating + that it is a quickcheck property -} +isProp :: HsDecl -> Bool +isProp d@(HsFunBind _) = "prop_" `isPrefixOf` (declName d) +isProp _ = False + +{- | takes an HsDecl and returns the name of the declaration -} +declName :: HsDecl -> String +declName (HsFunBind (HsMatch _ (HsIdent name) _ _ _:_)) = name +declName _ = undefined +** old import hierarchy "Parse" "TimeLog" "Ledger" diff --git a/PrintCommand.hs b/PrintCommand.hs index 6b9bccff1..d558c3a10 100644 --- a/PrintCommand.hs +++ b/PrintCommand.hs @@ -10,6 +10,9 @@ import Ledger import Options +printcommandtests = TestList [ + ] + -- | Print ledger entries in standard format. printentries :: [Opt] -> [String] -> Ledger -> IO () printentries opts args l = putStr $ showEntries $ setprecisions $ entries $ rawledger l diff --git a/RegisterCommand.hs b/RegisterCommand.hs index f6473efb6..a9c36ed89 100644 --- a/RegisterCommand.hs +++ b/RegisterCommand.hs @@ -10,6 +10,9 @@ import Ledger import Options +registercommandtests = TestList [ + ] + -- | Print a register report. printregister :: [Opt] -> [String] -> Ledger -> IO () printregister opts args l = putStr $ showTransactionsWithBalances txns startingbalance diff --git a/Tests.hs b/Tests.hs index 9872fb6d4..76d7b6aa9 100644 --- a/Tests.hs +++ b/Tests.hs @@ -5,63 +5,87 @@ import Text.ParserCombinators.Parsec import Test.HUnit import Ledger import BalanceCommand +import PrintCommand +import RegisterCommand -- import Test.QuickCheck -- quickcheck = mapM quickCheck ([ -- ] :: [Bool]) -hunit = runTestTT $ concattests [ - tests - ,amounttests - ] +runhunit = runTestTT alltests + +alltests = concattests [ + tests + ,accounttests + ,accountnametests + ,amounttests + ,balancecommandtests + ,currencytests + ,entrytests + ,ledgertests + ,parsertests + ,printcommandtests + ,rawledgertests + ,rawtransactiontests + ,registercommandtests + ,timelogtests + ] where - concattests = foldr addtests (TestList []) - addtests (TestList as) (TestList bs) = TestList (as ++ bs) + concattests = foldr (\(TestList as) (TestList bs) -> TestList (as ++ bs)) (TestList []) tests = TestList [ - "punctuatethousands" ~: punctuatethousands "" @?= "" + show (dollars 1) ~?= "$1.00" + ,show (hours 1) ~?= "h1.00" -- should be 1.0h + + ,"precision subtleties" ~: do + let a1 = Amount (getcurrency "$") 1.23 1 + let a2 = Amount (getcurrency "$") (-1.23) 2 + let a3 = Amount (getcurrency "$") (-1.23) 3 + assertequal (Amount (getcurrency "$") 0 1) (a1 + a2) + assertequal (Amount (getcurrency "$") 0 1) (a1 + a3) + assertequal (Amount (getcurrency "$") (-2.46) 2) (a2 + a3) + assertequal (Amount (getcurrency "$") (-2.46) 3) (a3 + a3) + -- sum adds 0, with Amount fromIntegral's default precision of 2 + assertequal (Amount (getcurrency "$") 0 1) (sum [a1,a2]) + assertequal (Amount (getcurrency "$") (-2.46) 2) (sum [a2,a3]) + assertequal (Amount (getcurrency "$") (-2.46) 2) (sum [a3,a3]) + + ,"ledgertransaction" ~: do + assertparseequal rawtransaction1 (parsewith ledgertransaction rawtransaction1_str) + + ,"ledgerentry" ~: do + assertparseequal entry1 (parsewith ledgerentry entry1_str) + + ,"autofillEntry" ~: do + assertequal + (Amount (getcurrency "$") (-47.18) 2) + (tamount $ last $ etransactions $ autofillEntry entry1) + + ,"punctuatethousands" ~: punctuatethousands "" @?= "" ,"punctuatethousands" ~: punctuatethousands "1234567.8901" @?= "1,234,567.8901" ,"punctuatethousands" ~: punctuatethousands "-100" @?= "-100" - ,"test_ledgertransaction" ~: do - assertparseequal rawtransaction1 (parsewith ledgertransaction rawtransaction1_str) - - ,"test_ledgerentry" ~: do - assertparseequal entry1 (parsewith ledgerentry entry1_str) - - ,"test_autofillEntry" ~: do - assertequal - (Amount (getcurrency "$") (-47.18) 2) - (tamount $ last $ etransactions $ autofillEntry entry1) - - ,"test_timelogentry" ~: do - assertparseequal timelogentry1 (parsewith timelogentry timelogentry1_str) - assertparseequal timelogentry2 (parsewith timelogentry timelogentry2_str) - - ,"test_timelog" ~: - assertparseequal timelog1 (parsewith timelog timelog1_str) - - ,"test_expandAccountNames" ~: do + ,"expandAccountNames" ~: do assertequal ["assets","assets:cash","assets:checking","expenses","expenses:vacation"] (expandAccountNames ["assets:cash","assets:checking","expenses:vacation"]) - ,"test_ledgerAccountNames" ~: do + ,"ledgerAccountNames" ~: do assertequal ["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances", "expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation", "liabilities","liabilities:credit cards","liabilities:credit cards:discover"] (accountnames ledger7) - ,"test_cacheLedger" ~: do + ,"cacheLedger" ~: do assertequal 15 (length $ Map.keys $ accounts $ cacheLedger wildcard rawledger7 ) - ,"test_showLedgerAccounts" ~: do + ,"showLedgerAccounts" ~: do assertequal 4 (length $ lines $ showLedgerAccountBalances ledger7 1) - ,"test_ledgeramount" ~: do + ,"ledgeramount" ~: do assertparseequal (Amount (getcurrency "$") 47.18 2) (parsewith ledgeramount " $47.18") assertparseequal (Amount (getcurrency "$") 1 0) (parsewith ledgeramount " $1.") @@ -71,7 +95,6 @@ tests = TestList [ assertparseequal :: (Show a, Eq a) => a -> (Either ParseError a) -> Assertion assertparseequal expected parsed = either printParseError (assertequal expected) parsed - -- test data rawtransaction1_str = " expenses:food:dining $10.00\n" @@ -89,6 +112,7 @@ entry1 = [RawTransaction "expenses:food:groceries" (Amount (getcurrency "$") 47.18 2) "", RawTransaction "assets:checking" (Amount (getcurrency "$") (-47.18) 2) ""] "") + entry2_str = "\ \2007/01/27 * joes diner\n\ \ expenses:food:dining $10.00\n\ diff --git a/hledger.hs b/hledger.hs index 0212829d8..2d90548ce 100644 --- a/hledger.hs +++ b/hledger.hs @@ -32,7 +32,7 @@ main = do run cmd opts args | Help `elem` opts = putStr usage | Version `elem` opts = putStr version - | cmd `isPrefixOf` "selftest" = hunit >> return () + | cmd `isPrefixOf` "selftest" = runhunit >> return () | cmd `isPrefixOf` "print" = parseLedgerAndDo opts args printentries | cmd `isPrefixOf` "register" = parseLedgerAndDo opts args printregister | cmd `isPrefixOf` "balance" = parseLedgerAndDo opts args printbalance