DouKaku?

module Main (main) where

import Data.List
import System.Environment

main :: IO ()
main = do { a:_ <- getArgs
          ; let { e = read a :: [Int]
                ; s = sort e
                ; caption = putStrLn . concat . intersperse " " . map show
                }
          ; caption s >> putStr (showAmida (length e - 1) (amida e)) >> caption e
          }

amida :: [Int] -> [[(Int,Int)]]
amida p = reverse $ fst $ head $ dropWhile (not . null . snd) $ iterate f ([],invs)
  where invs = inversions p
        f (acc,invs) = case select invs of
                         (xs,ys) -> (xs:acc, foldr map ys (map exchange xs))

inversions :: [Int] -> [(Int,Int)]
inversions [] = []
inversions (y:ys) = map (flip (,) y) (filter (y >) ys) ++ inversions ys

select :: [(Int,Int)] -> ([(Int,Int)],[(Int,Int)])
select invs = case partition ((1==) . uncurry subtract) $ sort $ invs of
                ([]  ,ys)       -> ([],ys)
                (x:xs,ys) 
                  -> case partition (share x) (xs++ys) of
                        (zs,ws) -> case select ws of
                                     (us,vs) -> (x:us,zs++vs)

share :: (Int,Int) -> (Int,Int) -> Bool
share (x,y) (p,q) = x == p || x == q || y == p || y == q

exchange :: (Int,Int) -> (Int,Int) -> (Int,Int)
exchange (x,y) pq@(p,q) | x == p    = (y,q)
                        | x == q    = (p,y)
                        | y == p    = (x,q)
                        | y == q    = (p,x)
                        | otherwise = pq

showAmida :: Int -> [[(Int,Int)]] -> String
showAmida n = unlines . map (showStep n)

showStep :: Int -> [(Int,Int)] -> String
showStep n xs = '|':step n 0 xs
  where step n m xs 
          | n == m    = ""
          | otherwise = case xs of
                          [] -> nostep $ step n (m+1) xs
                          (i,_):rs | m == i    -> astep  $ step n (m+1) rs
                                   | otherwise -> nostep $ step n (m+1) xs
        nostep = (' ':).('|':)
        astep  = ('-':).('|':)