Blackjack in Haskell (newbie code ahead)

hlackjack.hs

import Data.List (delete, nub, intersperse)
import System.IO (hFlush, stdout)
import System.Random
import System.Exit
import Control.Monad (when)

data Suit = Spades | Clubs | Hearts | Diamonds deriving (Eq)
data Rank = Number Int | Jack | Queen | King | Ace deriving (Eq)
type Card = (Rank, Suit)

instance Show Suit where
    show Spades   = "♠"
    show Clubs    = "♣"
    show Hearts   = "♥"
    show Diamonds = "♦"

instance Show Rank where
    show (Number num) = show num
    show Jack         = "J"
    show Queen        = "Q"
    show King         = "K"
    show Ace          = "A"

suits = [Spades, Clubs, Hearts, Diamonds]
ranks = map Number [2..10] ++ [Jack, Queen, King, Ace]
deck  = concatMap (\ c -> flip zip suits (repeat c)) ranks

shuffle :: (Eq a) => StdGen -> [a] -> [a]
shuffle _ [] = []
shuffle gen list = randItem : (shuffle gen' (delete randItem list))
    where randItem = list !! randPos
          (randPos, gen') = randomR (0,listLen-1) gen :: (Int, StdGen)
          listLen  = (length list)

resetAllANSI   = "\x1b[0m"
setReverseANSI = "\x1b[7m"
setBlackBgANSI = "\x1b[40m"
setRedBgANSI   = "\x1b[41m"

showCard :: Card -> String
showCard (rank,suit) =
    setReverseANSI ++ setColor ++ show rank ++ show suit ++ resetAllANSI
    where setColor = case suit of Spades   -> setBlackBgANSI
                                  Clubs    -> setBlackBgANSI
                                  Hearts   -> setRedBgANSI
                                  Diamonds -> setRedBgANSI

hiddenCard :: String
hiddenCard = setReverseANSI ++ setRedBgANSI ++ backPattern ++ resetAllANSI
    where backPattern    = "▒▒" -- "░░"

showCardsAndScore :: [Card] -> IO ()
showCardsAndScore cards = do
    mapM_ (putStr . (++ " ") . showCard) $ cards
    putStr "score: "
    let scores = getCardsScores cards
    if length scores == 1 then
        putStrLn $ show $ scores !! 0
    else do
        putStr $ concat $ intersperse ", " $ map show $ init scores
        putStrLn $ (" or " ++ ) $ show $ last scores

cardValue :: Card -> (Int, Maybe Int)
cardValue (rank,_) =
    case rank of (Number num) -> (num, Nothing)
                 Jack         -> (10,  Nothing)
                 Queen        -> (10,  Nothing)
                 King         -> (10,  Nothing)
                 Ace          -> (1,   Just 11)

getCardsScores :: [Card] -> [Int]
getCardsScores list = nub $ getScores [] $ map (mapFunc . cardValue) list
    where mapFunc = (\ (a,b) -> case b of { Nothing -> (a,0); Just num -> (a,num) })
          getScores :: [Int] -> [(Int, Int)] -> [Int]
          getScores [] ((a,b):xs)     = getScores (if b == 0 then [a] else [a, b]) xs
          getScores scores []         = scores
          getScores scores ((a,b):xs) =
              let newList = if b == 0 then
                                map (a+) scores
                            else
                                foldl (\ acc x -> acc ++ [x+a, x+b]) [] scores
              in getScores newList xs

choice :: [String] -> IO String
choice list = do
    mapM_ putStrLn $ zipWith (\ a b -> show a ++ ") " ++ b) [1..] list
    idx <- getValidIndexFromInput $ length list
    return $ list !! idx
    where
        getValidIndexFromInput :: Int -> IO Int
        getValidIndexFromInput listLen = do
            putStr "> "
            hFlush stdout
            inputChoice <- getLine
            when (inputChoice == "q") $ do
                exitSuccess
            let idx = case (reads inputChoice :: [(Int, String)]) of
                           [(num, "")] -> num-1
                           _           -> -1
            if idx `elem` [0..listLen] then
                return idx
            else do
                putStrLn "Invalid choice"
                getValidIndexFromInput listLen

startGame deck = do
    let cards = splitAt 4 deck
    let dealersCards = drop 2 $ fst cards
    let playersCards = take 2 $ fst cards
    putStrLn "Dealer's cards:"
    putStr $ concat [hiddenCard, " ", showCard (dealersCards !! 1), "\n"]

    playersPlay dealersCards playersCards (snd cards)

playersPlay dealersCards playersCards deck = do
    putStrLn "Your cards:"
    showCardsAndScore $ playersCards
    putStrLn ""

    whatDo <- choice ["Hit", "Stand"]
    putStrLn $ "You choose " ++ whatDo

main = do
    putStrLn "Welcome to Hlackjack!"
    putStrLn "Choose with \"1\", \"2\" ..."
    putStrLn "Enter \"q\" to quit."
    putStrLn ""
    startGame (shuffle (mkStdGen 1) deck)