(in-package #:hito)

;;; --- Heavy Duty I Program Definition ---
;;;
;;; The program is encoded as pure data: a list of workout days, each containing
;;; ordered exercise entries with superset groupings, set counts, and rep ranges.
;;; This is the single source of truth for what Mentzer prescribed.

(defparameter *hd1-program*
  '((:day 1
     :name "Chest & Back"
     :exercises
     ((:superset
       ((:name "Pec Deck"             :sets 1 :rep-low 6 :rep-high 10)
        (:name "Incline Barbell Press" :sets 1 :rep-low 6 :rep-high 10)))
      (:superset
       ((:name "Straight-Arm Pulldowns"         :sets 1 :rep-low 6 :rep-high 10)
        (:name "Close-Grip Palms-Up Pulldowns"  :sets 1 :rep-low 6 :rep-high 10)))
      (:straight
       ((:name "Bent-Over Barbell Rows" :sets 2 :rep-low 6 :rep-high 10)))))

    (:day 2
     :name "Legs"
     :exercises
     ((:superset
       ((:name "Leg Extensions" :sets 1 :rep-low 6 :rep-high 10)
        (:name "Leg Press"      :sets 1 :rep-low 6 :rep-high 10)))
      (:straight
       ((:name "Squats"              :sets 1 :rep-low 6 :rep-high 10)))
      (:straight
       ((:name "Leg Curls"           :sets 2 :rep-low 6 :rep-high 10)))
      (:straight
       ((:name "Standing Calf Raises" :sets 2 :rep-low 6 :rep-high 10)))
      (:straight
       ((:name "Toe Presses"         :sets 1 :rep-low 6 :rep-high 10)))))

    (:day 3
     :name "Shoulders"
     :exercises
     ((:superset
       ((:name "Lateral Raises"  :sets 1 :rep-low 6 :rep-high 10)
        (:name "Overhead Press"  :sets 1 :rep-low 6 :rep-high 10)))
      (:straight
       ((:name "Bent-Over Lateral Raises" :sets 2 :rep-low 6 :rep-high 10)))))

    (:day 4
     :name "Arms"
     :exercises
     ((:straight
       ((:name "Barbell Curls"     :sets 2 :rep-low 6 :rep-high 10)))
      (:superset
       ((:name "Triceps Pushdowns" :sets 1 :rep-low 6 :rep-high 10)
        (:name "Dips"              :sets 1 :rep-low 6 :rep-high 10))))))
  "Heavy Duty I: the complete 4-day split as Mentzer prescribed it.
Each workout day contains exercise groups — either :superset (pre-exhaust)
or :straight (standalone). Each exercise specifies sets and rep range.")

;;; --- Starting Weight Defaults by Experience Level ---
;;;
;;; Conservative starting points. The progression engine will correct these
;;; within 2-3 sessions. Better to start light and progress than to start
;;; heavy and stall.

(defparameter *starting-weights*
  '(;; (exercise-name beginner intermediate advanced) — all in kg
    ("Pec Deck"                       20   35   55)
    ("Incline Barbell Press"          40   60   85)
    ("Straight-Arm Pulldowns"         15   22   32)
    ("Close-Grip Palms-Up Pulldowns"  27   45   65)
    ("Bent-Over Barbell Rows"         35   60   85)
    ("Leg Extensions"                 20   32   45)
    ("Leg Press"                      60  115  180)
    ("Squats"                         40   70  100)
    ("Leg Curls"                      20   32   45)
    ("Standing Calf Raises"           35   70  100)
    ("Toe Presses"                    45   90  135)
    ("Lateral Raises"                  7   11   16)
    ("Overhead Press"                 25   42   60)
    ("Bent-Over Lateral Raises"        5    9   14)
    ("Barbell Curls"                  18   30   40)
    ("Triceps Pushdowns"              14   22   32)
    ("Dips"                            0    0   10))
  "Starting weights by exercise and experience level.
Dips default to 0 (bodyweight) for beginner/intermediate.")

(defun get-starting-weight (exercise-name level)
  "Return the starting weight for an exercise at the given level.
LEVEL is one of :beginner, :intermediate, :advanced."
  (let ((entry (assoc exercise-name *starting-weights* :test #'string=)))
    (when entry
      (case level
        (:beginner     (second entry))
        (:intermediate (third entry))
        (:advanced     (fourth entry))
        (otherwise     (second entry))))))

;;; --- Program Query Functions ---

(defun get-workout-day (day-number)
  "Return the program definition for a given day (1-4)."
  (find day-number *hd1-program* :key (lambda (d) (getf d :day))))

(defun get-workout-day-name (day-number)
  "Return the human-readable name for a workout day."
  (let ((day (get-workout-day day-number)))
    (when day (getf day :name))))

(defun get-day-exercises (day-number)
  "Return the exercise group list for a given day."
  (let ((day (get-workout-day day-number)))
    (when day (getf day :exercises))))

;;; --- Exercise Resolution ---

(defun find-active-exercise-for-slot (canonical-name)
  "Find the currently active exercise for a program slot.
If the user has substituted the canonical exercise, return the substitute.
Otherwise return the canonical exercise itself."
  (let ((canonical (find-exercise-by-name canonical-name)))
    (when canonical
      ;; Check if there's an active substitution pointing to this exercise
      (let ((substitute (first (mito:select-dao 'exercise
                                 (sxql:where (:= :substitution-for
                                                 (mito:object-id canonical)))))))
        (or substitute canonical)))))

;;; --- Prescription Generation ---

(defstruct exercise-prescription
  "A single exercise prescription within a session."
  exercise-id
  exercise-name
  set-count
  rep-low
  rep-high
  target-weight
  group-type      ; :superset or :straight
  group-position) ; position within superset (0-indexed), nil for straight

(defun get-last-weight-for-exercise (exercise-id workout-day)
  "Find the most recent actual weight used for this exercise in a completed session
of the same workout day. Returns nil if no history."
  (let* ((sessions (mito:select-dao 'training-session
                     (sxql:where (:and (:= :workout-day workout-day)
                                       (:= :completed-p 1)))
                     (sxql:order-by (:desc :session-date))
                     (sxql:limit 1)))
         (last-session (first sessions)))
    (when last-session
      (let ((records (mito:select-dao 'set-record
                       (sxql:where (:and (:= :session-id (mito:object-id last-session))
                                         (:= :exercise-id exercise-id))))))
        ;; Return the actual weight from the last set of this exercise
        (when records
          (let ((last-record (first (sort (copy-list records) #'>
                                          :key (lambda (r) (set-record-set-number r))))))
            (set-record-actual-weight last-record)))))))

(defun get-prescribed-weight-for-exercise (exercise-id workout-day)
  "Get the next prescribed weight for an exercise.
First checks progression table (computed by progression engine),
then falls back to last actual weight, then to nil (needs user input)."
  ;; For now, just use last actual weight. Progression engine (Task 4)
  ;; will enhance this.
  (get-last-weight-for-exercise exercise-id workout-day))

(defun prescribe-session (workout-day)
  "Generate a full session prescription for the given workout day.
Returns a list of exercise-prescription structs ordered as the program dictates."
  (let ((day-def (get-workout-day workout-day))
        (prescriptions '()))
    (unless day-def
      (error "Invalid workout day: ~D (must be 1-4)" workout-day))
    (dolist (group (getf day-def :exercises))
      (let* ((group-type (first group))
             (exercises (second group))
             (position 0))
        (dolist (ex-def exercises)
          (let* ((canonical-name (getf ex-def :name))
                 (active-exercise (find-active-exercise-for-slot canonical-name))
                 (exercise-id (when active-exercise (mito:object-id active-exercise)))
                 (exercise-name (if active-exercise
                                    (exercise-name active-exercise)
                                    canonical-name))
                 (target-weight (when exercise-id
                                  (get-prescribed-weight-for-exercise
                                   exercise-id workout-day))))
            (push (make-exercise-prescription
                   :exercise-id exercise-id
                   :exercise-name exercise-name
                   :set-count (getf ex-def :sets)
                   :rep-low (getf ex-def :rep-low)
                   :rep-high (getf ex-def :rep-high)
                   :target-weight target-weight
                   :group-type group-type
                   :group-position (when (eq group-type :superset) position))
                  prescriptions)
            (incf position)))))
    (nreverse prescriptions)))

(defun format-prescription (prescription)
  "Format a single exercise-prescription for display."
  (let ((weight (exercise-prescription-target-weight prescription)))
    (format nil "~A: ~@[~A kg × ~]~D-~D reps × ~D set~:P"
            (exercise-prescription-exercise-name prescription)
            (when weight (round weight))
            (exercise-prescription-rep-low prescription)
            (exercise-prescription-rep-high prescription)
            (exercise-prescription-set-count prescription))))

(defun format-session-prescription (workout-day)
  "Format an entire session prescription as a readable string."
  (let ((day-def (get-workout-day workout-day))
        (prescriptions (prescribe-session workout-day))
        (groups (get-day-exercises workout-day)))
    (with-output-to-string (out)
      (format out "~%=== Day ~D: ~A ===~%~%"
              workout-day (getf day-def :name))
      ;; Walk the groups directly and print prescriptions in order
      (let ((presc-idx 0))
        (loop for group in groups
              for group-idx from 0
              for group-type = (first group)
              for group-exercises = (second group)
              do (when (> group-idx 0) (format out "~%"))
                 (if (eq group-type :superset)
                     (format out "[Pre-Exhaust Superset]~%")
                     (format out "[Straight Set]~%"))
                 (loop for i below (length group-exercises)
                       do (format out "  ~A~%"
                                  (format-prescription (nth presc-idx prescriptions)))
                          (incf presc-idx)))))))