module Muscle = struct
  type t =
    | Pecs
    | Delts
    | Triceps
    | Biceps
    | Forearms
    | Lats
    | Traps
    | Erectors
    | Quadriceps
    | Hamstrings
    | Glutes
    | Calves
    | Abdominals

  let equal = ( = )
end

type equipment =
  | Barbell
  | Cable
  | Dumbbell
  | Machine
  | Bodyweight
  | Unspecified

type movement =
  | Fly
  | Crossover
  | Pec_deck
  | Press
  | Lateral_raise
  | French_press
  | Pressdown
  | Dip
  | Pullover
  | Pulldown
  | Row
  | Chin
  | Shrug
  | Hyperextension
  | Deadlift
  | Curl
  | Leg_extension
  | Leg_press
  | Squat
  | Leg_curl
  | Calf_raise
  | Sit_up

type variation =
  | Standard
  | Incline
  | Bent_over
  | Rear_delt
  | Lying
  | Triceps
  | Close_grip_palms_up
  | Straight_arm
  | Preacher

type key = { equipment : equipment; movement : movement; variation : variation }
type id = string
type mechanic = Isolation | Compound

type t = {
  key : key;
  id : id;
  name : string;
  mechanic : mechanic;
  muscles : Muscle.t list;
}

let make_key ~equipment ~movement ~variation =
  { equipment; movement; variation }

let key_equal = ( = )
let key t = t.key
let id t = t.id
let name t = t.name
let equal a b = key_equal a.key b.key
let pp ppf t = Format.pp_print_string ppf t.name

let iso ~key ~id ~name muscle =
  { key; id; name; mechanic = Isolation; muscles = [ muscle ] }

let comp ~key ~id ~name muscles =
  { key; id; name; mechanic = Compound; muscles }

(* The movements HD1 names, in the order its Ideal Routine introduces them.
   The stable [id] preserves external serialization. The structured [key] is the
   catalog identity. [Unspecified] records where HD1 names no equipment. *)
let dumbbell_flyes =
  make_key ~equipment:Dumbbell ~movement:Fly ~variation:Standard

let cable_crossovers =
  make_key ~equipment:Cable ~movement:Crossover ~variation:Standard

let pec_deck =
  make_key ~equipment:Machine ~movement:Pec_deck ~variation:Standard

let incline_presses =
  make_key ~equipment:Unspecified ~movement:Press ~variation:Incline

let laterals =
  make_key ~equipment:Unspecified ~movement:Lateral_raise ~variation:Standard

let bent_over_laterals =
  make_key ~equipment:Dumbbell ~movement:Lateral_raise ~variation:Bent_over

let reverse_pec_deck =
  make_key ~equipment:Machine ~movement:Pec_deck ~variation:Rear_delt

let lying_french_presses =
  make_key ~equipment:Unspecified ~movement:French_press ~variation:Lying

let pressdowns =
  make_key ~equipment:Cable ~movement:Pressdown ~variation:Standard

let triceps_machine =
  make_key ~equipment:Machine ~movement:Press ~variation:Triceps

let dips = make_key ~equipment:Bodyweight ~movement:Dip ~variation:Standard

let pullovers =
  make_key ~equipment:Unspecified ~movement:Pullover ~variation:Standard

let straight_arm_pulldowns =
  make_key ~equipment:Cable ~movement:Pulldown ~variation:Straight_arm

let close_grip_pulldowns =
  make_key ~equipment:Cable ~movement:Pulldown ~variation:Close_grip_palms_up

let bent_over_rows =
  make_key ~equipment:Barbell ~movement:Row ~variation:Bent_over

let chins = make_key ~equipment:Bodyweight ~movement:Chin ~variation:Standard
let shrugs = make_key ~equipment:Unspecified ~movement:Shrug ~variation:Standard

let hyperextensions =
  make_key ~equipment:Bodyweight ~movement:Hyperextension ~variation:Standard

let deadlifts =
  make_key ~equipment:Barbell ~movement:Deadlift ~variation:Standard

let curls = make_key ~equipment:Barbell ~movement:Curl ~variation:Standard

let preacher_curls =
  make_key ~equipment:Barbell ~movement:Curl ~variation:Preacher

let leg_extensions =
  make_key ~equipment:Machine ~movement:Leg_extension ~variation:Standard

let leg_presses =
  make_key ~equipment:Machine ~movement:Leg_press ~variation:Standard

let squats = make_key ~equipment:Barbell ~movement:Squat ~variation:Standard

let leg_curls =
  make_key ~equipment:Machine ~movement:Leg_curl ~variation:Standard

let calf_raises =
  make_key ~equipment:Unspecified ~movement:Calf_raise ~variation:Standard

let sit_ups =
  make_key ~equipment:Bodyweight ~movement:Sit_up ~variation:Standard

let catalog =
  [
    iso ~key:dumbbell_flyes ~id:"dumbbell-flyes" ~name:"Dumbbell Flyes"
      Muscle.Pecs;
    iso ~key:cable_crossovers ~id:"cable-crossovers" ~name:"Cable Crossovers"
      Muscle.Pecs;
    iso ~key:pec_deck ~id:"pec-deck" ~name:"Pec Deck" Muscle.Pecs;
    comp ~key:incline_presses ~id:"incline-press" ~name:"Incline Presses"
      [ Muscle.Pecs; Muscle.Delts; Muscle.Triceps ];
    iso ~key:laterals ~id:"laterals" ~name:"Laterals" Muscle.Delts;
    iso ~key:bent_over_laterals ~id:"bent-over-laterals"
      ~name:"Bent-over Dumbbell Laterals" Muscle.Delts;
    iso ~key:reverse_pec_deck ~id:"reverse-pec-deck"
      ~name:"Pec Deck (rear delts)" Muscle.Delts;
    iso ~key:lying_french_presses ~id:"lying-french-press"
      ~name:"Lying French Presses" Muscle.Triceps;
    iso ~key:pressdowns ~id:"pressdowns" ~name:"Pressdowns" Muscle.Triceps;
    iso ~key:triceps_machine ~id:"triceps-machine" ~name:"Triceps Machine"
      Muscle.Triceps;
    comp ~key:dips ~id:"dips" ~name:"Dips"
      [ Muscle.Triceps; Muscle.Pecs; Muscle.Delts ];
    iso ~key:pullovers ~id:"pullovers" ~name:"Pullovers" Muscle.Lats;
    iso ~key:straight_arm_pulldowns ~id:"straight-arm-pulldowns"
      ~name:"Straight-Arm Pulldowns" Muscle.Lats;
    comp ~key:close_grip_pulldowns ~id:"close-grip-pulldowns"
      ~name:"Close-grip, palms-up Pulldowns"
      [ Muscle.Lats; Muscle.Biceps; Muscle.Forearms ];
    comp ~key:bent_over_rows ~id:"bent-over-rows" ~name:"Bent-over Barbell Rows"
      [ Muscle.Lats; Muscle.Biceps; Muscle.Forearms; Muscle.Erectors ];
    comp ~key:chins ~id:"chins" ~name:"Chins"
      [ Muscle.Lats; Muscle.Biceps; Muscle.Forearms ];
    iso ~key:shrugs ~id:"shrugs" ~name:"Shrugs" Muscle.Traps;
    iso ~key:hyperextensions ~id:"hyperextensions" ~name:"Hyperextensions"
      Muscle.Erectors;
    comp ~key:deadlifts ~id:"deadlifts" ~name:"Deadlifts"
      [
        Muscle.Erectors;
        Muscle.Glutes;
        Muscle.Hamstrings;
        Muscle.Quadriceps;
        Muscle.Traps;
      ];
    iso ~key:curls ~id:"curls" ~name:"Curls" Muscle.Biceps;
    iso ~key:preacher_curls ~id:"preacher-curls" ~name:"Preacher Curls"
      Muscle.Biceps;
    iso ~key:leg_extensions ~id:"leg-extensions" ~name:"Leg Extensions"
      Muscle.Quadriceps;
    comp ~key:leg_presses ~id:"leg-presses" ~name:"Leg Presses"
      [ Muscle.Quadriceps; Muscle.Glutes; Muscle.Hamstrings ];
    comp ~key:squats ~id:"squats" ~name:"Squats"
      [ Muscle.Quadriceps; Muscle.Glutes; Muscle.Hamstrings; Muscle.Erectors ];
    iso ~key:leg_curls ~id:"leg-curls" ~name:"Leg Curls" Muscle.Hamstrings;
    iso ~key:calf_raises ~id:"calf-raises" ~name:"Calf Raises" Muscle.Calves;
    iso ~key:sit_ups ~id:"sit-ups" ~name:"Sit-Ups" Muscle.Abdominals;
  ]

let find sought =
  List.find_opt (fun exercise -> key_equal exercise.key sought) catalog

let find_id sought =
  List.find_opt (fun exercise -> String.equal exercise.id sought) catalog

(* Mutually substitutable catalog keys. Grouping guarantees symmetry: every
   member of a group may stand in for every other. Each group is one of HD1's
   own "or" lists. *)
let substitution_groups =
  [
    [ dumbbell_flyes; cable_crossovers; pec_deck ];
    [ lying_french_presses; pressdowns; triceps_machine ];
    [ bent_over_laterals; reverse_pec_deck ];
    [ pullovers; straight_arm_pulldowns ];
    [ close_grip_pulldowns; bent_over_rows; chins ];
    [ hyperextensions; deadlifts ];
    [ curls; preacher_curls ];
    [ leg_presses; squats ];
  ]

let group_of exercise =
  List.find_opt (List.exists (key_equal exercise.key)) substitution_groups
  |> Option.value ~default:[]

let permitted_substitutes exercise =
  group_of exercise
  |> List.filter (fun key -> not (key_equal key exercise.key))
  |> List.filter_map find

let may_substitute ~original ~candidate =
  List.exists (equal candidate) (permitted_substitutes original)

let may_pre_exhaust ~isolation ~compound =
  match (isolation.mechanic, compound.mechanic, isolation.muscles) with
  | Isolation, Compound, [ target ] ->
      List.exists (Muscle.equal target) compound.muscles
      && List.length compound.muscles >= 2
  | _ -> false