import Test.QuickCheck



-----------------------------------------------------------------------

-- We have seen that `IO` is a type that represents side-effecting instructions.
-- `IO` instructions can be built using do notation:

ask :: IO ()
ask = do
    putStr "Type something: "
    s <- getLine
    putStrLn $ "You typed " ++ show (length s) ++ " characters."




-- Another instruction type is `Gen` which can be thought of as instructions for
-- generating random numbers. Just like `IO`, `Gen` is an abstract type, but
-- `quickCheck` knows how to use this type to generate random numbers. Just like
-- for `IO`, we can use do notation and `return` to construct `Gen` values.

-- sample arbitrary

-- sample (return ...)

-- `evenInteger` generates even integers
-- (or, rather, holds instructions to generate even integers)

evenInteger :: Gen Int
evenInteger = do
    n <- arbitrary
    return (2*n)
  -- sample

-- do notation does not restrict the instruction type. For example, `doTwice`
-- from the IO lecture works for any instruction type:

doTwice :: Monad m => m a -> m (a,a)
doTwice instr = do
    a <- instr
    b <- instr
    return (a,b)

-- `Monad` is the class of all "instruction-like" types. Both `IO` and `Gen`
-- are members of this class.
--
-- Some functions from the IO lecture have more general types:
--
--     return    :: Monad m => a -> m a
--     sequence_ :: Monad m => [m a] -> m ()
--     sequence  :: Monad m => [m a] -> m [a]

-- sample $ doTwice evenInteger

-- doTwice_bad
  -- sample $ doTwice_bad evenInteger

doTwice_bad :: Monad m => m a -> m (a,a)
doTwice_bad instr = do
    a <- instr
    return (a,a)

-- `evenIntegers` generates a list of even integers
evenIntegers :: Gen [Int]
evenIntegers = do
    l <- arbitrary
    sequence $ replicate l evenInteger
  -- Alt. `vectorOf`



-----------------------------------------------------------------------

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

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

instance Arbitrary Suit
  where
    arbitrary = suit

prop_suit s = s == (s :: Suit)



-----------------------------------------------------------------------

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

rank :: Gen Rank
rank = frequency
    [ (1, return Ace  )
    , (1, return King )
    , (1, return Queen)
    , (1, return Jack )
    , (9, do n <- choose (2,10)
             return (Numeric n)
      )
    ]
  -- oneof
  -- frequency

instance Arbitrary Rank
  where
    arbitrary = rank

-- Check that the arbitrary instance produces valid ranks
validRank :: Rank -> Bool
validRank (Numeric n) = n >= 2 && n <= 10
validRank _ = True

prop_rank r = collect r (validRank r)
  -- collect



-----------------------------------------------------------------------

data Card = Card Rank Suit
    deriving (Show,Eq)

card :: Gen Card
card = do
    r <- rank
    s <- suit
    return (Card r s)



-----------------------------------------------------------------------

data Hand = Empty | Add Card Hand
  deriving (Eq, Show)

hand :: Gen Hand
hand = frequency
    [ (1, return Empty)
    , (4, do c <- card
             h <- hand
             return (Add c h)
      )
    ]
  -- oneof
  -- frequency

instance Arbitrary Hand
  where
    arbitrary = hand

size :: Hand -> Integer
size Empty     = 0
size (Add _ h) = 1 + size h

prop_hand h = collect (size h) True
  -- collect