1 open Dream_html 2 open Page_kit 3 open Page_shell 4 5 let extension_select ?(selected = "") ~input_id () = 6 let option (code : string) label = 7 let attrs = [ Dream_html.string_attr "value" "%s" code ] in 8 let attrs = 9 if String.equal code selected then Dream_html.attr "selected" :: attrs 10 else attrs 11 in 12 tag "option" attrs [ txt "%s" label ] 13 in 14 tag "select" 15 [ name "extension"; Dream_html.string_attr "id" "%s" input_id ] 16 [ 17 option "" "to positive failure"; 18 option "forced" "then forced reps"; 19 option "negatives" "then negatives"; 20 option "static" "then a static hold"; 21 ] 22 23 (* The extension amount counts reps or seconds. Both words are rendered, and 24 the CSS shows the one that matches the selected ending. *) 25 let reps_or_seconds ~reps ~seconds = 26 [ 27 tag "span" [ class_ "amount-label-reps" ] [ txt "%s" reps ]; 28 tag "span" [ class_ "amount-label-sep" ] [ txt " / " ]; 29 tag "span" [ class_ "amount-label-seconds" ] [ txt "%s" seconds ]; 30 ] 31 32 (* One movement is one item in the prescribed sequence. Its name, load, and 33 reps stay together, so a responsive layout cannot mix two movements. *) 34 let movement_group ~name ~load_id ~load_field ~reps_id ~reps_field ?load_value 35 ?reps_value ?previous_load ?previous_reps ~reps_label () = 36 let number_field ~additional_class ~input_id ~field ~value ~step_ ~label 37 ~previous ~unit = 38 let input = 39 void "input" 40 ([ 41 type_ "number"; 42 Dream_html.string_attr "name" "%s" field; 43 Dream_html.string_attr "id" "%s" input_id; 44 step "%s" step_; 45 required; 46 ] 47 @ 48 match value with 49 | None -> [] 50 | Some v -> [ Dream_html.string_attr "value" "%s" v ]) 51 in 52 let group_class = 53 match previous with 54 | None -> "input-group" 55 | Some _ -> "input-group input-group-with-previous" 56 in 57 let previous_control = 58 match previous with 59 | None -> [] 60 | Some p -> [ tag "span" [ class_ "exercise-previous" ] [ txt "%s" p ] ] 61 in 62 let control = 63 tag "div" 64 [ Dream_html.string_attr "class" "%s" group_class ] 65 (previous_control 66 @ [ input; tag "span" [ class_ "input-unit" ] [ txt "%s" unit ] ]) 67 in 68 tag "div" 69 [ class_ "field field-number%s" additional_class ] 70 [ 71 tag "label" 72 [ Dream_html.string_attr "for" "%s" input_id; class_ "sr-only" ] 73 [ txt "%s" label ]; 74 control; 75 ] 76 in 77 tag "li" 78 [ class_ "movement-group" ] 79 [ 80 tag "fieldset" 81 [ class_ "movement-fieldset" ] 82 [ 83 tag "legend" [] [ txt "%s" name ]; 84 tag "div" 85 [ class_ "movement-controls" ] 86 [ 87 number_field ~additional_class:"" ~input_id:load_id 88 ~field:load_field ~value:load_value ~step_:"0.5" 89 ~label:"Load (kg)" ~previous:previous_load ~unit:"kg"; 90 number_field ~additional_class:" field-after-load" 91 ~input_id:reps_id ~field:reps_field ~value:reps_value ~step_:"1" 92 ~label:reps_label ~previous:previous_reps ~unit:"reps"; 93 ]; 94 ]; 95 ] 96 97 (* A stimulus records one movement or a prescribed pre-exhaust sequence. Its 98 ending belongs to the whole stimulus, not to its final movement. *) 99 let form_for_stimulus request ~action_path ~slot 100 ~(movements : View_model.Workout.movement list) ~selected_extension 101 ~selected_extension_amount ?(enhanced = false) ?(submit = "Record") 102 ?(correction = false) () = 103 let field_id field = Printf.sprintf "slot-%d-%s" slot field in 104 let selected = selected_extension in 105 let movement_of (m : View_model.Workout.movement) = 106 movement_group ~name:m.name ~load_id:(field_id m.load_field) 107 ~load_field:m.load_field ~reps_id:(field_id m.reps_field) 108 ~reps_field:m.reps_field ?load_value:m.load_value ?reps_value:m.reps_value 109 ?previous_load:m.previous_load ?previous_reps:m.previous_reps 110 ~reps_label:m.reps_label () 111 in 112 let set_ending = 113 tag "fieldset" 114 [ class_ "set-ending" ] 115 [ 116 tag "legend" [] [ txt "Set ending" ]; 117 tag "div" 118 [ class_ "set-ending-controls" ] 119 [ 120 tag "div" 121 [ class_ "field field-ending" ] 122 [ 123 tag "label" 124 [ 125 Dream_html.string_attr "for" "%s" (field_id "extension"); 126 class_ "sr-only"; 127 ] 128 [ txt "Ending" ]; 129 extension_select ~selected ~input_id:(field_id "extension") (); 130 ]; 131 tag "div" 132 [ class_ "field field-extension-amount field-after-ending" ] 133 [ 134 tag "label" 135 [ 136 Dream_html.string_attr "for" "%s" 137 (field_id "extension_amount"); 138 class_ "sr-only"; 139 ] 140 (reps_or_seconds ~reps:"Extension reps" 141 ~seconds:"Hold seconds"); 142 tag "div" 143 [ class_ "input-group" ] 144 [ 145 void "input" 146 [ 147 type_ "number"; 148 name "extension_amount"; 149 Dream_html.string_attr "id" "%s" 150 (field_id "extension_amount"); 151 Dream_html.string_attr "min" "1"; 152 step "1"; 153 Dream_html.string_attr "value" "%s" 154 selected_extension_amount; 155 ]; 156 tag "span" 157 [ class_ "input-unit" ] 158 (reps_or_seconds ~reps:"reps" ~seconds:"seconds"); 159 ]; 160 ]; 161 ]; 162 ] 163 in 164 let action_control = 165 if correction then 166 tag "div" 167 [ class_ "correction-actions" ] 168 [ 169 void "input" 170 [ 171 type_ "submit"; 172 Dream_html.string_attr "value" "%s" submit; 173 Dream_html.attr "data-hito-correction-action"; 174 ]; 175 tag "button" [ type_ "reset"; class_ "secondary" ] [ txt "Reset" ]; 176 ] 177 else 178 void "input" 179 [ 180 type_ "submit"; 181 class_ "record-action"; 182 Dream_html.string_attr "value" "%s" submit; 183 ] 184 in 185 tag "form" 186 ([ action_path; post_form ] 187 @ (if enhanced then [ Dream_html.attr "data-hito-workout-form" ] 188 else [ Dream_html.attr "data-hito-app-form" ]) 189 @ if correction then [ Dream_html.attr "data-hito-correction-form" ] else [] 190 ) 191 [ 192 Dream_html.csrf_tag request; 193 tag "div" 194 [ class_ "logging-form" ] 195 [ 196 tag "ol" [ class_ "movement-list" ] (List.map movement_of movements); 197 set_ending; 198 action_control; 199 ]; 200 ] 201 202 let workout request ~viewer ?workout_started ~record_id ~active_slot 203 (vm : View_model.Workout.t) = 204 let enhanced = Option.is_none record_id in 205 (* A live workout view is itself the workout in progress, so its own start 206 drives the nav timer. A saved-record view is history: the timer, if any, 207 belongs to a separate workout the handler reports through [workout_started]. *) 208 let workout_started = 209 if enhanced then Some vm.started_at_unix else workout_started 210 in 211 let record_action slot = 212 match record_id with 213 | None -> action Routes.workout_slot slot 214 | Some record_id -> action Routes.record_slot record_id slot 215 in 216 let edit_action slot = 217 match record_id with 218 | None -> action Routes.workout_slot_edit slot 219 | Some record_id -> action Routes.record_slot_edit record_id slot 220 in 221 (* The exercise accordion: one <details> per prescription slot, all sharing a 222 [name], which the browser treats as an exclusive group — opening one closes 223 the rest, with no script. The active slot is open; the handler picks it from 224 [?slot=], so a record or correction reopens the slot it belongs to. The 225 summary carries the slot's level-two heading: its number and exercise label, 226 struck through once recorded. A recorded slot shows a pre-filled correction 227 form (which replaces the slot rather than adding volume); an outstanding 228 slot shows the record form. *) 229 let slot_section (slot : View_model.Workout.slot) = 230 let index = slot.index in 231 let done_ = Option.is_some slot.recorded_summary in 232 let body = 233 match slot.recorded_summary with 234 | Some _ -> 235 [ 236 form_for_stimulus request ~action_path:(edit_action index) 237 ~slot:index ~movements:slot.movements 238 ~selected_extension:slot.selected_extension 239 ~selected_extension_amount:slot.selected_extension_amount 240 ~enhanced ~submit:"Save correction" ~correction:true (); 241 ] 242 | None -> 243 [ 244 form_for_stimulus request ~action_path:(record_action index) 245 ~slot:index ~movements:slot.movements 246 ~selected_extension:slot.selected_extension 247 ~selected_extension_amount:slot.selected_extension_amount 248 ~enhanced (); 249 ] 250 in 251 tag "details" 252 ([ 253 class_ "slot-accordion"; 254 Dream_html.string_attr "name" "exercise"; 255 Dream_html.string_attr "id" "slot-%d" index; 256 ] 257 @ (if index = active_slot then [ Dream_html.attr "open" ] else []) 258 @ if done_ then [ Dream_html.string_attr "data-done" "true" ] else []) 259 [ 260 tag "summary" [] 261 [ 262 tag "h2" 263 [ class_ "slot-heading" ] 264 [ 265 tag "span" [ class_ "slot-number" ] [ txt "%d." (index + 1) ]; 266 tag "span" 267 [ 268 Dream_html.string_attr "class" "slot-label%s" 269 (if done_ then " slot-label-done" else ""); 270 ] 271 [ txt "%s" slot.label ]; 272 ]; 273 ]; 274 tag "div" 275 [ class_ "slot-panel" ] 276 [ tag "div" [ class_ "slot-panel-body" ] body ]; 277 ] 278 in 279 let slots = 280 [ tag "div" [ class_ "slot-accordions" ] (List.map slot_section vm.slots) ] 281 in 282 let complete_note = 283 if vm.all_recorded then 284 [ 285 tag "p" 286 [ class_ "done" ] 287 [ txt "Everything prescribed has been recorded." ]; 288 ] 289 else [] 290 in 291 let finish_section = 292 match record_id with 293 | Some _ -> [] 294 | None -> 295 [ 296 tag "div" 297 [ 298 Dream_html.string_attr "class" "button-group finish-actions%s" 299 (if vm.all_recorded then " finish-actions-complete" else ""); 300 ] 301 [ 302 tag "form" 303 [ 304 action Routes.finish_workout; 305 post_form; 306 Dream_html.attr "data-hito-app-form"; 307 ] 308 [ 309 Dream_html.csrf_tag request; 310 void "input" [ type_ "submit"; value "Finish workout" ]; 311 ]; 312 (* Cancel is a native POST form. Without script, it submits 313 immediately. The client only opens the confirm dialog. Its 314 acceptance submits this form as a full document navigation so 315 the cancelled workout cannot leave a stale app shell behind. *) 316 tag "form" 317 [ 318 action Routes.cancel_workout; 319 post_form; 320 Dream_html.attr "data-hito-confirm-form"; 321 ] 322 [ 323 Dream_html.csrf_tag request; 324 void "input" 325 [ 326 type_ "submit"; 327 class_ "secondary"; 328 value "Cancel logging"; 329 Dream_html.attr "data-hito-confirm-cancel"; 330 ]; 331 ]; 332 ]; 333 (* The confirmation modal. Native dialog for built-in focus trapping 334 and Escape-to-close. The client opens it. "Cancel workout" submits 335 the cancel form, "Keep logging" closes it. *) 336 tag "dialog" 337 [ 338 class_ "confirm-dialog"; Dream_html.attr "data-hito-confirm-modal"; 339 ] 340 [ 341 tag "h2" [] [ txt "Cancel logging this workout?" ]; 342 tag "p" [] [ txt "This action cannot be undone." ]; 343 tag "div" 344 [ class_ "button-group" ] 345 [ 346 tag "button" 347 [ 348 type_ "button"; Dream_html.attr "data-hito-confirm-accept"; 349 ] 350 [ txt "Cancel logging" ]; 351 tag "button" 352 [ 353 type_ "button"; 354 class_ "secondary"; 355 Dream_html.attr "data-hito-confirm-dismiss"; 356 ] 357 [ txt "Continue logging" ]; 358 ]; 359 ]; 360 ] 361 in 362 html_page ~viewer ~request ~active:"workout" ?workout_started vm.name 363 ([ 364 tag "h1" [] [ txt "%s" vm.name ]; 365 tag "h2" [ class_ "workout-date" ] [ txt "%s" vm.date ]; 366 ] 367 @ slots @ complete_note @ finish_section 368 @ 369 if enhanced then 370 [ 371 tag "p" 372 [ 373 Dream_html.string_attr "aria-live" "polite"; 374 Dream_html.attr "data-hito-workout-status"; 375 ] 376 []; 377 ] 378 else []) 379