Game.hs

{-# LANGUAGE NamedFieldPuns #-}
module Set.Game (
        -- * Types
          Game

        -- * 'Game' creation functions
        , newGame

        -- * 'Game' update functions
        , considerSet
        , extraCards
        , sortTableau

        -- * Game query functions
        , tableau
        , deckNull
        , deckSize
        , emptyGame
        , hint
  ) where

import Control.Monad (guard)
import System.Random (RandomGen)

import Set.Card
import Set.Utils
import Data.List (sortBy)

-- | 'tableauSize' is the minimum number of cards that should be on the tableau.
tableauSize :: Int
tableauSize = 12

-- | 'Game' represents the current state of a Set game including the remaining
-- shuffled deck and the current tableau.
data Game = Game [Card] [Card]

tableau :: Game -> [Card]
tableau (Game t _) = t

-- | 'newGame' creates a new 'Game' with a full tableau and shuffled deck.
newGame :: IO Game
newGame = (deal . Game []) `fmap` shuffleIO allCards

-- | 'deal' adds additional cards as needed to reach 'tableauSize' cards.
deal :: Game -> Game
deal game = addCards (tableauSize - length (tableau game)) game

-- | 'considerSet' verifies that a given set exists in the tableau
-- and then removes the set from the tableau.
considerSet :: Card -> Card -> Card -> Game -> Maybe Game
considerSet card0 card1 card2 (Game t d) = do
  guard (validSet card0 card1 card2)
  t' <- delete1 card0 =<< delete1 card1 =<< delete1 card2 t
  return (deal (Game t' d))

-- | 'addCards' adds the top @n cards from the deck to the end of the tableau.
addCards :: Int -> Game -> Game
addCards n (Game t d) = Game (t ++ dealt) d'
  where
  (dealt, d')    = splitAt n d

-- | 'deckSize' returns the number of cards remaining in the deck.
deckSize :: Game -> Int
deckSize (Game _ d) = length d

-- | 'deckNull' returns 'True' iff the deck is empty.
deckNull :: Game -> Bool
deckNull (Game _ d) = null d

-- | 'extraCards' returns either a new game with 3 additional cards dealt
-- or the number of sets remaining in the tableau.
extraCards :: Game -> Either Int Game
extraCards game
  | sets == 0 && not (deckNull game) = Right (addCards 3 game)
  | otherwise                        = Left sets
  where
   sets = length (solve (tableau game))

-- | 'hint' returns a randomly selected card contained in a set found on
-- the tableau.
hint :: RandomGen g => g -> Game -> (Maybe Card, g)
hint g game =
  let (tableau', g') = shuffle (tableau game) g
  in case solve tableau' of
      ((a,_,_):_) -> (Just a, g')
      _ -> (Nothing, g')

-- | 'sortTableau' sorts the tableau with a given order.
sortTableau :: (Card -> Card -> Ordering) -> Game -> Game
sortTableau f (Game t d) = Game (sortBy f t) d

-- | 'emptyGame' tests for a game with no cards remaining
--   in either the tableau or the deck.
emptyGame :: Game -> Bool
emptyGame game = null (tableau game) && deckNull game