マップの通り抜け

http://ja.doukaku.org/30/nested/より。このRubyのプログラムをHaskellに移植してみました。
配列はとりあえずData.Arrayを使ってみました。HaskellのData.Arrayは、(Int, Int)もインデックスに使えます。二次元配列ぽく使えて便利。副作用がない代わりに全配列をコピーしています。たかだか幅×高さ回のコピーなので問題ないのかもしれませんが、おとなしく変更可能な配列を使った方がよかったかしら。
Haskell使うと大容量のデータとか副作用を前提としたデータ構造を如何に使うか悩みます。。。んー、この問題を関数型のアプローチで解くにはどんなデータ構造でアプローチするのがいいのでしょう。。。

module Main (main) where

import Data.Array (Array, listArray, bounds, (!), (//))

type Map = Array Point Char
type Point = (Int, Int) 

create :: String -> Map
create s = 
  let ls @ (l : _) = lines s
      w = length l
      h = length ls
  in listArray ((0, 0), (h - 1, w - 1)) $ concat ls

dump :: Map -> String
dump m = concat [[get m (x, y) | x <- xrange m] ++ "\n" | y <- yrange m]

width :: Map -> Int
width m = succ $ snd $ snd $ bounds m

height :: Map -> Int
height m = succ $ fst $ snd $ bounds m

xrange :: Map -> [Int]
xrange m = [0 .. width m - 1]

yrange :: Map -> [Int]
yrange m = [0 .. height m - 1]

get :: Map -> Point -> Char
get m (x, y) = m ! (y, x)

put :: Map -> Point -> Char -> Map
put m (x, y) c = m // [((y, x), c)]

fill :: Map -> Map
fill m = foldl f m $ zip (xrange m) (repeat 0)
  where
    f :: Map -> Point -> Map
    f m p @ (x, y) = 
      if x >= 0 && x < width m && y >= 0 && y < height m && get m p == '+'
      then flip f (x, y - 1) $
           flip f (x, y + 1) $
           flip f (x - 1, y) $
           flip f (x + 1, y) $
           put m p '#'
      else m

through m = if canThrough then "through.\n" else "No through.\n"
  where
    canThrough =
      any ('#' ==) [get m p | p <- zip (xrange m) (repeat (height m - 1))]

main :: IO ()
main = interact (\ s -> let m = fill $ create s in dump m ++ through m)