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

Generators for arbitrary Lua values.
-}
module Test.Tasty.Lua.Arbitrary
  ( registerArbitrary
  , registerDefaultGenerators
  , pushArbitraryTable
  )
where

import HsLua.Core
import HsLua.Marshalling
import Lua.Arbitrary ()
import Test.QuickCheck (Arbitrary (..), generate, vectorOf)

-- | Register a Lua value generator.
registerArbitrary :: forall a e. (Arbitrary a, LuaError e)
                  => Name
                  -> Pusher e a
                  -> Peeker e a
                  -> LuaE e ()
registerArbitrary :: forall a e.
(Arbitrary a, LuaError e) =>
Name -> Pusher e a -> Peeker e a -> LuaE e ()
registerArbitrary Name
name Pusher e a
push Peeker e a
peek = do
  forall e. LuaE e ()
pushArbitraryTable
  forall e. Name -> LuaE e ()
pushName Name
name
  forall e. LuaE e ()
newtable
  forall e. Name -> LuaE e ()
pushName Name
"generator"
  forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction forall a b. (a -> b) -> a -> b
$ do
    [a]
samples <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. Gen a -> IO a
generate forall a b. (a -> b) -> a -> b
$ forall a. Int -> Gen a -> Gen [a]
vectorOf Int
30 (forall a. Arbitrary a => Gen a
arbitrary @a))
    forall a e.
LuaError e =>
(a -> LuaE e NumResults) -> [a] -> LuaE e NumResults
pushIterator (\a
x -> CInt -> NumResults
NumResults CInt
1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Pusher e a
push a
x) [a]
samples
  forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  forall e. Name -> LuaE e ()
pushName Name
"shrink"
  forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction forall a b. (a -> b) -> a -> b
$
    forall e a. Peeker e a -> StackIndex -> LuaE e (Result a)
runPeeker Peeker e a
peek (CInt -> StackIndex
nthBottom CInt
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Success a
x -> do
        forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e a
push (forall a. Arbitrary a => a -> [a]
shrink a
x)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (CInt -> NumResults
NumResults CInt
1)
      Result a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (CInt -> NumResults
NumResults CInt
0)
  forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  forall e. Int -> LuaE e ()
pop Int
1  -- remove `tasty.arbitrary` table


-- | Pushes the table holding all arbitrary generators to the stack.
pushArbitraryTable :: LuaE e ()
pushArbitraryTable :: forall e. LuaE e ()
pushArbitraryTable =
  forall e. Name -> LuaE e Bool
newmetatable Name
"tasty.arbitrary" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False ->    -- table exists
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Bool
True  -> do -- table created
      -- make table it's own metatable
      forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
top
      forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)

registerDefaultGenerators :: LuaError e => LuaE e ()
registerDefaultGenerators :: forall e. LuaError e => LuaE e ()
registerDefaultGenerators = do
  forall a e.
(Arbitrary a, LuaError e) =>
Name -> Pusher e a -> Peeker e a -> LuaE e ()
registerArbitrary Name
"boolean" forall e. Bool -> LuaE e ()
pushboolean forall e. Peeker e Bool
peekBool
  forall a e.
(Arbitrary a, LuaError e) =>
Name -> Pusher e a -> Peeker e a -> LuaE e ()
registerArbitrary Name
"integer" forall e. Integer -> LuaE e ()
pushinteger forall a e. (Integral a, Read a) => Peeker e a
peekIntegral
  forall a e.
(Arbitrary a, LuaError e) =>
Name -> Pusher e a -> Peeker e a -> LuaE e ()
registerArbitrary Name
"number"  forall e. Number -> LuaE e ()
pushnumber  forall a e. (RealFloat a, Read a) => Peeker e a
peekRealFloat
  forall a e.
(Arbitrary a, LuaError e) =>
Name -> Pusher e a -> Peeker e a -> LuaE e ()
registerArbitrary Name
"string"  forall e. String -> LuaE e ()
pushString  forall e. Peeker e String
peekString