more tests cleanup.. prepare for per-module tests, but consolidate in Tests where I think we will stay

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

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
 

Ledger/AccountName.hs

@@ -10,6 +10,10 @@ where
 import Ledger.Utils
 import Ledger.Types
 
+
+accountnametests = TestList [
+                   ]
+
 sepchar = ':'
 
 accountNameComponents :: AccountName -> [String]

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

Ledger/Currency.hs

@@ -12,6 +12,9 @@ import Ledger.Utils
 import Ledger.Types
 
 
+currencytests = TestList [
+                ]
+
 currencies = 
     [
      Currency "$"   1        

Ledger/Entry.hs

@@ -13,6 +13,9 @@ import Ledger.RawTransaction
 import Ledger.Amount
 
 
+entrytests = TestList [
+             ]
+
 instance Show Entry where show = showEntryDescription
 
 {-

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) +

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)

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) +

Ledger/RawTransaction.hs

@@ -12,6 +12,9 @@ import Ledger.Types
 import Ledger.Amount
 
 
+rawtransactiontests = TestList [
+                      ]
+
 instance Show RawTransaction where show = showLedgerTransaction
 
 showLedgerTransaction :: RawTransaction -> String

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)
 

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]

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

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] <sm> 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] <Nafai> What do you think will help in that?
 [1:27pm] <sm> 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] <sm> those would be a good start. How do I make those visual
 [2:09pm] <sm> 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"

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

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

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\

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