(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)))))))