どう書く? org 「あみだくじ」

問題は以下。

次のような書式で与えられた「あみだくじ」があります。
(あみだくじはコード中に埋め込んでも、標準入力や
外部ファイルから読み込んでも、書きやすい方法でかまいません)

A B C D E
| | |-| |
|-| | |-|
| |-| |-|
|-| |-| |
|-| | | |

このあみだくじをたどって
A B C D E
| | |-| |
|-| | |-|
| |-| |-|
|-| |-| |
|-| | | |
B D C A E
のように結果を表示させるプログラムを作ってください。

うまいやり方が思いつかなかったので、普通に解いた。

import List

main :: IO ()
main = do headline <- getLine
          amida <- getContents
          let headline' = " " ++ headline
              allPos = findIndices (/= ' ') headline'
              allPos' = solveAll allPos amida
              footline = intersperse ' ' $ map snd $ sort $ zip allPos' $ map (headline' !!) allPos
          putStrLn $ concat [headline ++ "\n", amida, footline]

solveAll :: [Int] -> String -> [Int]
solveAll allPos amida = let ss = map (\l -> " " ++ l ++ " ") $ lines amida
                            in map (flip solve ss) allPos

solve :: Int -> [String] -> Int
solve pos lines = foldl step pos lines
    where step :: Int -> String -> Int
          step pos line = case take 3 $ drop (pos - 1) line of
                               "-| " -> pos - 2
                               " |-" -> pos + 2
                               " | " -> pos

一本ずつくじを辿って、どこに辿り着くかを調べている。