{-# LANGUAGE ScopedTypeVariables #-}
import Data.Char
import Data.List.Split
import Data.List
import Data.Maybe

main = do
    ls <- readFile "5.in"
    putStrLn . show . solve . parse $ ls where
        solve (ss, ms) = map head . applyMovesA (map (map ((+)(-1))) ms) . map (filter (/=' ')) $ buildStacks ss where
        --solveB (ss, ms) = map head . applyMovesB (map (map ((+)(-1))) ms) . map (filter (/=' ')) $ buildStacks ss
            size = length $ ss !! 0
            buildStacks :: [[Char]] -> [[Char]]
            buildStacks (x: xs) = zipWith (:) x (buildStacks xs)
            buildStacks [] = replicate size []


        parse = parseStacksAndMoves . take 2 . map lines . splitOn "\n\n" where
            parseStacksAndMoves [ss, ms] = (filter ((/='1') . (!!0) ) $ parseStacks ss, parseMoves ms)
            parseStacks = map split3 where
                split3 (a:b:c:[]) = b : []
                split3 (a:b:c:' ':xs) = b : (split3 xs)
                split3 (_) = []
            parseMoves = map (map parseInt . getNums . words) where
                getNums x = [x !! 1, x !! 3, x !! 5]
                parseInt = read :: String -> Int

applyMovesA moves stacks = foldl applyMove stacks moves where
    applyMove stacks [count, from, to] = iterate (moveOne from to) stacks !! (count + 1)
    moveOne from to stack = moveMany 0 from to stack

applyMovesB moves stacks = foldl applyMove stacks moves where
    applyMove stacks [count, from, to] = moveMany count from to stacks

moveMany count from to stack = updateStack from to stack where
    newItems = take (count +1) $ (stack !! from)
    updateStack :: Int -> Int -> [[Char]] -> [[Char]]
    updateStack from to (x:xs) | from == 0 = (iterate tail x !! (count + 1)) : (updateStack (from - 1) (to - 1) xs)
    updateStack from to (x:xs) | to    == 0= (newItems ++ x) : (updateStack (from - 1) (to - 1) xs)
    updateStack from to (x:xs)             = x : (updateStack (from - 1) (to - 1) xs)
    updateStack from to [] = []