    {-# 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