From 158b202ba113914a8aa1fc7a8a410d98bfb18f5b Mon Sep 17 00:00:00 2001
From: Jan Tuomi <jans.tuomi@gmail.com>
Date: Mon, 26 Sep 2022 11:15:48 +0300
Subject: Improve tests

---
 app/Main.hs       |  4 ++--
 src/Utils.hs      |  3 +++
 test/Spec.hs      | 44 ++++++++++++++++++++++++++++----------------
 test/TestUtils.hs | 20 +++++++++++++++-----
 4 files changed, 48 insertions(+), 23 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 06ddb62..4f69776 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -24,7 +24,7 @@ repl config env = do
     case minput of
         Nothing -> return ()
         Just input -> do
-            result <- lift $ runExceptT $ runReaderT (runInlineScript env input) config
+            result <- lift $ runL config (runInlineScript env input)
             case result of
                 Left (LException ex) -> do
                     outputStrLn $ "Error: " ++ ex
@@ -56,7 +56,7 @@ main = do
 
         case (configScriptFileName config) of
             Just scriptFileName -> do
-                result <- runExceptT $ runReaderT (runScriptFile builtinEnv scriptFileName) config
+                result <- runL config (runScriptFile builtinEnv scriptFileName)
                 case result of
                     Left (LException ex) -> putStrLn $ "Error: " ++ ex
                     Right _ -> return ()
diff --git a/src/Utils.hs b/src/Utils.hs
index 3cf61bf..76f1524 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -18,6 +18,9 @@ data Config = Config {
 
 type LContext a = ReaderT Config (ExceptT LException IO) a
 
+runL :: Config -> LContext a -> IO (Either LException a)
+runL config lc = runExceptT $ runReaderT lc config
+
 type Env = M.Map String AST
 
 type LFunction = (Env -> AST -> LContext AST)
diff --git a/test/Spec.hs b/test/Spec.hs
index db28f39..9011aba 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -2,28 +2,40 @@
 import Test.HUnit
 import Control.Monad.Except
 import qualified Data.Map as M
+import Builtins
 import Tokenizer ( tokenize )
 import Parser ( parse )
 import Evaluator ( evaluate )
-import Builtins
-import TestUtils
 import Utils
+import TestUtils
+
+tokenizeTests = TestLabel "tokenize" $ TestList $ map TestCase [
+     do got <- expectSuccessL $ tokenize "(+ 1 (- 10 5))"
+        let expected = ["(", "+", "1", "(", "-", "10", "5", ")", ")"]
+        assertEqual "" got expected
+    ]
+
+parseTests = TestLabel "parse" $ TestList $ map TestCase [
+     do got <- expectSuccessL $ parse ["(", "+", "1", "2", ")"]
+        let expected = [ASTFunctionCall [ASTSymbol "+", ASTInteger 1, ASTInteger 2]]
+        assertEqual "" got expected,
+     do got <- expectErrorL $ parse ["(", "+", "1", "2"]
+        let expected = "unbalanced function call"
+        assertEqual "" got expected
+    ]
+
+evaluateTests = TestLabel "evaluate" $ TestList $ map TestCase [
+     do let env = M.fromList [("+", builtinAdd2)] :: Env
+        (gotEnv, gotAST) <- expectSuccessL $ evaluate env (ASTFunctionCall [ASTSymbol "+", ASTInteger 1, ASTInteger 2])
+        let expectedAST = ASTInteger 3
+        assertEqual "" gotAST expectedAST
+        assertEqual "" (M.keys gotEnv) (M.keys env)
+    ]
 
 tests = [
-    "tokenize1" ~:
-         do got <- runL $ tokenize "(+ 1 (- 10 5))"
-            let expected = ["(", "+", "1", "(", "-", "10", "5", ")", ")"]
-            assertEqual "" got expected,
-    "parse1" ~:
-         do got <- runL $ parse ["(", "+", "1", "2", ")"]
-            let expected = [ASTFunctionCall [ASTSymbol "+", ASTInteger 1, ASTInteger 2]]
-            assertEqual "" got expected,
-    "evaluate1" ~:
-         do let env = M.fromList [("+", builtinAdd2)] :: Env
-            (gotEnv, gotAST) <- runL $ evaluate env (ASTFunctionCall [ASTSymbol "+", ASTInteger 1, ASTInteger 2])
-            let expectedAST = ASTInteger 3
-            assertEqual "" gotAST expectedAST
-            assertEqual "" (M.keys gotEnv) (M.keys env)
+    tokenizeTests,
+    parseTests,
+    evaluateTests
     ]
 
 main :: IO ()
diff --git a/test/TestUtils.hs b/test/TestUtils.hs
index bcb147c..676df1d 100644
--- a/test/TestUtils.hs
+++ b/test/TestUtils.hs
@@ -12,9 +12,19 @@ initialConfig = Config {
     configShowHelp = False
 }
 
-runL :: LContext a -> IO a
-runL lc = do res <- runExceptT $ runReaderT lc initialConfig
-             case res of
-                Left (LException err) -> error err
-                Right val -> return val
+testRunL :: LContext a -> IO (Either LException a)
+testRunL lc = runExceptT $ runReaderT lc initialConfig
 
+expectSuccessL :: LContext a -> IO a
+expectSuccessL lc =
+     do res <- testRunL lc
+        case res of
+            Left (LException err) -> error $ "unexpected error: " ++ err
+            Right val -> return val
+
+expectErrorL :: Show a => LContext a -> IO String
+expectErrorL lc =
+     do res <- testRunL lc
+        case res of
+            Left (LException err) -> return err
+            Right val -> error $ "unexpected success: " ++ show val
-- 
cgit v1.3