module Effort = Evidence.Stimulus.Effort

let beats ~previous ~current =
  let load = Float.compare (Effort.load current) (Effort.load previous) in
  let reps = Int.compare (Effort.reps current) (Effort.reps previous) in
  load > 0 || (load = 0 && reps > 0)

type assessment = Progressing | Stalled
type error = Insufficient_data

exception Invalid of error

let pp_assessment ppf = function
  | Progressing -> Format.pp_print_string ppf "progressing"
  | Stalled -> Format.pp_print_string ppf "stalled"

let pp_error ppf Insufficient_data =
  Format.pp_print_string ppf "not enough record to judge"

let stall_window = Recovery.days 14
let rec last = function [] -> None | [ x ] -> Some x | _ :: rest -> last rest

(* The most recent observation that improved on the one before it. *)
let last_advance observations =
  let rec scan found = function
    | (previous : Evidence.Log.observation) :: (current :: _ as rest) ->
        let found =
          if beats ~previous:previous.effort ~current:current.effort then
            Some current
          else found
        in
        scan found rest
    | _ -> found
  in
  scan None observations

let elapsed_between (a : Evidence.Log.observation)
    (b : Evidence.Log.observation) =
  Recovery.duration_to_seconds
    (Recovery.elapsed ~since:a.performed_at ~now:b.performed_at)

let assess observations =
  let window = Recovery.duration_to_seconds stall_window in
  match (observations, last observations) with
  | ([] | [ _ ]), _ | _, None -> raise (Invalid Insufficient_data)
  | first :: _, Some latest -> (
      match last_advance observations with
      | Some advance ->
          if elapsed_between advance latest >= window then Stalled
          else Progressing
      | None ->
          (* Never advanced. Only a stall once the record is long enough to say
             so; otherwise two sessions a day apart would condemn the routine. *)
          if elapsed_between first latest >= window then Stalled
          else raise (Invalid Insufficient_data))

type remedy =
  | Lay_off_then_reduce of {
      lay_off : Recovery.duration;
      drop_stimuli_per_workout : int;
      extra_rest : Recovery.duration;
    }

let remedy = function
  | Progressing -> None
  | Stalled ->
      Some
        (Lay_off_then_reduce
           {
             lay_off = Recovery.days 7;
             drop_stimuli_per_workout = 1;
             extra_rest = Recovery.days 1;
           })

let pp_remedy ppf
    (Lay_off_then_reduce { lay_off; drop_stimuli_per_workout; extra_rest }) =
  Format.fprintf ppf
    "take %a off, then drop %d stimulus per workout and add %a between workouts"
    Recovery.pp_duration lay_off drop_stimuli_per_workout Recovery.pp_duration
    extra_rest

let load_increase_trigger = 12
let load_increase ~current = (current *. 1.10, current *. 1.20)

type load_verdict = Hold | Increase of float * float | Too_heavy

(* The trigger is absolute, so the window's ceiling never gates the verdict —
   only its floor does. *)
let judge_load ~rep_range effort =
  let reps = Effort.reps effort in
  let min_reps, _ = Prescription.Rep_range.bounds rep_range in
  if reps >= load_increase_trigger then
    let low, high = load_increase ~current:(Effort.load effort) in
    Increase (low, high)
  else if reps < min_reps then Too_heavy
  else Hold

let pp_load_verdict ppf = function
  | Hold -> Format.pp_print_string ppf "hold the load"
  | Increase (low, high) ->
      Format.fprintf ppf "raise the load to %g-%g kg" low high
  | Too_heavy -> Format.pp_print_string ppf "load is too heavy for the window"

type diagnostic =
  | Excess_volume of int
  | Extensions_on_every_stimulus of int
  | Trained_under_recovered of int

let excess_volume workout =
  List.length (Evidence.Workout.stimuli workout)
  > Evidence.Workout.filled_slots workout

let all_extended workout =
  match Evidence.Workout.stimuli workout with
  | [] -> false
  | stimuli -> List.for_all Evidence.Stimulus.is_extended stimuli

let under_recovered workout =
  match Recovery.basis (Evidence.Workout.clearance workout) with
  | Recovery.Recovered -> false
  | Recovery.Overridden _ -> true

let diagnose log =
  let workouts = Evidence.Log.workouts log in
  let count predicate = List.length (List.filter predicate workouts) in
  let excessive = count excess_volume in
  let extended = count all_extended in
  let overridden = count under_recovered in
  let when_present n d = if n > 0 then [ d n ] else [] in
  when_present excessive (fun n -> Excess_volume n)
  @ when_present extended (fun n -> Extensions_on_every_stimulus n)
  @ when_present overridden (fun n -> Trained_under_recovered n)

let pp_diagnostic ppf = function
  | Excess_volume n ->
      Format.fprintf ppf "%d workout(s) recorded more stimuli than prescribed" n
  | Extensions_on_every_stimulus n ->
      Format.fprintf ppf "%d workout(s) extended every stimulus beyond failure"
        n
  | Trained_under_recovered n ->
      Format.fprintf ppf "%d workout(s) begun before recovery was complete" n