{-# LANGUAGE NoMonomorphismRestriction, RecordWildCards
  , StandaloneDeriving
  , TypeSynonymInstances, FlexibleInstances, FlexibleContexts
  , UndecidableInstances, DeriveDataTypeable, GeneralizedNewtypeDeriving
  , RankNTypes, PatternGuards
  #-}
{-# OPTIONS -Wall #-}
module Codec.TPTP.QuickCheck where

import Test.QuickCheck
import Control.Monad
import Data.Char
import Data.Array.ST
import Data.Array.IArray
import Data.Array.Base

argsFreq :: (Int -> Gen a) -> Gen a
argsFreq :: forall a. (Int -> Gen a) -> Gen a
argsFreq Int -> Gen a
f = [(Int, Gen a)] -> Gen a
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [ (Int
10,Int -> Gen a
f Int
0)
                        , (Int
10,Int -> Gen a
f Int
1)
                        , (Int
10,Int -> Gen a
f Int
2)
                        , (Int
2 ,Int -> Gen a
f Int
3)
                        , (Int
2 ,Int -> Gen a
f Int
4)
                        , (Int
1, Int -> Gen a
f Int
15)
                        ]

arbVar :: Gen [Char]
arbVar :: Gen [Char]
arbVar = (Char -> [Char] -> [Char]) -> Gen Char -> Gen [Char] -> Gen [Char]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) ([Char] -> Gen Char
forall a. HasCallStack => [a] -> Gen a
elements [Char]
"WXZY") (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Gen Int -> Gen [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose(Int
1::Int,Int
3))

-- sorry I don't feel like calculating this distribution deductively at the moment ;)
-- | Return random partition of n items into the given number of buckets if buckets>0
--
-- Return [] if buckets=0
arbPartition :: Int -> Int -> Gen [Int]
arbPartition :: Int -> Int -> Gen [Int]
arbPartition Int
0 Int
_ = [Int] -> Gen [Int]
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return []
arbPartition Int
1 Int
n = [Int] -> Gen [Int]
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int
n]
arbPartition Int
buckets Int
n = do
  [Int]
choices <- Int -> Gen Int -> Gen [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1,Int
buckets))
  let uarray :: UArray Int Int
      uarray :: UArray Int Int
uarray = (forall s. ST s (STUArray s Int Int)) -> UArray Int Int
forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray ((forall s. ST s (STUArray s Int Int)) -> UArray Int Int)
-> (forall s. ST s (STUArray s Int Int)) -> UArray Int Int
forall a b. (a -> b) -> a -> b
$
        do STUArray s Int Int
arrr <- (Int, Int) -> Int -> ST s (STUArray s Int Int)
forall i. Ix i => (i, i) -> Int -> ST s (STUArray s i Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
1,Int
buckets) Int
0
           [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int]
choices (\Int
bucket -> STUArray s Int Int -> Int -> Int -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Int
arrr Int
bucket (Int -> ST s ()) -> (Int -> Int) -> Int -> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
succ (Int -> ST s ()) -> ST s Int -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STUArray s Int Int -> Int -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Int
arrr Int
bucket)
           STUArray s Int Int -> ST s (STUArray s Int Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return STUArray s Int Int
arrr
  [Int] -> Gen [Int]
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> Gen [Int]) -> [Int] -> Gen [Int]
forall a b. (a -> b) -> a -> b
$ UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
uarray

arbPrintable :: Gen [Char]
arbPrintable :: Gen [Char]
arbPrintable = Gen Char -> Gen [Char]
forall a. Gen a -> Gen [a]
listOf (Gen Char
forall a. Arbitrary a => Gen a
arbitrary Gen Char -> (Char -> Bool) -> Gen Char
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` Char -> Bool
printable)

printable :: Char -> Bool
printable :: Char -> Bool
printable Char
x = Char -> Bool
isAscii Char
x Bool -> Bool -> Bool
&& Char -> Bool
isPrint Char
x --isDigit x || isLetter x || x `elem` " _+!@#$%^&*()[]{}-=?.,;'\":/\\"

arbLowerWord :: Gen String
arbLowerWord :: Gen [Char]
arbLowerWord = (:) (Char -> [Char] -> [Char]) -> Gen Char -> Gen ([Char] -> [Char])
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> Gen Char
forall a. HasCallStack => [a] -> Gen a
elements [Char
'a'..Char
'z'] Gen ([Char] -> [Char]) -> Gen [Char] -> Gen [Char]
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` Gen Char -> Gen [Char]
forall a. Gen a -> Gen [a]
listOf ([Char] -> Gen Char
forall a. HasCallStack => [a] -> Gen a
elements ([Char
'a'..Char
'z'][Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char
'A'..Char
'Z'][Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"_"))


arbUpperWord :: Gen String
arbUpperWord :: Gen [Char]
arbUpperWord = (:) (Char -> [Char] -> [Char]) -> Gen Char -> Gen ([Char] -> [Char])
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> Gen Char
forall a. HasCallStack => [a] -> Gen a
elements [Char
'A'..Char
'Z'] Gen ([Char] -> [Char]) -> Gen [Char] -> Gen [Char]
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` Gen Char -> Gen [Char]
forall a. Gen a -> Gen [a]
listOf ([Char] -> Gen Char
forall a. HasCallStack => [a] -> Gen a
elements ([Char
'a'..Char
'z'][Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char
'A'..Char
'Z'][Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"_"))


arbNum :: forall a a1. (Arbitrary a, Num a) => (a -> a1) -> Gen a1
arbNum :: forall a a1. (Arbitrary a, Num a) => (a -> a1) -> Gen a1
arbNum a -> a1
f =
    [(Int, Gen a1)] -> Gen a1
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
1,(a -> a1) -> Gen a -> Gen a1
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a1
f Gen a
forall a. Arbitrary a => Gen a
arbitrary)
              ,(Int
8, (Int -> a1) -> Gen Int -> Gen a1
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a1
f (a -> a1) -> (Int -> a) -> Int -> a1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Gen Int
forall a. Arbitrary a => Gen a
arbitrary::Gen Int))
              ]