1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
(in-package #:hito)
;;; --- Database Configuration ---
(defvar *db-path*
(asdf:system-relative-pathname "hito" "hito.db")
"Path to the SQLite database file.")
;;; --- Table Definitions ---
(mito:deftable exercise ()
((name :col-type (:varchar 128)
:documentation "Exercise name, e.g. 'Pec Deck'")
(muscle-group :col-type (:varchar 64)
:documentation "Primary muscle group: chest, back, legs, shoulders, arms")
(is-default-p :col-type :boolean
:initform t
:documentation "Whether this is a Mentzer canonical exercise")
(substitution-for :col-type (or :bigint :null)
:initform nil
:documentation "FK to exercise this substitutes for (nil if canonical)"))
(:documentation "An exercise in the HITO system. Mentzer's canonical movements are seeded by default."))
(mito:deftable user-profile ()
((name :col-type (:varchar 128)
:initform "Trainee"
:documentation "User's name")
(current-workout-day :col-type :integer
:initform 1
:documentation "Next workout day in the rotation (1-4)")
(last-session-date :col-type (or :varchar :null)
:initform nil
:documentation "ISO date string of last completed session")
(training-start-date :col-type (or :varchar :null)
:initform nil
:documentation "ISO date string of when training began"))
(:documentation "Single user profile. Architected for multi-user extension."))
(mito:deftable training-session ()
((session-date :col-type (:varchar 32)
:documentation "ISO date string of this session")
(workout-day :col-type :integer
:documentation "Which day in the rotation (1-4)")
(completed-p :col-type :boolean
:initform nil
:documentation "Whether the session was completed")
(notes :col-type (or :text :null)
:initform nil
:documentation "Optional session notes")
(override-p :col-type :boolean
:initform nil
:documentation "Whether recovery gate was overridden for this session"))
(:documentation "A single training session, one workout day."))
(mito:deftable set-record ()
((session-id :col-type :bigint
:documentation "FK to training-session")
(exercise-id :col-type :bigint
:documentation "FK to exercise")
(set-number :col-type :integer
:documentation "Order within the exercise (1, 2, ...)")
(prescribed-weight :col-type :real
:documentation "Target weight in kg")
(prescribed-rep-low :col-type :integer
:initform 6
:documentation "Lower bound of rep range")
(prescribed-rep-high :col-type :integer
:initform 10
:documentation "Upper bound of rep range")
(actual-weight :col-type (or :real :null)
:initform nil
:documentation "Weight actually used (filled after session)")
(actual-reps :col-type (or :integer :null)
:initform nil
:documentation "Reps actually achieved (filled after session)")
(to-failure-p :col-type (or :boolean :null)
:initform nil
:documentation "Whether the set was taken to muscular failure"))
(:documentation "A single set within a session — both prescription and result."))
;;; --- Database Initialization ---
(defun connect-db ()
"Connect to the SQLite database."
(mito:connect-toplevel :sqlite3
:database-name *db-path*))
(defun ensure-tables ()
"Create or migrate all tables."
(mito:ensure-table-exists 'exercise)
(mito:ensure-table-exists 'user-profile)
(mito:ensure-table-exists 'training-session)
(mito:ensure-table-exists 'set-record))
;;; --- Seed Data: Mentzer's HD I Canonical Exercises ---
(defparameter *hd1-exercises*
'(;; Day 1: Chest & Back
("Pec Deck" "chest")
("Incline Barbell Press" "chest")
("Straight-Arm Pulldowns" "back")
("Close-Grip Palms-Up Pulldowns" "back")
("Bent-Over Barbell Rows" "back")
;; Day 2: Legs
("Leg Extensions" "legs")
("Leg Press" "legs")
("Squats" "legs")
("Leg Curls" "legs")
("Standing Calf Raises" "legs")
("Toe Presses" "legs")
;; Day 3: Shoulders
("Lateral Raises" "shoulders")
("Overhead Press" "shoulders")
("Bent-Over Lateral Raises" "shoulders")
;; Day 4: Arms
("Barbell Curls" "arms")
("Triceps Pushdowns" "arms")
("Dips" "arms"))
"Mentzer's canonical Heavy Duty I exercises.")
(defparameter *substitution-options*
'(;; Each entry: (canonical-exercise-name . list-of-substitute-names)
("Pec Deck" "Cable Crossovers" "Dumbbell Flyes")
("Incline Barbell Press" "Incline Dumbbell Press" "Flat Barbell Press")
("Straight-Arm Pulldowns" "Dumbbell Pullovers" "Straight-Arm Cable Pushdowns")
("Close-Grip Palms-Up Pulldowns" "Chin-Ups" "Close-Grip Cable Rows")
("Bent-Over Barbell Rows" "T-Bar Rows" "Seated Cable Rows")
("Leg Extensions" "Sissy Squats")
("Leg Press" "Hack Squats" "Front Squats")
("Squats" "Belt Squats" "Bulgarian Split Squats")
("Leg Curls" "Romanian Deadlifts" "Glute-Ham Raises")
("Standing Calf Raises" "Seated Calf Raises" "Donkey Calf Raises")
("Toe Presses" "Calf Press on Leg Press")
("Lateral Raises" "Cable Lateral Raises" "Machine Lateral Raises")
("Overhead Press" "Dumbbell Shoulder Press" "Machine Shoulder Press")
("Bent-Over Lateral Raises" "Reverse Pec Deck" "Face Pulls")
("Barbell Curls" "Dumbbell Curls" "EZ-Bar Curls")
("Triceps Pushdowns" "Overhead Triceps Extension" "Close-Grip Bench Press")
("Dips" "Weighted Dips" "Decline Close-Grip Press"))
"Available substitutions for each canonical exercise.
The movement pattern is what matters, not brand loyalty to specific equipment.")
(defun seed-exercises ()
"Seed the database with Mentzer's canonical exercises if not already present."
(when (zerop (mito:count-dao 'exercise))
(dolist (entry *hd1-exercises*)
(mito:create-dao 'exercise
:name (first entry)
:muscle-group (second entry)
:is-default-p t
:substitution-for nil))
(format t "~&Seeded ~D canonical exercises.~%" (length *hd1-exercises*))))
(defun find-exercise-by-name (name)
"Look up an exercise DAO by name. Returns nil if not found."
(first (mito:select-dao 'exercise
(sxql:where (:= :name name)))))
(defun seed-substitution-options ()
"Seed available substitution exercises (not active, just available for selection).
These are stored with is-default-p = nil and substitution-for = nil until activated."
(dolist (entry *substitution-options*)
(let* ((canonical-name (first entry))
(canonical (find-exercise-by-name canonical-name))
(subs (rest entry)))
(when canonical
(dolist (sub-name subs)
;; Only create if not already in DB
(unless (find-exercise-by-name sub-name)
(let ((muscle-group (exercise-muscle-group canonical)))
(mito:create-dao 'exercise
:name sub-name
:muscle-group muscle-group
:is-default-p nil
:substitution-for nil)))))))
(format t "~&Seeded substitution options.~%"))
;;; --- Top-Level Initialization ---
(defun init-db ()
"Initialize the database: connect, create tables, seed data."
(connect-db)
(ensure-tables)
(seed-exercises)
(seed-substitution-options)
(format t "~&Database initialized at ~A~%" *db-path*))
|