diff --git a/day 10/day_10_sebastian.hs b/day 10/day_10_sebastian.hs
new file mode 100644
index 0000000000000000000000000000000000000000..4cc54230de088c059fb64db77d1e9b87b9063c81
--- /dev/null
+++ b/day 10/day_10_sebastian.hs	
@@ -0,0 +1,45 @@
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+module Main where
+
+import Data.List (transpose)
+import Data.Array
+import qualified Data.Set as S
+import qualified Data.Map as M
+
+neighbours :: (Int, Int) -> [(Int, Int)]
+neighbours (i, j) = [(i + 1, j), (i - 1, j), (i, j + 1), (i, j - 1)]
+
+main :: IO ()
+main = interact solve
+
+solve :: String -> String
+solve s = unlines ["Part 1: " ++ part1 s, "Part 2: " ++ part2 s]
+
+part1 :: String -> String
+part1 s = show $ sum $ M.map S.size zeroes where
+  m = readInput s
+  (lv9:lvls) = getLevels m
+  nines = M.fromSet S.singleton lv9
+  zeroes = foldl descend nines lvls
+
+descend :: M.Map (Int, Int) (S.Set (Int, Int)) -> S.Set (Int, Int) -> M.Map (Int, Int) (S.Set (Int, Int))
+descend upper = M.fromSet (S.unions . map (flip (M.findWithDefault S.empty) upper) . neighbours)
+
+part2 :: String -> String
+part2 s = show (sum zeroes) where
+  m = readInput s
+  (lv9:lvls) = getLevels m
+  nines = M.fromSet (const (1 :: Int)) lv9
+  zeroes = foldl descend' nines lvls
+
+descend' :: M.Map (Int, Int) Int -> S.Set (Int, Int) -> M.Map (Int, Int) Int
+descend' upper = M.fromSet (sum . map (flip (M.findWithDefault 0) upper) . neighbours)
+
+readInput :: String -> Array (Int, Int) Char
+readInput s = listArray ((0, 0), (w - 1, h - 1)) (concat ls) where
+  ls = transpose (lines s)
+  w = length (head ls)
+  h = length ls
+
+getLevels :: Array (Int, Int) Char -> [S.Set (Int, Int)]
+getLevels m = map (\c -> S.filter (\i -> m ! i == c) (S.fromList (indices m))) (reverse ['0' .. '9'])