Solution to Advent of Code 2022, Day 5.

Day05.elm

module Day05 exposing (partOne, partTwo)

import Dict exposing (Dict)
import List.Extra as List


type alias Crate =
    Char


type alias Stack =
    List Crate


type alias Move =
    { numberOfCrates : Int
    , fromStackKey : Int
    , toStackKey : Int
    }


type alias RearrangementProcedure =
    { stacks : Dict Int Stack
    , steps : List Move
    }


runProcedure : (Int -> Stack -> Stack -> ( Stack, Stack )) -> RearrangementProcedure -> Dict Int Stack
runProcedure moveFunc { stacks, steps } =
    let
        rearrangeCrates : Move -> Dict Int Stack -> Dict Int Stack
        rearrangeCrates { numberOfCrates, fromStackKey, toStackKey } currentStacks =
            case ( Dict.get fromStackKey currentStacks, Dict.get toStackKey currentStacks ) of
                ( Just fromStack, Just toStack ) ->
                    let
                        ( newFromStack, newToStack ) =
                            moveFunc numberOfCrates fromStack toStack
                    in
                    Dict.map
                        (\key stack ->
                            if key == fromStackKey then
                                newFromStack

                            else if key == toStackKey then
                                newToStack

                            else
                                stack
                        )
                        currentStacks

                _ ->
                    stacks
    in
    List.foldl rearrangeCrates stacks steps


parseInput : String -> RearrangementProcedure
parseInput input =
    let
        buildStacks : String -> Dict Int Stack
        buildStacks layout =
            layout
                |> String.lines
                |> List.map String.toList
                |> List.transpose
                |> List.map (List.filter Char.isUpper)
                |> List.filter (not << List.isEmpty)
                |> List.indexedMap (\i xs -> ( i + 1, xs ))
                |> Dict.fromList

        buildSteps : String -> List Move
        buildSteps instructions =
            let
                toMove : String -> Maybe Move
                toMove instruction =
                    case String.words instruction |> List.filterMap String.toInt of
                        numberOfCrates :: fromStack :: toStack :: _ ->
                            Just (Move numberOfCrates fromStack toStack)

                        _ ->
                            Nothing
            in
            instructions |> String.lines |> List.filterMap toMove
    in
    case String.split "\n\n" input of
        layout :: instructions :: _ ->
            RearrangementProcedure (buildStacks layout) (buildSteps instructions)

        _ ->
            RearrangementProcedure Dict.empty []


partOne : String -> String
partOne input =
    input
        |> parseInput
        |> runProcedure
            (\numberOfCrates fromStack toStack ->
                ( List.drop numberOfCrates fromStack, List.foldl (::) toStack (List.take numberOfCrates fromStack) )
            )
        |> Dict.values
        |> List.filterMap List.head
        |> String.fromList


partTwo : String -> String
partTwo input =
    input
        |> parseInput
        |> runProcedure
            (\numberOfCrates fromStack toStack ->
                ( List.drop numberOfCrates fromStack, List.concat [ List.take numberOfCrates fromStack, toStack ] )
            )
        |> Dict.values
        |> List.filterMap List.head
        |> String.fromList