module Ivory.QuickCheck.Arbitrary where
import qualified Test.QuickCheck.Arbitrary as A
import qualified Test.QuickCheck.Gen as G
import Data.Int
import Data.Word
import Data.String (IsString(fromString))
import GHC.TypeLits
import Ivory.Language
import Ivory.QuickCheck.Monad
instance A.Arbitrary IBool where
arbitrary = fmap toIvory (A.arbitrary :: G.Gen Bool)
where toIvory True = true
toIvory False = false
instance A.Arbitrary IString where
arbitrary = fmap fromString (A.arbitrary :: G.Gen String)
integralArb :: (Integral a, Num b) => G.Gen a -> G.Gen b
integralArb = fmap fromIntegral
instance A.Arbitrary Uint8 where
arbitrary = integralArb (A.arbitrary :: G.Gen Word8)
instance A.Arbitrary Uint16 where
arbitrary = integralArb (A.arbitrary :: G.Gen Word16)
instance A.Arbitrary Uint32 where
arbitrary = integralArb (A.arbitrary :: G.Gen Word32)
instance A.Arbitrary Uint64 where
arbitrary = integralArb (A.arbitrary :: G.Gen Word64)
instance A.Arbitrary Sint8 where
arbitrary = integralArb (A.arbitrary :: G.Gen Int8)
instance A.Arbitrary Sint16 where
arbitrary = integralArb (A.arbitrary :: G.Gen Int16)
instance A.Arbitrary Sint32 where
arbitrary = integralArb (A.arbitrary :: G.Gen Int32)
instance A.Arbitrary Sint64 where
arbitrary = integralArb (A.arbitrary :: G.Gen Int64)
instance A.Arbitrary IFloat where
arbitrary = fmap ifloat (A.arbitrary :: G.Gen Float)
instance A.Arbitrary IDouble where
arbitrary = fmap idouble (A.arbitrary :: G.Gen Double)
instance (SingI len, A.Arbitrary a, IvoryType a, IvoryInit a)
=> A.Arbitrary (Init (Array len (Stored a)))
where
arbitrary = do
let sz = fromSing (sing :: Sing len)
arr <- G.vectorOf (fromInteger sz) A.arbitrary
return $ iarray (map ival arr)
sampleStoredLabel :: (A.Arbitrary a, IvoryInit a)
=> Label sym (Stored a) -> G.Gen (InitStruct sym)
sampleStoredLabel label = do
v <- A.arbitrary
return (label .= ival v)
mkSamples :: Int -> G.Gen a -> IvoryGen [a]
mkSamples n (G.MkGen f) = mapM go ns
where
ns = [0,2..n*2]
go i = do
rnd <- get
return (f rnd i)