{-# LANGUAGE ImportQualifiedPost #-}

module Days.D18 where

import Common
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Tuple.Extra (uncurry3)
import Parse
import Text.Megaparsec.Char (char)

parser :: Parser [(Int, Int, Int)]
parser = someLines point
  where
    point = (,,) <$> int <* char ',' <*> int <* char ',' <*> int

mins :: [(Int, Int, Int)] -> (Int, Int, Int)
mins =
  foldr1
    (\(a', b', c') (a, b, c) -> (min a' a, min b' b, min c' c))

maxs :: [(Int, Int, Int)] -> (Int, Int, Int)
maxs =
  foldr1
    (\(a', b', c') (a, b, c) -> (max a' a, max b' b, max c' c))

adjacent :: (Int, Int, Int) -> [(Int, Int, Int)]
adjacent (x, y, z) =
  [ (x - 1, y, z),
    (x + 1, y, z),
    (x, y - 1, z),
    (x, y + 1, z),
    (x, y, z - 1),
    (x, y, z + 1)
  ]

part1 :: [(Int, Int, Int)] -> Int
part1 l =
  let s = Set.fromList l
   in length
        . filter (\v -> not $ Set.member v s)
        . concatMap adjacent
        $ l

part2 :: [(Int, Int, Int)] -> Int
part2 points =
  let (x_max, y_max, z_max) = maxs points
      (x_min, y_min, z_min) = mins points
      insideSearchSpace (x, y, z) =
        x_min - 1 <= x
          && x <= x_max + 1
          && y_min - 1 <= y
          && y <= y_max + 1
          && z_min - 1 <= z
          && z <= z_max + 1

      start = (x_min - 1, y_min - 1, z_min - 1)
   in go insideSearchSpace [start] (Set.singleton start) 0
  where
    pointSet :: Set (Int, Int, Int)
    pointSet = Set.fromList points

    go _ [] _ result = result
    go inside active_ seen_ result_ =
      uncurry3 (go inside)
        . foldr
          ( \p (active, seen, result) ->
              if Set.member p seen
                then (active, seen, result)
                else
                  if Set.member p pointSet
                    then (active, seen, result + 1)
                    else (p : active, Set.insert p seen, result)
          )
          ([], seen_, result_)
        . filter inside
        . concatMap adjacent
        $ active_

day :: Day
day = parsecDay parser (definitive . part1, definitive . part2)