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

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 HsLua.Core
  ( HaskellFunction, LuaError, NumResults (..), Status (OK)
  , dostringTrace, nth, rawset, throwErrorAsException )
import HsLua.Marshalling (pushName)
import Test.Tasty.Lua.Arbitrary

-- | Tasty Lua script
tastyScript :: ByteString
tastyScript :: ByteString
tastyScript = $(embedFile "tasty.lua")

-- | Push the tasty module on the Lua stack.
pushModule :: LuaError e => HaskellFunction e
pushModule :: forall e. LuaError e => HaskellFunction e
pushModule = forall e. ByteString -> LuaE e Status
dostringTrace ByteString
tastyScript forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Status
OK -> CInt -> NumResults
NumResults CInt
1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
    -- add `arbitrary` table
    forall e. Name -> LuaE e ()
pushName Name
"arbitrary"
    forall e. LuaE e ()
pushArbitraryTable
    forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
    forall e. LuaError e => LuaE e ()
registerDefaultGenerators
  Status
_  -> forall e a. LuaError e => LuaE e a
throwErrorAsException
{-# INLINABLE pushModule #-}