{-# LANGUAGE LambdaCase #-}
{-|
Module      : Test.Tasty.Lua.Core
Copyright   : © 2019–2020 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 :: FilePath -> Lua (Either FilePath [ResultTree])
runTastyFile FilePath
fp = do
  Lua ()
Lua.openlibs
  FilePath -> Lua () -> Lua ()
Lua.requirehs FilePath
"tasty" (Lua NumResults -> Lua ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Lua NumResults
pushModule)
  Status
res <- FilePath -> Lua Status
Lua.dofile FilePath
fp
  if Status
res Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK
    then FilePath -> Either FilePath [ResultTree]
forall a b. a -> Either a b
Left (FilePath -> Either FilePath [ResultTree])
-> (ByteString -> FilePath)
-> ByteString
-> Either FilePath [ResultTree]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
toString (ByteString -> Either FilePath [ResultTree])
-> Lua ByteString -> Lua (Either FilePath [ResultTree])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua ByteString
Lua.tostring' StackIndex
Lua.stackTop
    else Lua [ResultTree] -> Lua (Either Exception [ResultTree])
forall a. Lua a -> Lua (Either Exception a)
Lua.try (StackIndex -> Lua [ResultTree]
forall a. Peekable a => StackIndex -> Lua [a]
Lua.peekList StackIndex
Lua.stackTop) Lua (Either Exception [ResultTree])
-> (Either Exception [ResultTree]
    -> Lua (Either FilePath [ResultTree]))
-> Lua (Either FilePath [ResultTree])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
           Left (Lua.Exception FilePath
e) -> Either FilePath [ResultTree] -> Lua (Either FilePath [ResultTree])
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Either FilePath [ResultTree]
forall a b. a -> Either a b
Left FilePath
e)
           Right [ResultTree]
trees            -> Either FilePath [ResultTree] -> Lua (Either FilePath [ResultTree])
forall (m :: * -> *) a. Monad m => a -> m a
return ([ResultTree] -> Either FilePath [ResultTree]
forall a b. b -> Either a b
Right [ResultTree]
trees)

-- | Convert UTF8-encoded @'ByteString'@ to a @'String'@.
toString :: ByteString -> String
toString :: ByteString -> FilePath
toString = Text -> FilePath
Text.unpack (Text -> FilePath)
-> (ByteString -> Text) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
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 :: StackIndex -> Lua ResultTree
peek = StackIndex -> Lua ResultTree
peekResultTree

peekResultTree :: StackIndex -> Lua ResultTree
peekResultTree :: StackIndex -> Lua ResultTree
peekResultTree StackIndex
idx = do
  FilePath
name   <- StackIndex -> FilePath -> Lua ()
Lua.getfield StackIndex
idx FilePath
"name"   Lua () -> Lua FilePath -> Lua FilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lua FilePath
forall a. Peekable a => Lua a
Lua.popValue
  UnnamedTree
result <- StackIndex -> FilePath -> Lua ()
Lua.getfield StackIndex
idx FilePath
"result" Lua () -> Lua UnnamedTree -> Lua UnnamedTree
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lua UnnamedTree
forall a. Peekable a => Lua a
Lua.popValue
  ResultTree -> Lua ResultTree
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultTree -> Lua ResultTree) -> ResultTree -> Lua ResultTree
forall a b. (a -> b) -> a -> b
$ FilePath -> UnnamedTree -> ResultTree
ResultTree FilePath
name UnnamedTree
result

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

instance Peekable UnnamedTree where
  peek :: StackIndex -> Lua UnnamedTree
peek = StackIndex -> Lua UnnamedTree
peekUnnamedTree

-- | Unmarshal an @'UnnamedTree'@.
peekUnnamedTree :: StackIndex -> Lua UnnamedTree
peekUnnamedTree :: StackIndex -> Lua UnnamedTree
peekUnnamedTree StackIndex
idx = do
  Type
ty <- StackIndex -> Lua Type
Lua.ltype StackIndex
idx
  case Type
ty of
    Type
Lua.TypeTable   -> [ResultTree] -> UnnamedTree
TestGroup   ([ResultTree] -> UnnamedTree)
-> Lua [ResultTree] -> Lua UnnamedTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua [ResultTree]
forall a. Peekable a => StackIndex -> Lua [a]
Lua.peekList StackIndex
idx
    Type
_               -> Outcome -> UnnamedTree
SingleTest  (Outcome -> UnnamedTree) -> Lua Outcome -> Lua UnnamedTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua Outcome
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx


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

instance Peekable Outcome where
  peek :: StackIndex -> Lua Outcome
peek = StackIndex -> Lua Outcome
peekOutcome

-- | Unmarshal a test outcome
peekOutcome :: StackIndex -> Lua Outcome
peekOutcome :: StackIndex -> Lua Outcome
peekOutcome StackIndex
idx = do
  Type
ty <- StackIndex -> Lua Type
Lua.ltype StackIndex
idx
  case Type
ty of
    Type
Lua.TypeString  -> FilePath -> Outcome
Failure (FilePath -> Outcome) -> Lua FilePath -> Lua Outcome
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua FilePath
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx
    Type
Lua.TypeBoolean -> do
      Bool
b <- StackIndex -> Lua Bool
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx
      Outcome -> Lua Outcome
forall (m :: * -> *) a. Monad m => a -> m a
return (Outcome -> Lua Outcome) -> Outcome -> Lua Outcome
forall a b. (a -> b) -> a -> b
$ if Bool
b then Outcome
Success else FilePath -> Outcome
Failure FilePath
"???"
    Type
_ -> do
      FilePath
s <- ByteString -> FilePath
toString (ByteString -> FilePath) -> Lua ByteString -> Lua FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua ByteString
Lua.tostring' StackIndex
idx
      FilePath -> Lua Outcome
forall a. FilePath -> Lua a
Lua.throwException (FilePath
"not a test result: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s)