[Haskell-cafe] QuickCheck Fun with Phantom Types

[Dominic Steinitz]

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)