diff options
Diffstat (limited to 'src/routes.lisp')
| -rw-r--r-- | src/routes.lisp | 411 |
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))))))) |