module L01B where
import Test.QuickCheck

-- Algebraic data types
-- David Sands 
-- 2012-11-01

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

data Colour = Red | Black
  deriving Show

colour :: Suit -> Colour
colour Spades = Black
colour Clubs  = Black
colour _      = Red

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

-- data Value = Two | Three | 
-- rankBeats rank1 rank2 checks if rank1 beats rank2

rankBeats :: Rank -> Rank -> Bool
-- when is one rank higher than another?
-- "longhand" definition in the lecture notes. 
-- Here we use "deriving Ord" to induce ordering operations
rankBeats r1 r2 = r1 > r2
-- rankBeats = (>)

prop_rankBeats r1 r2 = r1 == r2 |+| r1 `rankBeats` r2 
                                |+| r2 `rankBeats` r1

-- xor: example using pattern matching
infixr 2 |+|
True  |+| False = True
False |+| True  = True
_     |+| _     = False

-- Card: a data type containing a Rank and a Suit
data Card = Card Rank Suit
  deriving (Show,Eq)

rank (Card r _) = r
suit (Card _ s) = s

-- An alternative shorthand for the three lines above:
-- data Card = Card {rank::Rank, suit::Suit}
 

-- cardBeats card1 card2 checks if card1 beats card2
cardBeats :: Card -> Card -> Bool
-- w & wo pattern matching

-- cardBeats c1 c2 = suit c1 == suit c2 && rank c1 `rankBeats` rank c2
cardBeats (Card r1 s1) (Card r2 s2) = s1 == s2 && r1 `rankBeats` r2

----------------------------------------------------------
-- Hand: datatype for a hand of cards

data Hand = Empty | Add Card Hand
  deriving Show
-- either Empty, or the result of Adding a card to another hand

exHand1 = Add (Card Ace Hearts) Empty
exHand2 = Add (Card Ace Spades) exHand1

-- handBeats: when does one hand beat a given card
-- handBeats :: Hand -> Card -> Bool
handBeats Empty      c = False
handBeats (Add c' h) c = c' `cardBeats` c || handBeats h c

-- chooseCard beat hand 
-- chooses a card from hand to play, 
-- when beat is the card to be beaten
   -- If the hand is only one card, play it
   -- If there is a choice,
   --    Select the best card from the rest of the hand
   --    Choose between it and the first card
   -- Principles
   --   1. Follow suit if possible 
   -- (like in "trick winning" games: whist, bridge, ...)
   --   2. Play lowest winning card if possible
   --   3. Play lowest losing card otherwise

-- version from the slides, refactored slightly

chooseCard :: Card -> Hand -> Card
chooseCard beat (Add c Empty) = c
chooseCard beat (Add c rest) 
  | bnb c  c' = c
  | bnb c' c  = c'
  | tnt c  c' = c
  | tnt c' c  = c'
  | otherwise = rankMin c c'
 where
    bnb c1 c2 = c1 `cardBeats` beat && not(c2 `cardBeats` beat) 
    tnt c1 c2 = suit c1 == suit beat && suit c2 /= suit beat
    
    c' = chooseCard beat rest
    rankMin c1 c2 
      | rankBeats (rank c1) (rank c2) = c2 
      | otherwise                     = c1

    
    -- Trumps-Non-Trumps: first card has same suit, second does not


-- property: relating chooseCard and handBeats
-- The hand can beat the card 
-- if and only if the chosen card can
prop_win c h = isNonEmpty h  ==> 
       h `handBeats` c == chooseCard c h `cardBeats` c 
  where isNonEmpty Empty = False
        isNonEmpty _     = True
-------------------------------------------------------------------------
-- 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)
  shrink Empty = []
  shrink (Add c h) = h : map (Add c) (shrink h)

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