module L04A where 
--------------------------
-- Instructions for
-- Test Data Generation
-- Lecture 4A, 2017
--------------------------
import Test.QuickCheck hiding ( OrderedList(..) )
import Data.List

-------------------------------------------------
-- IO instructions

getName = do
    putStr "Type your name: "
    name <- getLine
    putStrLn ("Hi " ++ name ++ "!")
    return name

doTwice io = do 
   a <- io
   b <- io
   return (a,b)

doNothing io =
  do return "hej"

-- look at the types
-- Monad
-- recept

-------------------------------------------------
-- Gen instructions

-- Gen a
-- sample
-- arbitrary 

-- natural numbers
-- nats :: Gen Integer

nats :: Gen Integer
nats =
  do x <- arbitrary
     return (abs x)

evens :: Gen Integer
evens =
  do x <- arbitrary
     return (2 * x)




prop_Reverse xs =
  reverse xs == (xs :: [Int])
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  












-- evens :: Gen Integer

-------------------------------------------------
-- Gen for cards

data Suit = Spades
          | Hearts
          | Diamonds
          | Clubs
    deriving (Show,Eq)

-- rSuit

rSuit :: Gen Suit
rSuit =
  oneof [ return Spades
        , return Hearts
        , return Diamonds
        , return Clubs ]

-- Rank

data Rank = Numeric Int
          | Jack
          | Queen
          | King
          | Ace
  deriving (Eq,Show)

-- rRank

rRank' :: Gen Rank
rRank' = oneof [ return Jack
               , return Queen
               , return King
               , return Ace
               , do k <- choose (2,10)
                    return (Numeric k) ]
               
rRank :: Gen Rank
rRank = frequency
        [ (1, return Jack)
        , (1, return Queen)
        , (1, return King)
        , (1, return Ace)
        , (9, do k <- choose (2,10)
                 return (Numeric k)) ]
              
data Card = Card Rank Suit
   deriving (Eq,Show)

-------------------------------------------------
-- Arbitrary

instance Arbitrary Suit where
  arbitrary = rSuit

instance Arbitrary Rank where
  arbitrary = rRank

instance Arbitrary Card where
  arbitrary =
        do r <- rRank
           s <- rSuit
           return (Card r s)

-- datatype invariant
prop_rank (Numeric n) = 2 <= n && n <= 10
prop_rank _           = True

-------------------------------------------------
-- Rank ordering

beats :: Rank -> Rank -> Bool
Ace       `beats` _         = True
King      `beats` _         = True
Queen     `beats` _         = True
Jack      `beats` _         = True
Numeric n `beats` Numeric m = n > m

prop_beats r1 r2 =
  (r1 `beats` r2) ==> not (r2 `beats` r1)

-- other properties of beats?














-------------------------------------------------
-- lists / hands

-- A hand of cards
type Hand = [Card]

-- A generator for Hand? ...

data Deck = Deck {cards :: [Card]}
            deriving (Eq, Show)

instance Arbitrary Deck where
  arbitrary =
    do h <- arbitrary
       return (Deck (nub h))

prop_Deck (Deck h) =
  length h <= 52


















-------------------------------------------------
-- How to use a different generator than
-- default arbitrary?

-- (i) use QuickCheck function forAll 
--    [not covered here: see documentation]

-- (ii) Make a new type from the old with its 
-- own generator

-- Example: a poker hand (five different cards) 

data PokerHand = PokerHand Hand
  deriving (Eq, Show)

instance Arbitrary PokerHand where
  arbitrary =
    do h <- pokerHand 5
       return (PokerHand h)

pokerHand :: Int -> Gen Hand
pokerHand 0 =
  do return []

pokerHand n =
  do h <- pokerHand (n-1)
     x <- cardNotIn h
     return (x:h)

cardNotIn :: [Card] -> Gen Card
cardNotIn cards =
  do x <- arbitrary
     if x `elem` cards
       then cardNotIn cards
       else return x
     
-------------------------------------------------
-- testing insert

-- import Data.List
-- ordered
-- types!

prop_Insert x (Ordered xs) =
  collect (length xs) $
    ordered xs ==> ordered (insert x (xs :: [Int]))

ordered []       = True
ordered [x]      = True
ordered (x:y:xs) = x <= y && ordered (y:xs)

data OrderedList = Ordered [Int]
  deriving (Eq, Ord, Show)

instance Arbitrary OrderedList where
  arbitrary =
    do xs <- arbitrary
       return (Ordered (sort xs))






















-- data OrderedList = Ordered [Int]