    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeApplications #-}
    {-|
    Module      : Test.Tasty.Lua
    Copyright   : © 2019-2024 Albert Krewinkel
    License     : MIT
    Maintainer  : Albert Krewinkel <tarleb@hslua.org>
    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
      , registerArbitrary
      )
    where

    import Control.Exception (SomeException, try)
    import Data.Bifunctor (first)
    import Data.List (intercalate)
    import HsLua.Core (LuaE, LuaError)
    import Test.Tasty (TestName, TestTree)
    import Test.Tasty.Providers (IsTest (..), singleTest, testFailed, testPassed)
    import Test.Tasty.Lua.Arbitrary (registerArbitrary)
    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 e. LuaError e
                => (forall a. LuaE e a -> IO a)
                -> TestName
                -> FilePath
                -> TestTree
    testLuaFile :: forall e.
    LuaError e =>
    (forall a. LuaE e a -> IO a) -> TestName -> TestName -> TestTree
    testLuaFile forall a. LuaE e a -> IO a
    runLua TestName
    name TestName
    fp =
      let testAction :: TestCase
    testAction = IO ResultSummary -> TestCase
    TestCase (IO ResultSummary -> TestCase) -> IO ResultSummary -> TestCase
    forall a b. (a -> b) -> a -> b
    $ do
            eitherResult <- LuaE e (Either TestName [ResultTree])
    -> IO (Either TestName [ResultTree])
    forall a. LuaE e a -> IO a
    runLua (forall e.
    LuaError e =>
    TestName -> LuaE e (Either TestName [ResultTree])
    runTastyFile @e TestName
    fp)
            return $ case eitherResult of
              Left TestName
    errMsg  -> [FailureInfo] -> ResultSummary
    FailureSummary [([TestName
    name], TestName
    errMsg)]
              Right [ResultTree]
    result -> [ResultTree] -> ResultSummary
    summarize [ResultTree]
    result
      in TestName -> TestCase -> TestTree
    forall t. IsTest t => TestName -> t -> TestTree
    singleTest TestName
    name TestCase
    testAction

    -- | Lua test case action
    newtype TestCase = TestCase (IO ResultSummary)

    instance IsTest TestCase where
      run :: OptionSet -> TestCase -> (Progress -> IO ()) -> IO Result
    run OptionSet
    _ (TestCase IO ResultSummary
    action) Progress -> IO ()
    _ = do
        result <- IO ResultSummary -> IO (Either SomeException ResultSummary)
    forall e a. Exception e => IO a -> IO (Either e a)
    try IO ResultSummary
    action
        return $ case result of
          Left SomeException
    e        -> TestName -> Result
    testFailed (SomeException -> TestName
    forall a. Show a => a -> TestName
    show (SomeException
    e :: SomeException))
          Right ResultSummary
    summary -> case ResultSummary
    summary of
            SuccessSummary Int
    n ->
              TestName -> Result
    testPassed (TestName -> Result) -> TestName -> Result
    forall a b. (a -> b) -> a -> b
    $ TestName
    "+++ Success: " TestName -> TestName -> TestName
    forall a. [a] -> [a] -> [a]
    ++ Int -> TestName
    forall a. Show a => a -> TestName
    show Int
    n TestName -> TestName -> TestName
    forall a. [a] -> [a] -> [a]
    ++ TestName
    " Lua tests passed"
            FailureSummary [FailureInfo]
    fails ->
              TestName -> Result
    testFailed (TestName -> Result) -> TestName -> Result
    forall a b. (a -> b) -> a -> b
    $ (FailureInfo -> TestName) -> [FailureInfo] -> TestName
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap FailureInfo -> TestName
    stringifyFailureGist [FailureInfo]
    fails

      testOptions :: Tagged TestCase [OptionDescription]
    testOptions = [OptionDescription] -> Tagged TestCase [OptionDescription]
    forall a. a -> Tagged TestCase a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    summarize :: [ResultTree] -> ResultSummary
    summarize :: [ResultTree] -> ResultSummary
    summarize = (ResultTree -> ResultSummary -> ResultSummary)
    -> ResultSummary -> [ResultTree] -> ResultSummary
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (ResultSummary -> ResultSummary -> ResultSummary
    forall a. Semigroup a => a -> a -> a
    (<>) (ResultSummary -> ResultSummary -> ResultSummary)
    -> (ResultTree -> ResultSummary)
    -> ResultTree
    -> ResultSummary
    -> ResultSummary
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ResultTree -> ResultSummary
    collectSummary) (Int -> ResultSummary
    SuccessSummary Int
    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 :: FailureInfo -> TestName
    stringifyFailureGist ([TestName]
    names, TestName
    msg) =
      TestName -> [TestName] -> TestName
    forall a. [a] -> [[a]] -> [a]
    intercalate TestName
    " // " [TestName]
    names TestName -> TestName -> TestName
    forall a. [a] -> [a] -> [a]
    ++ TestName
    ":\n" TestName -> TestName -> TestName
    forall a. [a] -> [a] -> [a]
    ++ TestName
    msg TestName -> TestName -> TestName
    forall a. [a] -> [a] -> [a]
    ++ TestName
    "\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 -> ResultSummary
    collectSummary (ResultTree TestName
    name UnnamedTree
    tree) =
      case UnnamedTree
    tree of
        SingleTest Outcome
    Success       -> Int -> ResultSummary
    SuccessSummary Int
    1
        SingleTest (Failure TestName
    msg) -> [FailureInfo] -> ResultSummary
    FailureSummary [([TestName
    name], TestName
    msg)]
        TestGroup [ResultTree]
    subtree        -> (ResultTree -> ResultSummary) -> [ResultTree] -> ResultSummary
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap (TestName -> ResultSummary -> ResultSummary
    addGroup TestName
    name (ResultSummary -> ResultSummary)
    -> (ResultTree -> ResultSummary) -> ResultTree -> ResultSummary
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ResultTree -> ResultSummary
    collectSummary)
                                            [ResultTree]
    subtree

    -- | Add the name of the current test group to all failure summaries.
    addGroup :: TestName -> ResultSummary -> ResultSummary
    addGroup :: TestName -> ResultSummary -> ResultSummary
    addGroup TestName
    name  (FailureSummary [FailureInfo]
    fs) = [FailureInfo] -> ResultSummary
    FailureSummary ((FailureInfo -> FailureInfo) -> [FailureInfo] -> [FailureInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map (([TestName] -> [TestName]) -> FailureInfo -> FailureInfo
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (TestName
    nameTestName -> [TestName] -> [TestName]
    forall a. a -> [a] -> [a]
    :)) [FailureInfo]
    fs)
    addGroup TestName
    _name ResultSummary
    summary             = ResultSummary
    summary

    instance Semigroup ResultSummary where
      (SuccessSummary Int
    n)  <> :: ResultSummary -> ResultSummary -> ResultSummary
    <> (SuccessSummary Int
    m)  = Int -> ResultSummary
    SuccessSummary (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    m)
      (SuccessSummary Int
    _)  <> (FailureSummary [FailureInfo]
    fs) = [FailureInfo] -> ResultSummary
    FailureSummary [FailureInfo]
    fs
      (FailureSummary [FailureInfo]
    fs) <> (SuccessSummary Int
    _)  = [FailureInfo] -> ResultSummary
    FailureSummary [FailureInfo]
    fs
      (FailureSummary [FailureInfo]
    fs) <> (FailureSummary [FailureInfo]
    gs) = [FailureInfo] -> ResultSummary
    FailureSummary ([FailureInfo]
    fs [FailureInfo] -> [FailureInfo] -> [FailureInfo]
    forall a. [a] -> [a] -> [a]
    ++ [FailureInfo]
    gs)

    instance Monoid ResultSummary where
      mempty :: ResultSummary
    mempty = Int -> ResultSummary
    SuccessSummary Int
    0
      mappend :: ResultSummary -> ResultSummary -> ResultSummary
    mappend = ResultSummary -> ResultSummary -> ResultSummary
    forall a. Semigroup a => a -> a -> a
    (<>)             -- GHC 8.2 compatibility