[OCaml] High Intensity Training Online
feat Seed two rotations of the ideal routine
On first run, seed the blendux account with two full rotations of the Ideal Routine as finished history, loads rising in the second rotation so the logbook progression column has data. Idempotent: skipped when history exists.
bin/main.ml
@@ -37,20 +37,149 @@
37
37
let getenv name default =
38
38
match Sys.getenv_opt name with Some v when v <> "" -> v | _ -> default
39
39
40
Removed:
(* Public sign-up is closed for now, so the deployment runs on a single
41
Removed:
pre-seeded account. The password comes from the environment, never a
42
Removed:
hardcoded default. Seeding is idempotent: a username already present is a
43
Removed:
success, not an error — so rotating the password means updating the store,
44
Removed:
not re-running this. Remove this once public registration returns. *)
40
Added:
(* Seed two full rotations of the Ideal Routine as workout history, so the
41
Added:
logbook and progression view have meaningful data from the start. Idempotent:
42
Added:
skipped when the trainee already has history. Each rotation uses slightly
43
Added:
higher loads so progression is visible. Workouts are spaced by HD1's
44
Added:
recovery intervals: 48h between days, 72h after the final day. *)
45
Added:
let seed_workout_history repo trainee_id =
46
Added:
Hito_persistence.Sqlite_repo.history repo trainee_id >|= List.length
47
Added:
>>= fun count ->
48
Added:
if count > 0 then Lwt.return_unit
49
Added:
else
50
Added:
let routine = Prescription.Routine.ideal in
51
Added:
let workouts = Prescription.Routine.workouts routine in
52
Added:
let clearance = Recovery.override Recovery.Ready in
53
Added:
let get id =
54
Added:
match Exercise.find_id id with Some e -> e | None -> failwith id
55
Added:
in
56
Added:
let effort ?(outcome = Evidence.Stimulus.Positive_failure) id load reps =
57
Added:
Evidence.Stimulus.Effort.make ~exercise:(get id) ~load ~reps ~outcome
58
Added:
in
59
Added:
let single id load reps =
60
Added:
Evidence.Stimulus.make (Evidence.Stimulus.Single (effort id load reps))
61
Added:
in
62
Added:
let pair iso_id iso_load iso_reps comp_id comp_load comp_reps =
63
Added:
Evidence.Stimulus.make
64
Added:
(Evidence.Stimulus.Pair
65
Added:
{
66
Added:
first = effort iso_id iso_load iso_reps;
67
Added:
second = effort comp_id comp_load comp_reps;
68
Added:
})
69
Added:
in
70
Added:
(* Two rotations of Day 1, 2, 3. The second rotation's loads are 5-10%
71
Added:
higher so the progression judge counts exercises that beat their prior. *)
72
Added:
let rotation_stimuli =
73
Added:
[|
74
Added:
(* Rotation 1 *)
75
Added:
[
76
Added:
(* Day 1 *)
77
Added:
[
78
Added:
pair "dumbbell-flyes" 18. 8 "incline-press" 55. 7;
79
Added:
single "laterals" 10. 8;
80
Added:
single "bent-over-laterals" 8. 9;
81
Added:
pair "lying-french-press" 25. 8 "dips" 0. 7;
82
Added:
];
83
Added:
(* Day 2 *)
84
Added:
[
85
Added:
pair "pullovers" 20. 8 "close-grip-pulldowns" 50. 7;
86
Added:
single "bent-over-rows" 50. 8;
87
Added:
single "shrugs" 40. 10;
88
Added:
single "hyperextensions" 0. 10;
89
Added:
single "curls" 30. 8;
90
Added:
];
91
Added:
(* Day 3 *)
92
Added:
[
93
Added:
pair "leg-extensions" 40. 9 "leg-presses" 100. 8;
94
Added:
single "leg-curls" 30. 9;
95
Added:
single "calf-raises" 50. 12;
96
Added:
single "sit-ups" 0. 15;
97
Added:
];
98
Added:
];
99
Added:
(* Rotation 2: higher loads or reps so progress is visible *)
100
Added:
[
101
Added:
[
102
Added:
pair "dumbbell-flyes" 20. 9 "incline-press" 60. 7;
103
Added:
single "laterals" 12. 8;
104
Added:
single "bent-over-laterals" 10. 9;
105
Added:
pair "lying-french-press" 28. 8 "dips" 0. 8;
106
Added:
];
107
Added:
[
108
Added:
pair "pullovers" 22. 8 "close-grip-pulldowns" 55. 7;
109
Added:
single "bent-over-rows" 55. 8;
110
Added:
single "shrugs" 45. 10;
111
Added:
single "hyperextensions" 0. 12;
112
Added:
single "curls" 32. 9;
113
Added:
];
114
Added:
[
115
Added:
pair "leg-extensions" 45. 9 "leg-presses" 110. 8;
116
Added:
single "leg-curls" 32. 10;
117
Added:
single "calf-raises" 55. 12;
118
Added:
single "sit-ups" 0. 18;
119
Added:
];
120
Added:
];
121
Added:
|]
122
Added:
in
123
Added:
(* Space workouts: 48h between days, 72h after the last day of a rotation.
124
Added:
Start the first workout 14 days ago so the seed feels recent. Precompute
125
Added:
each workout's start time, then persist the sequence in Lwt — the seeder
126
Added:
already runs under Lwt_main.run, so it must not nest another. *)
127
Added:
let last_day = List.length workouts - 1 in
128
Added:
let base = int_of_float (Unix.gettimeofday ()) - (14 * 86_400) in
129
Added:
let planned, _ =
130
Added:
Array.to_list rotation_stimuli
131
Added:
|> List.concat_map (fun rotation ->
132
Added:
List.mapi (fun day_idx stimuli -> (day_idx, stimuli)) rotation)
133
Added:
|> List.fold_left
134
Added:
(fun (acc, time) (day_idx, stimuli) ->
135
Added:
let rest =
136
Added:
if day_idx = last_day then
137
Added:
Recovery.duration_to_seconds Prescription.Routine.cycle_rest
138
Added:
else
139
Added:
Recovery.duration_to_seconds
140
Added:
Prescription.Routine.training_interval
141
Added:
in
142
Added:
(acc @ [ (day_idx, stimuli, time) ], time + 2400 + rest))
143
Added:
([], base)
144
Added:
in
145
Added:
Lwt_list.iter_s
146
Added:
(fun (day_idx, stimuli, time) ->
147
Added:
let prescription = List.nth workouts day_idx in
148
Added:
let started_at = Recovery.timestamp_of_unix_seconds time in
149
Added:
let workout =
150
Added:
Evidence.Workout.start prescription ~clearance ~started_at
151
Added:
in
152
Added:
let workout =
153
Added:
List.fold_left Evidence.Workout.add_stimulus workout stimuli
154
Added:
in
155
Added:
let ended_at = Recovery.timestamp_of_unix_seconds (time + 2400) in
156
Added:
let workout = Evidence.Workout.finish workout ~ended_at in
157
Added:
Hito_persistence.Sqlite_repo.finish_workout repo trainee_id workout
158
Added:
>|= ignore)
159
Added:
planned
160
Added:
45
161
let seed_single_user repo ~password =
46
162
let service = Service.make ~repo in
47
Removed:
Service.register service ~username:"blendux" ~password
48
Removed:
|> Lwt.map (function
49
Removed:
| Ok _ | Error `Username_taken -> ()
50
Removed:
| Error (`Username e) ->
51
Removed:
Format.eprintf "hito: cannot seed user: %a@."
52
Removed:
Hito_app.Trainee.pp_username_error e;
53
Removed:
exit 1)
163
Added:
Service.register service ~username:"blendux" ~password >>= function
164
Added:
| Ok trainee ->
165
Added:
Hito_persistence.Sqlite_repo.set_active_routine repo
166
Added:
trainee.Hito_app.Trainee.id
167
Added:
(Hito_app.Repository.routine_id "ideal")
168
Added:
>>= fun () -> seed_workout_history repo trainee.Hito_app.Trainee.id
169
Added:
| Error `Username_taken -> (
170
Added:
match Hito_app.Trainee.username "blendux" with
171
Added:
| Error _ -> Lwt.return_unit
172
Added:
| Ok username -> (
173
Added:
Hito_persistence.Sqlite_repo.find_trainee_by_username repo username
174
Added:
>>= fun trainee_opt ->
175
Added:
match trainee_opt with
176
Added:
| None -> Lwt.return_unit
177
Added:
| Some trainee ->
178
Added:
seed_workout_history repo trainee.Hito_app.Trainee.id))
179
Added:
| Error (`Username e) ->
180
Added:
Format.eprintf "hito: cannot seed user: %a@."
181
Added:
Hito_app.Trainee.pp_username_error e;
182
Added:
exit 1
54
183
55
184
let clf_month = function
56
185
| 1 -> "Jan"