------------------------------------
-- Blackjack game
-- By amz
-- 2009-03-23
------------------------------------

-- Note for non-Windows users: switch showCard and showCard' around, or you'll get console garbage


---------- Imports

import System.Random
import Data.List


---------- Main Loop

main = do
        rand <- getStdGen
        let world = makeWorld rand
        putStrLn $ getStatus world
        mainLoop world

-- Game's main loop
mainLoop :: World -> IO ()
mainLoop w = do
        putStrLn $ "\nCurrent player: " ++ (show curPlayer)
        action <- getAction curPlayer w
        if action == Quit
                then return ()
                else do
                        putStrLn $ "Action: " ++ show action ++ "\n"
                        let world = processAction action w
                        putStrLn $ getStatus world
                        if gameHasWinner world
                                then putStrLn $ "\n" ++ (showWinner world)
                                else mainLoop world
        where
                curPlayer = currentPlayer w


---------- World

data World = World { deck          :: Deck
                   , playerHand    :: Deck
                   , dealerHand    :: Deck
                   , currentPlayer :: Player
                   , numStands     :: Int
                   } deriving (Show)

-- Constructs a new world
makeWorld :: StdGen -> World
makeWorld rand = bothBuy $ bothBuy w
        where
                w = World { deck = shuffledDeck rand, playerHand = [], dealerHand = [], currentPlayer = User, numStands = 0 }
                bothBuy w = doHit Dealer $ doHit User w

-- Gets the current world status
getStatus :: World -> String
getStatus w = playerInfo ++ "\n" ++ dealerInfo
        where
                playerInfo = " Player's hand: " ++ (deckString $ playerHand w)
                dealerInfo = " Dealer's hand: " ++ (deckString $ dealerHand w)

-- Checks if the game is over
gameHasWinner :: World -> Bool
gameHasWinner w = sc1 > 21 || sc2 > 21 || numStands w >= 2
        where
                sc1 = deckValue $ playerHand w
                sc2 = deckValue $ dealerHand w

-- Gets the string describing the game outcome
showWinner :: World -> String
showWinner w
        | winner == Nothing   = "The game ended in a draw!"
        | winner == Just User = "You have won! Congratulations!"
        | otherwise           = "You have lost! Better luck next time!"
        where
                winner = getWinner w

-- Gets the winner, if it wasn't a draw
getWinner :: World -> Maybe Player
getWinner w
        | playerSc > 21       = Just Dealer
        | dealerSc > 21       = Just User
        | playerSc > dealerSc = Just User
        | dealerSc > playerSc = Just Dealer
        | otherwise           = Nothing
        where
                playerSc = deckValue $ playerHand w
                dealerSc = deckValue $ dealerHand w


---------- Deck

type Deck = [Card]

-- Constructs a shuffled deck
shuffledDeck :: StdGen -> Deck
shuffledDeck rand = shuffle rand standardDeck

-- Shuffles a list
shuffle :: StdGen -> [a] -> [a]
shuffle rand deck = map (fst) sorted
        where
                sorted           = sortBy (comp) pairs
                pairs            = zip deck ((randoms rand) :: [Integer])
                comp (x,y) (z,w) = compare y w

-- Constructs a standard deck, with all 52 cards in order
standardDeck :: Deck
standardDeck = [Card {suit=s, value=v} | s <- [Hearts .. Spades], v <- [Ace .. King] ]

-- String representation of a deck/hand
deckString :: Deck -> String
deckString deck = (deckString' deck) ++ " - Total = " ++ (show $ deckValue deck)

deckString' :: Deck -> String
deckString' (c:[]) = show c
deckString' (c:cs) = (show c) ++ ", " ++ (deckString' cs)
deckString' []     = ""

-- Finds the value of a hand
deckValue :: Deck -> Int
deckValue deck = deckValue' val countAces
        where
                val       = foldr (+) 0 $ map (cardValue) deck
                countAces = length $ filter (\x -> value x == Ace) deck

-- Adjusts the deck's value by promoting Ace values to 10 while it's an advantage to player
deckValue' :: Int -> Int -> Int
deckValue' v aces
        | v <= 12 && aces > 0 = deckValue' (v+9) (aces-1)
        | otherwise           = v


---------- Card

data Card = Card { value :: CardValue
                 , suit  :: CardSuit
                 }

data CardValue = Ace | Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King
        deriving (Eq, Ord, Show, Read, Bounded, Enum)

data CardSuit = Hearts | Diamonds | Clubs | Spades
        deriving (Eq, Ord, Show, Read, Bounded, Enum)

-- Displays the suit as a string
-- Will only work on Windows's console
showSuit :: CardSuit -> String
showSuit x = [(toEnum $ fromEnum x + 3) :: Char]

-- Displays the value as the string printed on the card
showValue :: CardValue -> String
showValue Ace   = "A"
showValue Jack  = "J"
showValue Queen = "Q"
showValue King  = "K"
showValue x     = show (fromEnum x + 1)

-- Switch the method names below if you're on Linux
-- Displays the card as a string (Windows version)
showCard :: Card -> String
showCard c = showValue (value c) ++ showSuit (suit c)

-- Displays the card as a string (Linux version)
showCard' :: Card -> String
showCard' c = show (value c) ++ " of " ++ show (suit c)

instance Show Card where
        show = showCard

-- Gets the card's value (Ace = 1)
cardValue :: Card -> Int
cardValue card
        | v >= Ten  = 10
        | otherwise = (fromEnum v) + 1
        where
                v = value card


---------- Players

data Player = User | Dealer
        deriving (Show, Eq)


---------- Player Actions

data Action = Hit | Stand | Quit
        deriving (Show, Eq)

-- Asks player/dealer what to do
getAction :: Player -> World -> IO Action
getAction User w   = getAction'
getAction Dealer w = dealerPlay w

-- Asks the user what to do
getAction' :: IO Action
getAction' = do
        putStrLn "Enter your action (h/s/q): "
        action <- getLine
        case action of "h"       -> return Hit
                       "s"       -> return Stand
                       "q"       -> return Quit
                       otherwise -> do
                                putStrLn ("Invalid action (" ++ action ++ "). Please enter h, s or q: ")
                                getAction'

-- Process the player's action
processAction :: Action -> World -> World
processAction Hit w   = doHit (currentPlayer w) w
processAction Stand w = nextPlayer w
processAction Quit w  = w

-- Makes a player do a "hit"
doHit :: Player -> World -> World
doHit p w = if p == User then w' { playerHand = hand } else w' { dealerHand = hand }
        where
                (w',card) = buyCard w
                hand      = ((if p == User then playerHand else dealerHand) w) ++ [card]

-- Gets a card from the deck, returns updated world too
buyCard :: World -> (World, Card)
buyCard w = (w',c)
        where
                d  = deck w
                w' = w { deck = tail d }
                c  = head $ d

-- Updates the world with current player = next
nextPlayer :: World -> World
nextPlayer w = w { currentPlayer = player', numStands = (numStands w + 1) }
        where
                player' = if currentPlayer w == User then Dealer else User


--------- AI
-- Dumb as a brick, doesn't even know what to do with Aces

dealerPlay :: World -> IO Action
dealerPlay w = return $ getDealerAction w

getDealerAction :: World -> Action
getDealerAction w
        | amSecond && losing       = Hit
        | amSecond && draw && safe = Hit
        | amFirst && safe          = Hit
        | otherwise                = Stand
        where
                amFirst  = numStands w == 0
                amSecond = not amFirst
                myScore  = deckValue (dealerHand w)
                plScore  = deckValue (playerHand w)
                losing   = myScore < plScore
                draw     = myScore == plScore
                safe     = myScore < 15