diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ -# Revision history for hslua-module-json +# Revision history for tasty-lua -## 0.1.0 -- YYYY-mm-dd +## 0.1.1 -- 2019-05-17 + +- Add new function `testFileWith`, allowing to run a file as a + single test case. Lua tests should be defined with `tasty.lua`. + Failures, if any, are summarized in the failure message of the + test. + +## 0.1.0 -- 2019-05-11 * First version. Released on an unsuspecting world. diff --git a/src/Test/Tasty/Lua.hs b/src/Test/Tasty/Lua.hs --- a/src/Test/Tasty/Lua.hs +++ b/src/Test/Tasty/Lua.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} {-| Module : Test.Tasty.Lua @@ -14,15 +15,18 @@ ( -- * Lua module pushModule -- * Running tests + , testFileWith , testsFromFile -- * Helpers , pathFailure ) where +import Control.Exception (throw, try) import Control.Monad (void) import Data.ByteString (ByteString) import Data.FileEmbed +import Data.List (intercalate) import Foreign.Lua (Lua, NumResults, Peekable, StackIndex) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text.Encoding @@ -30,7 +34,79 @@ import qualified Test.Tasty as Tasty import qualified Test.Tasty.Providers as Tasty +-- | Run the given file as a single test. It is possible to use +-- `tasty.lua` in the script. This test collects and summarizes all +-- errors, but shows generally no information on the successful tests. +testFileWith :: FilePath -> (forall a . Lua a -> IO a) -> Tasty.TestTree +testFileWith fp runLua = + let testAction = TestCase $ do + result <- runLua (runTastyFile fp) + case result >>= failuresMessage of + Left errMsg -> throw (Lua.Exception errMsg) + Right _ -> return () + in Tasty.singleTest fp testAction +newtype TestCase = TestCase (IO ()) + +instance Tasty.IsTest TestCase where + run _ (TestCase action) _ = do + result <- try action + return $ case result of + Left (Lua.Exception message) -> Tasty.testFailed message + Right () -> Tasty.testPassed "" + + testOptions = return [] + +-- | Run tasty.lua tests from the given file. +testsFromFile :: FilePath -> Lua Tasty.TestTree +testsFromFile fp = do + result <- runTastyFile fp + case result of + Left errMsg -> return $ pathFailure fp errMsg + Right tree -> return $ Tasty.testGroup fp $ map testTree tree + +-- | Run a tasty Lua script from a file and return either the resulting +-- test tree or the error message. +runTastyFile :: FilePath -> Lua (Either String [Tree]) +runTastyFile fp = do + Lua.openlibs + Lua.requirehs "tasty" (void pushModule) + res <- Lua.dofile fp + if res == Lua.OK + then Right <$> Lua.peekList Lua.stackTop + else Left . toString <$> Lua.tostring' Lua.stackTop + +-- | Generate a single error message from all failures in a test tree. +failuresMessage :: [Tree] -> Either String () +failuresMessage tree = + case mapM collectFailureMessages tree of + Nothing -> return () + Just errs -> Left $ concatMap (concatMap stringifyFailureGist) errs + +-- | Failure message generated by tasty.lua +type LuaErrorMessage = String +-- | Info about a test failure +type FailureGist = ([Tasty.TestName], LuaErrorMessage) + +-- | Convert a test failure, given as the pair of the test's path and +-- its error message, into an error string. +stringifyFailureGist :: FailureGist -> String +stringifyFailureGist (names, msg) = + intercalate " // " names ++ ":\n" ++ msg ++ "\n\n" + +-- | Extract all failures from a test result tree. +collectFailureMessages :: Tree -> Maybe [FailureGist] +collectFailureMessages (Tree name tree) = + case tree of + SingleTest Success -> Nothing + SingleTest (Failure msg) -> Just [([name], msg)] + TestGroup subtree -> foldr go Nothing subtree + where go tree' acc = case acc of + Nothing -> collectFailureMessages tree' + Just errs -> case collectFailureMessages tree' of + Nothing -> Just errs + Just x -> Just (x ++ errs) + -- | Tasty Lua script tastyScript :: ByteString tastyScript = $(embedFile "tasty.lua") @@ -48,20 +124,6 @@ pathFailure :: FilePath -> String -> Tasty.TestTree pathFailure fp errMsg = Tasty.singleTest fp (Failure errMsg) --- | Run tasty.lua tests from the given file. -testsFromFile :: FilePath -> Lua Tasty.TestTree -testsFromFile fp = do - Lua.openlibs - Lua.requirehs "tasty" (void pushModule) - res <- Lua.dofile fp - if res == Lua.OK - then do - results <- Lua.peekList Lua.stackTop - return $ Tasty.testGroup fp $ map testTree results - else do - errMsg <- toString <$> Lua.tostring' Lua.stackTop - return $ pathFailure fp errMsg - -- | Convert internal (tasty.lua) tree format into Tasty tree. testTree :: Tree -> Tasty.TestTree testTree (Tree name tree) = @@ -83,7 +145,7 @@ Failure msg -> Tasty.testFailed msg testOptions = return [] - +-- | Either a raw test outcome, or a nested @'Tree'@. data UnnamedTree = SingleTest Outcome | TestGroup [Tree] diff --git a/tasty-lua.cabal b/tasty-lua.cabal --- a/tasty-lua.cabal +++ b/tasty-lua.cabal @@ -1,5 +1,5 @@ name: tasty-lua -version: 0.1.0 +version: 0.1.1 synopsis: Write tests in Lua, integrate into tasty. description: Allow users to define tasty tests from Lua. homepage: https://github.com/hslua/tasty-lua @@ -39,6 +39,7 @@ ghc-options: -Wall -threaded build-depends: base , directory + , filepath >= 1.4 , hslua , tasty , tasty-lua diff --git a/test/test-tasty-lua.hs b/test/test-tasty-lua.hs --- a/test/test-tasty-lua.hs +++ b/test/test-tasty-lua.hs @@ -14,9 +14,10 @@ import Control.Monad (void) import Foreign.Lua (Lua) import System.Directory (withCurrentDirectory) +import System.FilePath (()) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (assertEqual, testCase) -import Test.Tasty.Lua (pushModule, testsFromFile) +import Test.Tasty.Lua (pushModule, testFileWith, testsFromFile) import qualified Foreign.Lua as Lua @@ -44,6 +45,9 @@ Lua.requirehs "tasty" (void pushModule) assertEqual' "loading the module fails " Lua.OK =<< Lua.dostring "require 'tasty'" + + , testGroup "testFileWith" $ + [testFileWith ("test" "test-tasty.lua") Lua.run] ] assertEqual' :: (Show a, Eq a) => String -> a -> a -> Lua ()