Solve sudoku in haskell

sudoku.hs

import Data.Char  (ord)
import Data.Maybe (isJust)

data CellValue = CellValue { index :: Int
                           , row   :: Int
                           , col   :: Int
                           , box   :: Int
                           , value :: Int
                           }

toCellValue :: Int -> Int -> CellValue
toCellValue index = CellValue index row col box
  where (row, col) = quotRem index 9
        box = 3 * (row `div` 3) + (col `div` 3)

-- Returns true if the given CellValues can be part of the same sudoku grid
compatible :: CellValue -> CellValue -> Bool
compatible (CellValue i a b c m) (CellValue j p q r n)
  | i == j                     = m == n
  | a == p || b == q || c == r = m /= n
  | otherwise                  = True

-- Take all options (729) and keep the ones compatible with given values
-- Important: The options are sorted by cell index
--
-- Note: Randomizing the order of options while keeping the list sorted by
-- cell index might give a better worst case performance because it would
-- make it impossible to design a puzzle that exploits the deterministic
-- backtracking strategy current employed by this solver.
cellOptions :: [Int] -> [CellValue]
cellOptions values = foldr (filter . compatible) options given
  where options = [toCellValue i n | i <- [0..80], n <- [1..9]]
        given   = filter ((/= 0) . value) $ zipWith toCellValue [0..] values

-- Find a consistent set of 81 CellValues
backtrack :: Int -> [CellValue] -> [CellValue] -> Maybe [CellValue]
backtrack 81 chosen _  = Just (reverse chosen)
backtrack _  _      [] = Nothing
backtrack n  chosen (o:os)
  | n /= index o = Nothing
  | isJust use_o = use_o
  | otherwise    = backtrack n chosen os
  where use_o    = backtrack (n + 1) (o:chosen) (filter (compatible o) os)

solve :: [Int] -> Maybe [Int]
solve sudoku = map value <$> backtrack 0 [] (cellOptions sudoku)

sudokuToString :: [Int] -> String
sudokuToString = unlines . map unwords . chunksOf 9 . map show
  where chunksOf :: Int -> [a] -> [[a]]
        chunksOf _ [] = []
        chunksOf n xs = take n xs : chunksOf n (drop n xs)

parseInput s
  | any (\d -> d < 0 || d > 9) digits = error "Unexpected character in input"
  | otherwise                         = digits
  where digits = if length s /= 81
                 then error "Input must contain exactly 81 characters"
                 else map (\c -> if c == '.' then 0 else ord c - ord '0') s

-- Input format: a string of integers, missing values replaced with .
main = interact $ \input ->
       let solution = solve $ parseInput (take 81 input) in
       maybe "No solution found\n" sudokuToString solution