loopの列挙

http://karetta.jp/article/blog/oneline/010741から。http://d.hatena.ne.jp/takatoh/20070116経由です。

import Data.List ((\\), intersperse)

f :: (Eq a) => a -> [a] -> [[a]]
f root xs = map (root :) $ concatMap (\x -> recurse root x xs) xs

recurse :: (Eq a) => a -> a -> [a] -> [[a]]
recurse root pos xs | root == pos    = [[pos]]
                    | length xs == 1 = [xs]
                    | otherwise      = map (pos :) sub
    where rest = xs \\ [pos]
          sub  = concatMap (\new -> recurse root new rest) rest

exec :: (Eq a, Show a) => [a] -> IO ()
exec xs = mapM_ putStrLn $ toStr $ concatMap (\x -> f x xs) xs

toStr :: (Eq a, Show a) => [[a]] -> [String]
toStr xs = map (concat . intersperse "->" . map show) xs