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,8 +1,10 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-| Module : Test.Tasty.Lua -Copyright : © 2019–2020 Albert Krewinkel +Copyright : © 2019–2021 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha @@ -24,8 +26,7 @@ import Control.Exception (SomeException, try) import Data.Bifunctor (first) import Data.List (intercalate) -import Data.Semigroup (Semigroup (..)) -import Foreign.Lua (Lua) +import HsLua.Core (LuaE, LuaError) import Test.Tasty (TestName, TestTree) import Test.Tasty.Providers (IsTest (..), singleTest, testFailed, testPassed) import Test.Tasty.Lua.Module (pushModule) @@ -33,16 +34,21 @@ runTastyFile) import Test.Tasty.Lua.Translate (pathFailure, translateResultsFromFile) +#if !MIN_VERSION_base(4,12,0) +import Data.Semigroup (Semigroup ((<>))) +#endif + -- | 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 :: forall e. LuaError e + => (forall a. LuaE e a -> IO a) + -> TestName + -> FilePath + -> TestTree testLuaFile runLua name fp = let testAction = TestCase $ do - eitherResult <- runLua (runTastyFile fp) + eitherResult <- runLua (runTastyFile @e fp) return $ case eitherResult of Left errMsg -> FailureSummary [([name], errMsg)] Right result -> summarize result diff --git a/src/Test/Tasty/Lua/Core.hs b/src/Test/Tasty/Lua/Core.hs --- a/src/Test/Tasty/Lua/Core.hs +++ b/src/Test/Tasty/Lua/Core.hs @@ -1,7 +1,9 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {-| Module : Test.Tasty.Lua.Core -Copyright : © 2019–2020 Albert Krewinkel +Copyright : © 2019–2021 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha @@ -17,78 +19,69 @@ ) where -import Control.Monad (void) +import Control.Monad ((<$!>), void) import Data.ByteString (ByteString) -import Foreign.Lua (Lua, Peekable, StackIndex) +import HsLua.Core (LuaE, LuaError, absindex, pop, toboolean, top) +import HsLua.Marshalling + ( Peeker, failPeek, liftLua, resultToEither, retrieving + , peekList, peekString, runPeek, typeMismatchMessage) 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 Data.Text as T +import qualified Data.Text.Encoding as T.Encoding +import qualified HsLua.Core 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 :: LuaError e => FilePath -> LuaE e (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) + then Left . toString <$> Lua.tostring' top + else resultToEither <$> runPeek (peekList peekResultTree top) -- | Convert UTF8-encoded @'ByteString'@ to a @'String'@. toString :: ByteString -> String -toString = Text.unpack . Text.Encoding.decodeUtf8 +toString = T.unpack . T.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 :: LuaError e => Peeker e ResultTree peekResultTree idx = do - name <- Lua.getfield idx "name" *> Lua.popValue - result <- Lua.getfield idx "result" *> Lua.popValue - return $ ResultTree name result + idx' <- liftLua $ absindex idx + name <- liftLua (Lua.getfield idx' "name") *> peekString top + result <- liftLua (Lua.getfield idx' "result") *> peekUnnamedTree top + liftLua $ pop 2 + 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 +peekUnnamedTree :: LuaError e => Peeker e UnnamedTree +peekUnnamedTree idx = liftLua (Lua.ltype idx) >>= \case + Lua.TypeTable -> TestGroup <$!> peekList peekResultTree idx + _ -> SingleTest <$!> peekOutcome 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 +peekOutcome :: LuaError e => Peeker e Outcome +peekOutcome idx = retrieving "test result" $ do + liftLua (Lua.ltype idx) >>= \case + Lua.TypeString -> Failure <$!> peekString idx Lua.TypeBoolean -> do - b <- Lua.peek idx + b <- liftLua $ toboolean idx return $ if b then Success else Failure "???" - _ -> do - s <- toString <$> Lua.tostring' idx - Lua.throwException ("not a test result: " ++ s) + _ -> typeMismatchMessage "string or boolean" idx >>= failPeek diff --git a/src/Test/Tasty/Lua/Module.hs b/src/Test/Tasty/Lua/Module.hs --- a/src/Test/Tasty/Lua/Module.hs +++ b/src/Test/Tasty/Lua/Module.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} {-| Module : Test.Tasty.Lua.Module -Copyright : © 2019–2020 Albert Krewinkel +Copyright : © 2019–2021 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha @@ -16,17 +16,18 @@ import Data.ByteString (ByteString) import Data.FileEmbed -import Foreign.Lua (Lua, NumResults, Status (OK), dostring, throwTopMessage) +import HsLua.Core + (LuaE, LuaError, NumResults, Status (OK), dostring, throwErrorAsException) -- | Tasty Lua script tastyScript :: ByteString tastyScript = $(embedFile "tasty.lua") -- | Push the Aeson module on the Lua stack. -pushModule :: Lua NumResults +pushModule :: LuaError e => LuaE e NumResults pushModule = do result <- dostring tastyScript if result == OK then return 1 - else throwTopMessage + else throwErrorAsException {-# INLINABLE pushModule #-} diff --git a/src/Test/Tasty/Lua/Translate.hs b/src/Test/Tasty/Lua/Translate.hs --- a/src/Test/Tasty/Lua/Translate.hs +++ b/src/Test/Tasty/Lua/Translate.hs @@ -1,6 +1,6 @@ {-| Module : Test.Tasty.Lua.Translate -Copyright : © 2019–2020 Albert Krewinkel +Copyright : © 2019–2021 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha @@ -14,7 +14,7 @@ ) where -import Foreign.Lua (Lua) +import HsLua.Core (LuaE, LuaError) import Test.Tasty.Lua.Core (Outcome (..), ResultTree (..), UnnamedTree (..), runTastyFile) import qualified Test.Tasty as Tasty @@ -22,7 +22,7 @@ -- | Run tasty.lua tests from the given file and translate the result -- into a mock Tasty @'TestTree'@. -translateResultsFromFile :: FilePath -> Lua Tasty.TestTree +translateResultsFromFile :: LuaError e => FilePath -> LuaE e Tasty.TestTree translateResultsFromFile fp = do result <- runTastyFile fp case result of @@ -53,5 +53,3 @@ Failure msg -> Tasty.testFailed msg testOptions = return [] - - 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.2.3.2 +version: 1.0.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 @@ -7,7 +7,7 @@ license-file: LICENSE author: Albert Krewinkel maintainer: albert+hslua@zeitkraut.de -copyright: © 2019–2020 Albert Krewinkel +copyright: © 2019–2021 Albert Krewinkel category: Foreign build-type: Simple extra-source-files: CHANGELOG.md @@ -20,19 +20,21 @@ , GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.3 - , GHC == 8.10.1 + , GHC == 8.10.4 + , GHC == 9.0.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.4 - , tasty >= 1.2 && < 1.5 - , text >= 1.0 && < 1.3 + build-depends: base >= 4.9 && < 5 + , bytestring >= 0.10.2 && < 0.12 + , file-embed >= 0.0 && < 0.1 + , hslua-core >= 2.0 && < 2.1 + , hslua-marshalling >= 2.0 && < 2.1 + , tasty >= 1.2 && < 1.5 + , text >= 1.0 && < 1.3 exposed-modules: Test.Tasty.Lua , Test.Tasty.Lua.Core , Test.Tasty.Lua.Module @@ -50,7 +52,8 @@ build-depends: base , directory , filepath >= 1.4 - , hslua + , hslua-core + , hslua-marshalling , tasty , tasty-lua , tasty-hunit 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 @@ -1,7 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {-| Module : Main -Copyright : © 2019 Albert Krewinkel +Copyright : © 2019-2021 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha @@ -12,18 +13,18 @@ -} import Control.Monad (void) -import Foreign.Lua (Lua) +import HsLua.Core (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 +import qualified HsLua.Core as Lua main :: IO () main = do - luaTest <- withCurrentDirectory "test" . Lua.run $ + luaTest <- withCurrentDirectory "test" . Lua.run @Lua.Exception $ translateResultsFromFile "test-tasty.lua" defaultMain $ testGroup "tasty-hslua" [luaTest, tests] @@ -31,13 +32,13 @@ tests :: TestTree tests = testGroup "HsLua tasty module" [ testCase "can be pushed to the stack" $ - Lua.run (void pushModule) + Lua.run (void pushModule :: Lua ()) , 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.loadstring "return package.preload.tasty" *> Lua.call 0 1 Lua.ltype (-1) , testCase "can be loaded as tasty" . Lua.run $ do @@ -47,7 +48,8 @@ Lua.dostring "require 'tasty'" , testGroup "testFileWith" - [ testLuaFile Lua.run "test-tasty.lua" ("test" "test-tasty.lua") + [ testLuaFile (Lua.run @Lua.Exception) + "test-tasty.lua" ("test" "test-tasty.lua") ] ]