FP_BFS v2

Updated version for sample3 and sample4

type Maze = [String]

type Position = (Int, Int)
type Queue = [(Position, [Position])]

printMaze :: Maze -> IO ()
printMaze x = putStr (concat (map (++"\n") x))

getFromMaze :: Maze -> Position -> Char
getFromMaze maze (row, col) = (maze !! row) !! col

putIntoMaze :: Maze -> [(Int, Int, Char)] -> Maze
putIntoMaze maze [] = maze
putIntoMaze maze ((row, col, c):rest) = 
    let rowStr = maze !! row
        newRow = take col rowStr ++ [c] ++ drop (col + 1) rowStr
        newMaze = take row maze ++ [newRow] ++ drop (row + 1) maze
    in putIntoMaze newMaze rest

bfs :: Maze -> Position -> Position -> Maybe [Position]
bfs maze start end = bfs' [(start, [start])] []
  where
    height = length maze
    width = length (head maze)

    bfs' :: Queue -> [Position] -> Maybe [Position]
    bfs' [] _ = Nothing
    bfs' ((pos, path):rest) visited
        | pos == end = Just path
        | pos `elem` visited = bfs' rest visited
        | otherwise = bfs' (rest ++ neighbors) (pos:visited)
      where
        neighbors = [(next, path ++ [next]) | next <- validMoves pos]
        validMoves (r, c) = filter isValid [(r+1,c), (r-1,c), (r,c+1), (r,c-1)]
        isValid p@(r, c) = r >= 0 && r < height && 
                          c >= 0 && c < width && 
                          getFromMaze maze p /= '*' &&
                          p `notElem` visited

makePath :: Maze -> Position -> Position -> Maze
makePath maze start end = 
    case bfs maze start end of
        Nothing -> maze
        Just path -> putIntoMaze maze (zipWith makeMark [0..] path)
  where
    makeMark n pos = (fst pos, snd pos, intToChar n)
    intToChar n | n > 9 = head $ show (n `mod` 10)
                | otherwise = head $ show n

sample1 :: Maze
sample1 = ["*********",
           "* *   * *",
           "* * * * *",
           "* * * * *",
           "*   *   *",
           "******* *",
           "        *",
           "*********"]

sample2 :: Maze
sample2 = ["       ",
           "       ",
           "  ***  ",
           "  ***  ",
           "  ***  ",
           "       ",
           "       "]

sample3 :: Maze
sample3 = ["  * *  ",
           " ##### ",
           "  ***  ",
           "  * *  ",
           "  ***  ",
           "     * ",
           "       "]
sample4 :: Maze
sample4 = ["*********",
           "*s*   *e*",
           "* *   * *",
           "* *   * *",
           "*       *",
           "******* *",
           "        *",
           "*********"]
           

main :: IO ()
main = do
  putStrLn "Sample 1:"
  printMaze (makePath sample1 (1,1) (6,1))
  putStrLn "\nSample 2:"
  printMaze (makePath sample2 (5,5) (1,1))
  putStrLn "\nSample 3:"
  printMaze (makePath sample1 (1,1) (6,1))
  putStrLn "\nSample 4:"
  printMaze (makePath sample1 (2,2) (6,1))

Results:

Sample 1:
*********
*0*890* *
*1*7*1* *
*2*6*2* *
*345*345*
*******6*
 3210987*
*********

Sample 2:
       
 87654 
  ***3 
  ***2 
  ***1 
     0 
       

Sample 3:
*********
*0*890* *
*1*7*1* *
*2*6*2* *
*345*345*
*******6*
 3210987*
*********

Sample 4:
*********
* *234* *
* 01*5* *
* * *6* *
*   *789*
*******0*
 7654321*
*********