{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module      : Test.Tasty.Lua.Core
Copyright   : © 2019-2024 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>

Core types and functions for tasty Lua tests.
-}
module Test.Tasty.Lua.Core
  ( runTastyFile
  , ResultTree (..)
  , Outcome (..)
  , UnnamedTree (..)
  )
where

import Control.Monad ((<$!>), void)
import HsLua.Core (LuaE, LuaError, pop, toboolean, top)
import HsLua.Marshalling
  ( Peeker, lastly, liftLua, resultToEither, retrieving
  , peekFieldRaw, peekList, peekString, runPeek)
import Test.Tasty.Lua.Module (pushModule)
import qualified HsLua.Core as Lua
import qualified HsLua.Core.Utf8 as Utf8
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 :: LuaError e => FilePath -> LuaE e (Either String [ResultTree])
runTastyFile :: forall e.
LuaError e =>
FilePath -> LuaE e (Either FilePath [ResultTree])
runTastyFile FilePath
fp = do
  LuaE e ()
forall e. LuaE e ()
Lua.openlibs
  Name -> (Name -> LuaE e ()) -> LuaE e ()
forall e. LuaError e => Name -> (Name -> LuaE e ()) -> LuaE e ()
Lua.requirehs Name
"tasty" (LuaE e () -> Name -> LuaE e ()
forall a b. a -> b -> a
const (LuaE e () -> Name -> LuaE e ())
-> (LuaE e NumResults -> LuaE e ())
-> LuaE e NumResults
-> Name
-> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LuaE e NumResults -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e NumResults -> Name -> LuaE e ())
-> LuaE e NumResults -> Name -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ LuaE e NumResults
forall e. LuaError e => HaskellFunction e
pushModule)
  res <- Maybe FilePath -> LuaE e Status
forall e. Maybe FilePath -> LuaE e Status
Lua.dofileTrace (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fp)
  if res /= Lua.OK
    then Left . Utf8.toString <$> Lua.tostring' top
    else resultToEither <$> runPeek (peekList peekResultTree top)

-- | 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

peekResultTree :: LuaError e => Peeker e ResultTree
peekResultTree :: forall e. LuaError e => Peeker e ResultTree
peekResultTree StackIndex
idx = do
  name   <- Peeker e FilePath -> Name -> Peeker e FilePath
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e FilePath
forall e. Peeker e FilePath
peekString Name
"name" StackIndex
idx
  result <- peekFieldRaw peekUnnamedTree "result" idx
  return $! ResultTree name result

-- | Either a raw test outcome, or a nested @'Tree'@.
data UnnamedTree
  = SingleTest Outcome
  | TestGroup [ResultTree]

-- | Unmarshal an @'UnnamedTree'@.
peekUnnamedTree :: LuaError e => Peeker e UnnamedTree
peekUnnamedTree :: forall e. LuaError e => Peeker e UnnamedTree
peekUnnamedTree StackIndex
idx = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
Lua.ltype StackIndex
idx) Peek e Type -> (Type -> Peek e UnnamedTree) -> Peek e UnnamedTree
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
Lua.TypeTable -> [ResultTree] -> UnnamedTree
TestGroup   ([ResultTree] -> UnnamedTree)
-> Peek e [ResultTree] -> Peek e UnnamedTree
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e ResultTree -> Peeker e [ResultTree]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e ResultTree
forall e. LuaError e => Peeker e ResultTree
peekResultTree StackIndex
idx
  Type
_             -> Outcome -> UnnamedTree
SingleTest  (Outcome -> UnnamedTree) -> Peek e Outcome -> Peek e UnnamedTree
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Outcome
forall e. LuaError e => Peeker e Outcome
peekOutcome StackIndex
idx


-- | Test outcome
data Outcome = Success | Failure String

-- | Unmarshal a test outcome
peekOutcome :: LuaError e => Peeker e Outcome
peekOutcome :: forall e. LuaError e => Peeker e Outcome
peekOutcome StackIndex
idx = Name -> Peek e Outcome -> Peek e Outcome
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"test result" (Peek e Outcome -> Peek e Outcome)
-> Peek e Outcome -> Peek e Outcome
forall a b. (a -> b) -> a -> b
$ do
  LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
Lua.ltype StackIndex
idx) Peek e Type -> (Type -> Peek e Outcome) -> Peek e Outcome
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
Lua.TypeString  -> FilePath -> Outcome
Failure (FilePath -> Outcome) -> Peek e FilePath -> Peek e Outcome
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e FilePath
forall e. Peeker e FilePath
peekString StackIndex
idx
    Type
Lua.TypeBoolean -> do
      b <- LuaE e Bool -> Peek e Bool
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Bool -> Peek e Bool) -> LuaE e Bool -> Peek e Bool
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
toboolean StackIndex
idx
      return $ if b then Success else Failure "???"
    Type
_ -> FilePath -> Outcome
Failure (FilePath -> Outcome) -> Peek e FilePath -> Peek e Outcome
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>
         (LuaE e ByteString -> Peek e ByteString
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e ByteString
forall e. LuaError e => StackIndex -> LuaE e ByteString
Lua.tostring' StackIndex
idx) Peek e ByteString -> Peek e FilePath -> Peek e FilePath
forall a b. Peek e a -> Peek e b -> Peek e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e FilePath
forall e. Peeker e FilePath
peekString StackIndex
top) Peek e FilePath -> LuaE e () -> Peek e FilePath
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1