summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authortarleb <>2019-05-19 06:59:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-05-19 06:59:00 (GMT)
commit5044cb8421bca986db79208351c15d1ccbdb1a8a (patch)
tree24e69b20613e970d3275922e2cbd00ad7630eae4
parenta4bd3120361f29abd67e0369a615ec9a34a5277a (diff)
version 0.2.00.2.0
-rwxr-xr-xCHANGELOG.md12
-rw-r--r--src/Test/Tasty/Lua.hs194
-rw-r--r--src/Test/Tasty/Lua/Core.hs94
-rw-r--r--src/Test/Tasty/Lua/Module.hs32
-rw-r--r--src/Test/Tasty/Lua/Translate.hs57
-rw-r--r--tasty-lua.cabal7
-rw-r--r--test/test-tasty-lua.hs6
7 files changed, 262 insertions, 140 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 6aeed99..c87daa9 100755
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,17 @@
# Revision history for tasty-lua
+## 0.2.0 -- 2019-05-19
+
+- Renamed `testFileWith` to `testLuaFile`, and
+ `testsFromFile` to `translateResultsFromFile`.
+
+- Fixed and extended test summary: if all tests pass, a brief
+ summary about the number of passed tests is show. Furthermore,
+ some bugs (caused by a misused Foldable instance) have been
+ fixed.
+
+- Code has been split into multiple sub-modules.
+
## 0.1.1 -- 2019-05-17
- Add new function `testFileWith`, allowing to run a file as a
diff --git a/src/Test/Tasty/Lua.hs b/src/Test/Tasty/Lua.hs
index 7423b47..2d6175d 100644
--- a/src/Test/Tasty/Lua.hs
+++ b/src/Test/Tasty/Lua.hs
@@ -1,6 +1,5 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module : Test.Tasty.Lua
Copyright : © 2019 Albert Krewinkel
@@ -15,166 +14,91 @@ module Test.Tasty.Lua
( -- * Lua module
pushModule
-- * Running tests
- , testFileWith
- , testsFromFile
+ , testLuaFile
+ , translateResultsFromFile
-- * Helpers
, pathFailure
)
where
-import Control.Exception (throw, try)
-import Control.Monad (void)
-import Data.ByteString (ByteString)
-import Data.FileEmbed
+import Control.Exception (SomeException, try)
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
-import qualified Foreign.Lua as Lua
-import qualified Test.Tasty as Tasty
-import qualified Test.Tasty.Providers as Tasty
+import Data.Semigroup (Semigroup (..))
+import Foreign.Lua (Lua)
+import Test.Tasty (TestName, TestTree)
+import Test.Tasty.Providers (IsTest (..), singleTest, testFailed, testPassed)
+import Test.Tasty.Lua.Module (pushModule)
+import Test.Tasty.Lua.Core (Outcome (..), ResultTree (..), UnnamedTree (..),
+ runTastyFile)
+import Test.Tasty.Lua.Translate (pathFailure, translateResultsFromFile)
-- | 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 =
+testLuaFile :: (forall a . Lua a -> IO a)
+ -> TestName
+ -> FilePath
+ -> TestTree
+testLuaFile runLua name fp =
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
+ eitherResult <- runLua (runTastyFile fp)
+ return $ case eitherResult of
+ Left errMsg -> FailureSummary [([name], errMsg)]
+ Right result -> summarize result
+ in singleTest name testAction
-newtype TestCase = TestCase (IO ())
+-- | Lua test case action
+newtype TestCase = TestCase (IO ResultSummary)
-instance Tasty.IsTest TestCase where
+instance IsTest TestCase where
run _ (TestCase action) _ = do
result <- try action
return $ case result of
- Left (Lua.Exception message) -> Tasty.testFailed message
- Right () -> Tasty.testPassed ""
+ Left e -> testFailed (show (e :: SomeException))
+ Right summary -> case summary of
+ SuccessSummary n ->
+ testPassed $ "+++ Success: " ++ show n ++ " Lua tests passed"
+ FailureSummary fails ->
+ testFailed $ concatMap stringifyFailureGist fails
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
+summarize :: [ResultTree] -> ResultSummary
+summarize = foldr ((<>) . collectSummary) (SuccessSummary 0)
-- | Failure message generated by tasty.lua
type LuaErrorMessage = String
--- | Info about a test failure
-type FailureGist = ([Tasty.TestName], LuaErrorMessage)
+-- | Info about a single failure
+type FailureInfo = ([TestName], LuaErrorMessage)
+
+-- | Summary about a test result
+data ResultSummary
+ = SuccessSummary Int -- ^ Number of successful tests
+ | FailureSummary [FailureInfo]
+ -- ^ Failure messages, together with the test paths
-- | 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 :: FailureInfo -> 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) =
+collectSummary :: ResultTree -> ResultSummary
+collectSummary (ResultTree 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")
-
--- | Push the Aeson module on the Lua stack.
-pushModule :: Lua NumResults
-pushModule = do
- result <- Lua.dostring tastyScript
- if result == Lua.OK
- then return 1
- else Lua.throwTopMessage
-{-# INLINABLE pushModule #-}
-
--- | Report failure of testing a path.
-pathFailure :: FilePath -> String -> Tasty.TestTree
-pathFailure fp errMsg = Tasty.singleTest fp (Failure errMsg)
-
--- | Convert internal (tasty.lua) tree format into Tasty tree.
-testTree :: Tree -> Tasty.TestTree
-testTree (Tree name tree) =
- case tree of
- SingleTest outcome -> Tasty.singleTest name outcome
- TestGroup results -> Tasty.testGroup name (map testTree results)
-
-data Tree = Tree Tasty.TestName UnnamedTree
-
-instance Peekable Tree where
- peek idx = do
- name <- Lua.getfield idx "name" *> Lua.popValue
- result <- Lua.getfield idx "result" *> Lua.popValue
- return $ Tree name result
-
-instance Tasty.IsTest Outcome where
- run _ tr _ = return $ case tr of
- Success -> Tasty.testPassed ""
- Failure msg -> Tasty.testFailed msg
- testOptions = return []
-
--- | Either a raw test outcome, or a nested @'Tree'@.
-data UnnamedTree
- = SingleTest Outcome
- | TestGroup [Tree]
-
-instance Peekable UnnamedTree where
- peek = peekTree
-
-peekTree :: StackIndex -> Lua UnnamedTree
-peekTree idx = do
- ty <- Lua.ltype idx
- case ty of
- Lua.TypeTable -> TestGroup <$> Lua.peekList idx
- _ -> SingleTest <$> Lua.peek idx
-
--- | Test outcome
-data Outcome = Success | Failure String
-
-instance Peekable Outcome where
- peek idx = do
- ty <- Lua.ltype idx
- case ty of
- Lua.TypeString -> Failure <$> Lua.peek idx
- Lua.TypeBoolean -> do
- b <- Lua.peek idx
- return $ if b then Success else Failure "???"
- _ -> do
- s <- toString <$> Lua.tostring' idx
- Lua.throwException ("not a test result: " ++ s)
-
--- | Convert UTF8-encoded @'ByteString'@ to a @'String'@.
-toString :: ByteString -> String
-toString = Text.unpack . Text.Encoding.decodeUtf8
+ SingleTest Success -> SuccessSummary 1
+ SingleTest (Failure msg) -> FailureSummary [([name], msg)]
+ TestGroup subtree -> foldr go (SuccessSummary 0) subtree
+ where go r summary = collectSummary r <> addGroup name summary
+
+addGroup :: TestName -> ResultSummary -> ResultSummary
+addGroup name (FailureSummary fs) = FailureSummary (map addName fs)
+ where addName (names, msg) = (name : names, msg)
+addGroup _name summary = summary
+
+instance Semigroup ResultSummary where
+ (SuccessSummary n) <> (SuccessSummary m) = SuccessSummary (n + m)
+ (SuccessSummary _) <> (FailureSummary fs) = FailureSummary fs
+ (FailureSummary fs) <> (SuccessSummary _) = FailureSummary fs
+ (FailureSummary fs) <> (FailureSummary gs) = FailureSummary (fs ++ gs)
diff --git a/src/Test/Tasty/Lua/Core.hs b/src/Test/Tasty/Lua/Core.hs
new file mode 100644
index 0000000..665ab54
--- /dev/null
+++ b/src/Test/Tasty/Lua/Core.hs
@@ -0,0 +1,94 @@
+{-# LANGUAGE LambdaCase #-}
+{-|
+Module : Test.Tasty.Lua.Core
+Copyright : © 2019 Albert Krewinkel
+License : MIT
+Maintainer : Albert Krewinkel <albert+hslua@zeitkraut.de>
+Stability : alpha
+Portability : not portable, requires GHC or later
+
+Core types and functions for tasty Lua tests.
+-}
+module Test.Tasty.Lua.Core
+ ( runTastyFile
+ , ResultTree (..)
+ , Outcome (..)
+ , UnnamedTree (..)
+ )
+where
+
+import Control.Monad (void)
+import Data.ByteString (ByteString)
+import Foreign.Lua (Lua, Peekable, StackIndex)
+import Test.Tasty.Lua.Module (pushModule)
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text.Encoding
+import qualified Foreign.Lua as Lua
+import qualified Test.Tasty as Tasty
+
+-- | Run a tasty Lua script from a file and return either the resulting
+-- test tree or the error message.
+runTastyFile :: FilePath -> Lua (Either String [ResultTree])
+runTastyFile fp = do
+ Lua.openlibs
+ Lua.requirehs "tasty" (void pushModule)
+ res <- Lua.dofile fp
+ if res /= Lua.OK
+ then Left . toString <$> Lua.tostring' Lua.stackTop
+ else Lua.try (Lua.peekList Lua.stackTop) >>= \case
+ Left (Lua.Exception e) -> return (Left e)
+ Right trees -> return (Right trees)
+
+-- | Convert UTF8-encoded @'ByteString'@ to a @'String'@.
+toString :: ByteString -> String
+toString = Text.unpack . Text.Encoding.decodeUtf8
+
+-- | Tree of test results returned by tasty Lua scripts. This is
+-- similar to tasty's @'TestTree'@, with the important difference that
+-- all tests have already been run, and all test results are known.
+data ResultTree = ResultTree Tasty.TestName UnnamedTree
+
+instance Peekable ResultTree where
+ peek = peekResultTree
+
+peekResultTree :: StackIndex -> Lua ResultTree
+peekResultTree idx = do
+ name <- Lua.getfield idx "name" *> Lua.popValue
+ result <- Lua.getfield idx "result" *> Lua.popValue
+ return $ ResultTree name result
+
+-- | Either a raw test outcome, or a nested @'Tree'@.
+data UnnamedTree
+ = SingleTest Outcome
+ | TestGroup [ResultTree]
+
+instance Peekable UnnamedTree where
+ peek = peekUnnamedTree
+
+-- | Unmarshal an @'UnnamedTree'@.
+peekUnnamedTree :: StackIndex -> Lua UnnamedTree
+peekUnnamedTree idx = do
+ ty <- Lua.ltype idx
+ case ty of
+ Lua.TypeTable -> TestGroup <$> Lua.peekList idx
+ _ -> SingleTest <$> Lua.peek idx
+
+
+-- | Test outcome
+data Outcome = Success | Failure String
+
+instance Peekable Outcome where
+ peek = peekOutcome
+
+-- | Unmarshal a test outcome
+peekOutcome :: StackIndex -> Lua Outcome
+peekOutcome idx = do
+ ty <- Lua.ltype idx
+ case ty of
+ Lua.TypeString -> Failure <$> Lua.peek idx
+ Lua.TypeBoolean -> do
+ b <- Lua.peek idx
+ return $ if b then Success else Failure "???"
+ _ -> do
+ s <- toString <$> Lua.tostring' idx
+ Lua.throwException ("not a test result: " ++ s)
diff --git a/src/Test/Tasty/Lua/Module.hs b/src/Test/Tasty/Lua/Module.hs
new file mode 100644
index 0000000..c1b894a
--- /dev/null
+++ b/src/Test/Tasty/Lua/Module.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-|
+Module : Test.Tasty.Lua.Module
+Copyright : © 2019 Albert Krewinkel
+License : MIT
+Maintainer : Albert Krewinkel <albert+hslua@zeitkraut.de>
+Stability : alpha
+Portability : Requires TemplateHaskell
+
+Tasty Lua module, providing the functions necessary to write tasty tests
+in Lua scripts.
+-}
+module Test.Tasty.Lua.Module
+ ( pushModule )
+where
+
+import Data.ByteString (ByteString)
+import Data.FileEmbed
+import Foreign.Lua (Lua, NumResults, Status (OK), dostring, throwTopMessage)
+
+-- | Tasty Lua script
+tastyScript :: ByteString
+tastyScript = $(embedFile "tasty.lua")
+
+-- | Push the Aeson module on the Lua stack.
+pushModule :: Lua NumResults
+pushModule = do
+ result <- dostring tastyScript
+ if result == OK
+ then return 1
+ else throwTopMessage
+{-# INLINABLE pushModule #-}
diff --git a/src/Test/Tasty/Lua/Translate.hs b/src/Test/Tasty/Lua/Translate.hs
new file mode 100644
index 0000000..f432d25
--- /dev/null
+++ b/src/Test/Tasty/Lua/Translate.hs
@@ -0,0 +1,57 @@
+{-|
+Module : Test.Tasty.Lua.Translate
+Copyright : © 2019 Albert Krewinkel
+License : MIT
+Maintainer : Albert Krewinkel <albert+hslua@zeitkraut.de>
+Stability : alpha
+Portability : Requires TemplateHaskell
+
+Translate test results from Lua into a Tasty @'TestTree'@.
+-}
+module Test.Tasty.Lua.Translate
+ ( translateResultsFromFile
+ , pathFailure
+ )
+where
+
+import Foreign.Lua (Lua)
+import Test.Tasty.Lua.Core (Outcome (..), ResultTree (..), UnnamedTree (..),
+ runTastyFile)
+import qualified Test.Tasty as Tasty
+import qualified Test.Tasty.Providers as Tasty
+
+-- | Run tasty.lua tests from the given file and translate the result
+-- into a mock Tasty @'TestTree'@.
+translateResultsFromFile :: FilePath -> Lua Tasty.TestTree
+translateResultsFromFile fp = do
+ result <- runTastyFile fp
+ case result of
+ Left errMsg -> return $ pathFailure fp errMsg
+ Right tree -> return $ Tasty.testGroup fp (map testTree tree)
+
+-- | Report failure of testing a path.
+pathFailure :: FilePath -> String -> Tasty.TestTree
+pathFailure fp errMsg = Tasty.singleTest fp (MockTest (Failure errMsg))
+
+-- | Convert internal (tasty.lua) result tree format into Tasty tree.
+testTree :: ResultTree -> Tasty.TestTree
+testTree (ResultTree name tree) =
+ case tree of
+ SingleTest outcome -> Tasty.singleTest name (MockTest outcome)
+ TestGroup results -> Tasty.testGroup name (map testTree results)
+
+-- | Mock test which just returns the predetermined outcome. An
+-- @'Outcome'@ can be treated like a Tasty test, as it encodes all
+-- necessary information. Usually, calling @'run'@ would trigger the
+-- execution of the test, but in this case, the test has already been
+-- run when the Lua script was executed.
+newtype MockTest = MockTest Outcome
+
+instance Tasty.IsTest MockTest where
+ run _ (MockTest outcome) _ = return $ case outcome of
+ Success -> Tasty.testPassed ""
+ Failure msg -> Tasty.testFailed msg
+
+ testOptions = return []
+
+
diff --git a/tasty-lua.cabal b/tasty-lua.cabal
index 74997b5..6b240a7 100644
--- a/tasty-lua.cabal
+++ b/tasty-lua.cabal
@@ -1,5 +1,5 @@
name: tasty-lua
-version: 0.1.1
+version: 0.2.0
synopsis: Write tests in Lua, integrate into tasty.
description: Allow users to define tasty tests from Lua.
homepage: https://github.com/hslua/tasty-lua
@@ -17,7 +17,7 @@ tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5
source-repository head
type: git
- location: https://github.com/hslua/hslua-module-tasty.git
+ location: https://github.com/hslua/tasty-lua.git
library
build-depends: base >= 4.9 && < 5
@@ -27,6 +27,9 @@ library
, tasty >= 1.2 && < 1.3
, text >= 1.0 && < 1.3
exposed-modules: Test.Tasty.Lua
+ , Test.Tasty.Lua.Core
+ , Test.Tasty.Lua.Module
+ , Test.Tasty.Lua.Translate
hs-source-dirs: src
default-language: Haskell2010
ghc-options: -Wall
diff --git a/test/test-tasty-lua.hs b/test/test-tasty-lua.hs
index 13f1f30..9eb116b 100644
--- a/test/test-tasty-lua.hs
+++ b/test/test-tasty-lua.hs
@@ -17,14 +17,14 @@ import System.Directory (withCurrentDirectory)
import System.FilePath ((</>))
import Test.Tasty (TestTree, defaultMain, testGroup)
import Test.Tasty.HUnit (assertEqual, testCase)
-import Test.Tasty.Lua (pushModule, testFileWith, testsFromFile)
+import Test.Tasty.Lua (pushModule, testLuaFile, translateResultsFromFile)
import qualified Foreign.Lua as Lua
main :: IO ()
main = do
luaTest <- withCurrentDirectory "test" . Lua.run $
- testsFromFile "test-tasty.lua"
+ translateResultsFromFile "test-tasty.lua"
defaultMain $ testGroup "tasty-hslua" [luaTest, tests]
-- | HSpec tests for the Lua 'system' module
@@ -47,7 +47,7 @@ tests = testGroup "HsLua tasty module"
Lua.dostring "require 'tasty'"
, testGroup "testFileWith" $
- [testFileWith ("test" </> "test-tasty.lua") Lua.run]
+ [testLuaFile Lua.run "test-tasty.lua" ("test" </> "test-tasty.lua")]
]
assertEqual' :: (Show a, Eq a) => String -> a -> a -> Lua ()