{-# LANGUAGE NamedFieldPuns #-}
module Set.Game (
Game
, newGame
, considerSet
, extraCards
, sortTableau
, 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 :: Int
tableauSize = 12
data Game = Game [Card] [Card]
tableau :: Game -> [Card]
tableau (Game t _) = t
newGame :: IO Game
newGame = (deal . Game []) `fmap` shuffleIO allCards
deal :: Game -> Game
deal game = addCards (tableauSize - length (tableau game)) game
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 :: Int -> Game -> Game
addCards n (Game t d) = Game (t ++ dealt) d'
where
(dealt, d') = splitAt n d
deckSize :: Game -> Int
deckSize (Game _ d) = length d
deckNull :: Game -> Bool
deckNull (Game _ d) = null d
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 :: 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 :: (Card -> Card -> Ordering) -> Game -> Game
sortTableau f (Game t d) = Game (sortBy f t) d
emptyGame :: Game -> Bool
emptyGame game = null (tableau game) && deckNull game