working test framework

Options.hs

@@ -29,6 +29,6 @@ get_content (File s) = Just s
 --defaultLedgerFile = tildeExpand "~/ledger.dat"
 defaultLedgerFile = "ledger.dat"
 
-ledgerFile :: IO String
+ledgerFilePath :: IO String
-ledgerFile = do
+ledgerFilePath = do
   getEnv "LEDGER" `catch` \_ -> return defaultLedgerFile >>= return

Parse.hs

@@ -96,18 +96,17 @@ i, o, b, h
            timelog files."
 -}
 -- parsec example: http://pandoc.googlecode.com/svn/trunk/src/Text/Pandoc/Readers/RST.hs
+-- sample data in Tests.hs 
 
 module Parse where
 
 import Text.ParserCombinators.Parsec
-import qualified Text.ParserCombinators.Parsec.Token as P
 import Text.ParserCombinators.Parsec.Language
+import qualified Text.ParserCombinators.Parsec.Token as P
 
 import Types
 
--- see sample data in Tests.hs 
+-- set up token parsing, though we're not yet using these much
-
--- set up token parsers, though we're not using these heavily yet
 ledgerLanguageDef = LanguageDef {
    commentStart   = ""
    , commentEnd     = ""
@@ -233,13 +232,11 @@ whiteSpace1 = do space; whiteSpace
 
 -- ok, what can we do with it ?
 
-printParseResult r =
+printParseResult r = case r of
-    case r of
+                       Left e -> parseError e
-      Left err -> do putStr "ledger parse error at "; print err
+                       Right v  -> print v
-      Right x  -> do print x
+
+parseError e = do putStr "ledger parse error at "; print e
 
 parseLedgerFile :: IO String -> IO (Either ParseError Ledger)
-parseLedgerFile filepath = do
+parseLedgerFile f = f >>= parseFromFile ledger
-  f <- filepath
-  parseFromFile ledger f >>= return
-

Tests.hs

@@ -1,12 +1,12 @@
 module Tests where
 
+import Text.ParserCombinators.Parsec
 import Test.QuickCheck
 import Test.HUnit
-import Text.ParserCombinators.Parsec
---import Control.Exception (assert)
 
-import Parse
 import Options
+import Types
+import Parse
 
 -- sample data
 
@@ -110,44 +110,57 @@ sample_ledger6 = "\
 \;     equity:opening balances                         \n\
 \\n" --"
 
+-- utils
+
+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
+
+parse' p ts = parse p "" ts
+    
 -- hunit tests
 
-test1 = TestCase (assertEqual "1==1" 1 1)
+test_parse_ledgertransaction = TestCase (
-sometests = TestList [TestLabel "test1" test1]
+  assertParseEqual
+    (Transaction "expenses:food:dining" (Amount "$" 10))
+    (parse' ledgertransaction sample_transaction))
 
-tests = Test.HUnit.test [
+--   parseTest ledgertransaction sample_transaction2
-              "test1" ~: "1==1" ~: 1 ~=? 1,
+--   parseTest ledgerentry sample_entry
-              "test2" ~: assertEqual "2==2" 2 2
+--   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 ledgerFile >>= printParseResult
+
+hunittests = TestList [
+                       TestLabel "test_parse_ledgertransaction" test_parse_ledgertransaction
+                      ]
+
+hunittests2 = Test.HUnit.test [
+              "test1" ~: assertEqual "2 equals 2" 2 2
              ]
 
 -- quickcheck tests
 
-prop_test1 = 1 == 1
+prop1 = 1 == 1
-prop2 = 1 == 1
+
+--prop_test_parse_ledgertransaction = ?
 
 -- commands
 
 test :: IO ()      
 test = do
-  parseTest ledgertransaction sample_transaction
+  putStrLn "hunit: "; runTestTT hunittests; runTestTT hunittests2
-  parseTest ledgertransaction sample_transaction2
+  putStrLn "quickcheck: "; quickCheck prop1
-  parseTest ledgerentry sample_entry
-  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 ledgerFile >>= printParseResult
-  return ()
---   assert_ $ amount t1 == 8.50
---   putStrLn "ok"
---     where assert_ e = assert e return ()             
-

hledger.hs

@@ -10,22 +10,21 @@ import Types
 import Parse
 import Tests
 
--- commands
-
-register :: IO ()
-register = do 
-  p <- parseLedgerFile ledgerFile
-  case p of
-    Left e -> do putStr "ledger parse error at "; print e
-    Right l  -> putStr $ showLedger l
-
 main :: IO ()
 main = do
   (opts, args) <- getArgs >>= getOptions
-  --putStr "options: "; print opts
-  --putStr "arguments: "; print args
   if "reg" `elem` args
     then register
     else if "test" `elem` args 
          then test
          else return ()
+
+-- commands
+
+register :: IO ()
+register = do 
+  p <- parseLedgerFile ledgerFilePath
+  case p of
+    Left e -> do putStr "ledger parse error at "; print e
+    Right l  -> putStr $ showLedger l
+