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

parseLine :: String -> (Coord, Coord)
parseLine xs = (sensor, beacon) where
    [sensor, beacon] = map (parseCoord . dropWhile (/='x'))$ splitOn ":" xs

manhattan :: Coord -> Coord -> Int
manhattan (a,b) (x,y) = abs (a-x) + abs (b-y)

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,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 (\(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

    putStr "part 2: "
    let (x',y') = scan' x dists (0,3040754)
    print $ y' + x'*4000000