content: {-# 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 fp = do
    Lua.openlibs
    Lua.requirehs "tasty" (const . void $ pushModule)
    res <- Lua.dofileTrace (Just 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 idx = do
    name   <- peekFieldRaw peekString "name" 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 idx = liftLua (Lua.ltype idx) >>= \case
    Lua.TypeTable -> TestGroup   <$!> peekList peekResultTree idx
    _             -> SingleTest  <$!> peekOutcome idx
  
  
  -- | Test outcome
  data Outcome = Success | Failure String
  
  -- | Unmarshal a test outcome
  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 <- liftLua $ toboolean idx
        return $ if b then Success else Failure "???"
      _ -> Failure <$!>
           (liftLua (Lua.tostring' idx) *> peekString top) `lastly` pop 1
  