[Haskell-cafe] QuickCheck Fun with Phantom Types
Dominic Steinitz
dominic.steinitz at blueyonder.co.uk
Sat May 13 08:49:53 EDT 2006
I was doing Exercise 5 of Ralf's Fun with Phantom Types and naturally thought
I'd check my solution with QuickCheck. The best I could was this. Is there
something better? Can you somehow generate random types as well as random
values in those types?
Thanks, Dominic.
PS the full source for my solution with tests is attached.
prop_Idem t x = x == uncompress t (compress t x)
instance Arbitrary Char where
arbitrary = oneof (map return ['A'..'z'])
class Reflect a where
reflect :: Type a
instance Reflect Int where
reflect = RInt
instance Reflect Char where
reflect = RChar
instance (Reflect a, Reflect b) => Reflect (a,b) where
reflect = RPair reflect reflect
instance Reflect a => Reflect [a] where
reflect = RList reflect
type Test1 = Int -> Bool
type Test2 = (Int,Int) -> Bool
type Test3 = String -> Bool
type Test4 = (String,String) -> Bool
main =
do quickCheck ((prop_Idem reflect) :: Test1)
quickCheck ((prop_Idem reflect) :: Test2)
quickCheck ((prop_Idem reflect) :: Test3)
quickCheck ((prop_Idem reflect) :: Test4)
-------------- next part --------------
import Data.List
import Data.Char
import Test.QuickCheck
import Control.Monad.State
data Type :: * -> * where
RInt :: Type Int
RChar :: Type Char
RList :: Type a -> Type [a]
RPair :: Type a -> Type b -> Type (a,b)
rString :: Type String
rString = RList RChar
g = unfoldr f
f n = Just (n `mod` 2, n `div` 2)
compressInt x = take 32 (g x)
compressChar x = take 7 (g ((ord x)))
compress :: Type a -> a -> [Int]
compress RInt x = compressInt x
compress RChar x = compressChar x
compress (RList t) [] = [0]
compress (RList t) (x:xs) = 1:(compress t x ++ compress (RList t) xs)
compress (RPair s t) (x,y) = compress s x ++ compress t y
powersOf2 = 1:(map (2*) powersOf2)
uncompressInt xs = sum (zipWith (*) xs powersOf2)
uncompressChar x = chr (uncompressInt x)
uncompress :: Type a -> [Int] -> a
uncompress t x = let (r,_) = runState (bar t) x in r
bar :: Type a -> State [Int] a
bar RInt =
do xs <- get
let (ys,zs) = splitAt 32 xs
put zs
return (uncompressInt ys)
bar RChar =
do xs <- get
let (ys,zs) = splitAt 7 xs
put zs
return (uncompressChar ys)
bar (RList t) =
do s <- get
let (f,rs) = splitAt 1 s
put rs
if f == [0]
then return []
else
do x <- bar t
xs <- bar (RList t)
return (x:xs)
bar (RPair s t) =
do x <- bar s
y <- bar t
return (x,y)
prop_Idem t x = x == uncompress t (compress t x)
instance Arbitrary Char where
arbitrary = oneof (map return ['A'..'z'])
class Reflect a where
reflect :: Type a
instance Reflect Int where
reflect = RInt
instance Reflect Char where
reflect = RChar
instance (Reflect a, Reflect b) => Reflect (a,b) where
reflect = RPair reflect reflect
instance Reflect a => Reflect [a] where
reflect = RList reflect
type Test1 = Int -> Bool
type Test2 = (Int,Int) -> Bool
type Test3 = String -> Bool
type Test4 = (String,String) -> Bool
main =
do quickCheck ((prop_Idem reflect) :: Test1)
quickCheck ((prop_Idem reflect) :: Test2)
quickCheck ((prop_Idem reflect) :: Test3)
quickCheck ((prop_Idem reflect) :: Test4)
More information about the Haskell-Cafe
mailing list