tasty-lua-0.2.2/0000755000000000000000000000000007346545000011627 5ustar0000000000000000tasty-lua-0.2.2/CHANGELOG.md0000755000000000000000000000247207346545000013450 0ustar0000000000000000# Revision history for tasty-lua ## 0.2.2 -- 2020-01-26 - Avoid compilation warnings on GHC 8.2 and older. Monoid instances on older GHC versions require an explicit implementation of `mappend`. Newer instances use `(<>)` from Semigroup. - Improved CI tests: build with more GHC versions, build with stack, and ensure that there are no HLint errors. ## 0.2.1 -- 2020-01-26 - Fixed an issue with error reporting: the bug caused test-group names to be added multiple times when reporting a test failure. ## 0.2.0.1 -- 2019-06-19 - List all files in cabal file: *stack.yaml* and *test/tasty-lua.lua* were added to the list of extra source files. ## 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 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. tasty-lua-0.2.2/LICENSE0000644000000000000000000000204407346545000012634 0ustar0000000000000000Copyright (c) 2019 Albert Krewinkel Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. tasty-lua-0.2.2/Setup.hs0000644000000000000000000000005607346545000013264 0ustar0000000000000000import Distribution.Simple main = defaultMain tasty-lua-0.2.2/src/Test/Tasty/0000755000000000000000000000000007346545000014441 5ustar0000000000000000tasty-lua-0.2.2/src/Test/Tasty/Lua.hs0000644000000000000000000001014107346545000015513 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-| Module : Test.Tasty.Lua Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : Requires TemplateHaskell Convert Lua test results into a tasty test trees. -} module Test.Tasty.Lua ( -- * Lua module pushModule -- * Running tests , testLuaFile , translateResultsFromFile -- * Helpers , pathFailure ) where import Control.Exception (SomeException, try) import Data.Bifunctor (first) import Data.List (intercalate) 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. testLuaFile :: (forall a . Lua a -> IO a) -> TestName -> FilePath -> TestTree testLuaFile runLua name fp = let testAction = TestCase $ do eitherResult <- runLua (runTastyFile fp) return $ case eitherResult of Left errMsg -> FailureSummary [([name], errMsg)] Right result -> summarize result in singleTest name testAction -- | Lua test case action newtype TestCase = TestCase (IO ResultSummary) instance IsTest TestCase where run _ (TestCase action) _ = do result <- try action return $ case result of 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 [] summarize :: [ResultTree] -> ResultSummary summarize = foldr ((<>) . collectSummary) (SuccessSummary 0) -- | Failure message generated by tasty.lua type LuaErrorMessage = String -- | 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 :: FailureInfo -> String stringifyFailureGist (names, msg) = intercalate " // " names ++ ":\n" ++ msg ++ "\n\n" -- | Combine all failures (or successes) from a test result tree into a -- @'ResultSummary'@. If the tree contains only successes, the result -- will be @'SuccessSummary'@ with the number of successful tests; if -- there was at least one failure, the result will be -- @'FailureSummary'@, with a @'FailureInfo'@ for each failure. collectSummary :: ResultTree -> ResultSummary collectSummary (ResultTree name tree) = case tree of SingleTest Success -> SuccessSummary 1 SingleTest (Failure msg) -> FailureSummary [([name], msg)] TestGroup subtree -> foldMap (addGroup name . collectSummary) subtree -- | Add the name of the current test group to all failure summaries. addGroup :: TestName -> ResultSummary -> ResultSummary addGroup name (FailureSummary fs) = FailureSummary (map (first (name:)) fs) 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) instance Monoid ResultSummary where mempty = SuccessSummary 0 mappend = (<>) -- GHC 8.2 compatibility tasty-lua-0.2.2/src/Test/Tasty/Lua/0000755000000000000000000000000007346545000015162 5ustar0000000000000000tasty-lua-0.2.2/src/Test/Tasty/Lua/Core.hs0000644000000000000000000000545507346545000016417 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-| Module : Test.Tasty.Lua.Core Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel 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) tasty-lua-0.2.2/src/Test/Tasty/Lua/Module.hs0000644000000000000000000000150607346545000016745 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-| Module : Test.Tasty.Lua.Module Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel 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 #-} tasty-lua-0.2.2/src/Test/Tasty/Lua/Translate.hs0000644000000000000000000000365407346545000017463 0ustar0000000000000000{-| Module : Test.Tasty.Lua.Translate Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : Requires GHC 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 [] tasty-lua-0.2.2/stack.yaml0000755000000000000000000000010307346545000013615 0ustar0000000000000000resolver: lts-14.21 ghc-options: "$locals": -fhide-source-paths tasty-lua-0.2.2/tasty-lua.cabal0000644000000000000000000000372207346545000014542 0ustar0000000000000000name: tasty-lua version: 0.2.2 synopsis: Write tests in Lua, integrate into tasty. description: Allow users to define tasty tests from Lua. homepage: https://github.com/hslua/tasty-lua license: MIT license-file: LICENSE author: Albert Krewinkel maintainer: albert+hslua@zeitkraut.de copyright: © 2019–2020 Albert Krewinkel category: Foreign build-type: Simple extra-source-files: CHANGELOG.md , tasty.lua , test/test-tasty.lua , stack.yaml cabal-version: >=1.10 tested-with: GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.1 source-repository head type: git location: https://github.com/hslua/tasty-lua.git library build-depends: base >= 4.9 && < 5 , bytestring >= 0.10.2 && < 0.11 , file-embed >= 0.0 && < 0.1 , hslua >= 1.0.3 && < 1.2 , 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 test-suite test-tasty-lua default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: test-tasty-lua.hs hs-source-dirs: test ghc-options: -Wall -threaded build-depends: base , directory , filepath >= 1.4 , hslua , tasty , tasty-lua , tasty-hunit tasty-lua-0.2.2/tasty.lua0000755000000000000000000000620407346545000013503 0ustar0000000000000000------------------------------------------------------------------------ --- Assertors local assertors = {} local function register_assertor (name, callback, error_message) assertors[name] = function (...) local bool = callback(...) if bool then return end local success, formatted_message = pcall(string.format, error_message, ...) if not success then error('assertion failed, and error message could not be formatted', 2) end error('\n' .. formatted_message or 'assertion failed!', 2) end end --- Value is truthy local function is_truthy (x) return x ~= false and x ~= nil end --- Value is falsy local function is_falsy (x) return not is_truthy(x) end --- Value is nil local function is_nil (x) return x == nil end --- Values are equal local function are_equal (x, y) return x == y end local function cycle_aware_compare(t1, t2, cache) if cache[t1] and cache[t1][t2] then return true end local ty1 = type(t1) local ty2 = type(t2) -- if t1 == t2 then return true end if ty1 ~= ty2 then return false end if ty1 ~= 'table' then return t1 == t2 end -- Check tables have the same set of keys for k1 in pairs(t1) do if t2[k1] == nil then return false end end for k2 in pairs(t2) do if t1[k2] == nil then return false end end -- cache comparison result cache[t1] = cache[t1] or {} cache[t1][t2] = true for k1, v1 in pairs(t1) do local v2 = t2[k1] if not cycle_aware_compare(v1, v2, cache) then return false end end return true end --- Check if tables are the same local function are_same(x, y) return cycle_aware_compare(x, y, {}) end local function error_matches(fn, pattern) local success, msg = pcall(fn) if success then return false end return msg:match(pattern) end register_assertor('is_truthy', is_truthy, "expected a truthy value, got %s") register_assertor('is_falsy', is_falsy, "expected a falsy value, got %s") register_assertor('is_nil', is_nil, "expected nil, got %s") register_assertor('are_same', are_same, 'expected same values, got %s and %s') register_assertor( 'are_equal', are_equal, "expected values to be equal, got '%s' and '%s'" ) register_assertor( 'error_matches', error_matches, 'no error matching the given pattern was raised' ) ------------------------------------------------------------------------ local ok = true local function test_success (name) return { name = name, result = ok, } end local function test_failure (name, err_msg) return { name = name, result = err_msg, } end ------------------------------------------------------------------------ -- Test definitions local function test_case (name, callback) local success, err_msg = pcall(callback) return success and test_success(name) or test_failure(name, err_msg) end local function test_group (name, tests) if tests == nil then -- let's try to curry return function (tests_) return tests_ and test_group(name, tests_) or error('no tests') end end return { name = name, result = tests, } end return { assert = assertors, ok = ok, test_case = test_case, test_group = test_group } tasty-lua-0.2.2/test/0000755000000000000000000000000007346545000012606 5ustar0000000000000000tasty-lua-0.2.2/test/test-tasty-lua.hs0000644000000000000000000000334107346545000016043 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-| Module : Main Copyright : © 2019 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : Requires language extensions ForeignFunctionInterface, OverloadedStrings. Tests for the @tasty@ Lua module. -} 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, testLuaFile, translateResultsFromFile) import qualified Foreign.Lua as Lua main :: IO () main = do luaTest <- withCurrentDirectory "test" . Lua.run $ translateResultsFromFile "test-tasty.lua" defaultMain $ testGroup "tasty-hslua" [luaTest, tests] -- | HSpec tests for the Lua 'system' module tests :: TestTree tests = testGroup "HsLua tasty module" [ testCase "can be pushed to the stack" $ Lua.run (void pushModule) , testCase "can be added to the preloader" . Lua.run $ do Lua.openlibs Lua.preloadhs "tasty" pushModule assertEqual' "function not added to preloader" Lua.TypeFunction =<< do Lua.getglobal' "package.preload.tasty" Lua.ltype (-1) , testCase "can be loaded as tasty" . Lua.run $ do Lua.openlibs Lua.requirehs "tasty" (void pushModule) assertEqual' "loading the module fails " Lua.OK =<< Lua.dostring "require 'tasty'" , testGroup "testFileWith" [ testLuaFile Lua.run "test-tasty.lua" ("test" "test-tasty.lua") ] ] assertEqual' :: (Show a, Eq a) => String -> a -> a -> Lua () assertEqual' msg expected = Lua.liftIO . assertEqual msg expected tasty-lua-0.2.2/test/test-tasty.lua0000755000000000000000000000336207346545000015441 0ustar0000000000000000local tasty = require 'tasty' local assert = tasty.assert local test = tasty.test_case local group = tasty.test_group return { group 'assertors' { group 'error_matches' { test('succeeds if error matches', function () assert.error_matches( function () error 'Futurama' end, 'tura' ) end), test('fails if function succeeds', function () local success = pcall(assert.error_matches, function () end, '') assert.is_falsy(success) end) }, group 'is_truthy' { test('zero is truthy', function() assert.is_truthy(0) end), test('true is truthy', function() assert.is_truthy(true) end), test('empty string is truthy', function() assert.is_truthy '' end), }, group 'is_falsy' { test('false is falsy', function() assert.is_falsy(false) end), test('nil is falsy', function() assert.is_falsy(nil) end), }, group 'is_nil' { test('nil is nil', function () assert.is_nil(nil) end) }, group 'are_equal' { test('equal strings', function () assert.are_equal('test', 'test') end) }, group 'are_same' { test('numbers', function () assert.are_same(1, 1) end), test('nil', function () assert.are_same(nil, nil) end), test('table', function () assert.are_same({2, 3, 5, 7}, {2, 3, 5, 7}) end), test('unequal numbers', function () assert.error_matches( function () assert.are_same(0, 1) end, "expected same values, got 0 and 1" ) end), test('tables', function () assert.error_matches( function () assert.are_same({}, {1}) end, "expected same values, got" ) end), }, }, }