tests cleanup

NOTES

@@ -2,10 +2,14 @@ hledger project notes
 
 * TO DO
 ** bugs
+** compatibility
+*** , in thousands
+*** use greatest precision in register
+*** abbreviate 0
+*** don't combine entries so much in register
 ** basic features
 *** print
 *** !include
-*** , in thousands
 *** -j and -J graph data output
 
 ** advanced features
@@ -67,38 +71,3 @@ what does my balance future look like ?
 are there any cashflow, tax, budgetary problems looming ?
 
 * misc
-** testing support
-
--- {- | looks in Tests.hs for functions like prop_foo and returns
---   the list.  Requires that Tests.hs be valid Haskell98. -}
--- tests :: [String]
--- tests = unsafePerformIO $
---   do h <- openFile "src/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
-
--- mkCheck name = [| putStr (name ++ ": ")
---                >> quickCheck $(varE (mkName name)) |]
-
--- mkChecks []        = undefined -- if we don't have any tests, then the test suite is undefined right?
--- mkChecks [name]    = mkCheck name
--- mkChecks (name:ns) = [| $(mkCheck name) >> $(mkChecks ns) |]
-
--- {-# OPTIONS_GHC -fno-warn-unused-imports -no-recomp -fth #-}
--- runTests :: IO ()
--- runTests = $(mkChecks tests)
-
--- ghc --make Unit.hs -main-is Unit.runTests -o unit

Tests.hs

@@ -1,4 +1,3 @@
-
 module Tests
 where
 import qualified Data.Map as Map
@@ -9,7 +8,60 @@ import Models
 import Parse
 import Utils
 
--- sample data
+-- utils
+
+assertEqual' e a = assertEqual "" e a
+
+parse' p ts = parse p "" ts
+
+assertParseEqual :: (Show a, Eq a) => a -> (Either ParseError a) -> Assertion
+assertParseEqual expected parsed =
+    case parsed of
+      Left e -> parseError e
+      Right v -> assertEqual " " expected v
+
+parseEqual :: Eq a => (Either ParseError a) -> a -> Bool
+parseEqual parsed other =
+    case parsed of
+      Left e -> False
+      Right v -> v == other
+
+-- find tests with template haskell
+--
+-- {-# 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
+
+
+-- test data
 
 transaction1_str  = "  expenses:food:dining  $10.00\n"
 
@@ -236,37 +288,29 @@ timelog1 = TimeLog [
             timelogentry2
            ]
 
+-- tests
 
--- utils
+quickcheck = mapM quickCheck ([
+        ] :: [Bool])
 
-assertEqual' e a = assertEqual "" e a
+hunit = runTestTT $ "hunit" ~: test ([
-
+         "" ~: parseLedgerPatternArgs []                     @=? ([],[])
-parse' p ts = parse p "" ts
+        ,"" ~: parseLedgerPatternArgs ["a"]                  @=? (["a"],[])
-
+        ,"" ~: parseLedgerPatternArgs ["a","b"]              @=? (["a","b"],[])
-assertParseEqual :: (Show a, Eq a) => a -> (Either ParseError a) -> Assertion
+        ,"" ~: parseLedgerPatternArgs ["a","b","--"]         @=? (["a","b"],[])
-assertParseEqual expected parsed =
+        ,"" ~: parseLedgerPatternArgs ["a","b","--","c","b"] @=? (["a","b"],["c","b"])
-    case parsed of
+        ,"" ~: parseLedgerPatternArgs ["--","c"]             @=? ([],["c"])
-      Left e -> parseError e
+        ,"" ~: parseLedgerPatternArgs ["--"]                 @=? ([],[])
-      Right v -> assertEqual " " expected v
+        ,"" ~: test_ledgertransaction
-
+        ,"" ~: test_ledgerentry
-parseEquals :: Eq a => (Either ParseError a) -> a -> Bool
+        ,"" ~: test_autofillEntry
-parseEquals parsed other =
+        ,"" ~: test_timelogentry
-    case parsed of
+        ,"" ~: test_timelog
-      Left e -> False
+        ,"" ~: test_expandAccountNames
-      Right v -> v == other
+        ,"" ~: test_ledgerAccountNames
-
+        ,"" ~: test_cacheLedger
--- hunit tests
+        ,"" ~: test_showLedgerAccounts
-
+        ] :: [Test])
-tests = runTestTT $ test [
-         2 @=? 2
-        , test_ledgertransaction
-        , test_ledgerentry
-        , test_autofillEntry
-        , test_expandAccountNames
-        , test_ledgerAccountNames
-        , test_cacheLedger
-        , test_showLedgerAccounts
-        ]
 
 test_ledgertransaction :: Assertion
 test_ledgertransaction =
@@ -280,6 +324,13 @@ test_autofillEntry =
     (Amount (getcurrency "$") (-47.18))
     (tamount $ last $ etransactions $ autofillEntry entry1)
 
+test_timelogentry = do
+    assertParseEqual timelogentry1 (parse' timelogentry timelogentry1_str)
+    assertParseEqual timelogentry2 (parse' timelogentry timelogentry2_str)
+
+test_timelog =
+    assertParseEqual timelog1 (parse' timelog timelog1_str)
+
 test_expandAccountNames =
     assertEqual'
     ["assets","assets:cash","assets:checking","expenses","expenses:vacation"]
@@ -298,29 +349,3 @@ test_cacheLedger =
 test_showLedgerAccounts = 
     assertEqual' 4 (length $ lines $ showLedgerAccounts l7 [] False 1)
 
--- quickcheck properties
-
-props = mapM quickCheck
-    [
-     parse' ledgertransaction transaction1_str `parseEquals`
-     (Transaction "expenses:food:dining" (Amount (getcurrency "$") 10))
-    ,
-     rawLedgerAccountNames ledger7 == 
-     ["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"]
-    ,
-     parseLedgerPatternArgs [] == ([],[])
-    ,parseLedgerPatternArgs ["a"] == (["a"],[])
-    ,parseLedgerPatternArgs ["a","b"] == (["a","b"],[])
-    ,parseLedgerPatternArgs ["a","b","--"] == (["a","b"],[])
-    ,parseLedgerPatternArgs ["a","b","--","c","b"] == (["a","b"],["c","b"])
-    ,parseLedgerPatternArgs ["--","c"] == ([],["c"])
-    ,parseLedgerPatternArgs ["--"] == ([],[])
-    ,parse' timelogentry timelogentry1_str `parseEquals` timelogentry1
-    ,parse' timelogentry timelogentry2_str `parseEquals` timelogentry2
-    ,parse' timelog timelog1_str `parseEquals` timelog1
-    ]
-
-

hledger.hs

@@ -33,6 +33,12 @@ main = do
 
 -- commands
 
+selftest :: IO () -- "hledger test"
+selftest = do
+  Tests.hunit
+  Tests.quickcheck
+  return ()
+
 register :: [Flag] -> [String] -> [String] -> IO ()
 register opts acctpats descpats = do 
   doWithLedger opts printRegister
@@ -54,13 +60,6 @@ balance opts acctpats _ = do
                              ([],False) -> 1
                              otherwise  -> 9999
 
-selftest :: IO ()
-selftest = do
-  Tests.tests
-  Tests.props
-  -- Amount.tests
-  return ()
-
 -- utils
 
 doWithLedger :: [Flag] -> (Ledger -> IO ()) -> IO ()