module Cards where

import Test.QuickCheck

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

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

-- data type 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

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

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

-- 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

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

-- data type 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 (same suit and higher rank)
cardBeats :: Card -> Card -> Bool
cardBeats c c' = suit c == suit c' && rankBeats (rank c) (rank c')

-- cardBeats, alternative solution
cardBeats' :: Card -> Card -> Bool
cardBeats' (Card r1 s1) (Card r2 s2) = s1 == s2 && rankBeats r1 r2

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

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

-- firstCard h returns the first card in h
firstCard :: Hand -> Card
firstCard (Add c h) = c
firstCard Empty     = error "firstCard: Empty"

-- size h computes the number of cards in h
size :: Hand -> Integer
size Empty     = 0
size (Add c h) = 1 + size h

-- lastCard h returns the last card in h
lastCard :: Hand -> Card
lastCard (Add c Empty) = c
lastCard (Add c h)     = lastCard h
lastCard Empty         = error "lastCard: Empty"

-- handBeats h c checks if any card in h beats c
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 c (Add c' Empty) = c'
chooseCard c (Add c' h)
  | cardBeats c' c = c'
  | otherwise      = chooseCard c h

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

haveCard c (Add c' h) = c==c' || haveCard c h
haveCard c Empty = False

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

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)
      ]

  shrink Ace = [King]
  shrink King = [Queen]
  shrink Queen = [Jack]
  shrink Jack = [Numeric 10]
  shrink (Numeric n) = [Numeric n' | n' <- shrink n, 2<=n']

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

  shrink (Card r s) =
    [Card r' s | r' <- shrink r]

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)

  shrink (Add c h) =
    h : [Add c' h' | (c',h') <- shrink (c,h)]
  shrink Empty = []