Haskell code to solve sudokus using list monad for brute force nondeterminism

sudoku.hs

type Row = [Int]
type Col = [Int]
type Board = [Row]

addDigit :: Row -> Int -> Int -> Board -> [Row] -- takes a row r, its index m, the index of a cell in it m, and the board; returns list of possble rows with that cell filled
addDigit r m n b = let pos = r !! n
                       c   = getCol n b
                       s   = concat (getSquare m n b)
                       fill    = intersection (left c) (left r) (left s) -- list of numbers that could be in cell (m,n)
                    in if (pos > 0) then [r]            -- cell already filled
                       else fmap (\x -> replaceAtWith n x r) fill -- fill with one of the possibilities

getCol :: Int -> Board -> Col           -- takes n, 0 ≤ n ≤ 8 and a board; returns column n of the board
getCol n b = [(b !! i) !! n | i <- [0..8]]

getSquare :: Int -> Int -> Board -> [[Int]]. -- takes m, n, 0 ≤ m,n ≤ 8, and a board; returns minisquare containing cell (m,n)
getSquare m n b = let x = 3 * (div m 3)
                      y = 3 * (div n 3)
                   in [x,x+1,x+2] >>= \p -> [b !! p] >>= \row -> [take 3 (drop y row)]

left :: [Int] -> [Int]  -- finds complement of input list wrt [1..9]
left ns = filter (\x -> not (elem x ns)) [1..9]

intersection :: [Int] -> [Int] -> [Int] -> [Int]        -- intersection of three lists
intersection as bs cs = filter (\x -> elem x as) (filter (\y -> elem y bs) cs)

replaceAtWith :: Int -> a -> [a] -> [a]         -- takes index n, value v, list; returns list with value v at index n [regardless of old value] 
replaceAtWith pos val ns = (take pos ns) ++ [val] ++ (drop (pos+1) ns)

adds :: Board -> Int -> [Row -> [Row]]          -- list of functions that each take a row and fill one cell of it nondeterministically
adds b m = [\r -> addDigit r m i b | i <- [0..8]]

-- [row] >>= \r -> addDigit r m 0 b >>= \r -> addDigit r m 1 b ... >>= addDigit r m 8 b

solveRow :: Board -> Int -> [Row]               -- folds up "adds" to get all possible ways a certain row could be filled
solveRow b m = foldl (>>=) [b !! m] (adds b m)

getRow :: Board -> Int -> [Board]               -- returns all boards with row m solved in all possible ways
getRow b m = fmap (\r -> replaceAtWith m r b) (solveRow b m)

solves :: [Board -> [Board]]                    -- list of functions that each take a board and solve one row nondeterministically
solves = [\b -> getRow b i | i <- [0..8]]

-- [init] >>= \b -> getRow b 0 >>= \b -> getRow b 1 ... >>= \b -> getRow b 8

solveBoard :: Board -> [Board]                  -- folds up "solves" to get all possible solutions for the board
solveBoard init = foldl (>>=) [init] solves

solveAndShow :: Board -> IO ()                  -- solves and prints
solveAndShow b = let solved = head (solveBoard b)
                  in showBoard solved

showBoard :: Board -> IO ()                     -- prints
showBoard b = putStrLn (concat $ map (append '\n' . insert ' ' . concat . map show') b)

-- following fns only used for printing

show' :: Int -> String
show' 0 = " "
show' n = show n

append :: a -> [a] -> [a]
append x xs = xs ++ [x]

insert :: a -> [a] -> [a]
insert _ [] = []
insert x (y:ys) = y:x: insert x ys