{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-|
Module      : Test.Tasty.Lua.Arbitrary
Copyright   : © 2019-2024 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
  LuaE e ()
forall e. LuaE e ()
pushArbitraryTable
  Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
name
  LuaE e ()
forall e. LuaE e ()
newtable
  Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"generator"
  HaskellFunction e -> LuaE e ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction (HaskellFunction e -> LuaE e ()) -> HaskellFunction e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ do
    [a]
samples <- IO [a] -> LuaE e [a]
forall a. IO a -> LuaE e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Gen [a] -> IO [a]
forall a. Gen a -> IO a
generate (Gen [a] -> IO [a]) -> Gen [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ Int -> Gen a -> Gen [a]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
30 (forall a. Arbitrary a => Gen a
arbitrary @a))
    (a -> HaskellFunction e) -> [a] -> HaskellFunction e
forall a e.
LuaError e =>
(a -> LuaE e NumResults) -> [a] -> LuaE e NumResults
pushIterator (\a
x -> CInt -> NumResults
NumResults CInt
1 NumResults -> LuaE e () -> HaskellFunction e
forall a b. a -> LuaE e b -> LuaE e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Pusher e a
push a
x) [a]
samples
  StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"shrink"
  HaskellFunction e -> LuaE e ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction (HaskellFunction e -> LuaE e ()) -> HaskellFunction e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$
    Peeker e a -> StackIndex -> LuaE e (Result a)
forall e a. Peeker e a -> StackIndex -> LuaE e (Result a)
runPeeker Peeker e a
peek (CInt -> StackIndex
nthBottom CInt
1) LuaE e (Result a)
-> (Result a -> HaskellFunction e) -> HaskellFunction e
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Success a
x -> do
        Pusher e a -> [a] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e a
push (a -> [a]
forall a. Arbitrary a => a -> [a]
shrink a
x)
        NumResults -> HaskellFunction e
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CInt -> NumResults
NumResults CInt
1)
      Result a
_ -> NumResults -> HaskellFunction e
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CInt -> NumResults
NumResults CInt
0)
  StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  Int -> LuaE e ()
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 =
  Name -> LuaE e Bool
forall e. Name -> LuaE e Bool
newmetatable Name
"tasty.arbitrary" LuaE e Bool -> (Bool -> LuaE e ()) -> LuaE e ()
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False ->    -- table exists
      () -> LuaE e ()
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Bool
True  -> do -- table created
      -- make table it's own metatable
      StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
top
      StackIndex -> LuaE e ()
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
  Name -> Pusher e Bool -> Peeker e Bool -> LuaE e ()
forall a e.
(Arbitrary a, LuaError e) =>
Name -> Pusher e a -> Peeker e a -> LuaE e ()
registerArbitrary Name
"boolean" Pusher e Bool
forall e. Bool -> LuaE e ()
pushboolean Peeker e Bool
forall e. Peeker e Bool
peekBool
  Name -> Pusher e Integer -> Peeker e Integer -> LuaE e ()
forall a e.
(Arbitrary a, LuaError e) =>
Name -> Pusher e a -> Peeker e a -> LuaE e ()
registerArbitrary Name
"integer" Pusher e Integer
forall e. Integer -> LuaE e ()
pushinteger Peeker e Integer
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral
  Name -> Pusher e Number -> Peeker e Number -> LuaE e ()
forall a e.
(Arbitrary a, LuaError e) =>
Name -> Pusher e a -> Peeker e a -> LuaE e ()
registerArbitrary Name
"number"  Pusher e Number
forall e. Number -> LuaE e ()
pushnumber  Peeker e Number
forall a e. (RealFloat a, Read a) => Peeker e a
peekRealFloat
  Name -> Pusher e String -> Peeker e String -> LuaE e ()
forall a e.
(Arbitrary a, LuaError e) =>
Name -> Pusher e a -> Peeker e a -> LuaE e ()
registerArbitrary Name
"string"  Pusher e String
forall e. String -> LuaE e ()
pushString  Peeker e String
forall e. Peeker e String
peekString