module Day3

import Prelude
import Node
import Aoc

pfunc repr : {a : U} -> a -> String := `(a,o) => ''+o`
pfunc jrepr : {a : U} -> a -> String := `(a,o) => JSON.stringify(o, null, '  ')`


maybe : ∀ a b. b → (a → b) → Maybe a → b
maybe def f Nothing = def
maybe def f (Just a) = f a

-- was 'structure' I could make a `record` that destructures to this..
data Number : U where
  MkNumber : (start : Nat) -> (stop : Nat) → (value : Int) → Number


numbers : List Char -> List Number
numbers arr = go arr Z
  where
    go : List Char → Nat → List Number
    go (c :: cs) start = if isDigit c
      then case span isDigit (c :: cs) of
          (front,back) => let stop = start + length front
            in MkNumber start stop (stringToInt $ pack front) :: go back stop
      else go cs (S start)
    go Nil start = Nil


range : ∀ a. Nat -> Nat -> List a -> List a
range _ _ Nil = Nil
range _ Z _ = Nil
range Z (S k) (x :: xs) = x :: range Z k xs
range (S n) (S m) (x :: xs) = range n m xs

isPart : List (List Char) -> Nat -> Number -> Bool
isPart rows row (MkNumber start end _) =
  checkRow (pred row) || checkRow row || checkRow (S row)
  where
    isThing : Char -> Bool
    isThing c = not (isDigit c || c == '.')

    checkRow : Nat -> Bool
    checkRow r = case getAt r rows of
      Nothing => False
      Just chars => case filter isThing (range (pred start) (S end) chars) of
        Nil => False
        _ => True

getValue : Number -> Int
getValue (MkNumber _ _ v) = v

part1 : List (List Char) -> Int
part1 rows =
    foldl (\ acc num => acc + getValue num) 0 $
      join $ map (partNums rows) $ enumerate rows
  where
    partNums : List (List Char) -> (Nat × List Char) -> List Number
    partNums grid (r, cs) =
      filter (isPart grid r) $ (numbers cs)

gears : List (List Char) -> List Char -> Nat -> Int
gears rows row y =
    let a = numbers (getAt! (pred y) rows)
        b = numbers (getAt! y rows)
        c = numbers (getAt! (S y) rows)
        all = a ++ b ++ c
        cands = map fst $ filter (_==_ '*' ∘ snd) (enumerate row)
    in foldl _+_ 0 $ map (check all) cands
  where
    ratio : List Int → Int
    ratio (a :: b :: Nil) = a * b
    ratio _ = 0

    match : Nat → Number → Bool
    match y (MkNumber start stop value) = pred start <= y && y < S stop

    check : List Number → Nat →  Int
    check nums y = ratio $ map getValue (filter (match y) nums)

part2 : List (List Char) -> Int
part2 rows =
  foldl go 0 (enumerate rows)
  where
    go : Int → Nat × List Char → Int
    go acc (y, row) = acc + gears rows row y

-- 4361 / 467835
-- 517021 / 81296995
run : String -> IO Unit
run fn = do
  content <- readFile fn
  let grid = (splitOn '\n' $ unpack $ trim content)
  putStrLn fn
  printLn (part1 grid)
  printLn (part2 grid)

main : IO Unit
main = do
  run "aoc2023/day3/eg.txt"
  run "aoc2023/day3/input.txt"

