Puzzle game solver via Backtracking

Question

I'm relatively new to Haskell and I'd like to get feedback on the style of my program. Specifically:

• Coding Style: Can any parts be written in a more concise or more readable way?
• Misuse: Are there any parts that are generally should be avoided, or any typical beginner mistakes? (Basically the do's and don't's)

The game

The program solves a puzzle that is also known as binoxxo: There is a 2n x 2n square grid that is partially filled with X and O. The goal filling each cell of the grid with an X or O such that the result satisfies three conditions:

1. In each column and each row, the same symbol cannot occur more than twice in a row. (I.e. OXXOXO is ok, however OXXXOO is not.)
2. Each row and each column have exactly n Xs and n Os.
3. No two rows are equal and no two columns are equal.

(An online version can be found here.)

The program

The following module consists of three parts: First we define the new type to describe the grid, with the type constructors X,O and finally E (for an empty cell). Then we have two functions: isValid checks whether all three rules hold so far, and backtrack which actually solves the puzzle. It does so by placing an X and O in the first E spot of the given puzzle checking the validity of the new grids, and if that succeeds, recursing a step deeper. This function finds all the possible solutions, but due to the lazy evaluation we can use take 1 $ backtrack myBoard to get only one and finish a little bit quicker.

module Binoxxo (isValid, backtrack, exampleBoard, Cell (..), Board) where
import Control.Applicative
import Data.List
data Cell = E | X | O -- E = empty
 deriving (Eq,Show)
type Board = [[Cell]]
exampleBoard = -- for solving: call "backtrack exampleBoard"
 [[X,X,E,E],
 [E,E,E,E],
 [O,E,E,X],
 [O,O,E,X]]
-- backtracking
backtrack :: Board -> [Board]
backtrack b
 | isFull b = [b] --board has no more empty cells
 | otherwise = nub $ concat $ map backtrack validBoards
 where
 isFull b = not $ E `elem` concat b
 newBoards = generateAllBoards b :: [Board] 
 validBoards = filter isValid newBoards
 generateAllBoards :: Board -> [Board] -- adds one new X/O in the position of a E
 generateAllBoards b = concat $ map assembleBoards (prefixRowSuffix b)
 where 
 prefixRowSuffix :: [a] -> [([a],a,[a])]-- [1,2,3,4] -> [([],1,[2,3,4]), ([1],2,[3,4]), ([1,2],3,[4]), ([1,2,3],4,[])]
 prefixRowSuffix b = zip3 (inits b) b (drop 1 $ tails b)
 assembleBoards :: ([[Cell]],[Cell],[[Cell]]) -> [Board]
 assembleBoards (front,m,back) = take 2 -- we only need to place X and O in the first occurence of E, because one of them MUST be correct
 [front ++[f++[x]++b]++ back |
 (f,E,b)<-prefixRowSuffix m,x<-[X,O]]
-- validity check (implement the three rules)
isValid :: Board -> Bool
isValid b = and $ 
 [and . map checkNeighbours, checkDupli, and . map checkCount] -- each of these get applied to all normal and transposed board
 <*> [rows, cols] 
 where
 rows = b :: Board
 cols = transpose b :: Board
 -- we cannot have three consecutive X or O
 checkNeighbours :: [Cell] -> Bool
 checkNeighbours (a:b:c:xs) = 
 let this = not $ any ((&& a==b && b==c) . (c==)) [X,O] 
 rest = checkNeighbours (b:c:xs)
 in this && rest
 checkNeighbours _ = True
 -- we cannot have two equal rows/columns
 checkDupli :: Board -> Bool
 checkDupli b = check $ filter (all (/=E)) b -- only check full rows for duplicates
 where check (x:xs) =
 (not $ x `elem` xs) && check xs
 check [] = True
 -- if row is of length n, we can have at most n/2 X and O
 checkCount :: [Cell] -> Bool
 checkCount xs = notTooMany O && notTooMany X
 where 
 len = length xs
 notTooMany xo = len >= 2 * length (filter (==xo) xs)

• Zeta: If you're a Haskell beginner, you might want to add the beginner tag.

Answer 1

isFull fires when assembleBoards returns an empty list; we'd expect to be able to ask that question only once. newBoards and validBoards do not deserve names - if you want the reader to be able to tell what the value means, comments are more appropriate.

Most of the rest of backtrack is about descending into a nested data structure and changing a small part, which lens specializes in: traverse . traverse . filtered (==E) descends into the board, then each of its elements, then each of their E cells. holesOf gives you, roughly speaking, the positions of the targets in the original board - it separates the board into a Cell and a Cell -> Board for each target. peek lets you forget there was an E.

import Control.Comonad.Representable.Store (peek)
import Control.Lens (holesOf, filtered)
backtrack :: Board -> [Board]
backtrack b = case setFirstE b of
 -- board has no more empty cells
 Nothing -> [b]
 -- we only need to place X and O in the first occurence of E, because one of them MUST be correct
 Just setter -> nub $ concatMap backtrack $ filter isValid $ map setter [X,O]
-- Punches the first E out of the board, if any.
setFirstE :: Board -> Maybe (Cell -> Board)
setFirstE = listToMaybe . map (flip peek) . holesOf (traverse . traverse . filtered (==E))