Initial commit: HITO MVP

Heavy Duty I prescriptive training system encoding Mentzer's methodology.

- 4-day split program (Chest & Back, Legs, Shoulders, Arms)
- Prescription engine with pre-exhaust superset structure
- Strict progression logic (+5kg large / +2.5kg small muscles)
- Recovery gating with stall-based extension and override
- Onboarding via experience level (Novice/Intermediate/Advanced)
- Session logging with full progression analysis
- Exercise substitution (33 alternatives for 17 canonical movements)
- Objectivist aesthetic: black/gold, serif, rectilinear

Stack: Hunchentoot, Mito/SQLite, Djula, SBCL

1 files changed, 411 insertions, 0 deletions

diff --git a/src/routes.lisp b/src/routes.lisp
new file mode 100644
index 0000000..10d1a51
--- /dev/null
+++ b/src/routes.lisp
@@ -0,0 +1,411 @@
+(in-package #:hito)
+
+;;; --- Template Setup ---
+;;; Must happen before any template compilation in routes.lisp
+
+(djula:add-template-directory
+ (asdf:system-relative-pathname "hito" "templates/"))
+
+;;; --- Template Compilation ---
+
+(defvar *template-base* (djula:compile-template* "base.html"))
+(defvar *template-setup* (djula:compile-template* "setup.html"))
+(defvar *template-session* (djula:compile-template* "session.html"))
+(defvar *template-session-complete* (djula:compile-template* "session-complete.html"))
+(defvar *template-dashboard* (djula:compile-template* "dashboard.html"))
+(defvar *template-override* (djula:compile-template* "override.html"))
+(defvar *template-exercises* (djula:compile-template* "exercises.html"))
+
+;;; --- Helper: Check if user has completed setup ---
+
+(defun user-setup-complete-p ()
+  "Return T if a user profile exists (setup has been completed)."
+  (plusp (mito:count-dao 'user-profile)))
+
+;;; --- Helper: Get exercises grouped by workout day ---
+
+(defun get-exercises-by-day ()
+  "Return exercises grouped by workout day for the setup form.
+Each day entry has :number, :name, and :exercises (list of id/name pairs)."
+  (loop for day-def in *hd1-program*
+        collect
+        (let* ((day-num (getf day-def :day))
+               (day-name (getf day-def :name))
+               (day-exercises '()))
+          ;; Walk the program structure to get exercise names in order
+          (dolist (group (getf day-def :exercises))
+            (dolist (ex-def (second group))
+              (let* ((name (getf ex-def :name))
+                     (exercise (find-exercise-by-name name)))
+                (when exercise
+                  (push (list :id (mito:object-id exercise)
+                              :name name)
+                        day-exercises)))))
+          (list :number day-num
+                :name day-name
+                :exercises (nreverse day-exercises)))))
+
+;;; --- Routes ---
+
+;;; Root: redirect to setup if no profile, otherwise show dashboard
+(hunchentoot:define-easy-handler (index :uri "/") ()
+  (unless (user-setup-complete-p)
+    (hunchentoot:redirect "/setup")
+    (return-from index nil))
+  (let* ((profile (first (mito:select-dao 'user-profile)))
+         (workout-day (user-profile-current-workout-day profile))
+         (day-name (get-workout-day-name workout-day))
+         (status (recovery-status))
+         (ready (recovery-status-ready-p status))
+         ;; Recent sessions (last 5)
+         (recent-sessions (mito:select-dao 'training-session
+                            (sxql:where (:= :completed-p 1))
+                            (sxql:order-by (:desc :session-date))
+                            (sxql:limit 5)))
+         (session-entries
+           (mapcar (lambda (s)
+                     (list :date (training-session-session-date s)
+                           :day (training-session-workout-day s)
+                           :day_name (get-workout-day-name
+                                      (training-session-workout-day s))
+                           :override (training-session-override-p s)))
+                   ;; Filter out baseline sessions
+                   (remove-if (lambda (s)
+                                (let ((notes (training-session-notes s)))
+                                  (and notes (search "Baseline" notes))))
+                              recent-sessions))))
+    (setf (hunchentoot:content-type*) "text/html")
+    (djula:render-template* *template-dashboard* nil
+                            :ready ready
+                            :next_day workout-day
+                            :next_day_name day-name
+                            :days_remaining (recovery-status-days-remaining status)
+                            :days_plural (if (= (recovery-status-days-remaining status) 1)
+                                             "" "s")
+                            :next_date (recovery-status-next-date status)
+                            :reason (recovery-status-reason status)
+                            :has_history (not (null session-entries))
+                            :sessions session-entries)))
+
+;;; Setup GET: show the experience level selection
+(hunchentoot:define-easy-handler (setup-page :uri "/setup") ()
+  (when (user-setup-complete-p)
+    (hunchentoot:redirect "/")
+    (return-from setup-page nil))
+  (setf (hunchentoot:content-type*) "text/html")
+  (djula:render-template* *template-setup* nil))
+
+;;; Setup POST: process level selection and create user profile with starting weights
+(hunchentoot:define-easy-handler (setup-submit :uri "/setup/submit"
+                                              :default-request-type :post) ()
+  (let* ((params (hunchentoot:post-parameters*))
+         (level-str (or (cdr (assoc "level" params :test #'string=)) "beginner"))
+         (level (cond ((string= level-str "intermediate") :intermediate)
+                      ((string= level-str "advanced") :advanced)
+                      (t :beginner)))
+         (today (local-time:format-timestring nil (local-time:now)
+                  :format '(:year "-" (:month 2) "-" (:day 2)))))
+    ;; Create user profile
+    (mito:create-dao 'user-profile
+                     :name "Trainee"
+                     :current-workout-day 1
+                     :last-session-date nil
+                     :training-start-date today)
+    ;; Store starting weights as baseline sessions (backdated to avoid recovery gate)
+    (let ((baseline-date (local-time:format-timestring nil
+                           (local-time:timestamp- (local-time:now) 30 :day)
+                           :format '(:year "-" (:month 2) "-" (:day 2)))))
+      (loop for day from 1 to 4
+            do (let ((baseline-session
+                       (mito:create-dao 'training-session
+                                        :session-date baseline-date
+                                        :workout-day day
+                                        :completed-p t
+                                        :notes "Baseline weights from setup"
+                                        :override-p nil)))
+                 (dolist (group (getf (get-workout-day day) :exercises))
+                   (dolist (ex-def (second group))
+                     (let* ((name (getf ex-def :name))
+                            (exercise (find-exercise-by-name name))
+                            (exercise-id (when exercise (mito:object-id exercise)))
+                            (weight (get-starting-weight name level)))
+                       (when (and exercise-id weight)
+                         (loop for set-num from 1 to (getf ex-def :sets)
+                               do (mito:create-dao 'set-record
+                                                   :session-id (mito:object-id baseline-session)
+                                                   :exercise-id exercise-id
+                                                   :set-number set-num
+                                                   :prescribed-weight (coerce weight 'double-float)
+                                                   :prescribed-rep-low 6
+                                                   :prescribed-rep-high 10
+                                                   :actual-weight (coerce weight 'double-float)
+                                                   :actual-reps 8
+                                                   :to-failure-p t)))))))))
+    ;; Redirect to dashboard
+    (hunchentoot:redirect "/")))
+
+;;; --- Utility ---
+
+(defun parse-float (string)
+  "Parse a string as a float. Returns nil on failure."
+  (handler-case
+      (let ((val (read-from-string string)))
+        (when (numberp val) (coerce val 'double-float)))
+    (error () nil)))
+
+(defun parse-int (string)
+  "Parse a string as an integer. Returns nil on failure."
+  (handler-case
+      (parse-integer string :junk-allowed t)
+    (error () nil)))
+
+;;; --- Override Routes ---
+
+;;; Override GET: show confirmation page with warning
+(hunchentoot:define-easy-handler (override-page :uri "/override") ()
+  (unless (user-setup-complete-p)
+    (hunchentoot:redirect "/setup")
+    (return-from override-page nil))
+  (let ((status (recovery-status)))
+    (when (recovery-status-ready-p status)
+      ;; Already ready, no override needed
+      (hunchentoot:redirect "/")
+      (return-from override-page nil))
+    (setf (hunchentoot:content-type*) "text/html")
+    (djula:render-template* *template-override* nil
+                            :warning *override-warning*
+                            :days_remaining (recovery-status-days-remaining status)
+                            :next_date (recovery-status-next-date status))))
+
+;;; Override POST: confirm override and redirect to session
+(hunchentoot:define-easy-handler (override-confirm :uri "/override/confirm"
+                                                   :default-request-type :post) ()
+  (override-recovery)
+  (hunchentoot:redirect "/session"))
+
+;;; --- Exercise Routes ---
+
+(defun get-substitution-options-for (canonical-id)
+  "Get available substitution exercises for a canonical exercise.
+Returns non-canonical exercises with the same muscle group."
+  (let ((canonical (mito:find-dao 'exercise :id canonical-id)))
+    (when canonical
+      (let ((muscle-group (exercise-muscle-group canonical)))
+        ;; Find all non-default exercises in the same muscle group
+        ;; that aren't currently active as substitutions for OTHER exercises
+        (remove-if
+         (lambda (ex)
+           (or (= (mito:object-id ex) canonical-id)
+               (exercise-is-default-p ex)))
+         (mito:select-dao 'exercise
+           (sxql:where (:and (:= :muscle-group muscle-group)
+                             (:= :is-default-p 0)))))))))
+
+(defun build-exercises-page-data ()
+  "Build the data structure for the exercises template."
+  (loop for day-def in *hd1-program*
+        collect
+        (let* ((day-num (getf day-def :day))
+               (day-name (getf day-def :name))
+               (slots '()))
+          (dolist (group (getf day-def :exercises))
+            (dolist (ex-def (second group))
+              (let* ((canonical-name (getf ex-def :name))
+                     (canonical (find-exercise-by-name canonical-name))
+                     (canonical-id (when canonical (mito:object-id canonical)))
+                     (active (when canonical
+                               (find-active-exercise-for-slot canonical-name)))
+                     (active-id (when active (mito:object-id active)))
+                     (active-name (when active (exercise-name active)))
+                     (has-sub (and active canonical
+                                   (/= active-id canonical-id)))
+                     (options (when canonical-id
+                                (mapcar (lambda (ex)
+                                          (list :id (mito:object-id ex)
+                                                :name (exercise-name ex)))
+                                        (get-substitution-options-for canonical-id)))))
+                (push (list :canonical_name canonical-name
+                            :canonical_id canonical-id
+                            :active_name active-name
+                            :active_id active-id
+                            :has_substitute has-sub
+                            :options options)
+                      slots))))
+          (list :number day-num
+                :name day-name
+                :slots (nreverse slots)))))
+
+;;; Exercises GET: show exercise configuration page
+(hunchentoot:define-easy-handler (exercises-page :uri "/exercises") ()
+  (unless (user-setup-complete-p)
+    (hunchentoot:redirect "/setup")
+    (return-from exercises-page nil))
+  (setf (hunchentoot:content-type*) "text/html")
+  (djula:render-template* *template-exercises* nil
+                          :days (build-exercises-page-data)))
+
+;;; Exercises swap POST: activate a substitution
+(hunchentoot:define-easy-handler (exercises-swap :uri "/exercises/swap"
+                                                :default-request-type :post) ()
+  (let* ((params (hunchentoot:post-parameters*))
+         (canonical-id-str (cdr (assoc "canonical-id" params :test #'string=)))
+         (substitute-id-str (cdr (assoc "substitute-id" params :test #'string=)))
+         (canonical-id (parse-int canonical-id-str))
+         (substitute-id (parse-int substitute-id-str)))
+    (when canonical-id
+      ;; Clear any existing substitution for this canonical exercise
+      (let ((existing-subs (mito:select-dao 'exercise
+                             (sxql:where (:= :substitution-for canonical-id)))))
+        (dolist (ex existing-subs)
+          (setf (exercise-substitution-for ex) nil)
+          (mito:save-dao ex)))
+      ;; If substitute-id is non-zero and different from canonical, activate it
+      (when (and substitute-id (plusp substitute-id)
+                 (/= substitute-id canonical-id))
+        (let ((substitute (mito:find-dao 'exercise :id substitute-id)))
+          (when substitute
+            (setf (exercise-substitution-for substitute) canonical-id)
+            (mito:save-dao substitute))))))
+  (hunchentoot:redirect "/exercises"))
+
+;;; --- Session Helpers ---
+
+(defun build-session-groups (workout-day)
+  "Build the template data structure for displaying a workout session.
+Returns a list of groups, each with :type and :exercises."
+  (let ((day-def (get-workout-day workout-day))
+        (groups '())
+        (field-counter 0))
+    (dolist (group (getf day-def :exercises))
+      (let* ((group-type (first group))
+             (group-exercises '()))
+        (dolist (ex-def (second group))
+          (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)))
+                 (set-count (getf ex-def :sets))
+                 (sets '()))
+            ;; Build set entries
+            (loop for s from 1 to set-count
+                  do (incf field-counter)
+                     (push (list :number s
+                                 :field_key field-counter)
+                           sets))
+            (push (list :id exercise-id
+                        :name exercise-name
+                        :target_weight (if target-weight (round target-weight) 0)
+                        :rep_low (getf ex-def :rep-low)
+                        :rep_high (getf ex-def :rep-high)
+                        :sets (nreverse sets))
+                  group-exercises)))
+        (push (list :type (if (eq group-type :superset) "superset" "straight")
+                    :exercises (nreverse group-exercises))
+              groups)))
+    (nreverse groups)))
+
+;;; --- Session Routes ---
+
+;;; Session GET: display the prescribed workout
+(hunchentoot:define-easy-handler (session-page :uri "/session") ()
+  (unless (user-setup-complete-p)
+    (hunchentoot:redirect "/setup")
+    (return-from session-page nil))
+  (let* ((profile (first (mito:select-dao 'user-profile)))
+         (workout-day (user-profile-current-workout-day profile))
+         (day-name (get-workout-day-name workout-day))
+         (groups (build-session-groups workout-day)))
+    (setf (hunchentoot:content-type*) "text/html")
+    (djula:render-template* *template-session* nil
+                            :day_number workout-day
+                            :day_name day-name
+                            :groups groups)))
+
+;;; Session POST: process submitted workout results
+(hunchentoot:define-easy-handler (session-submit :uri "/session/submit"
+                                                :default-request-type :post) ()
+  (let* ((params (hunchentoot:post-parameters*))
+         (profile (first (mito:select-dao 'user-profile)))
+         (workout-day (user-profile-current-workout-day profile))
+         (today (local-time:format-timestring nil (local-time:now)
+                  :format '(:year "-" (:month 2) "-" (:day 2))))
+         ;; Check if this was an override
+         (status (recovery-status))
+         (is-override (not (recovery-status-ready-p status))))
+    ;; Create the training session
+    (let ((session (mito:create-dao 'training-session
+                                    :session-date today
+                                    :workout-day workout-day
+                                    :completed-p t
+                                    :override-p is-override)))
+      ;; Parse all set records from form params
+      (let ((field-counter 0))
+        (dolist (group (getf (get-workout-day workout-day) :exercises))
+          (dolist (ex-def (second group))
+            (loop for s from 1 to (getf ex-def :sets)
+                  do (incf field-counter)
+                     (let* ((key (format nil "~D" field-counter))
+                            (exercise-id-str (cdr (assoc (format nil "exercise-id-~A" key)
+                                                         params :test #'string=)))
+                            (actual-weight-str (cdr (assoc (format nil "actual-weight-~A" key)
+                                                           params :test #'string=)))
+                            (actual-reps-str (cdr (assoc (format nil "actual-reps-~A" key)
+                                                         params :test #'string=)))
+                            (prescribed-weight-str (cdr (assoc (format nil "prescribed-weight-~A" key)
+                                                               params :test #'string=)))
+                            (to-failure-str (cdr (assoc (format nil "to-failure-~A" key)
+                                                        params :test #'string=)))
+                            (exercise-id (parse-int exercise-id-str))
+                            (actual-weight (parse-float actual-weight-str))
+                            (actual-reps (parse-int actual-reps-str))
+                            (prescribed-weight (or (parse-float prescribed-weight-str) 0.0d0))
+                            (to-failure (not (null to-failure-str))))
+                       (when (and exercise-id actual-weight actual-reps)
+                         (mito:create-dao 'set-record
+                                          :session-id (mito:object-id session)
+                                          :exercise-id exercise-id
+                                          :set-number s
+                                          :prescribed-weight prescribed-weight
+                                          :prescribed-rep-low 6
+                                          :prescribed-rep-high 10
+                                          :actual-weight actual-weight
+                                          :actual-reps actual-reps
+                                          :to-failure-p to-failure)))))))
+      ;; Run progression engine
+      (let ((progression-results (process-session-progression session)))
+        ;; Update user profile: advance workout day, update last session date
+        (let ((next-day (1+ (mod workout-day 4))))
+          (when (zerop next-day) (setf next-day 4))
+          (setf (user-profile-current-workout-day profile) next-day)
+          (setf (user-profile-last-session-date profile) today)
+          (mito:save-dao profile))
+        ;; Calculate recovery for display
+        (let* ((rec-status (recovery-status))
+               (increases (count :increase progression-results
+                                 :key #'progression-result-status))
+               (stalls (count :stall progression-results
+                              :key #'progression-result-status))
+               ;; Build template data for results
+               (result-entries
+                 (mapcar (lambda (r)
+                           (list :exercise_name (progression-result-exercise-name r)
+                                 :status (string-downcase
+                                          (symbol-name (progression-result-status r)))
+                                 :text (format-progression-result r)))
+                         progression-results)))
+          (setf (hunchentoot:content-type*) "text/html")
+          (djula:render-template* *template-session-complete* nil
+                                  :results result-entries
+                                  :has_increases (plusp increases)
+                                  :increase_count increases
+                                  :increase_plural (if (= increases 1) "" "s")
+                                  :has_stalls (plusp stalls)
+                                  :stall_count stalls
+                                  :stall_plural (if (= stalls 1) "" "s")
+                                  :next_date (recovery-status-next-date rec-status)
+                                  :recovery_reason (recovery-status-reason rec-status)))))))