{-# LANGUAGE DeriveGeneric #-} module Language.Mulang.Interpreter.Runner ( runTests, runTestsForDir, TestResult(..), TestStatus(..)) where import GHC.Generics import Control.Monad (forM) import Control.Monad.State.Strict import Data.Maybe (fromMaybe, fromJust) import Data.List (intercalate) import qualified Language.Mulang.Ast as Mu import Language.Mulang.Interpreter import Language.Mulang.Parsers (MaybeParser) data TestResult = TestResult { description :: [String], status :: TestStatus } deriving (Generic, Show, Eq) data TestStatus = Success | Failure String deriving (Generic, Show, Eq) data MuTest = MuTest [String] Mu.Expression deriving (Show) runTestsForDir :: String -> String -> MaybeParser -> IO () runTestsForDir solutionPath testPath parse = do solution <- fromJust . parse <$> readFile solutionPath tests <- fromJust . parse <$> readFile testPath results <- runTests solution tests forM_ results $ \result -> case result of (TestResult desc Success) -> do putStrLn $ "PASS : " ++ intercalate " > " desc (TestResult desc (Failure reason)) -> do putStrLn $ "FAIL : " ++ intercalate " > " desc putStrLn $ " " ++ show reason runTests :: Mu.Expression -> Mu.Expression -> IO [TestResult] runTests code = runTests' code . getTests runTests' :: Mu.Expression -> [MuTest] -> IO [TestResult] runTests' expr tests = do (_ref, context) <- eval defaultContext expr forM tests $ \(MuTest desc testExpr) -> do (exceptionRef, testContext) <- eval' context $ do (_, lastException) <- evalRaising context testExpr return $ fromMaybe nullRef lastException let exception = dereference' (globalObjects testContext) exceptionRef case exception of MuNull -> return $ TestResult desc Success v -> return $ TestResult desc (Failure $ show v) getTests :: Mu.Expression -> [MuTest] getTests expr = getAllTestsFromExpr [] expr getAllTestsFromExpr :: [String] -> Mu.Expression -> [MuTest] getAllTestsFromExpr _ Mu.None = [] getAllTestsFromExpr s (Mu.Test (Mu.MuString desc) f) = [MuTest (s ++ [desc]) f] getAllTestsFromExpr s (Mu.TestGroup (Mu.MuString desc) f) = getAllTestsFromExpr (s ++ [desc]) f getAllTestsFromExpr s (Mu.Sequence expressions) = concatMap (getAllTestsFromExpr s) expressions getAllTestsFromExpr s e = error $ "Unknown expression: " ++ show e ++ "\nIn " ++ intercalate " > " s