tasty-lua 0.1.0 → 0.1.1
raw patch · 4 files changed
+93/−19 lines, 4 filesdep +filepath
Dependencies added: filepath
Files
- CHANGELOG.md +9/−2
- src/Test/Tasty/Lua.hs +77/−15
- tasty-lua.cabal +2/−1
- test/test-tasty-lua.hs +5/−1
CHANGELOG.md view
@@ -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.
src/Test/Tasty/Lua.hs view
@@ -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]
tasty-lua.cabal view
@@ -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
test/test-tasty-lua.hs view
@@ -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 ()