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)

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))