(*
 * SPDX-FileCopyrightText: Copyright 2025 Alexandre Jesus <https://adbjesus.com>
 *
 * SPDX-License-Identifier: GPL-3.0-or-later
 *)

type puzzle = { n : int; m : int; q : int list }
type shape = { n : int; m : int; g : bool array array }

let parse ch =
  let parse_puzzle s =
    let d = String.trim s |> String.split_on_char ':' in
    match d with
    | sz :: (q :: []) ->
       let n, m = Scanf.sscanf sz "%dx%d" (fun n m -> (n, m)) in
       let q = String.trim q |> String.split_on_char ' ' |> List.map int_of_string in
       { n; m;  q}
    | _ -> failwith ("Invalid puzzle: "^s)
  in
  let rec parse_shape l acc =
    let make_res tl =
      let g = List.rev acc |> Array.of_list in
      let n = Array.length g in
      let m = Array.length g.(0) in
      (tl, { n; m; g })
    in
    match l with
    | [] -> make_res []
    | "" :: tl -> make_res tl
    | line :: tl ->
       let gl = String.to_seq line |> Seq.map (fun c -> c = '#') |> Array.of_seq in
       parse_shape tl (gl :: acc)
  in
  let rec parse_all shapes puzzles l =
    match l with
    | [] -> (List.rev shapes, List.rev puzzles)
    | "" :: tl -> parse_all shapes puzzles tl
    | s :: tl ->
       match Scanf.sscanf_opt s "%d:" (fun _ -> parse_shape tl []) with
       | Some (l, shape) -> parse_all (shape :: shapes) puzzles l
       | None -> parse_all shapes ((parse_puzzle s) :: puzzles) tl
  in
  In_channel.input_lines ch
  |> parse_all [] []

let solve_naive shapes puzzle =
  (* This is NOT a solution to the general problem, but is enough for the given input *)
  List.map2 (fun s c -> s.n * s.m * c) shapes puzzle.q
  |> List.fold_left ( + ) 0
  |> fun a -> if a <= puzzle.n * puzzle.m then 1 else 0
  
let part1 ch =
  let shapes, puzzles = parse ch in
  List.map (solve_naive shapes) puzzles
  |> List.fold_left ( + ) 0
  |> Printf.printf "%d\n"