import Test.QuickCheck

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

-- Data type for colour of a card (black, red)
data Color = Black | Red
  deriving (Eq, Show)

-- Function that returns the color of a card
color :: Suit -> Color
color Spades   = Black
color Clubs    = Black
color Hearts   = Red
color Diamonds = Red

-- Data type for rank of a card (numeric, jack, queen, king, ace)
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 r1) (Numeric r2) = r1 > r2

-- Property that checks that either r1 beats r2 or vice versa
prop_rankBeats r1 r2 =
    r1/=r2 ==> rankBeats r1 r2 /= rankBeats r2 r1

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

c1 = Card Ace Spades
c2 = Card {suit = Spades}
c3 = c2 {rank = Ace}

defCard :: Suit -> Card
defCard s = Card Ace s

-- cardBeats card1 card2 checks if card1 beats card2 (same suit and higher rank)
cardBeats :: Card -> Card -> Bool
cardBeats c1 c2 = suit c1 == suit c2 && rankBeats (rank c1) (rank c2)
-- 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)

c4 = Card (Numeric 2) Hearts

hand = Add c1 (Add c4 Empty)

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

-- 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 h)
    | cardBeats c beat = c
    | otherwise        = chooseCard beat h
chooseCard beat Empty = error "chooseCard: Empty"

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

-- Add property that the chosen card was really in the hand

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

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 = []