-----------------------------------------------------------------------------

-- |

-- Module      : Data.Arbitrary

-- Copyright   : George Giorgidze

-- License     : BSD3

--

-- Maintainer  : George Giorgidze <http://cs.nott.ac.uk/~ggg/>

-- Stability   : Experimental

-- Portability : Portable

--

-- Additional instances of the 'Arbitrary' type class defined in 'Test.QuickCheck'.

-- Some portions of code were copied from the test suite of 'binary' package.

--

-----------------------------------------------------------------------------


{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Codec.Internal.Arbitrary (
    arrayGen
  , stringNulGen
  ) where

import qualified Data.ByteString      as B
import qualified Data.ByteString.Lazy as L

import Test.QuickCheck
import Data.Array.IArray
import Data.List
import Data.Word
import Data.Char

instance Arbitrary L.ByteString where
  arbitrary :: Gen ByteString
arbitrary = Gen [ByteString]
forall a. Arbitrary a => Gen a
arbitrary Gen [ByteString]
-> ([ByteString] -> Gen ByteString) -> Gen ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Gen ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Gen ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> Gen ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
B.null)

instance Arbitrary B.ByteString where
  arbitrary :: Gen ByteString
arbitrary = [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Gen [Word8]
forall a. Arbitrary a => Gen a
arbitrary
  
instance (Arbitrary e, Num i, IArray Array e, Ix i) =>  Arbitrary (Array i e) where
  arbitrary :: Gen (Array i e)
arbitrary = do
    Word
n <- (Word, Word) -> Gen Word
forall a. Random a => (a, a) -> Gen a
choose (Word
1, Word
128)
    Word -> Gen (Array i e)
forall e i (a :: * -> * -> *).
(Arbitrary e, Num i, IArray a e, Ix i) =>
Word -> Gen (a i e)
arrayGen Word
n

arrayGen :: (Arbitrary e, Num i, IArray a e, Ix i) => Word -> Gen (a i e)
arrayGen :: Word -> Gen (a i e)
arrayGen Word
0 = [Char] -> Gen (a i e)
forall a. HasCallStack => [Char] -> a
error [Char]
"Array with 0 elements can not be defined"
arrayGen Word
n = do
  [e]
es <- Int -> Gen [e]
forall a. Arbitrary a => Int -> Gen [a]
vector (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)
  a i e -> Gen (a i e)
forall (m :: * -> *) a. Monad m => a -> m a
return (a i e -> Gen (a i e)) -> a i e -> Gen (a i e)
forall a b. (a -> b) -> a -> b
$! (i, i) -> [e] -> a i e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (i
0 , Word -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> i) -> Word -> i
forall a b. (a -> b) -> a -> b
$ Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) [e]
es
  
stringNulGen :: Word -> Gen String
stringNulGen :: Word -> Gen [Char]
stringNulGen Word
n = do
  [Gen Char] -> Gen [Char]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Gen Char] -> Gen [Char]) -> [Gen Char] -> Gen [Char]
forall a b. (a -> b) -> a -> b
$ Word -> Gen Char -> [Gen Char]
forall i a. Integral i => i -> a -> [a]
genericReplicate Word
n (Gen Char -> [Gen Char]) -> Gen Char -> [Gen Char]
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1,Int
255) Gen Int -> (Int -> Gen Char) -> Gen Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> Gen Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Gen Char) -> (Int -> Char) -> Int -> Gen Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
chr