--
-- The JSON specifcation is available at <http://www.json.org/> .

module Testing.QuickGenerator where

import Test.QuickCheck
import Control.Monad (replicateM, liftM2)

infixl 7 ??*
infixl 7 ?*
infixl 4 .| 
infixl 3 .++ 


-- | 
--
-- > sample $ "abcd" ??* (0,2)
-- >  ["","da","","","c","bc","d","d","","ab","c"]
(??*) :: [a] -> (Int, Int) -> Gen [a]
xs ??* r = do
    n <- choose r
    vectorOf n (elements xs)

-- |
--
-- > sample $ ['a'..'z'] ??* (0,2) ?* (3,3)
-- >   ["zc","jf","gwgob","uc","rll","jnxjjr","bycd","s","nja","cm","tu"]
(?*) :: Gen [a] -> (Int, Int) -> Gen [a]
gs ?* r = do
    n <- choose r
    concat `fmap` replicateM n gs

-- | @repeatWithInter  g i (min, max)@
--   repeat @g@ with inset @i@ from @min@ to @max@ times.
repeatWithInter ::  Gen [a] -> Gen [a] -> (Int, Int) -> Gen [a]
repeatWithInter g i r = do
    n <- choose r
    case n of
        0 -> return []
        1 -> g
        _ -> (concat `fmap` replicateM (n - 1) (g .++ i)) .++ g

-- | Or .
(.|) :: Gen a -> Gen a -> Gen a
x .| y = do
    v <- choose (False, True) :: Gen Bool
    if v then x else y

-- | Concatetion.
(.++) :: Gen [a] -> Gen [a] -> Gen [a]
(.++) = liftM2 (++)

-- | Castom 'elements'.
--
-- > el xs =  (\x -> [x]) `fmap` elements xs   
el :: [a] -> Gen [a]
el xs =  (\x -> [x]) `fmap` elements xs