aoc2022day5.hs

import qualified Data.Text as T

main = do
  input <- readFile "input.txt"
  print $ solve input

type StackState = [[Char]]
data Action = Action {
  num :: Int,
  source :: Int,
  dest :: Int
}

solve :: String -> String
solve str = (fmap head) finalState
  where
    initialState = parseInitialState $ head $ split "\n\n" str
    moves = parseMoves $ head $ drop 1 $ split "\n\n" str
    finalState = foldl performMove initialState moves

-- Parsing Initial State
split :: String -> String -> [String]
split delim str = fmap T.unpack $ T.splitOn (T.pack delim) (T.pack str)

parseInitialState :: String -> StackState
parseInitialState = 
  (foldl combineLines []) 
  . (fmap parseStateLine) 
  . init 
  . lines

combineLines :: StackState -> StackState -> StackState
combineLines (x : xs) (y : ys) = (x ++ y) : combineLines xs ys
combineLines x [] = x
combineLines [] y = y


parseStateLine :: String -> StackState
parseStateLine ('[' : c : ']' : ' ' : rest) = [c] : parseStateLine rest
parseStateLine ('[' : c : ']' : rest) = [c] : parseStateLine rest
parseStateLine (' ' : ' ' : ' ' : ' ' : rest) = [] : parseStateLine rest
parseStateLine [] = []
parseStateLine _ = undefined

-- Parsing Moves
parseMoves :: String -> [Action]
parseMoves = (fmap parseMove) . lines 

parseMove :: String -> Action
parseMove line = Action {
    num = read (section!!1) :: Int,
    source = (read (section!!3) :: Int) - 1,
    dest = (read (section!!5) :: Int) - 1
  }
  where section = words line


performMove :: StackState -> Action -> StackState
performMove state action = replaceListElement (source action) newSource $ replaceListElement (dest action) newDest state
  where 
    contents = take (num action) (state !! (source action)) 
    newSource = drop (num action) (state !! (source action))
    newDest = reverse contents ++ (state !! (dest action))


replaceListElement :: Int -> a -> [a] -> [a]
replaceListElement index newelem list = start ++ [newelem] ++ end
  where 
    start = take index list
    end = drop (index + 1) list