(** See {!module:Hevy_csv} for the contract.

    The parse runs in two stages. First it maps the header to column indices,
    failing early on a missing column. Then it walks the data rows once: each
    row becomes a set for some workout, or a batch warning. Rows group into
    workouts by their exact [(title, start_time, end_time)] triple in
    first-appearance order, and warnings stay in source order. The source text
    is never rebuilt — it flows verbatim into the batch. *)

open Hito_app
module WI = Workout_import

type error =
  | Malformed_csv of { record : int; field : int; detail : string }
  | Missing_column of string
  | Empty_file

let pp_error ppf = function
  | Malformed_csv { record; field; detail } ->
      Format.fprintf ppf "malformed CSV at record %d, field %d: %s" record field
        detail
  | Missing_column name -> Format.fprintf ppf "missing column %S" name
  | Empty_file -> Format.pp_print_string ppf "empty file"

(* The strict native schema. Every column must be present. The order here is
   canonical: a missing-column error names the first absent column in this
   order, not the order the header happens to use. *)
let canonical_columns =
  [
    "title";
    "start_time";
    "end_time";
    "description";
    "exercise_title";
    "superset_id";
    "exercise_notes";
    "set_index";
    "set_type";
    "weight_kg";
    "reps";
    "distance_km";
    "duration_seconds";
    "rpe";
  ]

(* Column indices resolved from the header, keyed by canonical name. Built once,
   then read for every row. *)
type columns = (string * int) list

(* Maps the header row to column indices. The header order may vary, so each
   name is looked up by value. The first canonical column absent from the header
   fails the whole parse. *)
let resolve_columns (header : string list) : (columns, error) result =
  let indexed = List.mapi (fun i name -> (name, i)) header in
  let rec go acc = function
    | [] -> Ok (List.rev acc)
    | name :: rest -> (
        match List.assoc_opt name indexed with
        | Some i -> go ((name, i) :: acc) rest
        | None -> Error (Missing_column name))
  in
  go [] canonical_columns

(* A row is a plain string list. This reads one column by canonical name,
   returning [""] for a short row rather than raising. The column is guaranteed
   present in [cols] once [resolve_columns] succeeds. *)
let field (cols : columns) (row : string list) name =
  match List.assoc_opt name cols with
  | None -> ""
  | Some i -> ( match List.nth_opt row i with Some v -> v | None -> "")

(* {1 Datetime}

   Hevy writes local wall time as [DD Mon YYYY, HH:MM] with an English month
   abbreviation. The adapter converts to UTC seconds using the caller's fixed
   offset: UTC = civil - offset. The calendar date is validated by a round-trip
   through [days_from_civil], so an impossible date such as 31 Feb is rejected
   rather than normalised. *)

let months =
  [|
    "Jan";
    "Feb";
    "Mar";
    "Apr";
    "May";
    "Jun";
    "Jul";
    "Aug";
    "Sep";
    "Oct";
    "Nov";
    "Dec";
  |]

let month_index abbrev =
  let rec go i =
    if i >= Array.length months then None
    else if String.equal months.(i) abbrev then Some (i + 1)
    else go (i + 1)
  in
  go 0

(* Days from the civil date 1970-01-01 to [y]-[m]-[d]. Howard Hinnant's
   algorithm, valid for the proleptic Gregorian calendar. Used both to compute
   the timestamp and, by round-trip, to confirm the date is real. *)
let days_from_civil y m d =
  let y = if m <= 2 then y - 1 else y in
  let era = (if y >= 0 then y else y - 399) / 400 in
  let yoe = y - (era * 400) in
  let doy = (((153 * if m > 2 then m - 3 else m + 9) + 2) / 5) + d - 1 in
  let doe = (yoe * 365) + (yoe / 4) - (yoe / 100) + doy in
  (era * 146097) + doe - 719468

(* The inverse of [days_from_civil], for the round-trip check. *)
let civil_from_days z =
  let z = z + 719468 in
  let era = (if z >= 0 then z else z - 146096) / 146097 in
  let doe = z - (era * 146097) in
  let yoe = (doe - (doe / 1460) + (doe / 36524) - (doe / 146096)) / 365 in
  let y = yoe + (era * 400) in
  let doy = doe - ((365 * yoe) + (yoe / 4) - (yoe / 100)) in
  let mp = ((5 * doy) + 2) / 153 in
  let d = doy - (((153 * mp) + 2) / 5) + 1 in
  let m = if mp < 10 then mp + 3 else mp - 9 in
  ((if m <= 2 then y + 1 else y), m, d)

let is_digits s =
  String.length s > 0 && String.for_all (fun c -> c >= '0' && c <= '9') s

(* Parses one Hevy datetime to UTC seconds at the given offset. Returns [None]
   on any deviation from the exact [DD Mon YYYY, HH:MM] shape, an unknown month,
   or a date that fails the calendar round-trip. *)
let parse_datetime ~utc_offset_seconds s =
  match String.split_on_char ',' s with
  | [ date_part; time_part ] -> (
      let date_fields = String.split_on_char ' ' (String.trim date_part) in
      let time_fields = String.split_on_char ':' (String.trim time_part) in
      match (date_fields, time_fields) with
      | [ dd; mon; yyyy ], [ hh; mm ]
        when is_digits dd && is_digits yyyy && is_digits hh && is_digits mm -> (
          match month_index mon with
          | None -> None
          | Some month ->
              let day = int_of_string dd in
              let year = int_of_string yyyy in
              let hour = int_of_string hh in
              let minute = int_of_string mm in
              if
                day < 1 || day > 31 || hour > 23 || minute > 59
                || String.length yyyy <> 4
              then None
              else
                let days = days_from_civil year month day in
                (* Reject impossible calendar dates by round-trip. *)
                if civil_from_days days <> (year, month, day) then None
                else
                  let civil_seconds =
                    (days * 86_400) + (hour * 3_600) + (minute * 60)
                  in
                  Some (civil_seconds - utc_offset_seconds))
      | _ -> None)
  | _ -> None

(* {1 Set types} *)

(* Hevy set types the adapter understands. [Warmup] never reaches a set: it
   becomes a [Warmup_dropped] warning. Any other value is an unsupported row. *)
type parsed_set_type = Warmup | Working of WI.source_set_type

let parse_set_type s =
  match String.lowercase_ascii (String.trim s) with
  | "warmup" -> Some Warmup
  | "normal" -> Some (Working WI.Normal)
  | "failure" -> Some (Working WI.Failure)
  | "dropset" -> Some (Working WI.Dropset)
  | _ -> None

(* {1 Row outcome}

   Each data row resolves to exactly one of: a set belonging to a workout keyed
   by its datetime triple, a warning, or — when the datetimes are invalid and
   the row cannot be grouped — a batch-level warning with no workout. *)

(* A parsed superset id: absent, present, or malformed. *)
type superset = Absent | Present of int | Invalid

let parse_superset s =
  let s = String.trim s in
  if String.equal s "" then Absent
  else match int_of_string_opt s with Some i -> Present i | None -> Invalid

(* A finite float, rejecting NaN and the infinities that [float_of_string]
   otherwise accepts. *)
let finite_float_opt s =
  match float_of_string_opt (String.trim s) with
  | Some f when Float.is_finite f -> Some f
  | _ -> None

let nonneg_int_opt s =
  match int_of_string_opt (String.trim s) with
  | Some i when i >= 0 -> Some i
  | _ -> None

(* The grouping key: the exact triple that identifies a workout. *)
type key = string * string * string

(* One classified row, before workouts are assembled. *)
type row_outcome =
  | Set of { key : key; started : int; ended : int; set : WI.source_set }
  | Warning of WI.warning

(* Classifies one data row at 1-based source [row]. The header is row 1, so the
   first data row is row 2. The datetime triple keys the workout; invalid or
   reversed datetimes drop the row. A warmup is dropped with its own warning.
   Any field the strict schema needs but the row lacks turns the row into an
   [Unsupported_row] warning, with a concise reason, never a guessed set. *)
let classify_row ~utc_offset_seconds cols ~row (fields : string list) :
    row_outcome =
  let get = field cols fields in
  let title = get "title" in
  let start_time = get "start_time" in
  let end_time = get "end_time" in
  let exercise_title = get "exercise_title" in
  let exercise_name =
    if String.equal (String.trim exercise_title) "" then None
    else Some exercise_title
  in
  let warn reason =
    Warning { row; exercise_name; kind = WI.Unsupported_row reason }
  in
  match parse_set_type (get "set_type") with
  | None -> warn ("unknown set type " ^ get "set_type")
  | Some Warmup -> Warning { row; exercise_name; kind = WI.Warmup_dropped }
  | Some (Working set_type) -> (
      match
        ( parse_datetime ~utc_offset_seconds start_time,
          parse_datetime ~utc_offset_seconds end_time )
      with
      | None, _ -> warn "invalid start_time"
      | _, None -> warn "invalid end_time"
      | Some started, Some ended -> (
          if ended < started then warn "end_time precedes start_time"
          else if String.equal (String.trim exercise_title) "" then
            warn "missing exercise_title"
          else
            match parse_superset (get "superset_id") with
            | Invalid -> warn ("invalid superset_id " ^ get "superset_id")
            | superset_id -> (
                let superset_id =
                  match superset_id with
                  | Present i -> Some i
                  | Absent -> None
                  | Invalid -> None (* unreachable, handled above *)
                in
                match
                  ( nonneg_int_opt (get "set_index"),
                    finite_float_opt (get "weight_kg"),
                    nonneg_int_opt (get "reps") )
                with
                | None, _, _ -> warn "invalid set_index"
                | _, None, _ -> warn "missing or non-finite weight_kg"
                | _, _, None -> warn "missing or negative reps"
                | Some set_index, Some weight_kg, Some reps ->
                    let set : WI.source_set =
                      {
                        row;
                        exercise_name = exercise_title;
                        set_index;
                        set_type;
                        weight_kg;
                        reps;
                        superset_id;
                      }
                    in
                    Set
                      {
                        key = (title, start_time, end_time);
                        started;
                        ended;
                        set;
                      })))

(* {1 Grouping}

   Sets group into workouts by their key, in first-appearance order. A row whose
   datetimes were valid contributes its set here; the workout keeps the first
   [started]/[ended] it saw for that key. Warnings never group — they are
   collected separately in source order. *)

type group = {
  title : string;
  started : int;
  ended : int;
  mutable sets_rev : WI.source_set list;
}

(* Folds classified rows into ordered groups and an ordered warning list. Groups
   keep first-appearance order; within a group, sets keep source order. *)
let assemble outcomes =
  let groups_rev = ref [] in
  let table : (key, group) Hashtbl.t = Hashtbl.create 16 in
  let warnings_rev = ref [] in
  List.iter
    (fun outcome ->
      match outcome with
      | Warning w -> warnings_rev := w :: !warnings_rev
      | Set { key; started; ended; set } -> (
          match Hashtbl.find_opt table key with
          | Some g -> g.sets_rev <- set :: g.sets_rev
          | None ->
              let title, _, _ = key in
              let g = { title; started; ended; sets_rev = [ set ] } in
              Hashtbl.add table key g;
              groups_rev := g :: !groups_rev))
    outcomes;
  (List.rev !groups_rev, List.rev !warnings_rev)

(* Builds one imported workout from a group. [make_workout] can still reject the
   times with [Invalid_time]; the classifier already dropped reversed rows, so a
   surviving group should not hit it, but the adapter converts any such rejection
   into a batch warning rather than raising. *)
let build_workout ~batch_id ~index (g : group) : (WI.workout, WI.warning) result
    =
  let id =
    WI.workout_id (WI.batch_id_to_string batch_id ^ ":w" ^ string_of_int index)
  in
  let sets = List.rev g.sets_rev in
  match
    WI.make_workout ~id ~title:g.title
      ~started_at:(Recovery.timestamp_of_unix_seconds g.started)
      ~ended_at:(Recovery.timestamp_of_unix_seconds g.ended)
      ~sets
  with
  | Ok w -> Ok w
  | Error _ ->
      (* A whole group with reversed times; report at batch level. *)
      Error
        {
          WI.row = 0;
          exercise_name = None;
          kind = WI.Unsupported_row ("workout " ^ g.title ^ " has invalid time");
        }

let parse ~batch_id ~fingerprint ~imported_at ~utc_offset_seconds source =
  (* Parse the CSV text. [strip:false] keeps RFC4180 fidelity; quoted commas and
     newlines are preserved. A malformed export raises [Csv.Failure]. *)
  match
    try Ok (Csv.input_all (Csv.of_string ~strip:false source))
    with Csv.Failure (record, field, detail) ->
      Error (Malformed_csv { record; field; detail })
  with
  | Error _ as e -> e
  | Ok [] -> Error Empty_file
  | Ok (header :: data_rows) -> (
      match resolve_columns header with
      | Error _ as e -> e
      | Ok cols ->
          (* Row 1 is the header, so the first data row is row 2. *)
          let outcomes =
            List.mapi
              (fun i fields ->
                classify_row ~utc_offset_seconds cols ~row:(i + 2) fields)
              data_rows
          in
          let groups, row_warnings = assemble outcomes in
          let workouts_rev, workout_warnings_rev, _ =
            List.fold_left
              (fun (workouts, warnings, index) g ->
                match build_workout ~batch_id ~index g with
                | Ok w -> (w :: workouts, warnings, index + 1)
                | Error warning -> (workouts, warning :: warnings, index + 1))
              ([], [], 1) groups
          in
          let workouts = List.rev workouts_rev in
          (* Batch warnings stay in source order: the row warnings, then any
             workout-level rejections in group order. *)
          let warnings = row_warnings @ List.rev workout_warnings_rev in
          Ok
            (WI.make_batch ~id:batch_id ~source ~fingerprint ~imported_at
               ~workouts ~warnings))