{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Test.Tasty.Lua.Arbitrary
( registerArbitrary
, registerDefaultGenerators
, pushArbitraryTable
)
where
import HsLua.Core
import HsLua.Marshalling
import Lua.Arbitrary ()
import Test.QuickCheck (Arbitrary (..), generate, vectorOf)
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
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 ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Bool
True -> do
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