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)