左端のn段のハノイの塔を最小回数で右端に移動させるときの最初の一手について ref: http://qiita.com/nnabeyang/items/5339a3248284b0039255

hanoi.hs

import Control.Monad.Writer

size :: [[a]] -> Int
size = foldr (\ xs n -> length xs + n) 0
move :: [[Int]] -> (Int, Int) -> Writer [String] [[Int]]
move xss (from, to) = return([move_ xs y (from, to) i| (xs, i) <- zip xss [0..]])
                      where (y:_) = xss !! from
move_ :: [Int] -> Int -> (Int, Int) -> Int -> [Int]
move_ [] y (from, to) i = if i == to then [y] else []
move_ (x:xs) y (from, to) i |i == from = xs
                            |i == to   = (y:x:xs)
                            |otherwise = (x:xs)

hanoi :: Int -> Writer [String] [[Int]]
hanoi n = hanoi_ n [[0..(n-1)], [], []] (0, 1, 2)
hanoi_ :: Int -> [[Int]] -> (Int, Int, Int) -> Writer [String] [[Int]]
hanoi_ 0 xss (from, work, to) = return(xss)
hanoi_ n xss (from, work, to) = do xss' <- hanoi_ (n-1) xss (from, to, work)
                                   xss''  <- move xss' (from, to)
                                   tell [show(xss'') ++" (" ++ show(from) ++ " -> " ++ show(to) ++ ")"]
                                   xss''' <- hanoi_ (n-1) xss'' (work, from, to)
                                   return(xss''')
show_hanoi :: Int -> IO ()
show_hanoi n = mapM_ putStrLn $ snd $ runWriter (hanoi n)

test :: Int -> IO ()
test n = mapM_ putStrLn $ take n $ map (head . snd . runWriter . hanoi) [1..]