import Test.QuickCheck

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

-- datatype for suit of a card
data Suit = Spades | Hearts | Diamonds | Clubs
  deriving (Eq, Show)

-- datatype for colour of a card
data Colour = Black | Red
  deriving (Eq, Show)

colour :: Suit -> Colour
colour Spades   = Black
colour Hearts   = Red
colour Diamonds = Red
colour Clubs    = Black

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

-- datatype for rank of a card
data Rank = Numeric Integer | Jack | Queen | King | Ace
  deriving (Eq, Show, Ord)

-- rankBeats rank1 rank2 checks if rank1 beats rank2
rankBeats :: Rank -> Rank -> Bool
rankBeats _           Ace         = False
rankBeats Ace         _           = True
rankBeats _           King        = False
rankBeats King        _           = True
rankBeats _           Queen       = False
rankBeats Queen       _           = True
rankBeats _           Jack        = False
rankBeats Jack        _           = True
rankBeats (Numeric m) (Numeric n) = m > n

prop_RankBeats a b =
  a /= b ==>
    rankBeats a b || rankBeats b a

-- Alternative way of defining the function, taking advantage of the
-- "deriving ...,Ord". Note that this only works because we happen to
-- define the constructors in the right order in the definition.

rankBeats' :: Rank -> Rank -> Bool
rankBeats' r s = r > s

prop_RankBeats' a b =
    rankBeats a b == rankBeats' a b



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

-- datatype for card: a rank and a suit
data Card = Card{ rank :: Rank, suit :: Suit }
  deriving (Eq, Show)

-- cardBeats card1 card2 checks if card1 beats card2
cardBeats :: Card -> Card -> Bool
cardBeats c c' = suit c == suit c' && rankBeats (rank c) (rank c')

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

-- datatype for a hand of cards
data Hand = Empty | Add Card Hand
  deriving (Eq, Show)

-- handBeats hand card checks if hand beats card
handBeats :: Hand -> Card -> Bool
handBeats Empty     c' = False
handBeats (Add c h) c' = cardBeats c c' || handBeats h c'

-- chooseCard beat hand chooses a card from hand to
-- play, when beat is the card to be beaten
chooseCard :: Card -> Hand -> Card
chooseCard beat (Add c Empty) = c
chooseCard beat (Add c rest) 
  | suit c == suit beat && suit c' /= suit beat  = c
  | suit c /= suit beat && suit c' == suit beat  = c'
  | rankBeats (rank c) (rank c')                 = c'
  | otherwise                                    = c
 where
  c' = chooseCard beat rest

prop_chooseCardWinsIfPossible c h = 
  h /= Empty ==> 
    handBeats h c
      == cardBeats (chooseCard c h) c

-------------------------------------------------------------------------
-- The quickCheck "magic" we need to get it to generate arbitrary
-- elements of our new datatypes:

instance Arbitrary Suit where
  arbitrary = elements [Spades, Hearts, Diamonds, Clubs]

instance Arbitrary Rank where
  arbitrary =
    oneof $
      [ do return c
      | c <- [Jack,Queen,King,Ace]
      ] ++
      [ do n <- choose (2,10)
           return (Numeric n)
      ]

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

instance Arbitrary Hand where
  arbitrary =
    do cs <- arbitrary
       let hand []     = Empty
           hand (c:cs) = Add c (hand [ c' | c' <- cs, c' /= c ])
       return (hand cs)

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

{-
  | cardBeats c  beat && not (cardBeats c' beat) = c
  | cardBeats c' beat && not (cardBeats c beat)  = c'
-}