gistfile1.hs

import System.Environment
import Data.List
import Data.Maybe
import qualified Data.Map as Map
import System.Exit

maxDepth = 30

main :: IO ()
main = do
    args <- getArgs
    validArg <- parseArgs args
    putStrLn $ pretty $ solve 0 Map.empty validArg

parseArgs :: [String] -> IO String
parseArgs args = case args of
    [s] -> case validateArg s of
               True  -> do { return s }
               False -> do { putStrLn "Invalid arg";
                             exitWith (ExitFailure 1) }
    _   -> do { putStrLn "Invalid number of args";
                exitWith (ExitFailure 1) }

-- extremely slow in general, but fast enough in this case
validateArg :: String -> Bool
validateArg arg = elem arg (permutations "012345678")

solve :: Int -> Map.Map String Int -> String -> [String]
solve d m b | d > maxDepth = []
solve d m b = case b of
    "012345678" -> [b]
    _ -> b : extract (filter (elem "012345678") $ map (solve (d+1) m') $ getMoves m' b)
    where m' = Map.insert b 1 m

extract :: [[String]] -> [String]
extract [] = [""]
extract ss = head ss

getMoves :: Map.Map String Int -> String -> [String]
getMoves m s = filter (\a -> Map.notMember a m) (moveList s)

moveList :: String -> [String]
moveList s = [swap e d s | d <- adjacents e]
    where e = fromJust $ elemIndex '0' s

adjacents :: Int -> [Int]
adjacents a = case a of
    0 -> [1, 3]
    1 -> [0, 2, 4]
    2 -> [1, 5]
    3 -> [0, 4, 6]
    4 -> [1, 3, 5, 7]
    5 -> [2 ,4, 8]
    6 -> [3, 7]
    7 -> [4, 6, 8]
    8 -> [5, 7]
    _ -> []

swap :: Int -> Int -> [a] -> [a]
swap i j xs = take l xs ++ [xs !! u] ++ (take (u-l-1) $ drop (l+1) xs)
              ++ [xs !! l] ++ drop (u+1) xs
    where l = if i<j then i else j
          u = if i>j then i else j

pretty :: [String] -> String
pretty ss = foldl (++) "Solution:\n" $ map (subs '0' ' '.brk 0.brk 3.brk 6.brk 10) ss

brk :: Int -> String -> String
brk n s = a ++ "\n" ++ b
    where (a, b) = splitAt n s

subs :: Char -> Char -> String -> String
subs c d s = map (replace c d) s
    where replace x y z | z == x = y
                        | otherwise = z