-- | Modelling a Playing Cards
-- Examples to introduce data types in Haskell
-- Functional Programming course 2016.
-- Thomas Hallgren

{-
This started out as a skeleton, the definitions were filled in
during the lecture.
-}

-- | Every card has a suit  ♠ ♥ ♦ ♣
data Suit = Spades | Hearts | Diamonds | Clubs
            deriving (Show,Eq,Enum)

data Colour = Black | Red
              deriving Show


-- | Each suit has a colour – red or black
colour :: Suit -> Colour
colour Spades   = Black
colour Clubs    = Black
colour _        = Red



-- | Cards have ranks: 2, 3 .. 10, Jack, Queen, King, Ace
data Rank = Numeric Int | Jack | Queen | King | Ace
            deriving (Show,Eq,Ord)

all_ranks = [Numeric n|n<-[2..10]] ++ [Jack,Queen,King,Ace]

-- | When does one rank beat another rank?
rankBeats :: Rank -> Rank -> Bool
rankBeats r1 r2 = r1>r2


-- | Alternative, junk-free Rank type
{-
data Rank' = N2 | N3 | N4 | N5 | N6 | N7 | N8 | N9 | N10
           | Jack' | Queen' | King' | Ace'
           deriving (Show,Enum)

all_ranks' = [N2 .. Ace']
-}

--type Card = (Rank,Suit)

-- | A card has a rank and a suit
{-
data Card = Card Rank Suit
            deriving Show
-}
data Card = Card {rank::Rank, suit::Suit}
            deriving Show

example_card_1 = Card King Clubs
example_card_2 = Card {rank=Ace, suit=Spades}

{-
rank :: Card -> Rank
rank (Card r s) = r

suit :: Card -> Suit
suit (Card r s) = s
-}

-- | A card beats another card when it has the same suit and it beats the rank
-- of the other card
cardBeats :: Card -> Card -> Bool
cardBeats (Card r1 s1) (Card r2 s2) = s1==s2 && r1 `rankBeats` r2

-- | Alternative definition
cardBeats' card1 card2 =
    suit card1 == suit card2 && rank card1 `rankBeats` rank card2


--type Hand = [Card]

-- | A hand contains zero or more cards
data Hand = Empty | Add Card Hand
            deriving Show

example_hand_0 = Empty

example_hand_1 = Add example_card_1 Empty

example_hand_2 = Add example_card_2 example_hand_1

-- | A empty cand beats nothing. A non-empty hand can beat a card if the first
-- card can, or if the rest of the hand can
handBeats :: Hand -> Card -> Bool
handBeats Empty     card = False
handBeats (Add c h) card = c `cardBeats` card || h `handBeats` card

-- | Return the cards that beat the given card.
betterCards :: Hand -> Card -> Hand
betterCards Empty     card = Empty
betterCards (Add c h) card | c `cardBeats` card = Add c (betterCards h card)
                           | otherwise          = betterCards h card


-- | Find (one of) the lowest card in a hand
lowestCard :: Hand -> Card
lowestCard Empty = error "empty hand"
lowestCard (Add c Empty) = c
lowestCard (Add c h) | rank c <= rank low = c
                     | otherwise = low
  where
    low = lowestCard h

-- | Given a card to beat and a hand, choose a card from the hand that can
-- beat the card to beat, if possible.
-- Choose the lowest card that beats the card to beat
-- If you can follow suit, choose the lowest card of the same suit
-- Otherwise, choose the lowest card

chooseCard :: Card -> Hand -> Card
chooseCard beat hand
    | hand `handBeats` beat     = lowestCard (betterCards hand beat)
    | hand `haveSuit` suit beat = lowestCard (sameSuit hand (suit beat))
    | otherwise                 = lowestCard hand


-- * Functions added after the lecture

-- | Return a hand containing only the cards of the given suit
sameSuit :: Hand -> Suit -> Hand
sameSuit Empty     s               = Empty
sameSuit (Add c h) s | suit c == s =  Add c (sameSuit h s)
                     | otherwise   = sameSuit h s

-- * Does the hand contain a card of the given suit?
haveSuit :: Hand -> Suit -> Bool
haveSuit Empty     s = False
haveSuit (Add c h) s = suit c==s || haveSuit h s