haskerrank-swap-nodes

import Control.Applicative
import Data.List

data Tree a = Null | Node a (Tree a) (Tree a)

buildTree :: [(Int, (Int, Int))] -> Int -> Tree Int
buildTree _ (-1) = Null
buildTree items n = Node n (buildTree items l) (buildTree items r)
  where Just (l, r) = n `lookup` items

traverse :: Tree a -> [a]
traverse Null = []
traverse (Node i l r) = traverse l ++ [i] ++ traverse r

depth :: Tree a -> Int
depth Null = 0
depth (Node _ l r) = 1 + max (depth l) (depth r)

swap :: Int -> Tree a -> Tree a
swap _ Null = Null
swap 1 (Node i l r) = Node i r l
swap n (Node i l r) = Node i (swap n' l) (swap n' r)
  where n' = n - 1

main :: IO ()
main = do
  n <- readLn
  items <- mapM (\x -> (\[a, b] -> (x, (read a, read b))) <$> words <$> getLine) [1..n]
  t <- readLn
  ks <- mapM (const readLn) [1..t]
  let tree = buildTree items 1
      d = depth tree
      rs = tail $ scanl (\tree' k -> foldr swap tree' [k,2*k..d]) tree ks
  mapM_ (putStrLn . intercalate " " . map show . traverse) rs