Fix indentation

README.md

@@ -6,5 +6,5 @@
 |02 |★ ★  |08 |     |
 |03 |★ ★  |09 |     |
 |04 |★ ★  |10 |     |
-|05 |★    |11 |     |
+|05 |★ ★  |11 |     |
-|06 |     |12 |     |
+|06 |★ ★  |12 |     |

adventofcode2025.cabal

@@ -19,6 +19,7 @@ executable adventofcode2025
   main-is:             Main.hs
   default-language:    Haskell2010
   build-depends:       base >= 4.7 && < 5
+                     , mtl
                      , split
   ghc-options:         -Wall
                        -Wcompat
@@ -35,3 +36,5 @@ executable adventofcode2025
     Day03
     Day04
     Day05
+    Day06
+    Day07

src/Day02.hs

@@ -42,5 +42,5 @@ day02_2 = do
   values <- parseInput
   let result = sumInvalid' values
   putStrLn $
-    "Day 2, Puzzle 1 solution: "
+    "Day 2, Puzzle 2 solution: "
       ++ show result

src/Day05.hs

@@ -2,9 +2,11 @@
 
 module Day05
   ( day05_1,
+    day05_2,
   )
 where
 
+import Data.List (sortOn)
 import Data.List.Split (splitOn)
 
 getRange :: String -> (Int, Int)
@@ -20,6 +22,14 @@ isFresh ingredient (r : rs)
   | ingredient >= fst r && ingredient <= snd r = True
   | otherwise = isFresh ingredient rs
 
+countIngredients :: [(Int, Int)] -> Int -> Int
+countIngredients [] tot = tot
+countIngredients [r] tot = snd r - fst r + 1 + tot
+countIngredients (r : s : rs) tot
+  | snd r >= snd s = countIngredients (r : rs) tot
+  | snd r >= fst s = countIngredients ((fst r, fst s - 1) : s : rs) tot
+  | otherwise = countIngredients (s : rs) (snd r - fst r + 1 + tot)
+
 parseInput :: IO [String]
 parseInput = do
   lines <$> readFile "input/day5.txt"
@@ -32,3 +42,12 @@ day05_1 = do
   putStrLn $
     "Day 5, Puzzle 1 solution: "
       ++ show (length freshIngredients)
+
+day05_2 :: IO ()
+day05_2 = do
+  input <- parseInput
+  let ranges = sortOn fst . sortOn snd . map getRange $ takeWhile (/= "") input
+      result = countIngredients ranges 0
+  putStrLn $
+    "Day 5, Puzzle 2 solution: "
+      ++ show result

src/Day06.hs

@@ -0,0 +1,53 @@
+module Day06
+  ( day06_1,
+    day06_2,
+  )
+where
+
+import Data.List (groupBy, transpose)
+
+solveProblem :: [String] -> Int
+solveProblem problem =
+  let op = last problem
+      values = map read $ init problem
+   in case op of
+        "+" -> sum values
+        "*" -> product values
+        _ -> 0
+
+solveProblem' :: [String] -> Int
+solveProblem' [] = 0
+solveProblem' (x : xs) =
+  let op = last x
+      v1 = read $ init x
+      values = v1 : [read v | v <- xs]
+   in case op of
+        '+' -> sum values
+        '*' -> product values
+        _ -> 0
+
+parseInput :: IO [[String]]
+parseInput = do
+  transpose . map words . lines <$> readFile "input/day6.txt"
+
+parseInput' :: IO [[String]]
+parseInput' = do
+  input <- transpose . lines <$> readFile "input/day6.txt"
+  let problems = map (filter (not . all (== ' '))) $ groupBy (\_ y -> not (all (== ' ') y)) input
+  return problems
+
+day06_1 :: IO ()
+day06_1 = do
+  input <- parseInput
+  let result = sum $ map solveProblem input
+  putStrLn $
+    "Day 6, Puzzle 1 solution: "
+      ++ show result
+
+day06_2 :: IO ()
+day06_2 = do
+  input <- parseInput'
+  let result = sum $ map solveProblem' input
+  putStrLn $
+    "Day 6, Puzzle 2 solution: "
+      ++ show result

src/Day07.hs

@@ -0,0 +1,68 @@
+{-# OPTIONS_GHC -Wno-x-partial #-}
+
+module Day07
+  ( day07_1,
+  )
+where
+
+import Control.Monad.State
+import Data.List (elemIndex)
+import Data.Maybe (fromJust, isJust)
+
+type Coord = (Int, Int)
+
+type Grid = [String]
+
+parseInput :: IO [String]
+parseInput = do
+  lines <$> readFile "input/day7.txt"
+
+getStart :: Grid -> Int -> Coord
+getStart [] _ = (-1, -1)
+getStart (g : grid) row
+  | isJust start = (row, fromJust start)
+  | otherwise = getStart grid (row + 1)
+  where
+    start = elemIndex 'S' g
+
+isInside :: Coord -> Grid -> Bool
+isInside coord grid =
+  let w = length $ head grid
+      h = length grid
+   in fst coord >= 0 && fst coord < h && snd coord >= 0 && snd coord < w
+
+mark :: Coord -> State Grid ()
+mark coord = state $ \grid ->
+  ( (),
+    take (fst coord) grid ++ [take (snd coord) (grid !! fst coord) ++ ['x'] ++ drop (snd coord + 1) (grid !! fst coord)] ++ drop (fst coord + 1) grid
+  )
+
+beamSplitRecursive :: Coord -> State Grid ()
+beamSplitRecursive start = do
+  grid <- get
+  if not $ isInside start grid
+    then return ()
+    else
+      if grid !! fst start !! snd start == 'S' || grid !! fst start !! snd start == '.'
+        then beamSplitRecursive (fst start + 1, snd start)
+        else
+          if grid !! fst start !! snd start == 'x'
+            then return ()
+            else do
+              mark start
+              beamSplitRecursive (fst start, snd start - 1)
+              beamSplitRecursive (fst start, snd start + 1)
+
+beamSplit :: State Grid ()
+beamSplit = do
+  grid <- get
+  let start = getStart grid 0
+  beamSplitRecursive start
+
+day07_1 :: IO ()
+day07_1 = do
+  input <- parseInput
+  let grid = execState beamSplit input
+  putStrLn $
+    "Day 7, Puzzle 1 solution: "
+      ++ show (length $ concatMap (filter (== 'x')) grid)

src/Main.hs

@@ -4,7 +4,9 @@ import Day01 (day01_1, day01_2)
 import Day02 (day02_1, day02_2)
 import Day03 (day03_1, day03_2)
 import Day04 (day04_1, day04_2)
-import Day05 (day05_1)
+import Day05 (day05_1, day05_2)
+import Day06 (day06_1, day06_2)
+import Day07 (day07_1)
 import System.Environment (getArgs)
 
 main :: IO ()
@@ -32,8 +34,18 @@ main = do
       day04_1
       day04_2
     "5" : "1" : _ -> day05_1
+    "5" : "2" : _ -> day05_2
     "5" : _ -> do
       day05_1
+      day05_2
+    "6" : "1" : _ -> day06_1
+    "6" : "2" : _ -> day06_2
+    "6" : _ -> do
+      day06_1
+      day06_2
+    "7" : "1" : _ -> day07_1
+    "7" : _ -> do
+      day07_1
     "all" : _ -> do
       day01_1
       day01_2
@@ -44,4 +56,8 @@ main = do
       day04_1
       day04_2
       day05_1
+      day05_2
+      day06_1
+      day06_2
+      day07_1
     _ -> error "Not implemented"