-- | Use Hedgehog generators with QuickCheck.
--
module Test.QuickCheck.Hedgehog (
    hedgehog
  ) where

import           Hedgehog
import           Hedgehog.Internal.Gen (evalGen)
import qualified Hedgehog.Internal.Seed as Seed
import           Hedgehog.Internal.Tree (treeValue)

import qualified Test.QuickCheck as QuickCheck


genSeed :: QuickCheck.Gen Seed
genSeed :: Gen Seed
genSeed =
  Word64 -> Seed
Seed.from (Word64 -> Seed) -> Gen Word64 -> Gen Seed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. (Bounded a, Integral a) => Gen a
QuickCheck.arbitraryBoundedIntegral

-- | Create a QuickCheck 'QuickCheck.Gen' from a Hedgehog 'Gen'.
--
--   /Note that this conversion does not preserve shrinking. There is currently/
--   /no way to use Hedgehog's shrinking capability inside QuickCheck./
--
hedgehog :: Gen a -> QuickCheck.Gen a
hedgehog :: forall a. Gen a -> Gen a
hedgehog Gen a
gen =
  let
    loop :: t -> Gen a
loop t
n =
      if t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 then
        Gen a
forall a. a
QuickCheck.discard
      else do
        Seed
seed <- Gen Seed
genSeed
        Size
size <- (Int -> Gen Size) -> Gen Size
forall a. (Int -> Gen a) -> Gen a
QuickCheck.sized (Size -> Gen Size
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Size -> Gen Size) -> (Int -> Size) -> Int -> Gen Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
        case Size -> Seed -> Gen a -> Maybe (Tree a)
forall a. Size -> Seed -> Gen a -> Maybe (Tree a)
evalGen Size
size Seed
seed Gen a
gen of
          Maybe (Tree a)
Nothing ->
            t -> Gen a
loop (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
          Just Tree a
x ->
            a -> Gen a
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Gen a) -> a -> Gen a
forall a b. (a -> b) -> a -> b
$ Tree a -> a
forall a. Tree a -> a
treeValue Tree a
x
  in
    Int -> Gen a
forall {t}. (Ord t, Num t) => t -> Gen a
loop (Int
100 :: Int)