-----------------------------------------------------------------------
--
--  Haskell: The Craft of Functional Programming
--  Simon Thompson
--  (c) Addison-Wesley, 1996-2011.
-- 
--  QC.hs
--
--      Generating values randomly.
--
-----------------------------------------------------------------------

module QC where

import Test.QuickCheck

import Control.Monad (liftM,liftM2)
import System.IO.Unsafe (unsafePerformIO)
import Data.List (nub)
import QCfuns -- to Show functions

-- Simple examples for data generation

data Card = Card Int String
            deriving (Card -> Card -> Bool
(Card -> Card -> Bool) -> (Card -> Card -> Bool) -> Eq Card
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Card -> Card -> Bool
== :: Card -> Card -> Bool
$c/= :: Card -> Card -> Bool
/= :: Card -> Card -> Bool
Eq,Int -> Card -> ShowS
[Card] -> ShowS
Card -> String
(Int -> Card -> ShowS)
-> (Card -> String) -> ([Card] -> ShowS) -> Show Card
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Card -> ShowS
showsPrec :: Int -> Card -> ShowS
$cshow :: Card -> String
show :: Card -> String
$cshowList :: [Card] -> ShowS
showList :: [Card] -> ShowS
Show)

data Info = Number Int | Email String
            deriving (Info -> Info -> Bool
(Info -> Info -> Bool) -> (Info -> Info -> Bool) -> Eq Info
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Info -> Info -> Bool
== :: Info -> Info -> Bool
$c/= :: Info -> Info -> Bool
/= :: Info -> Info -> Bool
Eq, Int -> Info -> ShowS
[Info] -> ShowS
Info -> String
(Int -> Info -> ShowS)
-> (Info -> String) -> ([Info] -> ShowS) -> Show Info
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Info -> ShowS
showsPrec :: Int -> Info -> ShowS
$cshow :: Info -> String
show :: Info -> String
$cshowList :: [Info] -> ShowS
showList :: [Info] -> ShowS
Show)

data List a = Empty | Cons a (List a)
            deriving (List a -> List a -> Bool
(List a -> List a -> Bool)
-> (List a -> List a -> Bool) -> Eq (List a)
forall a. Eq a => List a -> List a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => List a -> List a -> Bool
== :: List a -> List a -> Bool
$c/= :: forall a. Eq a => List a -> List a -> Bool
/= :: List a -> List a -> Bool
Eq, Int -> List a -> ShowS
[List a] -> ShowS
List a -> String
(Int -> List a -> ShowS)
-> (List a -> String) -> ([List a] -> ShowS) -> Show (List a)
forall a. Show a => Int -> List a -> ShowS
forall a. Show a => [List a] -> ShowS
forall a. Show a => List a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> List a -> ShowS
showsPrec :: Int -> List a -> ShowS
$cshow :: forall a. Show a => List a -> String
show :: List a -> String
$cshowList :: forall a. Show a => [List a] -> ShowS
showList :: [List a] -> ShowS
Show)

instance Arbitrary Card where
    arbitrary :: Gen Card
arbitrary =
        do
          Int
int <- Gen Int
forall a. Arbitrary a => Gen a
arbitrary
          String
string <- Gen String
forall a. Arbitrary a => Gen a
arbitrary
          Card -> Gen Card
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> String -> Card
Card Int
int String
string)

instance Arbitrary Info where
    arbitrary :: Gen Info
arbitrary =
        do
          Bool
boo <- Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
          if Bool
boo
            then do
              Int
int <- Gen Int
forall a. Arbitrary a => Gen a
arbitrary
              Info -> Gen Info
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Info
Number Int
int) 
            else do
              String
string <- Gen String
forall a. Arbitrary a => Gen a
arbitrary
              Info -> Gen Info
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Info
Email String
string) 

-- Generating lists of samples

-- instance Arbitrary a => Arbitrary (List a) where
--     arbitrary =
--         do
--           boo <- elements [True, False]
--           if boo
--                   then 
--                     return $ Empty 
--                   else do
--                     val  <- arbitrary
--                     list <- arbitrary
--                     return $ Cons val list 

instance Arbitrary a => Arbitrary (List a) where
    arbitrary :: Gen (List a)
arbitrary =
        do
          Integer
switch <- [Integer] -> Gen Integer
forall a. HasCallStack => [a] -> Gen a
elements [Integer
1,Integer
2,Integer
3]
          case Integer
switch of 
            Integer
1 -> List a -> Gen (List a)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return List a
forall a. List a
Empty 
            Integer
_ -> 
                do
                  a
val  <- Gen a
forall a. Arbitrary a => Gen a
arbitrary
                  List a
list <- Gen (List a)
forall a. Arbitrary a => Gen a
arbitrary
                  List a -> Gen (List a)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> List a -> List a
forall a. a -> List a -> List a
Cons a
val List a
list) 

-- The expr type from the calculator

data Expr = Lit Integer |
            Add Expr Expr |
            Sub Expr Expr
                deriving (Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
(Int -> Expr -> ShowS)
-> (Expr -> String) -> ([Expr] -> ShowS) -> Show Expr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Expr -> ShowS
showsPrec :: Int -> Expr -> ShowS
$cshow :: Expr -> String
show :: Expr -> String
$cshowList :: [Expr] -> ShowS
showList :: [Expr] -> ShowS
Show,Expr -> Expr -> Bool
(Expr -> Expr -> Bool) -> (Expr -> Expr -> Bool) -> Eq Expr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
/= :: Expr -> Expr -> Bool
Eq)

instance Arbitrary Expr where
    arbitrary :: Gen Expr
arbitrary = (Int -> Gen Expr) -> Gen Expr
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen Expr
arbExpr

arbExpr :: Int -> Gen Expr

arbExpr :: Int -> Gen Expr
arbExpr Int
0 = (Integer -> Expr) -> Gen Integer -> Gen Expr
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Integer -> Expr
Lit Gen Integer
forall a. Arbitrary a => Gen a
arbitrary

arbExpr Int
n = [(Int, Gen Expr)] -> Gen Expr
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [(Int
1, (Integer -> Expr) -> Gen Integer -> Gen Expr
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Integer -> Expr
Lit Gen Integer
forall a. Arbitrary a => Gen a
arbitrary),
     (Int
2, (Expr -> Expr -> Expr) -> Gen Expr -> Gen Expr -> Gen Expr
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Expr -> Expr -> Expr
Add Gen Expr
subExp Gen Expr
subExp),
     (Int
2, (Expr -> Expr -> Expr) -> Gen Expr -> Gen Expr -> Gen Expr
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Expr -> Expr -> Expr
Sub Gen Expr
subExp Gen Expr
subExp)]
        where
          subExp :: Gen Expr
subExp = Int -> Gen Expr
arbExpr (Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
n Int
2)
{-
arbExpr 0 = 
    do int <- arbitrary
       return (Lit int)

arbExpr n
    | n>0 =
        do
          pick <- choose (0,2::Int)
          case pick of
            0 -> do 
              int <- arbitrary
              return (Lit int)
            1 -> do 
              left  <- subExp
              right <- subExp
              return (Add left right)
            2 -> do 
              left  <- subExp
              right <- subExp
              return (Sub left right)
        where
          subExp = arbExpr (div n 2)
-}

prettyE :: Expr -> String

prettyE :: Expr -> String
prettyE (Lit Integer
n) = Integer -> String
forall a. Show a => a -> String
show Integer
n
prettyE (Add Expr
e1 Expr
e2) = String
"("String -> ShowS
forall a. [a] -> [a] -> [a]
++Expr -> String
prettyE Expr
e1 String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"+"String -> ShowS
forall a. [a] -> [a] -> [a]
++Expr -> String
prettyE Expr
e2 String -> ShowS
forall a. [a] -> [a] -> [a]
++String
")"
prettyE (Sub Expr
e1 Expr
e2) = String
"("String -> ShowS
forall a. [a] -> [a] -> [a]
++Expr -> String
prettyE Expr
e1 String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"-"String -> ShowS
forall a. [a] -> [a] -> [a]
++Expr -> String
prettyE Expr
e2 String -> ShowS
forall a. [a] -> [a] -> [a]
++String
")"

-- Property of map

prop_map :: (Int -> Int) -> (Int -> Int) -> [Int] -> Bool
prop_map Int -> Int
f Int -> Int
g [Int]
xs =
  (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int
f::Int->Int) ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int
g::Int -> Int) [Int]
xs) [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int
g(Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Int
f) [Int]
xs