Generator.hs

module Test.Synthesizer.LLVM.Generator where

import qualified Synthesizer.LLVM.Parameter as Param
import qualified Synthesizer.LLVM.CausalParameterized.Functional as F

import Data.StorableVector.Lazy (ChunkSize, )

import System.Random (Random, )

import Control.Category (id, )
import Control.Applicative (liftA2, liftA3, )

import qualified Test.QuickCheck as QC

import Prelude hiding (id, )


data T f p a = Cons (QC.Gen p) (F.PrepareArguments f p a)

arg :: QC.Gen a -> T f a (f a)
arg gen = Cons gen F.atomArg

arbitrary :: (QC.Arbitrary a) => T f a (f a)
arbitrary = arg QC.arbitrary

choose :: (Random a) => (a,a) -> T f a (f a)
choose rng = arg $ QC.choose rng


pair ::
   (Functor f) =>
   T f a0 b0 ->
   T f a1 b1 ->
   T f (a0,a1) (b0,b1)
pair (Cons g0 p0) (Cons g1 p1) =
   Cons (liftA2 (,) g0 g1) (F.pairArgs p0 p1)

triple ::
   (Functor f) =>
   T f a0 b0 ->
   T f a1 b1 ->
   T f a2 b2 ->
   T f (a0,a1,a2) (b0,b1,b2)
triple (Cons g0 p0) (Cons g1 p1) (Cons g2 p2) =
   Cons (liftA3 (,,) g0 g1 g2) (F.tripleArgs p0 p1 p2)

withGenArgs ::
   T (Param.T p) p a ->
   (a -> IO (ChunkSize -> p -> test)) -> Test p test
withGenArgs (Cons gen prepArgs) f =
   (gen, withPreparedArgs prepArgs f)


withPreparedArgs ::
   F.PrepareArguments (Param.T p) p a -> (a -> test) -> test
withPreparedArgs (F.PrepareArguments prepare) f = f $ prepare id


type Test p test = (QC.Gen p, IO (ChunkSize -> p -> test))

checkWithParam :: (Show p, QC.Testable test) => Test p test -> IO ()
checkWithParam (gen, test) = do
   f <- test
   QC.quickCheck (QC.forAll gen $ flip f)