diff --git a/2022/day15.hs b/2022/day15.hs
index aeaae9e..7ee83d2 100644
--- a/2022/day15.hs
+++ b/2022/day15.hs
@@ -1,11 +1,17 @@
 import Data.List.Split (splitOn)
 import qualified Data.Set as S
+import Data.List (sortOn, sort)
+import qualified Data.Map as M
+import Debug.Trace (traceShowId)
+import GHC.Utils.GlobalVars (global)
 
 type Coord = (Int, Int)
 
 globalY :: Int
 globalY = 2000000
 
+bound = 4000000
+
 parseCoord :: String -> Coord
 parseCoord xs = (read $ init x, read y) where
     [x,y] = map (drop 2) $ splitOn " " xs
@@ -17,23 +23,86 @@ parseLine xs = (sensor, beacon) where
 manhattan :: Coord -> Coord -> Int
 manhattan (a,b) (x,y) = abs (a-x) + abs (b-y)
 
-allWithinRange :: Coord -> Coord -> S.Set Coord
-allWithinRange sensor@(a,b) beacon@(x,y) = S.fromList $ filter (\c -> manhattan sensor c <= dist) all where
+allWithinRange :: Coord -> Coord -> Int -> [Coord]
+allWithinRange sensor@(a,b) beacon@(x,y) row = filter (\c -> manhattan sensor c <= dist) all where
     minx = a - dist
     maxx = a + dist
     miny = b - dist
     maxy = b + dist
     dist = manhattan sensor beacon
-    all = [(x,y) | x <- [minx..maxx], y <- [globalY]]
+    all = [(x,row) | x <- [minx..maxx]]
+
+closest :: Coord -> M.Map Coord Int -> Coord
+closest coord beacons = closest -- manhattan coord closest > beacons M.! closest
+    where
+        closest = head $ sortOn (manhattan coord) (M.keys beacons)
+
+scan :: M.Map Coord Int -> Coord -> Coord
+scan dists progress@(x,y)
+  | outOfRange = progress
+  | x > bound = scan dists $ if y `mod` 1000 == 0 then traceShowId  (0,y+1) else (0, y+1)
+  | y > bound = error "no beacon"
+  | x < fst near = scan dists (fst near + abs xdist, y)
+  | otherwise = scan dists (x+1, y)
+  where
+      near = closest progress dists
+      outOfRange = all (\(sensor, dist) -> manhattan sensor progress > dist) (M.toList dists)
+      xdist = x - fst near
+      next = if x < fst near then (fst near + xdist, y) else (x + 1, y)
+
+bounds :: Coord -> Coord -> Int -> [(Int, Int)]
+bounds sensor@(x,y) coord@(a,b) row = [(x - xdist, x + xdist) | ydist <= dist] where
+    dist = manhattan sensor coord
+    ydist = abs (y-row)
+    xdist = (dist - ydist)
+
+mergeBounds :: [(Int, Int)] -> [(Int, Int)]
+mergeBounds [x] = [x]
+mergeBounds ((a,b):(x,y):xs)
+    | maxL >= minR - 1 = mergeBounds $ (minTot, maxTot):xs
+    | otherwise = [(a,b), (x,y)]
+    where
+    minL = min a b
+    maxL = max a b
+    minR = min x y
+    maxR = max x y
+    minTot = min minL minR
+    maxTot = max maxL maxR
+
+traceCond :: (Int, Int) -> (Int, Int)
+traceCond (x,y) = if x `mod` 1000 == 0 && y `mod` 1000 == 0 then traceShowId (x,y) else (x,y)
+
+scan' :: [(Coord, Coord)] -> M.Map Coord Int -> Coord -> Coord
+scan' input dists progress@(x,y)
+  | length covered == 1 && fst (head covered) <= 0 && snd (head covered) >= bound = scan' input dists $ traceCond (0, y+1)
+  | outOfRange = progress
+  | x > bound = scan' input dists $ traceShowId  (0,y+1)
+  | y > bound = error "no beacon"
+  | otherwise = scan' input dists $ traceCond (x+1, y)
+--   | x < fst near = scan' input dists $ traceShowId (fst near + abs xdist, y)
+--   | otherwise = scan' input dists $ traceShowId (x+1, y)
+  where
+      covered = mergeBounds $ sort $ concatMap (\(s,b) -> bounds s b y) input
+      near = closest progress dists
+      outOfRange = all (\(sensor, dist) -> manhattan sensor progress > dist) (M.toList dists)
+      xdist = x - fst near
+      next = if x < fst near then (fst near + xdist, y) else (x + 1, y)
+
 
 main :: IO ()
 main = do
     x <- map parseLine . lines <$> getContents
 
     let beacons = S.fromList $ map snd x
-    let reachable = foldr1 S.union $ map (uncurry allWithinRange) x
+    let reachable = foldr1 S.union $ map (\(a,b) -> S.fromList $ allWithinRange a b globalY) x
+
+    let dists = M.fromList $ map (\(s,b) -> (s, manhattan s b)) x
 
     let ys = S.size $ S.filter (\x -> snd x == globalY) (reachable S.\\ beacons)
 
-    putStr "part 1: "
-    print ys
\ No newline at end of file
+    -- putStr "part 1: "
+    -- print ys
+
+    putStr "part 2: "
+    let (x',y') = scan' x dists (0,3040754)
+    print $ y' + x'*4000000
\ No newline at end of file