diff --git a/Options.hs b/Options.hs index 837a4ca42..10b7b212d 100644 --- a/Options.hs +++ b/Options.hs @@ -29,6 +29,6 @@ get_content (File s) = Just s --defaultLedgerFile = tildeExpand "~/ledger.dat" defaultLedgerFile = "ledger.dat" -ledgerFile :: IO String -ledgerFile = do +ledgerFilePath :: IO String +ledgerFilePath = do getEnv "LEDGER" `catch` \_ -> return defaultLedgerFile >>= return diff --git a/Parse.hs b/Parse.hs index 46aaffed5..e7f800d4e 100644 --- a/Parse.hs +++ b/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 parsers, though we're not using these heavily yet +-- set up token parsing, though we're not yet using these much ledgerLanguageDef = LanguageDef { commentStart = "" , commentEnd = "" @@ -233,13 +232,11 @@ whiteSpace1 = do space; whiteSpace -- ok, what can we do with it ? -printParseResult r = - case r of - Left err -> do putStr "ledger parse error at "; print err - Right x -> do print x +printParseResult r = case r of + Left e -> parseError e + Right v -> print v + +parseError e = do putStr "ledger parse error at "; print e parseLedgerFile :: IO String -> IO (Either ParseError Ledger) -parseLedgerFile filepath = do - f <- filepath - parseFromFile ledger f >>= return - +parseLedgerFile f = f >>= parseFromFile ledger diff --git a/Tests.hs b/Tests.hs index ea66d036f..8d2b457fe 100644 --- a/Tests.hs +++ b/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) -sometests = TestList [TestLabel "test1" test1] +test_parse_ledgertransaction = TestCase ( + assertParseEqual + (Transaction "expenses:food:dining" (Amount "$" 10)) + (parse' ledgertransaction sample_transaction)) -tests = Test.HUnit.test [ - "test1" ~: "1==1" ~: 1 ~=? 1, - "test2" ~: assertEqual "2==2" 2 2 +-- parseTest ledgertransaction sample_transaction2 +-- 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 + +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 -prop2 = 1 == 1 +prop1 = 1 == 1 + +--prop_test_parse_ledgertransaction = ? -- commands test :: IO () test = do - parseTest ledgertransaction sample_transaction - parseTest ledgertransaction sample_transaction2 - 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 () - + putStrLn "hunit: "; runTestTT hunittests; runTestTT hunittests2 + putStrLn "quickcheck: "; quickCheck prop1 diff --git a/hledger.hs b/hledger.hs index 967a5edc4..828da512b 100644 --- a/hledger.hs +++ b/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 +