packages feed

tasty-lua 0.1.1 → 0.2.0

raw patch · 7 files changed

+260/−138 lines, 7 files

Files

CHANGELOG.md view
@@ -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
src/Test/Tasty/Lua.hs view
@@ -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 @@   ( -- * 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) =-  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) =+collectSummary :: ResultTree -> ResultSummary+collectSummary (ResultTree 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+    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 -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)+addGroup :: TestName -> ResultSummary -> ResultSummary+addGroup name (FailureSummary fs) = FailureSummary (map addName fs)+  where addName (names, msg) = (name : names, msg)+addGroup _name summary = summary --- | Convert UTF8-encoded @'ByteString'@ to a @'String'@.-toString :: ByteString -> String-toString = Text.unpack . Text.Encoding.decodeUtf8+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)
+ src/Test/Tasty/Lua/Core.hs view
@@ -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)
+ src/Test/Tasty/Lua/Module.hs view
@@ -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 #-}
+ src/Test/Tasty/Lua/Translate.hs view
@@ -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 []++
tasty-lua.cabal view
@@ -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 @@  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 @@                      , 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/test-tasty-lua.hs view
@@ -17,14 +17,14 @@ 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 @@         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 ()