(** See {!module:Workout_import} for the contract and the invariant this module
    upholds on behalf of the core. *)

type batch_id = string
type workout_id = string

let batch_id s = s
let workout_id s = s
let batch_id_to_string s = s
let workout_id_to_string s = s

type source_set_type = Normal | Failure | Dropset

type source_set = {
  row : int;
  exercise_name : string;
  set_index : int;
  set_type : source_set_type;
  weight_kg : float;
  reps : int;
  superset_id : int option;
}

type warning_kind = Warmup_dropped | Unsupported_row of string
type warning = { row : int; exercise_name : string option; kind : warning_kind }

type error =
  | Unknown_workout of workout_id
  | Empty_acknowledgement
  | Invalid_time

(* A mapping is confirmed per source exercise name and applies to every matching
   set. The acknowledgement is the one workout-level confirmation that promotes
   the workout's [Normal] sets. The revision advances whenever either changes,
   so a stored promotion made against an earlier revision is stale. *)
type workout = {
  id : workout_id;
  title : string;
  started_at : Recovery.timestamp;
  ended_at : Recovery.timestamp;
  sets : source_set list;
  mappings : (string * Exercise.t) list;
  acknowledgement : string option;
  revision : int;
}

type batch = {
  batch_identity : batch_id;
  source : string;
  fingerprint : string;
  imported_at : Recovery.timestamp;
  workouts : workout list;
  warnings : warning list;
  promotions : (workout_id * promoted) list;
}

and provenance = {
  batch_id : batch_id;
  workout_id : workout_id;
  source_rows : int list;
  normal_confirmation : string option;
  revision : int;
}

and promoted = {
  title : string;
  started_at : Recovery.timestamp;
  ended_at : Recovery.timestamp;
  observations : Evidence.Observation.t list;
  provenance : provenance;
}

let make_workout ~id ~title ~started_at ~ended_at ~sets =
  if
    Recovery.timestamp_to_unix_seconds ended_at
    < Recovery.timestamp_to_unix_seconds started_at
  then Error Invalid_time
  else
    Ok
      {
        id;
        title;
        started_at;
        ended_at;
        sets;
        mappings = [];
        acknowledgement = None;
        revision = 0;
      }

let make_batch ~id ~source ~fingerprint ~imported_at ~workouts ~warnings =
  {
    batch_identity = id;
    source;
    fingerprint;
    imported_at;
    workouts;
    warnings;
    promotions = [];
  }

(* {1 Accessors} *)

let batch_identity b = b.batch_identity
let batch_source b = b.source
let batch_fingerprint b = b.fingerprint
let batch_imported_at b = b.imported_at
let batch_workouts b = b.workouts
let batch_warnings b = b.warnings
let find_workout b id = List.find_opt (fun w -> String.equal w.id id) b.workouts
let workout_identity (w : workout) = w.id
let workout_title (w : workout) = w.title
let workout_started_at (w : workout) = w.started_at
let workout_ended_at (w : workout) = w.ended_at
let workout_sets (w : workout) = w.sets
let workout_revision (w : workout) = w.revision
let workout_acknowledgement (w : workout) = w.acknowledgement

let workout_mapping (w : workout) ~source_name =
  List.assoc_opt source_name w.mappings

(* Replaces the workout that shares [w]'s id, leaving every other workout and
   the batch's own fields untouched. *)
let replace_workout b w =
  {
    b with
    workouts =
      List.map (fun x -> if String.equal x.id w.id then w else x) b.workouts;
  }

(* {1 Cleaning} *)

let map_exercise b ~workout ~source_name exercise =
  match find_workout b workout with
  | None -> Error (Unknown_workout workout)
  | Some w ->
      let changed =
        match List.assoc_opt source_name w.mappings with
        | Some current -> not (Exercise.equal current exercise)
        | None -> true
      in
      if not changed then Ok b
      else
        let mappings =
          (source_name, exercise) :: List.remove_assoc source_name w.mappings
        in
        let w = { w with mappings; revision = w.revision + 1 } in
        Ok (replace_workout b w)

let confirm_normal_sets b ~workout ~acknowledgement =
  match find_workout b workout with
  | None -> Error (Unknown_workout workout)
  | Some w ->
      if String.equal (String.trim acknowledgement) "" then
        Error Empty_acknowledgement
      else
        let changed =
          match w.acknowledgement with
          | Some current -> not (String.equal current acknowledgement)
          | None -> true
        in
        if not changed then Ok b
        else
          let w =
            {
              w with
              acknowledgement = Some acknowledgement;
              revision = w.revision + 1;
            }
          in
          Ok (replace_workout b w)

(* {1 Blockers} *)

type blocker = No_sets | Unmapped_exercise of string | Normal_sets_unconfirmed

(* Distinct source exercise names in first-appearance order. *)
let distinct_names (sets : source_set list) =
  List.fold_left
    (fun acc (s : source_set) ->
      if List.mem s.exercise_name acc then acc else acc @ [ s.exercise_name ])
    [] sets

(* The sets that promote to canonical evidence. A drop set is not one clean
   drive to failure — HD1 knows only forced reps, negatives, and a static hold
   past failure, never a strip set — so a [Dropset] row is non-evidence, dropped
   the way a warmup is. What remains is the set taken to failure, which is what
   the doctrine counts. Every downstream decision — blockers, observations,
   provenance — reads this, so a drop set neither blocks a workout nor records
   an observation. *)
let promotable_sets w =
  List.filter (fun (s : source_set) -> s.set_type <> Dropset) w.sets

let blockers w =
  let sets = promotable_sets w in
  if sets = [] then [ No_sets ]
  else
    let unmapped =
      distinct_names sets
      |> List.filter (fun name -> not (List.mem_assoc name w.mappings))
      |> List.map (fun name -> Unmapped_exercise name)
    in
    let normal_blocker =
      if
        List.exists (fun (s : source_set) -> s.set_type = Normal) sets
        && w.acknowledgement = None
      then [ Normal_sets_unconfirmed ]
      else []
    in
    unmapped @ normal_blocker

(* {1 Promotion} *)

type workout_result =
  | Promoted of promoted
  | Already_promoted of promoted
  | Blocked of blocker list

type batch_result = {
  promoted : (workout_id * promoted) list;
  already_promoted : (workout_id * promoted) list;
  blocked : (workout_id * blocker list) list;
}

(* Every promoted set becomes one canonical observation, taken to failure and
   performed at the workout's end. The export's set type gated whether the
   workout could promote; it never colours the recorded outcome. The mapping is
   present for every set, guaranteed by [blockers] returning empty. *)
let observe w (s : source_set) =
  let exercise =
    match List.assoc_opt s.exercise_name w.mappings with
    | Some e -> e
    | None ->
        (* Unreachable: promotion only runs with no blockers, so every set is
           mapped. *)
        assert false
  in
  let effort =
    match
      Evidence.Stimulus.Effort.make ~exercise ~load:s.weight_kg ~reps:s.reps
        ~outcome:Evidence.Stimulus.Positive_failure
    with
    | Ok effort -> effort
    | Error _ ->
        (* Unreachable: the adapter admits only a finite nonnegative load and at
           least one rep, the same rule [Effort.make] enforces. *)
        assert false
  in
  Evidence.Observation.make ~exercise ~effort ~performed_at:w.ended_at

let promote_of_workout b (w : workout) =
  let sets = promotable_sets w in
  {
    title = w.title;
    started_at = w.started_at;
    ended_at = w.ended_at;
    observations = List.map (observe w) sets;
    provenance =
      {
        batch_id = b.batch_identity;
        workout_id = w.id;
        source_rows = List.map (fun (s : source_set) -> s.row) sets;
        normal_confirmation =
          (if List.exists (fun (s : source_set) -> s.set_type = Normal) sets
           then w.acknowledgement
           else None);
        revision = w.revision;
      };
  }

let store_promotion b workout_id promoted =
  {
    b with
    promotions =
      (workout_id, promoted) :: List.remove_assoc workout_id b.promotions;
  }

(* Promotes one workout against its current state, returning the result and the
   batch with any stored promotion refreshed. A blocked workout leaves the batch
   untouched. *)
let promote_workout_internal b w =
  match blockers w with
  | _ :: _ as bs -> (b, Blocked bs)
  | [] -> (
      match List.assoc_opt w.id b.promotions with
      | Some prior when prior.provenance.revision = w.revision ->
          (b, Already_promoted prior)
      | _ ->
          let promoted = promote_of_workout b w in
          (store_promotion b w.id promoted, Promoted promoted))

let promote_workout b workout =
  match find_workout b workout with
  | None -> Error (Unknown_workout workout)
  | Some w -> Ok (promote_workout_internal b w)

let promote_batch b =
  let b, promoted_rev, already_rev, blocked_rev =
    List.fold_left
      (fun (b, promoted, already, blocked) w ->
        let b, result = promote_workout_internal b w in
        match result with
        | Promoted p -> (b, (w.id, p) :: promoted, already, blocked)
        | Already_promoted p -> (b, promoted, (w.id, p) :: already, blocked)
        | Blocked bs -> (b, promoted, already, (w.id, bs) :: blocked))
      (b, [], [], []) b.workouts
  in
  ( b,
    {
      promoted = List.rev promoted_rev;
      already_promoted = List.rev already_rev;
      blocked = List.rev blocked_rev;
    } )

(* {1 Snapshot} *)

type observation_snapshot = {
  exercise_id : Exercise.id;
  load : float;
  reps : int;
  performed_at : Recovery.timestamp;
}

type promoted_snapshot = {
  title : string;
  started_at : Recovery.timestamp;
  ended_at : Recovery.timestamp;
  observations : observation_snapshot list;
  source_rows : int list;
  normal_confirmation : string option;
  revision : int;
}

type workout_snapshot = {
  id : workout_id;
  title : string;
  started_at : Recovery.timestamp;
  ended_at : Recovery.timestamp;
  sets : source_set list;
  mappings : (string * Exercise.id) list;
  acknowledgement : string option;
  revision : int;
  promotion : promoted_snapshot option;
}

type snapshot = {
  batch_id : batch_id;
  source : string;
  fingerprint : string;
  imported_at : Recovery.timestamp;
  workouts : workout_snapshot list;
  warnings : warning list;
}

type restore_error =
  | Unknown_exercise of string
  | Invalid_time
  | Invalid_effort of Evidence.Stimulus.Effort.error
      (** A stored observation the core refuses: a nonsensical load or rep
          count. The snapshot is corrupt, not merely stale. *)

(* A promoted observation is always a single failure effort, so its snapshot
   drops the delivery and the outcome. *)
let observation_snapshot obs =
  let effort = Evidence.Observation.effort obs in
  {
    exercise_id = Exercise.id (Evidence.Stimulus.Effort.exercise effort);
    load = Evidence.Stimulus.Effort.load effort;
    reps = Evidence.Stimulus.Effort.reps effort;
    performed_at = Evidence.Observation.performed_at obs;
  }

let promoted_snapshot (p : promoted) =
  {
    title = p.title;
    started_at = p.started_at;
    ended_at = p.ended_at;
    observations = List.map observation_snapshot p.observations;
    source_rows = p.provenance.source_rows;
    normal_confirmation = p.provenance.normal_confirmation;
    revision = p.provenance.revision;
  }

let workout_snapshot b (w : workout) =
  {
    id = w.id;
    title = w.title;
    started_at = w.started_at;
    ended_at = w.ended_at;
    sets = w.sets;
    mappings = List.map (fun (name, e) -> (name, Exercise.id e)) w.mappings;
    acknowledgement = w.acknowledgement;
    revision = w.revision;
    promotion = Option.map promoted_snapshot (List.assoc_opt w.id b.promotions);
  }

let snapshot b =
  {
    batch_id = b.batch_identity;
    source = b.source;
    fingerprint = b.fingerprint;
    imported_at = b.imported_at;
    workouts = List.map (workout_snapshot b) b.workouts;
    warnings = b.warnings;
  }

let ( let* ) = Result.bind

(* Resolve an exercise id, reporting the raw id string when the catalog no
   longer names it. *)
let resolve find_exercise (id : Exercise.id) =
  match find_exercise id with
  | Some e -> Ok e
  | None -> Error (Unknown_exercise (id :> string))

let restore_mappings find_exercise mappings =
  let rec go acc = function
    | [] -> Ok (List.rev acc)
    | (name, id) :: tl ->
        let* e = resolve find_exercise id in
        go ((name, e) :: acc) tl
  in
  go [] mappings

(* Rebuild a promotion from its snapshot. Each observation is reconstructed as a
   single failure effort, exactly as promotion first minted it. *)
let restore_promotion find_exercise batch_id workout_id (p : promoted_snapshot)
    =
  let restore_observation (o : observation_snapshot) =
    let* exercise = resolve find_exercise o.exercise_id in
    let* effort =
      Result.map_error
        (fun e -> Invalid_effort e)
        (Evidence.Stimulus.Effort.make ~exercise ~load:o.load ~reps:o.reps
           ~outcome:Evidence.Stimulus.Positive_failure)
    in
    Ok
      (Evidence.Observation.make ~exercise ~effort ~performed_at:o.performed_at)
  in
  let rec go acc = function
    | [] -> Ok (List.rev acc)
    | o :: tl ->
        let* obs = restore_observation o in
        go (obs :: acc) tl
  in
  let* observations = go [] p.observations in
  Ok
    {
      title = p.title;
      started_at = p.started_at;
      ended_at = p.ended_at;
      observations;
      provenance =
        {
          batch_id;
          workout_id;
          source_rows = p.source_rows;
          normal_confirmation = p.normal_confirmation;
          revision = p.revision;
        };
    }

let restore_workout find_exercise batch_id (ws : workout_snapshot) =
  if
    Recovery.timestamp_to_unix_seconds ws.ended_at
    < Recovery.timestamp_to_unix_seconds ws.started_at
  then Error Invalid_time
  else
    let* mappings = restore_mappings find_exercise ws.mappings in
    let* promotion =
      match ws.promotion with
      | None -> Ok None
      | Some p ->
          let* p = restore_promotion find_exercise batch_id ws.id p in
          Ok (Some p)
    in
    let w =
      {
        id = ws.id;
        title = ws.title;
        started_at = ws.started_at;
        ended_at = ws.ended_at;
        sets = ws.sets;
        mappings;
        acknowledgement = ws.acknowledgement;
        revision = ws.revision;
      }
    in
    Ok (w, Option.map (fun p -> (ws.id, p)) promotion)

let restore ~find_exercise (s : snapshot) =
  let rec go workouts promotions = function
    | [] -> Ok (List.rev workouts, List.rev promotions)
    | ws :: tl ->
        let* w, promo = restore_workout find_exercise s.batch_id ws in
        let promotions =
          match promo with Some p -> p :: promotions | None -> promotions
        in
        go (w :: workouts) promotions tl
  in
  let* workouts, promotions = go [] [] s.workouts in
  Ok
    {
      batch_identity = s.batch_id;
      source = s.source;
      fingerprint = s.fingerprint;
      imported_at = s.imported_at;
      workouts;
      warnings = s.warnings;
      promotions;
    }