Add Day 4, Puzzle 1 solution

README.md

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

adventofcode2025.cabal

@@ -33,3 +33,4 @@ executable adventofcode2025
     Day01
     Day02
     Day03
+    Day04

src/Day04.hs

@@ -0,0 +1,55 @@
+{-# OPTIONS_GHC -Wno-x-partial #-}
+
+module Day04
+  ( day04_1,
+  )
+where
+
+type Grid = [String]
+
+type Position = (Int, Int)
+
+data Direction = LU | U | RU | L | R | LD | D | RD deriving (Eq, Enum)
+
+isInside :: Position -> Int -> Int -> Bool
+isInside (x, y) w h = x >= 0 && y >= 0 && x < w && y < h
+
+move :: Position -> Direction -> Position
+move position LU = (fst position - 1, snd position - 1)
+move position U = (fst position, snd position - 1)
+move position RU = (fst position + 1, snd position - 1)
+move position L = (fst position - 1, snd position)
+move position R = (fst position + 1, snd position)
+move position LD = (fst position -1, snd position + 1)
+move position D = (fst position, snd position + 1)
+move position RD = (fst position + 1, snd position + 1)
+
+getValue :: Grid -> Position -> Char
+getValue grid position 
+    | not $ isInside position (length (head grid)) (length grid) = '.'
+    | otherwise = (grid !! snd position) !! fst position
+
+getAdjacent :: Grid -> Position -> Int
+getAdjacent grid position = length . filter (== '@') $ map (getValue grid . move position) [LU .. RD]
+
+isAccessible :: Grid -> Position -> Bool
+isAccessible grid position
+    | getValue grid position == '.' = False
+    | otherwise = getAdjacent grid position < 4
+
+countAccessible :: Grid -> Int
+countAccessible grid =  let w = length $ head grid
+                            h = length grid
+                            positions = [ (x, y) | x <- [0..w - 1], y <- [0..h - 1]]
+                         in length . filter id $ map (isAccessible grid) positions
+
+parseInput :: IO [String]
+parseInput = lines <$> readFile "input/day4.txt"
+
+day04_1 :: IO ()
+day04_1 = do
+  grid <- parseInput
+  let result = countAccessible grid
+  putStrLn $
+    "Day 4, Puzzle 1 solution: "
+      ++ show result

src/Main.hs

@@ -3,6 +3,7 @@ module Main (main) where
 import Day01 (day01_1, day01_2)
 import Day02 (day02_1, day02_2)
 import Day03 (day03_1, day03_2)
+import Day04 (day04_1)
 import System.Environment (getArgs)
 
 main :: IO ()
@@ -24,6 +25,9 @@ main = do
     "3" : _ -> do
       day03_1
       day03_2
+    "4" : "1" : _ -> day04_1
+    "4" : _ -> do
+      day04_1
     "all" : _ -> do
       day01_1
       day01_2
@@ -31,4 +35,5 @@ main = do
       day02_2
       day03_1
       day03_2
+      day04_1
     _ -> error "Not implemented"