1 open Dream_html 2 3 type page = Dream_html.node 4 5 let tag = Dream_html.std_tag 6 let void = Dream_html.void_tag 7 let class_ = Dream_html.string_attr "class" 8 let name = Dream_html.string_attr "name" 9 let value = Dream_html.string_attr "value" 10 let rel = Dream_html.string_attr "rel" 11 let type_ = Dream_html.string_attr "type" 12 let step = Dream_html.string_attr "step" 13 let id = Dream_html.string_attr "id" 14 let tabindex = Dream_html.string_attr "tabindex" 15 let required = Dream_html.attr "required" 16 let href path = Dream_html.path_attr (Dream_html.uri_attr "href") path 17 let src path = Dream_html.path_attr (Dream_html.uri_attr "src") path 18 let action path = Dream_html.path_attr (Dream_html.uri_attr "action") path 19 let post_form = Dream_html.string_attr "method" "post" 20 let flash_key = "hito.flash" 21 22 (* The shell. [viewer] and [request] are present on authenticated pages, which 23 then show a logout control and the username on the history link. Auth pages 24 omit both. *) 25 let theme_session_key = "hito.theme" 26 27 let html_page ?viewer ?request ?(active = "") ?(logging = false) 28 ?(show_nav = false) title content = 29 let spa_client = true in 30 let theme = 31 match request with 32 | Some request -> ( 33 match Dream.session_field request theme_session_key with 34 | Some "dark" -> "dark" 35 | _ -> "light") 36 | None -> "light" 37 in 38 let nav_link page path label = 39 let attrs = [ href path ] in 40 let attrs = 41 if spa_client then Dream_html.attr "data-hito-app-link" :: attrs 42 else attrs 43 in 44 let attrs = 45 if String.equal page active then 46 Dream_html.string_attr "aria-current" "page" :: attrs 47 else attrs 48 in 49 tag "a" attrs [ txt "%s" label ] 50 in 51 (* Three always-available actions. The middle slot points to the routine 52 normally and to the workout in progress while logging, so a running 53 workout stays one tap away without adding a fourth destination. The logbook 54 tab always reads "Logbook". The username lives on its own profile control. *) 55 let navigation_links () = 56 [ 57 nav_link "home" Routes.home "Home"; 58 (if logging then nav_link "workout" Routes.workout "Current workout" 59 else nav_link "routine" Routes.routine "Routine"); 60 nav_link "logbook" Routes.logbook "Logbook"; 61 ] 62 in 63 (* The profile control names the signed-in trainee and opens a drop-down of 64 account actions: Profile, Settings, and Sign out. It sits in the masthead, 65 and on mobile it is the top-bar profile control the bottom nav has no room 66 for. Settings points at the profile page too — account settings live there 67 and there is no separate settings page. A <details> menu needs no client 68 script, so it works before the SPA enhancement loads. The Sign-out form is 69 nested inside and keeps its CSRF token. *) 70 let profile_area = 71 match (viewer, request) with 72 | Some (viewer : View_model.Viewer.t), Some request -> 73 let menu_link page path label = 74 let attrs = [ class_ "profile-menu-item"; href path ] in 75 let attrs = Dream_html.string_attr "role" "menuitem" :: attrs in 76 let attrs = 77 if spa_client then Dream_html.attr "data-hito-app-link" :: attrs 78 else attrs 79 in 80 let attrs = 81 if String.equal page active then 82 Dream_html.string_attr "aria-current" "page" :: attrs 83 else attrs 84 in 85 tag "a" attrs [ txt "%s" label ] 86 in 87 let summary_attrs = 88 if String.equal "profile" active || String.equal "settings" active 89 then 90 [ class_ "profile"; Dream_html.string_attr "aria-current" "page" ] 91 else [ class_ "profile" ] 92 in 93 [ 94 tag "details" 95 [ class_ "profile-menu" ] 96 [ 97 tag "summary" summary_attrs 98 [ txt "%s" viewer.View_model.Viewer.username ]; 99 tag "div" 100 [ 101 class_ "profile-menu-drawer"; 102 Dream_html.string_attr "role" "menu"; 103 Dream_html.string_attr "aria-label" "Profile menu"; 104 ] 105 [ 106 menu_link "profile" Routes.profile "Profile"; 107 menu_link "settings" Routes.settings "Settings"; 108 menu_link "app-feedback" Routes.app_feedback "Feedback"; 109 tag "form" 110 [ 111 action Routes.logout; 112 post_form; 113 class_ "logout"; 114 Dream_html.attr "data-hito-app-form"; 115 ] 116 [ 117 Dream_html.csrf_tag request; 118 void "input" 119 [ 120 type_ "submit"; 121 class_ "profile-menu-item"; 122 Dream_html.string_attr "role" "menuitem"; 123 value "Sign out"; 124 ]; 125 ]; 126 ]; 127 ]; 128 ] 129 | _ -> [] 130 in 131 let account_area = [] in 132 let primary_nav = 133 match (viewer, request) with 134 | Some (_ : View_model.Viewer.t), Some _ -> 135 [ tag "nav" [ class_ "primary-nav" ] (navigation_links ()) ] 136 | _ when show_nav -> 137 [ tag "nav" [ class_ "primary-nav" ] (navigation_links ()) ] 138 | _ -> [] 139 in 140 let bottom_nav = 141 match (viewer, request) with 142 | Some (_ : View_model.Viewer.t), Some _ -> 143 [ 144 tag "nav" 145 [ 146 class_ "bottom-nav"; 147 Dream_html.string_attr "aria-label" "Mobile navigation"; 148 ] 149 (navigation_links ()); 150 ] 151 | _ when show_nav -> 152 [ 153 tag "nav" 154 [ 155 class_ "bottom-nav"; 156 Dream_html.string_attr "aria-label" "Mobile navigation"; 157 ] 158 (navigation_links ()); 159 ] 160 | _ -> [] 161 in 162 let flash_notice = 163 match request with 164 | Some request -> ( 165 match Dream.session_field request flash_key with 166 | Some message -> 167 [ 168 tag "div" 169 [ 170 class_ "toast"; 171 Dream_html.attr "data-hito-toast"; 172 Dream_html.string_attr "role" "status"; 173 Dream_html.string_attr "aria-live" "polite"; 174 ] 175 [ txt "%s" message ]; 176 ] 177 | None -> []) 178 | None -> [] 179 in 180 tag "html" 181 [ 182 Dream_html.string_attr "lang" "en"; 183 Dream_html.string_attr "data-theme" "%s" theme; 184 ] 185 [ 186 tag "head" [] 187 [ 188 tag "title" [] [ txt "Hito — %s" title ]; 189 void "meta" [ Dream_html.string_attr "charset" "utf-8" ]; 190 void "meta" 191 [ 192 Dream_html.string_attr "name" "viewport"; 193 Dream_html.string_attr "content" 194 "width=device-width,initial-scale=1"; 195 ]; 196 void "link" [ rel "stylesheet"; href Routes.stylesheet ]; 197 ]; 198 tag "body" 199 [ Dream_html.string_attr "class" "hito-app" ] 200 (flash_notice 201 @ [ 202 tag "a" 203 [ 204 class_ "skip-link"; 205 Dream_html.string_attr "href" "#main-content"; 206 ] 207 [ txt "Skip to main content" ]; 208 tag "div" 209 ([ 210 Dream_html.string_attr "class" "app-shell page-%s" active; 211 Dream_html.string_attr "data-hito-page-title" "Hito — %s" title; 212 ] 213 @ 214 if spa_client then [ Dream_html.attr "data-hito-app-shell" ] 215 else []) 216 ([ 217 tag "header" 218 [ class_ "masthead" ] 219 ([ 220 tag "a" 221 ([ class_ "brand"; href Routes.home ] 222 @ 223 if spa_client then 224 [ Dream_html.attr "data-hito-app-link" ] 225 else []) 226 [ txt "hito" ]; 227 ] 228 @ primary_nav @ profile_area @ account_area); 229 tag "main" 230 [ id "main-content"; tabindex "-1" ] 231 [ 232 tag "div" 233 ([ class_ "page-surface" ] 234 @ 235 if spa_client then 236 [ Dream_html.attr "data-hito-app-content" ] 237 else []) 238 content; 239 ]; 240 ] 241 @ bottom_nav); 242 ] 243 @ 244 if spa_client then 245 [ 246 tag "script" 247 [ src Routes.workout_client; Dream_html.attr "defer" ] 248 []; 249 ] 250 else []); 251 ] 252 253 let problem ~title ~detail = 254 html_page title 255 [ 256 tag "p" [ class_ "eyebrow" ] [ txt "Attention required" ]; 257 tag "h1" [] [ txt "%s" title ]; 258 tag "p" [ class_ "warn" ] [ txt "%s" detail ]; 259 ] 260 261 (* A branded error page for the common HTTP failures. It states only the class 262 of failure, never a server-supplied string, so nothing internal leaks. The 263 navigation stays present — top on desktop, bottom on mobile — so a lost 264 visitor is one tap from a known destination. *) 265 let error_page ?viewer ?request ~status () = 266 let title, detail = 267 match status with 268 | 404 -> 269 ("Page not found", "That page does not exist. Use the navigation below.") 270 | 400 -> ("Bad request", "That request could not be understood.") 271 | 403 -> ("Forbidden", "You do not have access to that page.") 272 | s when s >= 500 -> 273 ("Something went wrong", "The server hit a problem. Try again shortly.") 274 | _ -> ("Something went wrong", "That request could not be completed.") 275 in 276 html_page ?viewer ?request ~show_nav:true title 277 [ 278 tag "p" [ class_ "eyebrow" ] [ txt "%d" status ]; 279 tag "h1" [] [ txt "%s" title ]; 280 tag "p" [ class_ "warn" ] [ txt "%s" detail ]; 281 ] 282 283 (* --- authentication --- *) 284 285 let auth_error = function 286 | None -> [] 287 | Some message -> 288 [ 289 tag "p" 290 [ class_ "warn"; Dream_html.string_attr "role" "alert" ] 291 [ txt "%s" message ]; 292 ] 293 294 let credentials_form request ~submit ~action_path = 295 tag "form" 296 [ action action_path; post_form; Dream_html.attr "data-hito-app-form" ] 297 [ 298 Dream_html.csrf_tag request; 299 tag "div" 300 [ class_ "field" ] 301 [ 302 tag "label" 303 [ Dream_html.string_attr "for" "username" ] 304 [ txt "Username" ]; 305 void "input" 306 [ 307 type_ "text"; 308 name "username"; 309 Dream_html.string_attr "id" "username"; 310 Dream_html.string_attr "autocomplete" "username"; 311 required; 312 ]; 313 ]; 314 tag "div" 315 [ class_ "field" ] 316 [ 317 tag "label" 318 [ Dream_html.string_attr "for" "password" ] 319 [ txt "Password" ]; 320 void "input" 321 [ 322 type_ "password"; 323 name "password"; 324 Dream_html.string_attr "id" "password"; 325 Dream_html.string_attr "autocomplete" "current-password"; 326 required; 327 ]; 328 ]; 329 void "input" [ type_ "submit"; value submit ]; 330 ] 331 332 let login request ?error ?(registration_open = false) () = 333 let register_prompt = 334 if registration_open then 335 [ 336 tag "p" [] 337 [ 338 txt "No account yet? "; 339 tag "a" 340 [ href Routes.register; Dream_html.attr "data-hito-app-link" ] 341 [ txt "Register" ]; 342 ]; 343 ] 344 else [] 345 in 346 html_page ~active:"auth" "Sign in" 347 ([ 348 tag "h1" [] [ txt "Sign in" ]; 349 credentials_form request ~submit:"Sign in" ~action_path:Routes.login; 350 ] 351 @ register_prompt @ auth_error error) 352 353 let register request ?error () = 354 html_page ~active:"auth" "Register" 355 ([ 356 tag "h1" [] [ txt "Create an account" ]; 357 credentials_form request ~submit:"Register" ~action_path:Routes.register; 358 tag "p" [] 359 [ 360 txt "Already registered? "; 361 tag "a" 362 [ href Routes.login; Dream_html.attr "data-hito-app-link" ] 363 [ txt "Sign in" ]; 364 ]; 365 ] 366 @ auth_error error) 367 368 (* --- application pages --- *) 369 370 let error_id input_id = input_id ^ "-error" 371 372 let extension_select ?(selected = "") ?(invalid = false) ~input_id () = 373 let error_attrs = 374 if invalid then 375 [ 376 Dream_html.string_attr "aria-invalid" "true"; 377 Dream_html.string_attr "aria-describedby" "%s" (error_id input_id); 378 ] 379 else [] 380 in 381 let option (code : string) label = 382 let attrs = [ Dream_html.string_attr "value" "%s" code ] in 383 let attrs = 384 if String.equal code selected then Dream_html.attr "selected" :: attrs 385 else attrs 386 in 387 tag "option" attrs [ txt "%s" label ] 388 in 389 tag "select" 390 ([ name "extension"; Dream_html.string_attr "id" "%s" input_id ] 391 @ error_attrs) 392 [ 393 option "" "to positive failure"; 394 option "forced" "then forced reps"; 395 option "negatives" "then negatives"; 396 option "rest-pause" "then rest-pause"; 397 option "static" "then a static hold"; 398 ] 399 400 let choose_routine request ~logging ~viewer 401 ~(routines : View_model.Routine_choice.t list) = 402 html_page ~viewer ~request ~active:"home" ~logging "Choose a routine" 403 [ 404 tag "h1" [] [ txt "Routines" ]; 405 tag "div" [] 406 (List.map 407 (fun (choice : View_model.Routine_choice.t) -> 408 tag "form" 409 [ 410 action Routes.select_routine choice.id; 411 post_form; 412 Dream_html.attr "data-hito-app-form"; 413 ] 414 [ 415 Dream_html.csrf_tag request; 416 tag "fieldset" [] 417 [ 418 tag "legend" [] [ txt "%s" choice.name ]; 419 tag "p" [] 420 [ txt "%d workouts in the cycle." choice.workout_count ]; 421 void "input" [ type_ "submit"; value "Use this routine" ]; 422 ]; 423 ]) 424 routines); 425 ] 426 427 let begin_form request ~routine_id ~override label = 428 tag "form" 429 [ action Routes.workout; post_form; Dream_html.attr "data-hito-app-form" ] 430 [ 431 Dream_html.csrf_tag request; 432 void "input" 433 [ 434 type_ "hidden"; 435 name "routine"; 436 Dream_html.string_attr "value" "%s" routine_id; 437 ]; 438 void "input" 439 [ 440 type_ "hidden"; 441 name "override"; 442 Dream_html.string_attr "value" "%s" (string_of_bool override); 443 ]; 444 void "input" [ type_ "submit"; value label ]; 445 ] 446 447 (* Beginning under override needs an explicit acknowledgement, so its submit is 448 gated behind a confirmation modal. Without script the form submits at once — 449 the doctrine's deviation stays possible. The modal only makes it deliberate. 450 The client reuses the shared confirm machinery: [data-hito-confirm-cancel] 451 opens the dialog, [data-hito-confirm-form] is the form its accept submits. *) 452 let override_begin request ~routine_id = 453 [ 454 tag "form" 455 [ 456 action Routes.workout; 457 post_form; 458 Dream_html.attr "data-hito-app-form"; 459 Dream_html.attr "data-hito-confirm-form"; 460 ] 461 [ 462 Dream_html.csrf_tag request; 463 void "input" 464 [ 465 type_ "hidden"; 466 name "routine"; 467 Dream_html.string_attr "value" "%s" routine_id; 468 ]; 469 void "input" 470 [ 471 type_ "hidden"; 472 name "override"; 473 Dream_html.string_attr "value" "true"; 474 ]; 475 void "input" 476 [ 477 type_ "submit"; 478 value "Begin under override"; 479 Dream_html.attr "data-hito-confirm-cancel"; 480 ]; 481 ]; 482 tag "dialog" 483 [ class_ "confirm-dialog"; Dream_html.attr "data-hito-confirm-modal" ] 484 [ 485 tag "h2" [] [ txt "Begin before recovery is complete?" ]; 486 tag "p" [] 487 [ 488 txt 489 "Heavy Duty grows muscle during recovery, not in the gym. \ 490 Training early can cut into it. This is recorded as an \ 491 override."; 492 ]; 493 tag "div" 494 [ class_ "button-group" ] 495 [ 496 tag "button" 497 [ 498 type_ "button"; 499 class_ "secondary"; 500 Dream_html.attr "data-hito-confirm-dismiss"; 501 ] 502 [ txt "Wait to recover" ]; 503 tag "button" 504 [ type_ "button"; Dream_html.attr "data-hito-confirm-accept" ] 505 [ txt "Begin under override" ]; 506 ]; 507 ]; 508 ] 509 510 let home request ~viewer ~home:(vm : View_model.Home.t) = 511 let status, gate = 512 match vm.gate with 513 | View_model.Home.Ready -> 514 ( "Recovery is complete.", 515 [ 516 begin_form request ~routine_id:vm.routine_id ~override:false 517 "Begin next workout"; 518 ] ) 519 | View_model.Home.Recovering { status } -> 520 ( status, 521 [ 522 tag "div" 523 [ class_ "warn" ] 524 ([ 525 tag "p" [] 526 [ 527 txt "Heavy Duty requires recovery before the next workout."; 528 ]; 529 ] 530 @ override_begin request ~routine_id:vm.routine_id); 531 ] ) 532 in 533 html_page ~viewer ~request ~active:"home" "Home" 534 ([ 535 tag "h1" [] [ txt "%s" vm.routine_name ]; 536 tag "p" [ class_ "ledger-meta" ] [ txt "Next: %s" vm.next_workout ]; 537 tag "p" [ class_ "ledger-meta" ] [ txt "%s" status ]; 538 ] 539 @ gate) 540 541 (* Home while a workout is in progress. Rather than the recovery gate or the 542 routine chooser, Home shows a single card: the workout is under way and one 543 tap returns to it. The middle navigation action already reads "Current 544 workout" here, and this card is the matching Home affordance. *) 545 let workout_in_progress request ~viewer ~workout_name = 546 html_page ~viewer ~request ~active:"home" ~logging:true "Home" 547 [ 548 tag "a" 549 [ 550 class_ "in-progress-card"; 551 href Routes.workout; 552 Dream_html.attr "data-hito-app-link"; 553 ] 554 [ 555 tag "p" [ class_ "eyebrow" ] [ txt "Workout in progress" ]; 556 tag "h1" [] [ txt "%s" workout_name ]; 557 tag "p" [] [ txt "Return to the current workout to keep logging." ]; 558 ]; 559 ] 560 561 let routine request ?(logging = false) ~viewer (vm : View_model.Routine.t) = 562 html_page ~viewer ~request ~active:"routine" ~logging "Routine" 563 [ 564 tag "h1" [] [ txt "%s" vm.name ]; 565 tag "div" 566 [ class_ "routine-accordions" ] 567 (List.map 568 (fun (workout : View_model.Routine.workout) -> 569 tag "details" 570 [ class_ "routine-accordion" ] 571 [ 572 tag "summary" [] [ txt "%s" workout.name ]; 573 tag "div" 574 [ class_ "routine-description" ] 575 [ 576 tag "ul" [] 577 (List.map 578 (fun (exercise : View_model.Routine.exercise) -> 579 tag "li" [] 580 [ 581 tag "span" 582 [ class_ "routine-exercise" ] 583 [ txt "%s" exercise.name ]; 584 tag "span" 585 [ class_ "routine-reps" ] 586 [ txt "%s" exercise.reps ]; 587 ]) 588 workout.exercises); 589 ]; 590 ]) 591 vm.workouts); 592 ] 593 594 let error_for ~input_id (field : string) (errors : (string * string) list) = 595 match List.assoc_opt field errors with 596 | None -> [] 597 | Some error -> 598 [ 599 tag "p" 600 [ 601 Dream_html.string_attr "id" "%s" (error_id input_id); 602 class_ "warn"; 603 Dream_html.string_attr "role" "alert"; 604 ] 605 [ txt "%s" (Decode.errors_to_text [ (field, error) ]) ]; 606 ] 607 608 let input_row ?value:v ?(invalid = false) ?placeholder ?(hide_label = false) 609 ~input_id (field : string) label = 610 let error_attrs = 611 if invalid then 612 [ 613 Dream_html.string_attr "aria-invalid" "true"; 614 Dream_html.string_attr "aria-describedby" "%s" (error_id input_id); 615 ] 616 else [] 617 in 618 let placeholder_attr = 619 match placeholder with 620 | None -> [] 621 | Some p -> [ Dream_html.string_attr "placeholder" "%s" p ] 622 in 623 tag "div" 624 [ class_ "field" ] 625 [ 626 tag "label" 627 [ 628 Dream_html.string_attr "for" "%s" input_id; 629 class_ (if hide_label then "sr-only" else ""); 630 ] 631 [ txt "%s" label ]; 632 void "input" 633 ([ 634 type_ "number"; 635 Dream_html.string_attr "name" "%s" field; 636 Dream_html.string_attr "id" "%s" input_id; 637 step "0.5"; 638 required; 639 ] 640 @ placeholder_attr @ error_attrs 641 @ 642 match v with 643 | None -> [] 644 | Some v -> [ Dream_html.string_attr "value" "%s" v ]); 645 ] 646 647 (* A movement's fields as cells of the fieldset grid: the exercise name, the 648 load input, and the reps input. The cells are direct participants of the one 649 [.logging-grid] the fieldset wraps them in — a [display: contents] wrapper 650 groups a movement without opening a nested grid — so every movement's name, 651 load, and reps columns line up across the whole fieldset. The name reads as a 652 heading, the inputs as labelled fields. *) 653 let movement_row ~(errors : (string * string) list) ~name ~load_id ~load_field 654 ~reps_id ~reps_field ?load_value ?reps_value ~reps_label 655 ?(hide_labels = false) () = 656 tag "div" 657 [ class_ "movement" ] 658 [ 659 tag "p" [ class_ "exercise-name" ] [ txt "%s" name ]; 660 input_row ?value:load_value ~placeholder:"kg" ~hide_label:hide_labels 661 ~invalid:(List.mem_assoc load_field errors) 662 ~input_id:load_id load_field "Load (kg)"; 663 input_row ?value:reps_value ~placeholder:"reps" ~hide_label:hide_labels 664 ~invalid:(List.mem_assoc reps_field errors) 665 ~input_id:reps_id reps_field reps_label; 666 ] 667 668 (* A shared heading row for a multi-exercise group: empty name cell, then the 669 Load and Reps column headings. Rendered once as cells of the fieldset grid so 670 the labels are not repeated above every input. *) 671 let exercise_fields_head ~reps_label () = 672 tag "div" 673 [ class_ "movement movement-head" ] 674 [ 675 tag "span" [ class_ "exercise-name" ] [ txt "" ]; 676 tag "span" [ class_ "col-heading" ] [ txt "Load (kg)" ]; 677 tag "span" [ class_ "col-heading" ] [ txt "%s" reps_label ]; 678 ] 679 680 (* [movements] carries the record/correction field spec the controller built 681 from the slot's prescription: one row for a single exercise, two for a 682 pre-exhaust pair, each already pre-filled when correcting. [submit] names the 683 action. Load and reps of each movement are laid out side by side. *) 684 let form_for_stimulus request ~action_path ~slot 685 ~(movements : View_model.Workout.movement list) ~selected_extension 686 ?(enhanced = false) ?(submit = "Record") ~(errors : (string * string) list) 687 () = 688 let field_id field = Printf.sprintf "slot-%d-%s" slot field in 689 let selected = selected_extension in 690 (* A single-exercise slot shows one row with a visible "Reps to failure" 691 label. A pre-exhaust pair shows a shared column heading and hides the 692 per-row labels. *) 693 let hide_labels = List.length movements > 1 in 694 let head = 695 match movements with 696 | first :: _ :: _ -> 697 [ 698 exercise_fields_head ~reps_label:first.View_model.Workout.reps_label 699 (); 700 ] 701 | _ -> [] 702 in 703 let movement_of (m : View_model.Workout.movement) = 704 movement_row ~errors ~name:m.name ~load_id:(field_id m.load_field) 705 ~load_field:m.load_field ~reps_id:(field_id m.reps_field) 706 ~reps_field:m.reps_field ?load_value:m.load_value ?reps_value:m.reps_value 707 ~reps_label:m.reps_label ~hide_labels () 708 in 709 let fields = head @ List.map movement_of movements in 710 (* The error rows follow the fields present, so a single-exercise slot reports 711 load/reps and a pre-exhaust slot reports the iso/comp fields. *) 712 let field_names = 713 List.concat_map 714 (fun (m : View_model.Workout.movement) -> [ m.load_field; m.reps_field ]) 715 movements 716 @ [ "extension" ] 717 in 718 tag "form" 719 ([ action_path; post_form ] 720 @ 721 if enhanced then [ Dream_html.attr "data-hito-workout-form" ] 722 else [ Dream_html.attr "data-hito-app-form" ]) 723 [ 724 Dream_html.csrf_tag request; 725 tag "fieldset" 726 [ class_ "logging-fieldset" ] 727 (tag "div" 728 [ class_ "logging-grid" ] 729 (fields 730 @ [ 731 tag "div" 732 [ class_ "field field-ending" ] 733 [ 734 tag "label" 735 [ 736 Dream_html.string_attr "for" "%s" (field_id "extension"); 737 ] 738 [ txt "Ending" ]; 739 extension_select ~selected 740 ~invalid:(List.mem_assoc "extension" errors) 741 ~input_id:(field_id "extension") (); 742 ]; 743 ]) 744 :: List.concat_map 745 (fun field -> error_for ~input_id:(field_id field) field errors) 746 field_names 747 @ [ 748 void "input" 749 [ type_ "submit"; Dream_html.string_attr "value" "%s" submit ]; 750 ]); 751 ] 752 753 let workout request ~viewer ?(errors = []) ?editing ?logging ~record_id 754 ~active_slot (vm : View_model.Workout.t) = 755 let enhanced = Option.is_none record_id in 756 (* A live workout view is itself the workout in progress, so the middle nav 757 action reads "Current workout". A saved-record view defers to the handler, 758 which knows whether a separate workout is in progress. *) 759 let logging = Option.value logging ~default:enhanced in 760 let slot_count = List.length vm.slots in 761 let filled_slots = 762 List.length 763 (List.filter 764 (fun (s : View_model.Workout.slot) -> 765 Option.is_some s.recorded_summary) 766 vm.slots) 767 in 768 let record_action slot = 769 match record_id with 770 | None -> action Routes.workout_slot slot 771 | Some record_id -> action Routes.record_slot record_id slot 772 in 773 let edit_action slot = 774 match record_id with 775 | None -> action Routes.workout_slot_edit slot 776 | Some record_id -> action Routes.record_slot_edit record_id slot 777 in 778 (* The early-workout notice. The override was already confirmed in a modal, so 779 on the workout screen this is informational only: a toast rather than a 780 component in the main content. It is a polite live region. The client shows 781 it briefly then dismisses it. Without script it stays visible as a quiet 782 fixed notice, so a no-JS visitor is still told. *) 783 let override_note = 784 if vm.overridden then 785 [ 786 tag "div" 787 [ 788 class_ "toast"; 789 Dream_html.attr "data-hito-toast"; 790 Dream_html.string_attr "role" "status"; 791 Dream_html.string_attr "aria-live" "polite"; 792 ] 793 [ txt "Begun before recovery finished." ]; 794 ] 795 else [] 796 in 797 (* The exercise selector: a dropdown naming every prescription slot. Choosing 798 an option opens that exercise below. The selector is a GET form so it works 799 without script — submitting navigates to the slot via a [?slot=] query, the 800 same contract the panel already reads. The client enhances it: it navigates 801 the moment the selection changes, so the submit button is a no-JS fallback. 802 A recorded slot is marked done in its label. *) 803 let select_action_base = 804 match record_id with None -> "/workout" | Some id -> "/logbook/" ^ id 805 in 806 let exercise_group = 807 let option_for (slot : View_model.Workout.slot) = 808 let done_ = Option.is_some slot.recorded_summary in 809 let label = 810 if done_ then Printf.sprintf "%d. %s (done)" (slot.index + 1) slot.label 811 else Printf.sprintf "%d. %s" (slot.index + 1) slot.label 812 in 813 let attrs = [ Dream_html.string_attr "value" "%d" slot.index ] in 814 let attrs = 815 if slot.index = active_slot then Dream_html.attr "selected" :: attrs 816 else attrs 817 in 818 tag "option" attrs [ txt "%s" label ] 819 in 820 let form_attrs = 821 [ 822 Dream_html.string_attr "method" "get"; 823 Dream_html.string_attr "action" "%s" select_action_base; 824 class_ "exercise-select"; 825 ] 826 in 827 let form_attrs = 828 if enhanced then Dream_html.attr "data-hito-exercise-form" :: form_attrs 829 else form_attrs 830 in 831 tag "form" form_attrs 832 [ 833 tag "label" 834 [ Dream_html.string_attr "for" "exercise-choice"; class_ "sr-only" ] 835 [ txt "Exercise" ]; 836 tag "select" 837 [ 838 name "slot"; 839 id "exercise-choice"; 840 Dream_html.attr "data-hito-exercise-select"; 841 ] 842 (List.map option_for vm.slots); 843 void "input" 844 [ 845 type_ "submit"; class_ "secondary exercise-select-go"; value "Open"; 846 ]; 847 ] 848 in 849 (* The panel for the active slot. It shows one exercise at a time: a recorded 850 slot renders its read-only summary and a pre-filled correction form (which 851 replaces the slot rather than adding volume). An outstanding slot renders 852 the record form. *) 853 let active_panel = 854 match List.nth_opt vm.slots active_slot with 855 | None -> 856 [ 857 tag "p" 858 [ class_ "warn" ] 859 [ txt "That exercise is not part of this workout." ]; 860 ] 861 | Some (slot : View_model.Workout.slot) -> 862 let errors = if editing = Some active_slot then errors else [] in 863 let heading = tag "h2" [] [ txt "%s" slot.label ] in 864 let body = 865 match slot.recorded_summary with 866 | Some summary -> 867 [ 868 tag "p" [ class_ "eyebrow" ] [ txt "Recorded" ]; 869 tag "p" [ class_ "done" ] [ txt "%s" summary ]; 870 form_for_stimulus request ~action_path:(edit_action active_slot) 871 ~slot:active_slot ~movements:slot.movements 872 ~selected_extension:slot.selected_extension ~enhanced 873 ~submit:"Save correction" ~errors (); 874 ] 875 | None -> 876 [ 877 form_for_stimulus request 878 ~action_path:(record_action active_slot) 879 ~slot:active_slot ~movements:slot.movements 880 ~selected_extension:slot.selected_extension ~enhanced ~errors 881 (); 882 ] 883 in 884 [ tag "section" [ class_ "slot-panel" ] (heading :: body) ] 885 in 886 let complete_note = 887 if vm.all_recorded then 888 [ 889 tag "p" 890 [ class_ "done" ] 891 [ txt "Everything prescribed has been recorded." ]; 892 ] 893 else [] 894 in 895 (* A sticky timer bar for the workout in progress. It carries the workout's 896 start time as an epoch, and the client ticks the elapsed time from it. 897 Reading the true start on every render means an SPA content swap never 898 resets the count. Only the live workout shows it. *) 899 let timer_bar = 900 if enhanced then 901 let started = vm.started_at_unix in 902 [ 903 tag "div" 904 [ 905 class_ "workout-timer"; 906 Dream_html.attr "data-hito-workout-timer"; 907 Dream_html.string_attr "data-started" "%d" started; 908 ] 909 [ 910 tag "span" [ class_ "workout-timer-label" ] [ txt "Elapsed" ]; 911 tag "span" 912 [ 913 class_ "workout-timer-value"; 914 Dream_html.string_attr "aria-live" "off"; 915 Dream_html.attr "data-hito-workout-timer-value"; 916 ] 917 [ txt "0:00" ]; 918 ]; 919 ] 920 else [] 921 in 922 let finish_section = 923 match record_id with 924 | Some _ -> [] 925 | None -> 926 [ 927 tag "div" 928 [ class_ "button-group" ] 929 [ 930 tag "form" 931 [ 932 action Routes.finish_workout; 933 post_form; 934 Dream_html.attr "data-hito-app-form"; 935 ] 936 [ 937 Dream_html.csrf_tag request; 938 void "input" [ type_ "submit"; value "Finish workout" ]; 939 ]; 940 (* Cancel is a native POST form. Without script, it submits 941 immediately. The client only opens the confirm dialog. Its 942 acceptance submits this form as a full document navigation so 943 the cancelled workout cannot leave a stale app shell behind. *) 944 tag "form" 945 [ 946 action Routes.cancel_workout; 947 post_form; 948 Dream_html.attr "data-hito-confirm-form"; 949 Dream_html.attr "data-hito-cancel-form"; 950 ] 951 [ 952 Dream_html.csrf_tag request; 953 void "input" 954 [ 955 type_ "submit"; 956 class_ "secondary"; 957 value "Cancel logging"; 958 Dream_html.attr "data-hito-confirm-cancel"; 959 ]; 960 ]; 961 ]; 962 (* The confirmation modal. Native dialog for built-in focus trapping 963 and Escape-to-close. The client opens it. "Cancel workout" submits 964 the cancel form, "Keep logging" closes it. *) 965 tag "dialog" 966 [ 967 class_ "confirm-dialog"; Dream_html.attr "data-hito-confirm-modal"; 968 ] 969 [ 970 tag "h2" [] [ txt "Cancel this workout?" ]; 971 tag "p" [] 972 [ 973 txt 974 "The workout is discarded and leaves no record, then you \ 975 return Home."; 976 ]; 977 tag "div" 978 [ class_ "button-group" ] 979 [ 980 tag "button" 981 [ 982 type_ "button"; 983 class_ "secondary"; 984 Dream_html.attr "data-hito-confirm-dismiss"; 985 ] 986 [ txt "Keep logging" ]; 987 tag "button" 988 [ 989 type_ "button"; Dream_html.attr "data-hito-confirm-accept"; 990 ] 991 [ txt "Cancel workout" ]; 992 ]; 993 ]; 994 ] 995 in 996 html_page ~viewer ~request ~active:"workout" ~logging vm.name 997 [ 998 tag "div" 999 (if enhanced then 1000 [ 1001 Dream_html.attr "data-hito-workout"; 1002 Dream_html.attr "data-hito-workout-content"; 1003 ] 1004 else []) 1005 (timer_bar @ override_note 1006 @ [ 1007 tag "h1" [] [ txt "%s" vm.name ]; 1008 tag "p" 1009 [ class_ "ledger-meta" ] 1010 [ txt "%d of %d recorded." filled_slots slot_count ]; 1011 exercise_group; 1012 ] 1013 @ active_panel @ complete_note @ finish_section 1014 @ 1015 if enhanced then 1016 [ 1017 tag "p" 1018 [ 1019 Dream_html.string_attr "aria-live" "polite"; 1020 Dream_html.attr "data-hito-workout-status"; 1021 ] 1022 []; 1023 ] 1024 else []); 1025 ] 1026 1027 (* The subjective feedback form. Radio groups report sleep, appetite, 1028 readiness, motivation, and difficulty against a personal baseline. Flags 1029 report pain, injury, and insufficient preparation. A field left blank reports 1030 nothing, so the trainee submits only what they mean to. Feedback is 1031 standalone — recorded from the Logbook at any time. *) 1032 type feedback_flow = { step : int; answers : (string * string) list } 1033 1034 let feedback_factors = 1035 [ 1036 ("sleep", "Sleep"); 1037 ("appetite", "Appetite"); 1038 ("readiness", "Readiness"); 1039 ("motivation", "Motivation"); 1040 ("difficulty", "Perceived difficulty"); 1041 ] 1042 1043 (* Each subjective metric uses five unselected radio buttons styled as inline 1044 buttons. The server shows one metric at a time. *) 1045 let feedback_level_buttons field label ~selected = 1046 let choice code text = 1047 tag "label" 1048 [ class_ "feedback-choice"; Dream_html.attr "data-hito-feedback-choice" ] 1049 [ 1050 void "input" 1051 ([ 1052 type_ "radio"; 1053 Dream_html.string_attr "name" "choice"; 1054 Dream_html.string_attr "value" "%s" code; 1055 Dream_html.string_attr "id" "%s-%s" field code; 1056 ] 1057 @ 1058 if String.equal code selected then [ Dream_html.attr "checked" ] 1059 else []); 1060 tag "span" [] [ txt "%s" text ]; 1061 ] 1062 in 1063 tag "div" 1064 [ class_ "feedback-group" ] 1065 [ 1066 tag "p" [ class_ "feedback-group-label" ] [ txt "%s" label ]; 1067 tag "div" 1068 [ 1069 class_ "feedback-buttons"; 1070 Dream_html.string_attr "role" "group"; 1071 Dream_html.string_attr "aria-label" "%s" label; 1072 ] 1073 [ 1074 choice "1" "1 — very poor"; 1075 choice "2" "2"; 1076 choice "3" "3"; 1077 choice "4" "4"; 1078 choice "5" "5 — very good"; 1079 ]; 1080 ] 1081 1082 let feedback_flag field label = 1083 tag "label" 1084 [ class_ "feedback-flag" ] 1085 [ 1086 void "input" 1087 [ 1088 type_ "checkbox"; 1089 Dream_html.string_attr "name" "%s" field; 1090 value "true"; 1091 ]; 1092 txt " %s" label; 1093 ] 1094 1095 let feedback_progress step = 1096 let completed = min 5 (max 0 step) in 1097 tag "div" 1098 [ class_ "feedback-progress" ] 1099 [ 1100 tag "progress" 1101 [ 1102 Dream_html.string_attr "value" "%s" (string_of_int completed); 1103 Dream_html.string_attr "max" "5"; 1104 Dream_html.string_attr "aria-label" "Feedback progress"; 1105 ] 1106 [ txt "%d of 5 factors" completed ]; 1107 tag "p" [ class_ "ledger-meta" ] [ txt "%d of 5 factors" completed ]; 1108 ] 1109 1110 let feedback_action_button ~action ~label ?(secondary = false) () = 1111 tag "button" 1112 ([ 1113 type_ "submit"; 1114 name "action"; 1115 value action; 1116 Dream_html.attr "data-hito-feedback-action"; 1117 ] 1118 @ if secondary then [ class_ "secondary" ] else []) 1119 [ txt "%s" label ] 1120 1121 let feedback_flow_form request flow = 1122 let step = min 5 (max 0 flow.step) in 1123 let fields = 1124 [ 1125 void "input" 1126 [ 1127 type_ "hidden"; 1128 name "step"; 1129 Dream_html.string_attr "value" "%s" (string_of_int step); 1130 ]; 1131 void "input" 1132 [ 1133 type_ "hidden"; 1134 name "action"; 1135 Dream_html.string_attr "value" ""; 1136 Dream_html.attr "data-hito-feedback-action-value"; 1137 ]; 1138 Dream_html.csrf_tag request; 1139 ] 1140 in 1141 let body = 1142 if step < 5 then 1143 let field, label = List.nth feedback_factors step in 1144 fields 1145 @ [ 1146 tag "h3" [] [ txt "%s" label ]; 1147 feedback_level_buttons field label 1148 ~selected: 1149 (Option.value (List.assoc_opt field flow.answers) ~default:""); 1150 feedback_progress (step + 1); 1151 tag "div" 1152 [ class_ "feedback-actions" ] 1153 ((if step > 0 then 1154 let _, previous_label = List.nth feedback_factors (step - 1) in 1155 [ 1156 feedback_action_button ~action:"back" 1157 ~label:(Printf.sprintf "Back to %s" previous_label) 1158 ~secondary:true (); 1159 ] 1160 else []) 1161 @ [ 1162 feedback_action_button ~action:"skip" ~label:"Skip this factor" 1163 ~secondary:true (); 1164 ]); 1165 ] 1166 else 1167 fields 1168 @ [ 1169 tag "h3" [] [ txt "Anything else?" ]; 1170 tag "p" [] 1171 [ txt "Add an optional note about pain, injury, or preparation." ]; 1172 tag "div" 1173 [ class_ "field" ] 1174 [ 1175 feedback_flag "pain" "Pain"; 1176 feedback_flag "injury" "Injury"; 1177 feedback_flag "preparation" "Preparation was insufficient"; 1178 ]; 1179 feedback_progress 5; 1180 tag "div" 1181 [ class_ "feedback-actions" ] 1182 [ 1183 feedback_action_button ~action:"back" 1184 ~label:"Back to Perceived difficulty" ~secondary:true (); 1185 feedback_action_button ~action:"save" ~label:"Submit feedback" (); 1186 ]; 1187 ] 1188 in 1189 tag "form" 1190 [ 1191 action Routes.feedback; 1192 post_form; 1193 class_ "feedback-form"; 1194 Dream_html.attr "data-hito-feedback-form"; 1195 Dream_html.attr "data-hito-app-form"; 1196 ] 1197 [ tag "fieldset" [] body ] 1198 1199 let feedback_modal request ~flow ~open_ = 1200 tag "dialog" 1201 ([ class_ "feedback-modal"; Dream_html.attr "data-hito-feedback-modal" ] 1202 @ if open_ then [ Dream_html.attr "open" ] else []) 1203 [ 1204 tag "div" 1205 [ class_ "feedback-modal-content" ] 1206 [ 1207 tag "div" 1208 [ class_ "feedback-modal-heading" ] 1209 [ 1210 tag "h2" [] [ txt "How are you feeling?" ]; 1211 (* Close cancels the flow: it submits the cancel form, so the 1212 partial progress is discarded rather than kept for later. *) 1213 tag "form" 1214 [ 1215 action Routes.cancel_feedback; 1216 post_form; 1217 class_ "feedback-close-form"; 1218 Dream_html.attr "data-hito-app-form"; 1219 ] 1220 [ 1221 Dream_html.csrf_tag request; 1222 tag "button" 1223 [ 1224 type_ "submit"; 1225 class_ "feedback-modal-close"; 1226 Dream_html.string_attr "aria-label" "Close feedback"; 1227 ] 1228 [ txt "×" ]; 1229 ]; 1230 ]; 1231 feedback_flow_form request flow; 1232 ]; 1233 ] 1234 1235 (* A small inline-SVG line chart of leveled feedback over time, one polyline per 1236 factor. No script and no dependency: the logbook records, and this only draws 1237 what it already holds. Shown once at least two reports carry a leveled 1238 factor, since a single point is not a trend. *) 1239 let feedback_graph (reports : View_model.Feedback.report list) = 1240 let chronological = 1241 List.sort 1242 (fun (a : View_model.Feedback.report) (b : View_model.Feedback.report) -> 1243 Int.compare a.at_unix b.at_unix) 1244 reports 1245 in 1246 let count = List.length chronological in 1247 let score_of field (report : View_model.Feedback.report) = 1248 match List.assoc_opt field report.factor_scores with 1249 | Some s -> s 1250 | None -> None 1251 in 1252 let series = 1253 List.map 1254 (fun (field, label) -> 1255 ( label, 1256 List.mapi (fun i report -> (i, score_of field report)) chronological 1257 )) 1258 feedback_factors 1259 in 1260 (* A factor charts only if it holds at least two scored points. *) 1261 let plottable (_, points) = 1262 List.length (List.filter (fun (_, s) -> Option.is_some s) points) >= 2 1263 in 1264 let series = List.filter plottable series in 1265 if count < 2 || series = [] then [] 1266 else 1267 let width = 480 and height = 180 in 1268 let pad_left = 28 and pad_right = 12 and pad_top = 12 and pad_bottom = 24 in 1269 let plot_w = width - pad_left - pad_right in 1270 let plot_h = height - pad_top - pad_bottom in 1271 let x_of i = 1272 if count = 1 then pad_left + (plot_w / 2) 1273 else pad_left + (i * plot_w / (count - 1)) 1274 in 1275 (* Score 1..5 maps low-to-high, so 5 sits at the top. *) 1276 let y_of score = pad_top + ((5 - score) * plot_h / 4) in 1277 let polyline label points = 1278 let coords = 1279 List.filter_map 1280 (fun (i, s) -> 1281 Option.map (fun s -> Printf.sprintf "%d,%d" (x_of i) (y_of s)) s) 1282 points 1283 in 1284 tag "polyline" 1285 [ 1286 class_ "feedback-graph-line"; 1287 Dream_html.string_attr "points" "%s" (String.concat " " coords); 1288 Dream_html.string_attr "fill" "none"; 1289 Dream_html.string_attr "data-factor" "%s" label; 1290 ] 1291 [] 1292 in 1293 let axis = 1294 List.map 1295 (fun score -> 1296 let y = y_of score in 1297 tag "text" 1298 [ 1299 class_ "feedback-graph-tick"; 1300 Dream_html.string_attr "x" "%d" (pad_left - 6); 1301 Dream_html.string_attr "y" "%d" (y + 3); 1302 Dream_html.string_attr "text-anchor" "end"; 1303 ] 1304 [ txt "%d" score ]) 1305 [ 1; 2; 3; 4; 5 ] 1306 in 1307 let legend = 1308 tag "ul" 1309 [ class_ "feedback-graph-legend" ] 1310 (List.map 1311 (fun (label, _) -> 1312 tag "li" 1313 [ Dream_html.string_attr "data-factor" "%s" label ] 1314 [ txt "%s" label ]) 1315 series) 1316 in 1317 [ 1318 tag "figure" 1319 [ class_ "feedback-graph" ] 1320 [ 1321 tag "figcaption" [] [ txt "Feedback over time" ]; 1322 tag "svg" 1323 [ 1324 class_ "feedback-graph-svg"; 1325 Dream_html.string_attr "viewBox" "0 0 %d %d" width height; 1326 Dream_html.string_attr "role" "img"; 1327 Dream_html.string_attr "aria-label" 1328 "Subjective feedback scores over time, one line per factor"; 1329 ] 1330 (axis 1331 @ List.map (fun (label, points) -> polyline label points) series); 1332 legend; 1333 ]; 1334 ] 1335 1336 let feedback_list (reports : View_model.Feedback.report list) = 1337 if reports = [] then [] 1338 else 1339 [ 1340 tag "ul" 1341 [ class_ "feedback-list" ] 1342 (List.map 1343 (fun (report : View_model.Feedback.report) -> 1344 let signals = String.concat ", " report.signals in 1345 tag "li" [] 1346 [ txt "%s" (if signals = "" then "No signals" else signals) ]) 1347 reports); 1348 ] 1349 1350 let logbook request ?(logging = false) ~viewer ?(feedback = []) 1351 ?(suggest_feedback = false) ?feedback_flow ?(feedback_open = false) records 1352 = 1353 let feedback_flow = 1354 Option.value feedback_flow ~default:{ step = 0; answers = [] } 1355 in 1356 html_page ~viewer ~request ~active:"logbook" ~logging "Logbook" 1357 [ 1358 tag "h1" [] [ txt "Logbook" ]; 1359 (if records = [] then tag "p" [] [ txt "Nothing logged yet." ] 1360 else 1361 tag "ul" [] 1362 (List.map 1363 (fun (entry : View_model.Logbook_entry.t) -> 1364 tag "li" [] 1365 [ 1366 tag "a" 1367 [ 1368 href Routes.record entry.id; 1369 Dream_html.attr "data-hito-app-link"; 1370 ] 1371 [ 1372 txt "%s — %d stimuli" entry.workout_name 1373 entry.stimuli_count; 1374 ]; 1375 tag "p" 1376 [ class_ "done" ] 1377 [ 1378 txt "%s" 1379 (if entry.complete then "complete" else "incomplete"); 1380 ]; 1381 ]) 1382 records)); 1383 tag "section" 1384 [ class_ "feedback-section" ] 1385 ([ 1386 tag "h2" [] [ txt "How are you feeling?" ]; 1387 (if suggest_feedback then 1388 tag "p" 1389 [ class_ "eyebrow" ] 1390 [ txt "Workout saved — add feedback while it is fresh." ] 1391 else txt ""); 1392 tag "p" [] 1393 [ 1394 txt 1395 "Report each factor in turn. Skip any factor or the full flow."; 1396 ]; 1397 tag "a" 1398 [ 1399 class_ "feedback-toggle"; 1400 Dream_html.string_attr "href" "/logbook?feedback=start"; 1401 Dream_html.attr "data-hito-feedback-open"; 1402 ] 1403 [ txt "Record feedback" ]; 1404 feedback_modal request ~flow:feedback_flow ~open_:feedback_open; 1405 ] 1406 @ feedback_graph feedback @ feedback_list feedback); 1407 ] 1408 1409 (* The authenticated application feedback page. It keeps writing and reviewing 1410 feedback in separate tabs, while both tabs remain plain links for no-script 1411 use and progressive enhancement. *) 1412 let app_feedback_tab ~selected ~tab ~label = 1413 let path = 1414 match tab with 1415 | `Write -> "/app-feedback?tab=write" 1416 | `Submitted -> "/app-feedback?tab=submitted" 1417 in 1418 let attrs = 1419 [ 1420 class_ "feedback-tab"; 1421 Dream_html.string_attr "href" "%s" path; 1422 Dream_html.attr "data-hito-app-link"; 1423 ] 1424 in 1425 let attrs = 1426 if selected = tab then Dream_html.string_attr "aria-current" "page" :: attrs 1427 else attrs 1428 in 1429 tag "a" attrs [ txt "%s" label ] 1430 1431 let app_feedback_form request ?error () = 1432 let error_block = 1433 match error with 1434 | None -> [] 1435 | Some message -> 1436 [ 1437 tag "p" 1438 [ class_ "warn"; Dream_html.string_attr "role" "alert" ] 1439 [ txt "%s" message ]; 1440 ] 1441 in 1442 tag "form" 1443 [ 1444 action Routes.submit_app_feedback; 1445 post_form; 1446 class_ "app-feedback-form"; 1447 Dream_html.attr "data-hito-app-form"; 1448 ] 1449 (Dream_html.csrf_tag request 1450 :: tag "label" 1451 [ Dream_html.string_attr "for" "app-feedback-message" ] 1452 [ txt "Your feedback" ] 1453 :: tag "textarea" 1454 [ 1455 name "message"; 1456 id "app-feedback-message"; 1457 Dream_html.string_attr "rows" "8"; 1458 required; 1459 Dream_html.string_attr "placeholder" 1460 "Tell us what works well or what needs attention."; 1461 ] 1462 [] 1463 :: error_block 1464 @ [ void "input" [ type_ "submit"; value "Submit feedback" ] ]) 1465 1466 let app_feedback_vote_form request (report : View_model.App_feedback.t) = 1467 if report.viewer_owns then 1468 tag "p" [ class_ "app-feedback-own" ] [ txt "Your feedback" ] 1469 else 1470 let label = 1471 if report.viewer_upvoted then "Upvoted" 1472 else Printf.sprintf "Upvote (%d)" report.upvotes 1473 in 1474 let attrs = 1475 [ 1476 action Routes.upvote_app_feedback report.id; 1477 post_form; 1478 class_ "app-feedback-vote"; 1479 Dream_html.attr "data-hito-app-form"; 1480 ] 1481 in 1482 let attrs = 1483 if report.viewer_upvoted then Dream_html.attr "disabled" :: attrs 1484 else attrs 1485 in 1486 tag "form" attrs 1487 [ 1488 Dream_html.csrf_tag request; 1489 void "input" 1490 [ type_ "submit"; Dream_html.string_attr "value" "%s" label ]; 1491 ] 1492 1493 let app_feedback_edit_form request (report : View_model.App_feedback.t) = 1494 tag "form" 1495 [ 1496 action Routes.edit_app_feedback report.id; 1497 post_form; 1498 class_ "app-feedback-edit-form"; 1499 Dream_html.attr "data-hito-app-form"; 1500 ] 1501 [ 1502 Dream_html.csrf_tag request; 1503 tag "label" 1504 [ Dream_html.string_attr "for" "app-feedback-edit-%s" report.id ] 1505 [ txt "Edit feedback" ]; 1506 tag "textarea" 1507 [ 1508 name "message"; 1509 Dream_html.string_attr "id" "app-feedback-edit-%s" report.id; 1510 Dream_html.string_attr "rows" "4"; 1511 required; 1512 ] 1513 [ txt "%s" report.message ]; 1514 void "input" [ type_ "submit"; value "Save edit" ]; 1515 ] 1516 1517 let app_feedback_remove_form request (report : View_model.App_feedback.t) = 1518 tag "form" 1519 [ 1520 action Routes.remove_app_feedback report.id; 1521 post_form; 1522 class_ "app-feedback-remove-form"; 1523 Dream_html.attr "data-hito-app-form"; 1524 ] 1525 [ 1526 Dream_html.csrf_tag request; 1527 void "input" [ type_ "submit"; value "Remove feedback" ]; 1528 ] 1529 1530 let app_feedback_actions request (report : View_model.App_feedback.t) = 1531 if report.viewer_owns then 1532 tag "div" 1533 [ class_ "app-feedback-actions" ] 1534 [ 1535 app_feedback_edit_form request report; 1536 app_feedback_remove_form request report; 1537 ] 1538 else 1539 tag "div" 1540 [ class_ "app-feedback-actions" ] 1541 [ app_feedback_vote_form request report ] 1542 1543 let app_feedback request ?(logging = false) ~viewer ?(tab = `Write) ?error 1544 reports = 1545 let panel = 1546 match tab with 1547 | `Write -> 1548 [ 1549 tag "h2" [] [ txt "Write feedback" ]; 1550 tag "p" [] 1551 [ txt "Tell us about your experience using the application." ]; 1552 app_feedback_form request ?error (); 1553 ] 1554 | `Submitted -> 1555 [ 1556 tag "h2" [] [ txt "Submitted feedback" ]; 1557 (if reports = [] then 1558 tag "p" [] 1559 [ txt "You have not submitted any application feedback." ] 1560 else 1561 tag "ul" 1562 [ class_ "app-feedback-list" ] 1563 (List.map 1564 (fun (report : View_model.App_feedback.t) -> 1565 tag "li" [] 1566 [ 1567 tag "p" 1568 [ class_ "app-feedback-author" ] 1569 [ 1570 txt "%s — %d contributions" report.author 1571 report.contributions; 1572 ]; 1573 tag "time" 1574 [ 1575 class_ "app-feedback-time"; 1576 Dream_html.string_attr "datetime" "%s" 1577 report.submitted_at; 1578 ] 1579 [ txt "%s" report.submitted_at ]; 1580 tag "p" 1581 [ class_ "app-feedback-message" ] 1582 [ txt "%s" report.message ]; 1583 tag "p" 1584 [ class_ "app-feedback-upvotes" ] 1585 [ txt "Upvotes: %d" report.upvotes ]; 1586 app_feedback_actions request report; 1587 ]) 1588 reports)); 1589 ] 1590 in 1591 html_page ~viewer ~request ~active:"app-feedback" ~logging "App feedback" 1592 [ 1593 tag "div" [] 1594 ([ 1595 tag "h1" [] [ txt "App feedback" ]; 1596 tag "p" [] [ txt "Help us improve hito by sharing your experience." ]; 1597 tag "nav" 1598 [ 1599 class_ "feedback-tabs"; 1600 Dream_html.string_attr "aria-label" "App feedback tabs"; 1601 ] 1602 [ 1603 app_feedback_tab ~selected:tab ~tab:`Write 1604 ~label:"Write feedback"; 1605 app_feedback_tab ~selected:tab ~tab:`Submitted 1606 ~label:"Submitted feedback"; 1607 ]; 1608 ] 1609 @ panel); 1610 ] 1611 1612 (* The account profile page. It names the signed-in trainee and offers two 1613 independent forms: rename the account, and change the password. Each form 1614 reports its own error inline. [notice] confirms a successful change. Both are 1615 plain authenticated app-forms, so they work with or without script. *) 1616 let profile request ?(logging = false) ~viewer ?username_error ?password_error 1617 ?notice () = 1618 let notice_block = 1619 match notice with 1620 | Some message -> [ tag "p" [ class_ "notice" ] [ txt "%s" message ] ] 1621 | None -> [] 1622 in 1623 let error_block = function 1624 | Some message -> 1625 [ 1626 tag "p" 1627 [ class_ "warn"; Dream_html.string_attr "role" "alert" ] 1628 [ txt "%s" message ]; 1629 ] 1630 | None -> [] 1631 in 1632 html_page ~viewer ~request ~active:"profile" ~logging "Profile" 1633 ([ tag "h1" [] [ txt "Profile" ] ] 1634 @ notice_block 1635 @ [ 1636 (* Username: show the current value and a button that opens the edit 1637 modal. The modal holds the rename form. A no-script client, or an 1638 error re-render, opens the dialog through the [open] attribute so the 1639 form stays reachable and its inline error shows. *) 1640 tag "section" 1641 [ class_ "profile-section" ] 1642 [ 1643 tag "h2" [] [ txt "Username" ]; 1644 tag "div" 1645 [ class_ "profile-value" ] 1646 [ 1647 tag "span" [ class_ "profile-value-label" ] [ txt "Username" ]; 1648 tag "span" 1649 [ class_ "profile-value-text" ] 1650 [ txt "%s" viewer.View_model.Viewer.username ]; 1651 tag "button" 1652 [ 1653 type_ "button"; 1654 class_ "profile-edit"; 1655 Dream_html.string_attr "data-hito-dialog-open" 1656 "username-dialog"; 1657 ] 1658 [ txt "Change username" ]; 1659 ]; 1660 tag "dialog" 1661 ([ 1662 Dream_html.string_attr "id" "username-dialog"; 1663 class_ "profile-dialog"; 1664 ] 1665 @ 1666 if Option.is_some username_error then [ Dream_html.attr "open" ] 1667 else []) 1668 [ 1669 tag "div" 1670 [ class_ "profile-dialog-content" ] 1671 ([ 1672 tag "h3" [] [ txt "Change username" ]; 1673 tag "form" 1674 [ 1675 action Routes.profile_username; 1676 post_form; 1677 class_ "profile-form"; 1678 Dream_html.attr "data-hito-app-form"; 1679 ] 1680 [ 1681 Dream_html.csrf_tag request; 1682 tag "div" 1683 [ class_ "field" ] 1684 [ 1685 tag "label" 1686 [ Dream_html.string_attr "for" "username" ] 1687 [ txt "Username" ]; 1688 void "input" 1689 [ 1690 type_ "text"; 1691 name "username"; 1692 Dream_html.string_attr "id" "username"; 1693 Dream_html.string_attr "value" "%s" 1694 viewer.View_model.Viewer.username; 1695 required; 1696 ]; 1697 ]; 1698 tag "div" 1699 [ class_ "profile-dialog-actions" ] 1700 [ 1701 tag "button" 1702 [ 1703 type_ "button"; 1704 class_ "secondary"; 1705 Dream_html.attr "data-hito-dialog-close"; 1706 ] 1707 [ txt "Cancel" ]; 1708 void "input" 1709 [ type_ "submit"; value "Change username" ]; 1710 ]; 1711 ]; 1712 ] 1713 @ error_block username_error); 1714 ]; 1715 ]; 1716 (* Password: a button opens the change-password modal. *) 1717 tag "section" 1718 [ class_ "profile-section" ] 1719 [ 1720 tag "h2" [] [ txt "Password" ]; 1721 tag "div" 1722 [ class_ "profile-value" ] 1723 [ 1724 tag "span" [ class_ "profile-value-label" ] [ txt "Password" ]; 1725 tag "span" [ class_ "profile-value-text" ] [ txt "••••••••" ]; 1726 tag "button" 1727 [ 1728 type_ "button"; 1729 class_ "profile-edit"; 1730 Dream_html.string_attr "data-hito-dialog-open" 1731 "password-dialog"; 1732 ] 1733 [ txt "Change password" ]; 1734 ]; 1735 tag "dialog" 1736 ([ 1737 Dream_html.string_attr "id" "password-dialog"; 1738 class_ "profile-dialog"; 1739 ] 1740 @ 1741 if Option.is_some password_error then [ Dream_html.attr "open" ] 1742 else []) 1743 [ 1744 tag "div" 1745 [ class_ "profile-dialog-content" ] 1746 ([ 1747 tag "h3" [] [ txt "Change password" ]; 1748 tag "form" 1749 [ 1750 action Routes.profile_password; 1751 post_form; 1752 class_ "profile-form"; 1753 Dream_html.attr "data-hito-app-form"; 1754 ] 1755 [ 1756 Dream_html.csrf_tag request; 1757 tag "div" 1758 [ class_ "field" ] 1759 [ 1760 tag "label" 1761 [ Dream_html.string_attr "for" "current" ] 1762 [ txt "Current password" ]; 1763 void "input" 1764 [ 1765 type_ "password"; 1766 name "current"; 1767 Dream_html.string_attr "id" "current"; 1768 required; 1769 ]; 1770 ]; 1771 tag "div" 1772 [ class_ "field" ] 1773 [ 1774 tag "label" 1775 [ Dream_html.string_attr "for" "next" ] 1776 [ txt "New password" ]; 1777 void "input" 1778 [ 1779 type_ "password"; 1780 name "next"; 1781 Dream_html.string_attr "id" "next"; 1782 required; 1783 ]; 1784 ]; 1785 tag "div" 1786 [ class_ "profile-dialog-actions" ] 1787 [ 1788 tag "button" 1789 [ 1790 type_ "button"; 1791 class_ "secondary"; 1792 Dream_html.attr "data-hito-dialog-close"; 1793 ] 1794 [ txt "Cancel" ]; 1795 void "input" 1796 [ type_ "submit"; value "Change password" ]; 1797 ]; 1798 ]; 1799 ] 1800 @ error_block password_error); 1801 ]; 1802 ]; 1803 (* Import: a multipart form uploads a native Hevy CSV export. The file 1804 field is [csv], the wall-clock offset is [utc_offset_seconds], and an 1805 optional checkbox overrides duplicate-source rejection. The form is a 1806 plain multipart POST with its CSRF token, so it needs no script. *) 1807 tag "section" 1808 [ class_ "profile-section" ] 1809 [ 1810 tag "h2" [] [ txt "Import" ]; 1811 tag "form" 1812 [ 1813 action Routes.import_upload; 1814 post_form; 1815 Dream_html.string_attr "enctype" "multipart/form-data"; 1816 class_ "profile-form"; 1817 ] 1818 [ 1819 Dream_html.csrf_tag request; 1820 tag "div" 1821 [ class_ "field" ] 1822 [ 1823 tag "label" 1824 [ Dream_html.string_attr "for" "csv" ] 1825 [ txt "Hevy CSV export" ]; 1826 void "input" 1827 [ 1828 type_ "file"; 1829 name "csv"; 1830 Dream_html.string_attr "id" "csv"; 1831 Dream_html.string_attr "accept" ".csv,text/csv"; 1832 required; 1833 ]; 1834 ]; 1835 tag "div" 1836 [ class_ "field" ] 1837 [ 1838 tag "label" 1839 [ Dream_html.string_attr "for" "utc_offset_seconds" ] 1840 [ txt "UTC offset in seconds" ]; 1841 void "input" 1842 [ 1843 type_ "number"; 1844 name "utc_offset_seconds"; 1845 Dream_html.string_attr "id" "utc_offset_seconds"; 1846 Dream_html.string_attr "value" "0"; 1847 required; 1848 ]; 1849 ]; 1850 tag "div" 1851 [ class_ "field" ] 1852 [ 1853 void "input" 1854 [ 1855 type_ "checkbox"; 1856 name "allow_duplicate"; 1857 Dream_html.string_attr "id" "allow_duplicate"; 1858 value "true"; 1859 ]; 1860 tag "label" 1861 [ Dream_html.string_attr "for" "allow_duplicate" ] 1862 [ txt "Import even if this export was imported before" ]; 1863 ]; 1864 void "input" [ type_ "submit"; value "Upload import" ]; 1865 ]; 1866 ]; 1867 ]) 1868 1869 (* The settings page. It currently stores the user's light or dark theme choice 1870 in the session. *) 1871 let settings request ?(logging = false) ~viewer ~theme () = 1872 let next_theme, label = 1873 match theme with 1874 | "dark" -> ("light", "Use light theme") 1875 | _ -> ("dark", "Use dark theme") 1876 in 1877 html_page ~viewer ~request ~active:"settings" ~logging "Settings" 1878 [ 1879 tag "h1" [] [ txt "Settings" ]; 1880 tag "section" 1881 [ class_ "settings-section" ] 1882 [ 1883 tag "h2" [] [ txt "Theme" ]; 1884 tag "p" [] [ txt "Choose a light or dark theme for this session." ]; 1885 tag "form" 1886 [ action Routes.settings_theme; post_form; class_ "settings-form" ] 1887 [ 1888 Dream_html.csrf_tag request; 1889 void "input" 1890 [ 1891 type_ "hidden"; 1892 name "theme"; 1893 Dream_html.string_attr "value" "%s" next_theme; 1894 ]; 1895 void "input" 1896 [ type_ "submit"; Dream_html.string_attr "value" "%s" label ]; 1897 ]; 1898 ]; 1899 ] 1900 1901 (* The review of a provisional import batch. It renders the parse warnings, then 1902 each workout with its sets, blockers, and forms. Every form is a plain POST 1903 carrying its CSRF token, so cleaning and promotion need no script. The page 1904 names only the view model: the controller has already phrased set types, 1905 blockers, and warnings, so no core entity crosses the boundary here. *) 1906 let import_review request ~viewer (vm : View_model.Import_review.t) = 1907 let warnings_block = 1908 match vm.View_model.Import_review.warnings with 1909 | [] -> [] 1910 | warnings -> 1911 [ 1912 tag "section" 1913 [ class_ "import-warnings" ] 1914 [ 1915 tag "h2" [] [ txt "Dropped rows" ]; 1916 tag "ul" [] 1917 (List.map 1918 (fun (w : View_model.Import_warning.t) -> 1919 tag "li" [] 1920 [ 1921 txt "Row %d: %s" w.View_model.Import_warning.row 1922 w.View_model.Import_warning.detail; 1923 ]) 1924 warnings); 1925 ]; 1926 ] 1927 in 1928 (* One row per set. A mapped set shows the catalog name it resolves to. *) 1929 let set_row (s : View_model.Import_set.t) = 1930 let mapping = 1931 match s.View_model.Import_set.mapping with 1932 | Some name -> Printf.sprintf " → %s" name 1933 | None -> " → unmapped" 1934 in 1935 tag "li" [] 1936 [ 1937 txt "Row %d: %s (%s) %s kg × %s reps%s" s.View_model.Import_set.row 1938 s.View_model.Import_set.exercise_name s.View_model.Import_set.set_type 1939 s.View_model.Import_set.weight s.View_model.Import_set.reps mapping; 1940 ] 1941 in 1942 (* One mapping form per distinct source name in the workout. The source name 1943 is fixed by a hidden field; the trainee supplies the catalog exercise id. *) 1944 let mapping_form batch_id workout_id source_name = 1945 tag "form" 1946 [ 1947 action Routes.import_map batch_id workout_id; 1948 post_form; 1949 class_ "import-map-form"; 1950 ] 1951 [ 1952 Dream_html.csrf_tag request; 1953 void "input" 1954 [ 1955 type_ "hidden"; 1956 name "source_name"; 1957 Dream_html.string_attr "value" "%s" source_name; 1958 ]; 1959 tag "div" 1960 [ class_ "field" ] 1961 [ 1962 tag "label" [] [ txt "Map %s to exercise id" source_name ]; 1963 void "input" [ type_ "text"; name "exercise_id"; required ]; 1964 ]; 1965 void "input" [ type_ "submit"; value "Map exercise" ]; 1966 ] 1967 in 1968 let confirm_form batch_id workout_id acknowledgement = 1969 tag "form" 1970 [ 1971 action Routes.import_confirm batch_id workout_id; 1972 post_form; 1973 class_ "import-confirm-form"; 1974 ] 1975 [ 1976 Dream_html.csrf_tag request; 1977 tag "div" 1978 [ class_ "field" ] 1979 [ 1980 tag "label" [] [ txt "Confirm normal sets" ]; 1981 void "input" 1982 ([ type_ "text"; name "acknowledgement"; required ] 1983 @ 1984 match acknowledgement with 1985 | Some ack -> [ Dream_html.string_attr "value" "%s" ack ] 1986 | None -> []); 1987 ]; 1988 void "input" [ type_ "submit"; value "Confirm normal sets" ]; 1989 ] 1990 in 1991 let promote_workout_form batch_id workout_id = 1992 tag "form" 1993 [ 1994 action Routes.import_promote_workout batch_id workout_id; 1995 post_form; 1996 class_ "import-promote-workout-form"; 1997 ] 1998 [ 1999 Dream_html.csrf_tag request; 2000 void "input" [ type_ "submit"; value "Promote workout" ]; 2001 ] 2002 in 2003 let blockers_block (w : View_model.Import_workout.t) = 2004 match w.View_model.Import_workout.blockers with 2005 | [] -> [ tag "p" [ class_ "import-ready" ] [ txt "Ready to promote." ] ] 2006 | blockers -> 2007 [ 2008 tag "p" [] [ txt "Blocked:" ]; 2009 tag "ul" 2010 [ class_ "import-blockers" ] 2011 (List.map (fun b -> tag "li" [] [ txt "%s" b ]) blockers); 2012 ] 2013 in 2014 let workout_section (w : View_model.Import_workout.t) = 2015 let batch_id = vm.View_model.Import_review.batch_id in 2016 let workout_id = w.View_model.Import_workout.id in 2017 (* Every distinct source name, in first-appearance order. *) 2018 let source_names = 2019 List.fold_left 2020 (fun acc (s : View_model.Import_set.t) -> 2021 let n = s.View_model.Import_set.exercise_name in 2022 if List.mem n acc then acc else acc @ [ n ]) 2023 [] w.View_model.Import_workout.sets 2024 in 2025 tag "section" 2026 [ class_ "import-workout" ] 2027 ([ 2028 tag "h2" [] [ txt "%s" w.View_model.Import_workout.title ]; 2029 tag "ul" 2030 [ class_ "import-sets" ] 2031 (List.map set_row w.View_model.Import_workout.sets); 2032 ] 2033 @ blockers_block w 2034 @ List.map (mapping_form batch_id workout_id) source_names 2035 @ [ 2036 confirm_form batch_id workout_id 2037 w.View_model.Import_workout.acknowledgement; 2038 promote_workout_form batch_id workout_id; 2039 ]) 2040 in 2041 let batch_promote_form = 2042 tag "form" 2043 [ 2044 action Routes.import_promote_batch vm.View_model.Import_review.batch_id; 2045 post_form; 2046 class_ "import-promote-batch-form"; 2047 ] 2048 [ 2049 Dream_html.csrf_tag request; 2050 void "input" [ type_ "submit"; value "Promote whole batch" ]; 2051 ] 2052 in 2053 html_page ~viewer ~request ~active:"profile" "Import review" 2054 ([ tag "h1" [] [ txt "Import review" ] ] 2055 @ warnings_block 2056 @ List.map workout_section vm.View_model.Import_review.workouts 2057 @ [ batch_promote_form ]) 2058