Day 5 Part 2

05/Main.idr

@@ -58,6 +58,10 @@ parseStacks k (x :: xs) = let (Stks bottom) = parseStacks k xs
         parseStacksHelper (Just crate) xs = crate :: xs
         parseStacksHelper Nothing xs = xs
 
+-- Get the tops of each stack
+tops : Stacks -> String
+tops (Stks xss) = pack . map (\(C c) => c) . catMaybes . map head' $ xss
+
 simple : String
 simple = """
       [D]
@@ -85,10 +89,10 @@ parseCommand str =
         _ => Nothing
 
 -- Apply a command to the stacks
-applyCommand : Command -> Stacks -> Maybe Stacks
-applyCommand (Cmd count from to) stacks =
+applyCommand : Command -> Bool -> Stacks -> Maybe Stacks
+applyCommand (Cmd count from to) multiple stacks =
   do (crates, removed) <- extractCrates count from stacks
-     addCrates (reverse crates) to removed
+     addCrates (if multiple then crates else reverse crates) to removed
   where extractCrates : Nat -> Nat -> Stacks -> Maybe ((List Crate), Stacks)
         extractCrates count from (Stks []) = Nothing
         extractCrates count 0 (Stks (x :: xs)) =
@@ -113,11 +117,11 @@ Show CmdResult where
     unlines ["Command applied: " ++ (show bool), "Command: " ++ (show command), show stacks]
 
 -- Apply a list of commands to a stacks
-applyCommands : List Command -> Stacks -> List CmdResult
-applyCommands [] x = [CR False Nothing x]
-applyCommands (y :: xs) x =
-  case applyCommand y x of
-    Just stacks => CR True (Just y) stacks :: applyCommands xs stacks
+applyCommands : List Command -> Bool -> Stacks -> List CmdResult
+applyCommands [] multiple x = [CR False Nothing x]
+applyCommands (y :: xs) multiple x =
+  case applyCommand y multiple x of
+    Just stacks => CR True (Just y) stacks :: applyCommands xs multiple stacks
     Nothing => [CR False (Just y) x]
 
 mapM : Monad m => (a -> m b) -> List a -> m (List b)
@@ -127,17 +131,23 @@ mapM f (x :: xs) =
      rest <- mapM f xs
      pure $ x :: rest
 
-main : IO ()
+partial unwrap : Maybe a -> a
+unwrap (Just x) = x
+
+partial main : IO ()
 main =
  do file <- readFile "input"
     case file of
       Right content =>
         let stacks = parseStacks 9 . takeWhile (/= "") . lines $ content
             commands = catMaybes . map parseCommand . drop 1 . dropWhile (/= "") . lines $ content
-            result = applyCommands commands stacks
+            part1 = unwrap . map (\(CR _ _ stacks) => tops stacks) . last' . applyCommands commands False $ stacks
+            part2 = unwrap . map (\(CR _ _ stacks) => tops stacks) . last' . applyCommands commands True $ stacks
         in do putStrLn "Input: "
               printLn stacks
-              putStrLn ""
-              _ <- mapM printLn result
-              pure ()
+              putStrLn " "
+              putStr "Part 1: "
+              putStrLn part1
+              putStr "Part 2: "
+              putStrLn part2
       Left err => printLn err