adventofcode/2022/app/Day5/Main.hs

module Day5.Main (main) where

import System.IO
import Data.List
import Data.List.Split
import Text.Regex.TDFA

main :: IO ()
main = do
    putStrLn "Day 5"
    
    handle <- openFile "app/Day5/input" ReadMode
    contents <- hGetContents handle

    let r1 = part1 contents
    putStrLn $ "part 1: " ++ r1

    let r2 = part2 contents
    putStrLn $ "part 2: " ++ r2
    return ()

trim :: String -> String
trim = unwords . words

type Stack = [Char]
type Instruction = (Int, Int, Int) -- count, from, to

-- yea I'm not cleaning this up, I just glued this together in a repl
parseData :: String -> ([Stack], [Instruction])
parseData contents = (stacks, instructions)
    where
        parts = splitOn "\n\n" contents
        stacks = map (trim . snd) $ filter (\(i, _) -> i `mod` 4 == 2) $ zip [1..] (transpose $ init $ lines $ parts !! 0)
        instructions = map (\(a:b:c:_) -> (a,b-1,c-1)) $ map (\(_, _, _, m) -> map (read :: String -> Int) m) $ map ((=~ "move ([[:digit:]]+) from ([[:digit:]]+) to ([[:digit:]]+)") :: String -> (String, String, String, [String])) (lines $ parts !! 1)

update :: Int -> a -> [a] -> [a]
update n item ls = a ++ (item:b)
    where (a, (_:b)) = splitAt n ls

executeInstructions :: Bool -> [Stack] -> [Instruction] -> [Stack]
executeInstructions is9001 stacks []           = stacks
executeInstructions is9001 stacks ((c,f,t):is) = executeInstructions is9001 stacks' is
    where
        from = stacks !! f
        to = stacks !! t
        items = (if is9001 then id else reverse) $ take c from
        from' = drop c $ from
        to' = items ++ to
        stacks' = update f from' $ update t to' stacks

crane :: Bool -> String -> String
crane is9001 contents = map (!! 0) stacks'
    where
        (stacks, instructions) = parseData contents
        stacks' = executeInstructions is9001 stacks instructions
        
part1, part2 :: String -> String
part1 = crane False
part2 = crane True