Day 5 advent of code 2022

main.hs

    {-# LANGUAGE BlockArguments, Strict #-}

    import Control.Monad.State
    import Data.List
    import Data.Bifunctor (first)
    import Data.Char

    forEach xs state' f = foldM (\st v -> runState (f v) st) state' xs


    stackBuilder (numbers:input) =
      let
        count = read (last $ words numbers) :: Int
        crateStacks = map (const []) [1..count] -- 0-indexes are and remmain a mistake

        stackValues stack Nothing  = stack
        stackValues stack (Just a) = a : stack

        parseCrateLine []               = []
        parseCrateLine ('[':a:']':as)   = Just ['[',a,']'] : parseCrateLine (drop 1 as)
        parseCrateLine (' ':' ':' ':as) = Nothing          : parseCrateLine (drop 1 as)
      in
        foldl' (zipWith stackValues) crateStacks (map parseCrateLine input)

    parseOperation operation = let
        no_move = drop 5 operation
        (count, no_from) = (takeWhile isDigit no_move, drop 6 $ dropWhile isDigit no_move)
        (from, no_to) = (takeWhile isDigit no_from, drop 4 $ dropWhile isDigit no_from)
        to = takeWhile isDigit no_to
      in (read count, read from, read to)


    swapIn = go 0 where
      go _ _ _ [] = []
      go n (from,f) (to,t) (x:xs)
        | n == from = f : go (n + 1) (from,f) (to,t) xs
        | n == to   = t : go (n + 1) (from,f) (to,t) xs
        | otherwise = x : go (n + 1) (from,f) (to,t) xs

    part1 input stacks mover = forEach input stacks \operation -> do
      modify \stacks ->
        let 
          (count, from, to) = parseOperation operation
          fromCrate = stacks !! (from - 1)
          toCrate   = stacks !! (to - 1)
          (elements, fromCrate') = splitAt count fromCrate
          toCrate' = mover toCrate elements
        in
          swapIn (from - 1, fromCrate') (to - 1, toCrate') stacks

    crateMover 9000 = foldl (flip (:))
    crateMover 9001 = foldr (:)

    main = do
      input <- lines <$> readFile "/tmp/input1.txt"
      let (crates_info, operations) = fmap (drop 1) $ first reverse $ break null input
      let stacks = stackBuilder crates_info
      print $ map ((!! 1) . head) <$> part1 operations stacks (crateMover 9000)

      input <- lines <$> readFile "/tmp/input2.txt"
      let (crates_info, operations) = fmap (drop 1) $ first reverse $ break null input
      let stacks = stackBuilder crates_info
      print $ map ((!! 1) . head) <$> part1 operations stacks (crateMover 9001)