{-|
Module      : Test.Aeson.Internal.RandomSamples
Description : Types and functions to faciliate sampling
Copyright   : (c) Plow Technologies, 2016
License     : BSD3
Maintainer  : mchaver@gmail.com
Stability   : Beta

Internal module, use at your own risk.
-}

{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}

module Test.Aeson.Internal.RandomSamples where

import           Test.Aeson.Internal.Utils (aesonDecodeIO)

import           Data.Aeson
import           Data.ByteString.Lazy (ByteString)
import           Data.Int (Int32)

import           GHC.Generics

import           Test.QuickCheck
import           Test.QuickCheck.Gen
import           Test.QuickCheck.Random


-- | RandomSamples, using a seed allows you to replicate an arbitrary. By
-- storing the seed and the samples (previously produced arbitraries), we can
-- try to reproduce the same samples by generating the arbitraries with a seed.

data RandomSamples a = RandomSamples {
  RandomSamples a -> Int32
seed    :: Int32
, RandomSamples a -> [a]
samples :: [a]
} deriving (RandomSamples a -> RandomSamples a -> Bool
(RandomSamples a -> RandomSamples a -> Bool)
-> (RandomSamples a -> RandomSamples a -> Bool)
-> Eq (RandomSamples a)
forall a. Eq a => RandomSamples a -> RandomSamples a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RandomSamples a -> RandomSamples a -> Bool
$c/= :: forall a. Eq a => RandomSamples a -> RandomSamples a -> Bool
== :: RandomSamples a -> RandomSamples a -> Bool
$c== :: forall a. Eq a => RandomSamples a -> RandomSamples a -> Bool
Eq, Eq (RandomSamples a)
Eq (RandomSamples a) =>
(RandomSamples a -> RandomSamples a -> Ordering)
-> (RandomSamples a -> RandomSamples a -> Bool)
-> (RandomSamples a -> RandomSamples a -> Bool)
-> (RandomSamples a -> RandomSamples a -> Bool)
-> (RandomSamples a -> RandomSamples a -> Bool)
-> (RandomSamples a -> RandomSamples a -> RandomSamples a)
-> (RandomSamples a -> RandomSamples a -> RandomSamples a)
-> Ord (RandomSamples a)
RandomSamples a -> RandomSamples a -> Bool
RandomSamples a -> RandomSamples a -> Ordering
RandomSamples a -> RandomSamples a -> RandomSamples a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (RandomSamples a)
forall a. Ord a => RandomSamples a -> RandomSamples a -> Bool
forall a. Ord a => RandomSamples a -> RandomSamples a -> Ordering
forall a.
Ord a =>
RandomSamples a -> RandomSamples a -> RandomSamples a
min :: RandomSamples a -> RandomSamples a -> RandomSamples a
$cmin :: forall a.
Ord a =>
RandomSamples a -> RandomSamples a -> RandomSamples a
max :: RandomSamples a -> RandomSamples a -> RandomSamples a
$cmax :: forall a.
Ord a =>
RandomSamples a -> RandomSamples a -> RandomSamples a
>= :: RandomSamples a -> RandomSamples a -> Bool
$c>= :: forall a. Ord a => RandomSamples a -> RandomSamples a -> Bool
> :: RandomSamples a -> RandomSamples a -> Bool
$c> :: forall a. Ord a => RandomSamples a -> RandomSamples a -> Bool
<= :: RandomSamples a -> RandomSamples a -> Bool
$c<= :: forall a. Ord a => RandomSamples a -> RandomSamples a -> Bool
< :: RandomSamples a -> RandomSamples a -> Bool
$c< :: forall a. Ord a => RandomSamples a -> RandomSamples a -> Bool
compare :: RandomSamples a -> RandomSamples a -> Ordering
$ccompare :: forall a. Ord a => RandomSamples a -> RandomSamples a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (RandomSamples a)
Ord, Int -> RandomSamples a -> ShowS
[RandomSamples a] -> ShowS
RandomSamples a -> String
(Int -> RandomSamples a -> ShowS)
-> (RandomSamples a -> String)
-> ([RandomSamples a] -> ShowS)
-> Show (RandomSamples a)
forall a. Show a => Int -> RandomSamples a -> ShowS
forall a. Show a => [RandomSamples a] -> ShowS
forall a. Show a => RandomSamples a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RandomSamples a] -> ShowS
$cshowList :: forall a. Show a => [RandomSamples a] -> ShowS
show :: RandomSamples a -> String
$cshow :: forall a. Show a => RandomSamples a -> String
showsPrec :: Int -> RandomSamples a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RandomSamples a -> ShowS
Show, (forall x. RandomSamples a -> Rep (RandomSamples a) x)
-> (forall x. Rep (RandomSamples a) x -> RandomSamples a)
-> Generic (RandomSamples a)
forall x. Rep (RandomSamples a) x -> RandomSamples a
forall x. RandomSamples a -> Rep (RandomSamples a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (RandomSamples a) x -> RandomSamples a
forall a x. RandomSamples a -> Rep (RandomSamples a) x
$cto :: forall a x. Rep (RandomSamples a) x -> RandomSamples a
$cfrom :: forall a x. RandomSamples a -> Rep (RandomSamples a) x
Generic)

instance FromJSON a => FromJSON (RandomSamples a)
instance ToJSON   a => ToJSON   (RandomSamples a)

-- | Apply the seed.
setSeed :: Int -> Gen a -> Gen a
setSeed :: Int -> Gen a -> Gen a
setSeed rSeed :: Int
rSeed (MkGen g :: QCGen -> Int -> a
g) = (QCGen -> Int -> a) -> Gen a
forall a. (QCGen -> Int -> a) -> Gen a
MkGen ((QCGen -> Int -> a) -> Gen a) -> (QCGen -> Int -> a) -> Gen a
forall a b. (a -> b) -> a -> b
$ \ _randomSeed :: QCGen
_randomSeed size :: Int
size -> QCGen -> Int -> a
g (Int -> QCGen
mkQCGen Int
rSeed) Int
size

-- | Reads the seed without looking at the samples.
readSeed :: ByteString -> IO Int32
readSeed :: ByteString -> IO Int32
readSeed = (RandomSamples Value -> Int32)
-> IO (RandomSamples Value) -> IO Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RandomSamples Value -> Int32
forall a. RandomSamples a -> Int32
seed (IO (RandomSamples Value) -> IO Int32)
-> (ByteString -> IO (RandomSamples Value))
-> ByteString
-> IO Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromJSON (RandomSamples Value) =>
ByteString -> IO (RandomSamples Value)
forall a. FromJSON a => ByteString -> IO a
aesonDecodeIO @(RandomSamples Value)

-- | Read the sample size.
readSampleSize :: ByteString -> IO Int
readSampleSize :: ByteString -> IO Int
readSampleSize = (RandomSamples Value -> Int) -> IO (RandomSamples Value) -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Value] -> Int)
-> (RandomSamples Value -> [Value]) -> RandomSamples Value -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RandomSamples Value -> [Value]
forall a. RandomSamples a -> [a]
samples) (IO (RandomSamples Value) -> IO Int)
-> (ByteString -> IO (RandomSamples Value)) -> ByteString -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromJSON (RandomSamples Value) =>
ByteString -> IO (RandomSamples Value)
forall a. FromJSON a => ByteString -> IO a
aesonDecodeIO @(RandomSamples Value)