data Index = A | B | C | D | E | F | G

deriving (Eq, Ord, Show, Enum, Ix)

data Slot = Slot

{

shown :: [Card]

, hidden :: [Card]

} deriving (Show,Eq)

type Tableau = Array Index Slot

type Foundation = Array Suit [Card]

By deriving Index and Suit from the class

`Ix`

it becomes possible to use this to index items in an array.To play Klondike we need to deal the deck out. I've assumed the deck is already shuffled.

newGame :: [Card] -> Game

newGame cards = Game d emptyFoundation t where

(t,d) = dealTableau cards

emptyFoundation :: Foundation

emptyFoundation = array (Clubs,Spades) [(s,[]) | s <- [Clubs .. Spades]]

dealTableau :: [Card] -> (Tableau,[Card])

dealTableau dk = ((array (A,G) [(A,(Slot [a] as))

,(B,(Slot [b] bs))

,(C,(Slot [c] cs))

,(D,(Slot [d] ds))

,(E,(Slot [e] es))

,(F,(Slot [f] fs))

,(G,(Slot [g] gs))]),

rest) where

(a:as,h) = splitAt 1 dk

(b:bs,i) = splitAt 2 h

(c:cs,j) = splitAt 3 i

(d:ds,k) = splitAt 4 j

(e:es,l) = splitAt 5 k

(f:fs,m) = splitAt 6 l

(g:gs,rest) = splitAt 7 m

My goal is to write a simple model for Klondike so that I can experiment with various playing strategies. The first stage in this is writing the rules of the games.

data Move = TurnDeck

| ToFoundation Index

| DeckTo Index

| DeckUp

| MoveCards Index Int Index

| GameOver

deriving (Show,Eq)

-- |Can we turn the deck?

turnDeck :: Game -> Bool

turnDeck = null . deck

-- |Is the game complete?

gameWon :: Game -> Bool

gameWon game = all empty (elems (tableau game)) && not (turnDeck game)

-- |Does the second card follow the first?

successor :: Card -> Card -> Bool

successor a b = value a /= King && alternateColors a b && follows a b

-- |Can the card move down from the deck to the given slot?

cardDown :: Card -> Slot -> Bool

cardDown card (Slot s _) | null s = value card == King

| otherwise = successor card (head s)

-- |Can the card move to foundation?

cardUp :: Card -> Foundation -> Bool

cardUp (Card v suit) f | null cards = v == Ace

| otherwise = x /=King && succ x == v

where

cards = f ! suit

(Card x _) = head cards

-- |Can the card move from x to y?

slotMove :: Slot -> Slot -> Bool

slotMove (Slot from _) s | null from = False

| otherwise = cardDown (head from) s

Once we have a chunky load of predicates defined, we can put these together to get the list of moves possible from a given game state.

The

`getMoves`

function builds up a list of valid moves.

getMoves :: Game -> [Move]

getMoves g = [DeckUp | (not.null) dk && cardUp (head dk) (foundation g)]

++ [(DeckTo . fst) x | not.null $ dk, x <- filter (cardDown (head dk) . snd) slots]

++ [TurnDeck | not.null $ dk]

++ [ToFoundation is | is <- cardsUp]

++ slotMoves

++ [GameOver | gameWon g] where

dk = deck g

slots = assocs (tableau g)

cardsUp = map fst (filter (flip cardUpFromSlot (foundation g) . snd) slots)

slotMoves = [MoveCards (fst x) 1 (fst y) | x <- slots, y <- slots,

fst x /= fst y && slotMove (snd x) (snd y)]

There's also a corresponding

`move :: Game -> Move -> Game`

function that performs the given move and returns a new game state. It's a bit chunky to paste here (which probably indicates it could be improved!), but you can grab it from github.Now that I have a basic model of the game, I just need to write a routine that picks the best move based on the current state. My current thoughts are just to sort the moves according to some criteria (e.g. moving a card up is always preferable to turning the deck), but initial attempts having been that good. Maybe I just need brute force!