diff --git a/src/Day2504.hs b/src/Day2504.hs
new file mode 100644
index 0000000..4204582
--- /dev/null
+++ b/src/Day2504.hs
@@ -0,0 +1,79 @@
+module Main where
+
+import Debug.Trace (trace)
+
+guard :: Bool -> [()]
+guard True  = [()]
+guard False = []
+
+gridMap :: (a -> b) -> [[a]] -> [[b]]
+gridMap f = map (map f)
+
+gridMapWithIndex :: ((Int, Int) -> a -> b) -> [[a]] -> [[b]]
+gridMapWithIndex f grid = map (\(y, row) -> map (\(x, cell) -> (f (x,y) cell)) $ zip [0..] row) $ zip [0..] grid
+
+--------------------
+----- Problems -----
+--------------------
+
+isReachable :: [String] -> (Int, Int) -> Bool
+isReachable input (x,y) = let
+  w = length (head input)
+  h = length       input
+  in ((< (4+1)) . length) $ do
+  dy <- [-1..1]
+  dx <- [-1..1]
+
+  let ax = dx+x
+  let ay = dy+y
+
+  guard $ (ax >= 0 && ax < w && ay >= 0 && ay < h)
+
+  guard $ (input!!(y+dy))!!(x+dx) == '@'
+
+  return ()
+
+part1 :: String -> Int
+part1 str = length $ filter id a
+  where
+  w = length (head input)
+  h = length       input
+
+  input = lines str
+  a = do
+    y <- [0..w-1]
+    x <- [0..h-1]
+
+    guard $ (input!!y)!!x == '@'
+
+    return $ isReachable input (x,y)
+
+part2 :: String -> Int
+part2 str = go grid
+  where
+  grid = lines str
+  w = length (head grid)
+  h = length       grid
+
+  countBoxes = length . filter id . concat . gridMap (\c -> if c=='@' then True else False)
+
+  go :: [[Char]] -> Int
+  go grid | startCount == endCount = 0
+          | otherwise              = (startCount - endCount) + go end
+    where
+    startCount = countBoxes grid
+    end = iter grid
+    endCount   = countBoxes end
+
+  iter :: [[Char]] -> [[Char]]
+  iter input = gridMapWithIndex select input
+    where
+    select = \(x,y) c -> if c == '@' then if isReachable input (x,y) then '.' else '@' else c
+
+
+main :: IO ()
+main = do
+  str <- getContents
+
+  print $ part1 str
+  print $ part2 str