module Rep_range = struct
  type t = int * int

  type error =
    | Invalid_order of { min : int; max : int }
    | Outside_limits of { min : int; max : int }

  let limits = (6, 12)

  exception Invalid of error

  let make ~min ~max =
    let lower, upper = limits in
    if min <= 0 || max < min then raise (Invalid (Invalid_order { min; max }))
    else if min < lower || max > upper then
      raise (Invalid (Outside_limits { min; max }))
    else (min, max)

  let bounds t = t
end

module Stimulus = struct
  type delivery =
    | Single of Exercise.t
    | Pre_exhaust of { isolation : Exercise.t; compound : Exercise.t }

  type t = {
    delivery : delivery;
    rep_range : Rep_range.t;
    allowed_substitutes : Exercise.t list;
  }

  type error =
    | Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
    | Substitute_not_permitted of Exercise.id

  let pp_error ppf = function
    | Not_a_pre_exhaust { isolation; compound } ->
        Format.fprintf ppf "%s cannot pre-exhaust for %s"
          (isolation :> string)
          (compound :> string)
    | Substitute_not_permitted id ->
        Format.fprintf ppf "%s is not a permitted substitute" (id :> string)

  let delivery t = t.delivery

  exception Invalid of error

  let rep_range t = t.rep_range
  let allowed_substitutes t = t.allowed_substitutes

  let delivery_exercises = function
    | Single e -> [ e ]
    | Pre_exhaust { isolation; compound } -> [ isolation; compound ]

  let exercises t = delivery_exercises t.delivery

  let make ~delivery ~rep_range ~allowed_substitutes =
    let movements = delivery_exercises delivery in
    let unpermitted =
      List.find_opt
        (fun candidate ->
          not
            (List.exists
               (fun original -> Exercise.may_substitute ~original ~candidate)
               movements))
        allowed_substitutes
    in
    match (delivery, unpermitted) with
    | Pre_exhaust { isolation; compound }, _
      when not (Exercise.may_pre_exhaust ~isolation ~compound) ->
        raise
          (Invalid
             (Not_a_pre_exhaust
                {
                  isolation = Exercise.id isolation;
                  compound = Exercise.id compound;
                }))
    | _, Some candidate ->
        raise (Invalid (Substitute_not_permitted (Exercise.id candidate)))
    | _ -> { delivery; rep_range; allowed_substitutes }

  let permits t movement =
    List.exists (Exercise.equal movement) (exercises t)
    || List.exists (Exercise.equal movement) t.allowed_substitutes

  let pp_delivery ppf = function
    | Single e -> Exercise.pp ppf e
    | Pre_exhaust { isolation; compound } ->
        Format.fprintf ppf "%a into %a" Exercise.pp isolation Exercise.pp
          compound

  let pp ppf t =
    let min_reps, max_reps = Rep_range.bounds t.rep_range in
    Format.fprintf ppf "%a for %d-%d reps" pp_delivery t.delivery min_reps
      max_reps
end

module Workout = struct
  type error = Empty_workout
  type t = { name : string; stimuli : Stimulus.t list }

  exception Invalid of error

  let make ~name ~stimuli =
    match stimuli with
    | [] -> raise (Invalid Empty_workout)
    | _ -> { name; stimuli }

  let name t = t.name
  let stimuli t = t.stimuli
  let pp ppf t = Format.pp_print_string ppf t.name
end

module Routine = struct
  type error = Empty_routine
  type t = { name : string; workouts : Workout.t list }

  exception Invalid of error

  let make ~name ~workouts =
    match workouts with
    | [] -> raise (Invalid Empty_routine)
    | _ -> { name; workouts }

  let name t = t.name
  let workouts t = t.workouts
  let pp ppf t = Format.pp_print_string ppf t.name

  let workout_after t performed =
    let rec next = function
      | [] | [ _ ] -> List.hd t.workouts
      | w :: (following :: _ as rest) ->
          if w == performed then following else next rest
    in
    next t.workouts

  let training_interval = Recovery.hours 48
  let cycle_rest = Recovery.hours 72

  let recovery_after t performed =
    match List.rev t.workouts with
    | last :: _ when last == performed -> cycle_rest
    | _ -> training_interval

  (* {1 The Ideal Routine} *)

  open Exercise

  let exercise key =
    match Exercise.find key with
    | Some exercise -> exercise
    | None -> invalid_arg "Ideal Routine references an absent catalog key"

  let dumbbell_flyes =
    exercise { equipment = Dumbbell; movement = Fly; variation = Standard }

  let cable_crossovers =
    exercise { equipment = Cable; movement = Crossover; variation = Standard }

  let pec_deck =
    exercise { equipment = Machine; movement = Pec_deck; variation = Standard }

  let incline_presses =
    exercise { equipment = Unspecified; movement = Press; variation = Incline }

  let laterals =
    exercise
      {
        equipment = Unspecified;
        movement = Lateral_raise;
        variation = Standard;
      }

  let bent_over_laterals =
    exercise
      { equipment = Dumbbell; movement = Lateral_raise; variation = Bent_over }

  let reverse_pec_deck =
    exercise { equipment = Machine; movement = Pec_deck; variation = Rear_delt }

  let lying_french_presses =
    exercise
      { equipment = Unspecified; movement = French_press; variation = Lying }

  let pressdowns =
    exercise { equipment = Cable; movement = Pressdown; variation = Standard }

  let triceps_machine =
    exercise { equipment = Machine; movement = Press; variation = Triceps }

  let dips =
    exercise { equipment = Bodyweight; movement = Dip; variation = Standard }

  let pullovers =
    exercise
      { equipment = Unspecified; movement = Pullover; variation = Standard }

  let straight_arm_pulldowns =
    exercise
      { equipment = Cable; movement = Pulldown; variation = Straight_arm }

  let close_grip_pulldowns =
    exercise
      {
        equipment = Cable;
        movement = Pulldown;
        variation = Close_grip_palms_up;
      }

  let bent_over_rows =
    exercise { equipment = Barbell; movement = Row; variation = Bent_over }

  let shrugs =
    exercise { equipment = Unspecified; movement = Shrug; variation = Standard }

  let hyperextensions =
    exercise
      {
        equipment = Bodyweight;
        movement = Hyperextension;
        variation = Standard;
      }

  let deadlifts =
    exercise { equipment = Barbell; movement = Deadlift; variation = Standard }

  let curls =
    exercise { equipment = Barbell; movement = Curl; variation = Standard }

  let preacher_curls =
    exercise { equipment = Barbell; movement = Curl; variation = Preacher }

  let leg_extensions =
    exercise
      { equipment = Machine; movement = Leg_extension; variation = Standard }

  let leg_presses =
    exercise { equipment = Machine; movement = Leg_press; variation = Standard }

  let squats =
    exercise { equipment = Barbell; movement = Squat; variation = Standard }

  let leg_curls =
    exercise { equipment = Machine; movement = Leg_curl; variation = Standard }

  let calf_raises =
    exercise
      { equipment = Unspecified; movement = Calf_raise; variation = Standard }

  let sit_ups =
    exercise { equipment = Bodyweight; movement = Sit_up; variation = Standard }

  (* HD1's guideline window for every listed exercise. *)
  let six_to_ten = Rep_range.make ~min:6 ~max:10

  let prescribe ?(substitutes = []) delivery =
    Stimulus.make ~delivery ~rep_range:six_to_ten
      ~allowed_substitutes:substitutes

  let single ?substitutes exercise =
    prescribe ?substitutes (Stimulus.Single exercise)

  let pre_exhaust ?substitutes ~isolation ~compound () =
    prescribe ?substitutes (Stimulus.Pre_exhaust { isolation; compound })

  let day ~name stimuli = Workout.make ~name ~stimuli

  let ideal_day_one =
    day ~name:"Day 1"
      [
        pre_exhaust
          ~substitutes:[ cable_crossovers; pec_deck ]
          ~isolation:dumbbell_flyes ~compound:incline_presses ();
        single laterals;
        single ~substitutes:[ reverse_pec_deck ] bent_over_laterals;
        pre_exhaust
          ~substitutes:[ pressdowns; triceps_machine ]
          ~isolation:lying_french_presses ~compound:dips ();
      ]

  let ideal_day_two =
    day ~name:"Day 2"
      [
        pre_exhaust ~substitutes:[ straight_arm_pulldowns ] ~isolation:pullovers
          ~compound:close_grip_pulldowns ();
        single bent_over_rows;
        single shrugs;
        single ~substitutes:[ deadlifts ] hyperextensions;
        single ~substitutes:[ preacher_curls ] curls;
      ]

  let ideal_day_three =
    day ~name:"Day 3"
      [
        pre_exhaust ~substitutes:[ squats ] ~isolation:leg_extensions
          ~compound:leg_presses ();
        single leg_curls;
        single calf_raises;
        single sit_ups;
      ]

  let[@warning "-32"] ideal =
    make ~name:"Ideal Routine"
      ~workouts:[ ideal_day_one; ideal_day_two; ideal_day_three ]
end