module Test.QuickCheck.Gen.Faker
  ( fakeQuickcheck'
  , fakeQuickcheck
  )
where

import           Faker
import           System.IO.Unsafe (unsafePerformIO)
import           System.Random    (mkStdGen)
import qualified Test.QuickCheck  as Q

fakeQuickcheck :: Fake a -> Q.Gen a
fakeQuickcheck :: Fake a -> Gen a
fakeQuickcheck = FakerSettings -> Fake a -> Gen a
forall a. FakerSettings -> Fake a -> Gen a
fakeQuickcheck' FakerSettings
defaultFakerSettings

-- | Select a value 'Fake' program in 'Gen'.
--
-- Example property to check that names aren't empty:
--
-- @
-- λ> import Faker.Name (name)
-- λ> import Test.QuickCheck.Gen.Faker
-- λ> import qualified Test.QuickCheck as Q
-- λ> import qualified Data.Text as T
-- λ> Q.quickCheck (Q.forAll (fakeQuickcheck name) (not . T.null))
-- +++ OK, passed 100 tests.
--
-- @

fakeQuickcheck' :: FakerSettings -> Fake a -> Q.Gen a
fakeQuickcheck' :: FakerSettings -> Fake a -> Gen a
fakeQuickcheck' FakerSettings
fakerSettings Fake a
f = do
    StdGen
randomGen <- Int -> StdGen
mkStdGen (Int -> StdGen) -> Gen Int -> Gen StdGen
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
Q.choose (Int
forall a. Bounded a => a
minBound, Int
forall a. Bounded a => a
maxBound)
    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
$!
        IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$
        -- (parsonsmatt): OK so `unsafePerformIO` is bad, unless you know exactly
        -- what you're doing, so do I know exactly what I am doing? Perhaps I can
        -- convince you.
        --
        -- The Faker library doesn't keep the data as Haskell values, but stores it
        -- in `data-files`. The code that generates this fake data loads the values
        -- from the `data-files` for the library. That's what happens in IO. It is
        -- possible that the data-file is missing, and an exception will be thrown.
        -- However, no mutating actions are performed. I believe this is a safe use
        -- of 'unsafePerformIO'.
        --
        -- The alternative would be to lift it into `GenT IO a`, which is
        -- undesirable, as it would harm composition with basically any other
        -- generator.
        FakerSettings -> Fake a -> IO a
forall (m :: * -> *) a.
MonadIO m =>
FakerSettings -> FakeT m a -> m a
Faker.generateWithSettings
            (StdGen -> FakerSettings -> FakerSettings
Faker.setRandomGen
              StdGen
randomGen
              FakerSettings
fakerSettings
            )
            Fake a
f