open Dream_html type page = Dream_html.node let tag = Dream_html.std_tag let void = Dream_html.void_tag let class_ = Dream_html.string_attr "class" let name = Dream_html.string_attr "name" let value = Dream_html.string_attr "value" let rel = Dream_html.string_attr "rel" let type_ = Dream_html.string_attr "type" let step = Dream_html.string_attr "step" let id = Dream_html.string_attr "id" let tabindex = Dream_html.string_attr "tabindex" let required = Dream_html.attr "required" let href path = Dream_html.path_attr (Dream_html.uri_attr "href") path let src path = Dream_html.path_attr (Dream_html.uri_attr "src") path let action path = Dream_html.path_attr (Dream_html.uri_attr "action") path let post_form = Dream_html.string_attr "method" "post" let flash_key = "hito.flash" (* The shell. [viewer] and [request] are present on authenticated pages, which then show a logout control and the username on the history link. Auth pages omit both. *) let theme_session_key = "hito.theme" let html_page ?viewer ?request ?(active = "") ?(logging = false) ?(show_nav = false) title content = let spa_client = true in let theme = match request with | Some request -> ( match Dream.session_field request theme_session_key with | Some "dark" -> "dark" | _ -> "light") | None -> "light" in let nav_link page path label = let attrs = [ href path ] in let attrs = if spa_client then Dream_html.attr "data-hito-app-link" :: attrs else attrs in let attrs = if String.equal page active then Dream_html.string_attr "aria-current" "page" :: attrs else attrs in tag "a" attrs [ txt "%s" label ] in (* Three always-available actions. The middle slot points to the routine normally and to the workout in progress while logging, so a running workout stays one tap away without adding a fourth destination. The logbook tab always reads "Logbook". The username lives on its own profile control. *) let navigation_links () = [ nav_link "home" Routes.home "Home"; (if logging then nav_link "workout" Routes.workout "Current workout" else nav_link "routine" Routes.routine "Routine"); nav_link "logbook" Routes.logbook "Logbook"; ] in (* The profile control names the signed-in trainee and opens a drop-down of account actions: Profile, Settings, and Sign out. It sits in the masthead, and on mobile it is the top-bar profile control the bottom nav has no room for. Settings points at the profile page too — account settings live there and there is no separate settings page. A
menu needs no client script, so it works before the SPA enhancement loads. The Sign-out form is nested inside and keeps its CSRF token. *) let profile_area = match (viewer, request) with | Some (viewer : View_model.Viewer.t), Some request -> let menu_link page path label = let attrs = [ class_ "profile-menu-item"; href path ] in let attrs = Dream_html.string_attr "role" "menuitem" :: attrs in let attrs = if spa_client then Dream_html.attr "data-hito-app-link" :: attrs else attrs in let attrs = if String.equal page active then Dream_html.string_attr "aria-current" "page" :: attrs else attrs in tag "a" attrs [ txt "%s" label ] in let summary_attrs = if String.equal "profile" active || String.equal "settings" active then [ class_ "profile"; Dream_html.string_attr "aria-current" "page" ] else [ class_ "profile" ] in [ tag "details" [ class_ "profile-menu" ] [ tag "summary" summary_attrs [ txt "%s" viewer.View_model.Viewer.username ]; tag "div" [ class_ "profile-menu-drawer"; Dream_html.string_attr "role" "menu"; Dream_html.string_attr "aria-label" "Profile menu"; ] [ menu_link "profile" Routes.profile "Profile"; menu_link "settings" Routes.settings "Settings"; menu_link "app-feedback" Routes.app_feedback "Feedback"; tag "form" [ action Routes.logout; post_form; class_ "logout"; Dream_html.attr "data-hito-app-form"; ] [ Dream_html.csrf_tag request; void "input" [ type_ "submit"; class_ "profile-menu-item"; Dream_html.string_attr "role" "menuitem"; value "Sign out"; ]; ]; ]; ]; ] | _ -> [] in let account_area = [] in let primary_nav = match (viewer, request) with | Some (_ : View_model.Viewer.t), Some _ -> [ tag "nav" [ class_ "primary-nav" ] (navigation_links ()) ] | _ when show_nav -> [ tag "nav" [ class_ "primary-nav" ] (navigation_links ()) ] | _ -> [] in let bottom_nav = match (viewer, request) with | Some (_ : View_model.Viewer.t), Some _ -> [ tag "nav" [ class_ "bottom-nav"; Dream_html.string_attr "aria-label" "Mobile navigation"; ] (navigation_links ()); ] | _ when show_nav -> [ tag "nav" [ class_ "bottom-nav"; Dream_html.string_attr "aria-label" "Mobile navigation"; ] (navigation_links ()); ] | _ -> [] in let flash_notice = match request with | Some request -> ( match Dream.session_field request flash_key with | Some message -> [ tag "div" [ class_ "toast"; Dream_html.attr "data-hito-toast"; Dream_html.string_attr "role" "status"; Dream_html.string_attr "aria-live" "polite"; ] [ txt "%s" message ]; ] | None -> []) | None -> [] in tag "html" [ Dream_html.string_attr "lang" "en"; Dream_html.string_attr "data-theme" "%s" theme; ] [ tag "head" [] [ tag "title" [] [ txt "Hito — %s" title ]; void "meta" [ Dream_html.string_attr "charset" "utf-8" ]; void "meta" [ Dream_html.string_attr "name" "viewport"; Dream_html.string_attr "content" "width=device-width,initial-scale=1"; ]; void "link" [ rel "stylesheet"; href Routes.stylesheet ]; ]; tag "body" [ Dream_html.string_attr "class" "hito-app" ] (flash_notice @ [ tag "a" [ class_ "skip-link"; Dream_html.string_attr "href" "#main-content"; ] [ txt "Skip to main content" ]; tag "div" ([ Dream_html.string_attr "class" "app-shell page-%s" active; Dream_html.string_attr "data-hito-page-title" "Hito — %s" title; ] @ if spa_client then [ Dream_html.attr "data-hito-app-shell" ] else []) ([ tag "header" [ class_ "masthead" ] ([ tag "a" ([ class_ "brand"; href Routes.home ] @ if spa_client then [ Dream_html.attr "data-hito-app-link" ] else []) [ txt "hito" ]; ] @ primary_nav @ profile_area @ account_area); tag "main" [ id "main-content"; tabindex "-1" ] [ tag "div" ([ class_ "page-surface" ] @ if spa_client then [ Dream_html.attr "data-hito-app-content" ] else []) content; ]; ] @ bottom_nav); ] @ if spa_client then [ tag "script" [ src Routes.workout_client; Dream_html.attr "defer" ] []; ] else []); ] let problem ~title ~detail = html_page title [ tag "p" [ class_ "eyebrow" ] [ txt "Attention required" ]; tag "h1" [] [ txt "%s" title ]; tag "p" [ class_ "warn" ] [ txt "%s" detail ]; ] (* A branded error page for the common HTTP failures. It states only the class of failure, never a server-supplied string, so nothing internal leaks. The navigation stays present — top on desktop, bottom on mobile — so a lost visitor is one tap from a known destination. *) let error_page ?viewer ?request ~status () = let title, detail = match status with | 404 -> ("Page not found", "That page does not exist. Use the navigation below.") | 400 -> ("Bad request", "That request could not be understood.") | 403 -> ("Forbidden", "You do not have access to that page.") | s when s >= 500 -> ("Something went wrong", "The server hit a problem. Try again shortly.") | _ -> ("Something went wrong", "That request could not be completed.") in html_page ?viewer ?request ~show_nav:true title [ tag "p" [ class_ "eyebrow" ] [ txt "%d" status ]; tag "h1" [] [ txt "%s" title ]; tag "p" [ class_ "warn" ] [ txt "%s" detail ]; ] (* --- authentication --- *) let auth_error = function | None -> [] | Some message -> [ tag "p" [ class_ "warn"; Dream_html.string_attr "role" "alert" ] [ txt "%s" message ]; ] let credentials_form request ~submit ~action_path = tag "form" [ action action_path; post_form; Dream_html.attr "data-hito-app-form" ] [ Dream_html.csrf_tag request; tag "div" [ class_ "field" ] [ tag "label" [ Dream_html.string_attr "for" "username" ] [ txt "Username" ]; void "input" [ type_ "text"; name "username"; Dream_html.string_attr "id" "username"; Dream_html.string_attr "autocomplete" "username"; required; ]; ]; tag "div" [ class_ "field" ] [ tag "label" [ Dream_html.string_attr "for" "password" ] [ txt "Password" ]; void "input" [ type_ "password"; name "password"; Dream_html.string_attr "id" "password"; Dream_html.string_attr "autocomplete" "current-password"; required; ]; ]; void "input" [ type_ "submit"; value submit ]; ] let login request ?error ?(registration_open = false) () = let register_prompt = if registration_open then [ tag "p" [] [ txt "No account yet? "; tag "a" [ href Routes.register; Dream_html.attr "data-hito-app-link" ] [ txt "Register" ]; ]; ] else [] in html_page ~active:"auth" "Sign in" ([ tag "h1" [] [ txt "Sign in" ]; credentials_form request ~submit:"Sign in" ~action_path:Routes.login; ] @ register_prompt @ auth_error error) let register request ?error () = html_page ~active:"auth" "Register" ([ tag "h1" [] [ txt "Create an account" ]; credentials_form request ~submit:"Register" ~action_path:Routes.register; tag "p" [] [ txt "Already registered? "; tag "a" [ href Routes.login; Dream_html.attr "data-hito-app-link" ] [ txt "Sign in" ]; ]; ] @ auth_error error) (* --- application pages --- *) let error_id input_id = input_id ^ "-error" let extension_select ?(selected = "") ?(invalid = false) ~input_id () = let error_attrs = if invalid then [ Dream_html.string_attr "aria-invalid" "true"; Dream_html.string_attr "aria-describedby" "%s" (error_id input_id); ] else [] in let option (code : string) label = let attrs = [ Dream_html.string_attr "value" "%s" code ] in let attrs = if String.equal code selected then Dream_html.attr "selected" :: attrs else attrs in tag "option" attrs [ txt "%s" label ] in tag "select" ([ name "extension"; Dream_html.string_attr "id" "%s" input_id ] @ error_attrs) [ option "" "to positive failure"; option "forced" "then forced reps"; option "negatives" "then negatives"; option "rest-pause" "then rest-pause"; option "static" "then a static hold"; ] let choose_routine request ~logging ~viewer ~(routines : View_model.Routine_choice.t list) = html_page ~viewer ~request ~active:"home" ~logging "Choose a routine" [ tag "h1" [] [ txt "Routines" ]; tag "div" [] (List.map (fun (choice : View_model.Routine_choice.t) -> tag "form" [ action Routes.select_routine choice.id; post_form; Dream_html.attr "data-hito-app-form"; ] [ Dream_html.csrf_tag request; tag "fieldset" [] [ tag "legend" [] [ txt "%s" choice.name ]; tag "p" [] [ txt "%d workouts in the cycle." choice.workout_count ]; void "input" [ type_ "submit"; value "Use this routine" ]; ]; ]) routines); ] let begin_form request ~routine_id ~override label = tag "form" [ action Routes.workout; post_form; Dream_html.attr "data-hito-app-form" ] [ Dream_html.csrf_tag request; void "input" [ type_ "hidden"; name "routine"; Dream_html.string_attr "value" "%s" routine_id; ]; void "input" [ type_ "hidden"; name "override"; Dream_html.string_attr "value" "%s" (string_of_bool override); ]; void "input" [ type_ "submit"; value label ]; ] (* Beginning under override needs an explicit acknowledgement, so its submit is gated behind a confirmation modal. Without script the form submits at once — the doctrine's deviation stays possible. The modal only makes it deliberate. The client reuses the shared confirm machinery: [data-hito-confirm-cancel] opens the dialog, [data-hito-confirm-form] is the form its accept submits. *) let override_begin request ~routine_id = [ tag "form" [ action Routes.workout; post_form; Dream_html.attr "data-hito-app-form"; Dream_html.attr "data-hito-confirm-form"; ] [ Dream_html.csrf_tag request; void "input" [ type_ "hidden"; name "routine"; Dream_html.string_attr "value" "%s" routine_id; ]; void "input" [ type_ "hidden"; name "override"; Dream_html.string_attr "value" "true"; ]; void "input" [ type_ "submit"; value "Begin under override"; Dream_html.attr "data-hito-confirm-cancel"; ]; ]; tag "dialog" [ class_ "confirm-dialog"; Dream_html.attr "data-hito-confirm-modal" ] [ tag "h2" [] [ txt "Begin before recovery is complete?" ]; tag "p" [] [ txt "Heavy Duty grows muscle during recovery, not in the gym. \ Training early can cut into it. This is recorded as an \ override."; ]; tag "div" [ class_ "button-group" ] [ tag "button" [ type_ "button"; class_ "secondary"; Dream_html.attr "data-hito-confirm-dismiss"; ] [ txt "Wait to recover" ]; tag "button" [ type_ "button"; Dream_html.attr "data-hito-confirm-accept" ] [ txt "Begin under override" ]; ]; ]; ] let home request ~viewer ~home:(vm : View_model.Home.t) = let status, gate = match vm.gate with | View_model.Home.Ready -> ( "Recovery is complete.", [ begin_form request ~routine_id:vm.routine_id ~override:false "Begin next workout"; ] ) | View_model.Home.Recovering { status } -> ( status, [ tag "div" [ class_ "warn" ] ([ tag "p" [] [ txt "Heavy Duty requires recovery before the next workout."; ]; ] @ override_begin request ~routine_id:vm.routine_id); ] ) in html_page ~viewer ~request ~active:"home" "Home" ([ tag "h1" [] [ txt "%s" vm.routine_name ]; tag "p" [ class_ "ledger-meta" ] [ txt "Next: %s" vm.next_workout ]; tag "p" [ class_ "ledger-meta" ] [ txt "%s" status ]; ] @ gate) (* Home while a workout is in progress. Rather than the recovery gate or the routine chooser, Home shows a single card: the workout is under way and one tap returns to it. The middle navigation action already reads "Current workout" here, and this card is the matching Home affordance. *) let workout_in_progress request ~viewer ~workout_name = html_page ~viewer ~request ~active:"home" ~logging:true "Home" [ tag "a" [ class_ "in-progress-card"; href Routes.workout; Dream_html.attr "data-hito-app-link"; ] [ tag "p" [ class_ "eyebrow" ] [ txt "Workout in progress" ]; tag "h1" [] [ txt "%s" workout_name ]; tag "p" [] [ txt "Return to the current workout to keep logging." ]; ]; ] let routine request ?(logging = false) ~viewer (vm : View_model.Routine.t) = html_page ~viewer ~request ~active:"routine" ~logging "Routine" [ tag "h1" [] [ txt "%s" vm.name ]; tag "div" [ class_ "routine-accordions" ] (List.map (fun (workout : View_model.Routine.workout) -> tag "details" [ class_ "routine-accordion" ] [ tag "summary" [] [ txt "%s" workout.name ]; tag "div" [ class_ "routine-description" ] [ tag "ul" [] (List.map (fun (exercise : View_model.Routine.exercise) -> tag "li" [] [ tag "span" [ class_ "routine-exercise" ] [ txt "%s" exercise.name ]; tag "span" [ class_ "routine-reps" ] [ txt "%s" exercise.reps ]; ]) workout.exercises); ]; ]) vm.workouts); ] let error_for ~input_id (field : string) (errors : (string * string) list) = match List.assoc_opt field errors with | None -> [] | Some error -> [ tag "p" [ Dream_html.string_attr "id" "%s" (error_id input_id); class_ "warn"; Dream_html.string_attr "role" "alert"; ] [ txt "%s" (Decode.errors_to_text [ (field, error) ]) ]; ] let input_row ?value:v ?(invalid = false) ?placeholder ?(hide_label = false) ~input_id (field : string) label = let error_attrs = if invalid then [ Dream_html.string_attr "aria-invalid" "true"; Dream_html.string_attr "aria-describedby" "%s" (error_id input_id); ] else [] in let placeholder_attr = match placeholder with | None -> [] | Some p -> [ Dream_html.string_attr "placeholder" "%s" p ] in tag "div" [ class_ "field" ] [ tag "label" [ Dream_html.string_attr "for" "%s" input_id; class_ (if hide_label then "sr-only" else ""); ] [ txt "%s" label ]; void "input" ([ type_ "number"; Dream_html.string_attr "name" "%s" field; Dream_html.string_attr "id" "%s" input_id; step "0.5"; required; ] @ placeholder_attr @ error_attrs @ match v with | None -> [] | Some v -> [ Dream_html.string_attr "value" "%s" v ]); ] (* A movement's fields as cells of the fieldset grid: the exercise name, the load input, and the reps input. The cells are direct participants of the one [.logging-grid] the fieldset wraps them in — a [display: contents] wrapper groups a movement without opening a nested grid — so every movement's name, load, and reps columns line up across the whole fieldset. The name reads as a heading, the inputs as labelled fields. *) let movement_row ~(errors : (string * string) list) ~name ~load_id ~load_field ~reps_id ~reps_field ?load_value ?reps_value ~reps_label ?(hide_labels = false) () = tag "div" [ class_ "movement" ] [ tag "p" [ class_ "exercise-name" ] [ txt "%s" name ]; input_row ?value:load_value ~placeholder:"kg" ~hide_label:hide_labels ~invalid:(List.mem_assoc load_field errors) ~input_id:load_id load_field "Load (kg)"; input_row ?value:reps_value ~placeholder:"reps" ~hide_label:hide_labels ~invalid:(List.mem_assoc reps_field errors) ~input_id:reps_id reps_field reps_label; ] (* A shared heading row for a multi-exercise group: empty name cell, then the Load and Reps column headings. Rendered once as cells of the fieldset grid so the labels are not repeated above every input. *) let exercise_fields_head ~reps_label () = tag "div" [ class_ "movement movement-head" ] [ tag "span" [ class_ "exercise-name" ] [ txt "" ]; tag "span" [ class_ "col-heading" ] [ txt "Load (kg)" ]; tag "span" [ class_ "col-heading" ] [ txt "%s" reps_label ]; ] (* [movements] carries the record/correction field spec the controller built from the slot's prescription: one row for a single exercise, two for a pre-exhaust pair, each already pre-filled when correcting. [submit] names the action. Load and reps of each movement are laid out side by side. *) let form_for_stimulus request ~action_path ~slot ~(movements : View_model.Workout.movement list) ~selected_extension ?(enhanced = false) ?(submit = "Record") ~(errors : (string * string) list) () = let field_id field = Printf.sprintf "slot-%d-%s" slot field in let selected = selected_extension in (* A single-exercise slot shows one row with a visible "Reps to failure" label. A pre-exhaust pair shows a shared column heading and hides the per-row labels. *) let hide_labels = List.length movements > 1 in let head = match movements with | first :: _ :: _ -> [ exercise_fields_head ~reps_label:first.View_model.Workout.reps_label (); ] | _ -> [] in let movement_of (m : View_model.Workout.movement) = movement_row ~errors ~name:m.name ~load_id:(field_id m.load_field) ~load_field:m.load_field ~reps_id:(field_id m.reps_field) ~reps_field:m.reps_field ?load_value:m.load_value ?reps_value:m.reps_value ~reps_label:m.reps_label ~hide_labels () in let fields = head @ List.map movement_of movements in (* The error rows follow the fields present, so a single-exercise slot reports load/reps and a pre-exhaust slot reports the iso/comp fields. *) let field_names = List.concat_map (fun (m : View_model.Workout.movement) -> [ m.load_field; m.reps_field ]) movements @ [ "extension" ] in tag "form" ([ action_path; post_form ] @ if enhanced then [ Dream_html.attr "data-hito-workout-form" ] else [ Dream_html.attr "data-hito-app-form" ]) [ Dream_html.csrf_tag request; tag "fieldset" [ class_ "logging-fieldset" ] (tag "div" [ class_ "logging-grid" ] (fields @ [ tag "div" [ class_ "field field-ending" ] [ tag "label" [ Dream_html.string_attr "for" "%s" (field_id "extension"); ] [ txt "Ending" ]; extension_select ~selected ~invalid:(List.mem_assoc "extension" errors) ~input_id:(field_id "extension") (); ]; ]) :: List.concat_map (fun field -> error_for ~input_id:(field_id field) field errors) field_names @ [ void "input" [ type_ "submit"; Dream_html.string_attr "value" "%s" submit ]; ]); ] let workout request ~viewer ?(errors = []) ?editing ?logging ~record_id ~active_slot (vm : View_model.Workout.t) = let enhanced = Option.is_none record_id in (* A live workout view is itself the workout in progress, so the middle nav action reads "Current workout". A saved-record view defers to the handler, which knows whether a separate workout is in progress. *) let logging = Option.value logging ~default:enhanced in let slot_count = List.length vm.slots in let filled_slots = List.length (List.filter (fun (s : View_model.Workout.slot) -> Option.is_some s.recorded_summary) vm.slots) in let record_action slot = match record_id with | None -> action Routes.workout_slot slot | Some record_id -> action Routes.record_slot record_id slot in let edit_action slot = match record_id with | None -> action Routes.workout_slot_edit slot | Some record_id -> action Routes.record_slot_edit record_id slot in (* The early-workout notice. The override was already confirmed in a modal, so on the workout screen this is informational only: a toast rather than a component in the main content. It is a polite live region. The client shows it briefly then dismisses it. Without script it stays visible as a quiet fixed notice, so a no-JS visitor is still told. *) let override_note = if vm.overridden then [ tag "div" [ class_ "toast"; Dream_html.attr "data-hito-toast"; Dream_html.string_attr "role" "status"; Dream_html.string_attr "aria-live" "polite"; ] [ txt "Begun before recovery finished." ]; ] else [] in (* The exercise selector: a dropdown naming every prescription slot. Choosing an option opens that exercise below. The selector is a GET form so it works without script — submitting navigates to the slot via a [?slot=] query, the same contract the panel already reads. The client enhances it: it navigates the moment the selection changes, so the submit button is a no-JS fallback. A recorded slot is marked done in its label. *) let select_action_base = match record_id with None -> "/workout" | Some id -> "/logbook/" ^ id in let exercise_group = let option_for (slot : View_model.Workout.slot) = let done_ = Option.is_some slot.recorded_summary in let label = if done_ then Printf.sprintf "%d. %s (done)" (slot.index + 1) slot.label else Printf.sprintf "%d. %s" (slot.index + 1) slot.label in let attrs = [ Dream_html.string_attr "value" "%d" slot.index ] in let attrs = if slot.index = active_slot then Dream_html.attr "selected" :: attrs else attrs in tag "option" attrs [ txt "%s" label ] in let form_attrs = [ Dream_html.string_attr "method" "get"; Dream_html.string_attr "action" "%s" select_action_base; class_ "exercise-select"; ] in let form_attrs = if enhanced then Dream_html.attr "data-hito-exercise-form" :: form_attrs else form_attrs in tag "form" form_attrs [ tag "label" [ Dream_html.string_attr "for" "exercise-choice"; class_ "sr-only" ] [ txt "Exercise" ]; tag "select" [ name "slot"; id "exercise-choice"; Dream_html.attr "data-hito-exercise-select"; ] (List.map option_for vm.slots); void "input" [ type_ "submit"; class_ "secondary exercise-select-go"; value "Open"; ]; ] in (* The panel for the active slot. It shows one exercise at a time: a recorded slot renders its read-only summary and a pre-filled correction form (which replaces the slot rather than adding volume). An outstanding slot renders the record form. *) let active_panel = match List.nth_opt vm.slots active_slot with | None -> [ tag "p" [ class_ "warn" ] [ txt "That exercise is not part of this workout." ]; ] | Some (slot : View_model.Workout.slot) -> let errors = if editing = Some active_slot then errors else [] in let heading = tag "h2" [] [ txt "%s" slot.label ] in let body = match slot.recorded_summary with | Some summary -> [ tag "p" [ class_ "eyebrow" ] [ txt "Recorded" ]; tag "p" [ class_ "done" ] [ txt "%s" summary ]; form_for_stimulus request ~action_path:(edit_action active_slot) ~slot:active_slot ~movements:slot.movements ~selected_extension:slot.selected_extension ~enhanced ~submit:"Save correction" ~errors (); ] | None -> [ form_for_stimulus request ~action_path:(record_action active_slot) ~slot:active_slot ~movements:slot.movements ~selected_extension:slot.selected_extension ~enhanced ~errors (); ] in [ tag "section" [ class_ "slot-panel" ] (heading :: body) ] in let complete_note = if vm.all_recorded then [ tag "p" [ class_ "done" ] [ txt "Everything prescribed has been recorded." ]; ] else [] in (* A sticky timer bar for the workout in progress. It carries the workout's start time as an epoch, and the client ticks the elapsed time from it. Reading the true start on every render means an SPA content swap never resets the count. Only the live workout shows it. *) let timer_bar = if enhanced then let started = vm.started_at_unix in [ tag "div" [ class_ "workout-timer"; Dream_html.attr "data-hito-workout-timer"; Dream_html.string_attr "data-started" "%d" started; ] [ tag "span" [ class_ "workout-timer-label" ] [ txt "Elapsed" ]; tag "span" [ class_ "workout-timer-value"; Dream_html.string_attr "aria-live" "off"; Dream_html.attr "data-hito-workout-timer-value"; ] [ txt "0:00" ]; ]; ] else [] in let finish_section = match record_id with | Some _ -> [] | None -> [ tag "div" [ class_ "button-group" ] [ tag "form" [ action Routes.finish_workout; post_form; Dream_html.attr "data-hito-app-form"; ] [ Dream_html.csrf_tag request; void "input" [ type_ "submit"; value "Finish workout" ]; ]; (* Cancel is a native POST form. Without script, it submits immediately. The client only opens the confirm dialog. Its acceptance submits this form as a full document navigation so the cancelled workout cannot leave a stale app shell behind. *) tag "form" [ action Routes.cancel_workout; post_form; Dream_html.attr "data-hito-confirm-form"; Dream_html.attr "data-hito-cancel-form"; ] [ Dream_html.csrf_tag request; void "input" [ type_ "submit"; class_ "secondary"; value "Cancel logging"; Dream_html.attr "data-hito-confirm-cancel"; ]; ]; ]; (* The confirmation modal. Native dialog for built-in focus trapping and Escape-to-close. The client opens it. "Cancel workout" submits the cancel form, "Keep logging" closes it. *) tag "dialog" [ class_ "confirm-dialog"; Dream_html.attr "data-hito-confirm-modal"; ] [ tag "h2" [] [ txt "Cancel this workout?" ]; tag "p" [] [ txt "The workout is discarded and leaves no record, then you \ return Home."; ]; tag "div" [ class_ "button-group" ] [ tag "button" [ type_ "button"; class_ "secondary"; Dream_html.attr "data-hito-confirm-dismiss"; ] [ txt "Keep logging" ]; tag "button" [ type_ "button"; Dream_html.attr "data-hito-confirm-accept"; ] [ txt "Cancel workout" ]; ]; ]; ] in html_page ~viewer ~request ~active:"workout" ~logging vm.name [ tag "div" (if enhanced then [ Dream_html.attr "data-hito-workout"; Dream_html.attr "data-hito-workout-content"; ] else []) (timer_bar @ override_note @ [ tag "h1" [] [ txt "%s" vm.name ]; tag "p" [ class_ "ledger-meta" ] [ txt "%d of %d recorded." filled_slots slot_count ]; exercise_group; ] @ active_panel @ complete_note @ finish_section @ if enhanced then [ tag "p" [ Dream_html.string_attr "aria-live" "polite"; Dream_html.attr "data-hito-workout-status"; ] []; ] else []); ] (* The subjective feedback form. Radio groups report sleep, appetite, readiness, motivation, and difficulty against a personal baseline. Flags report pain, injury, and insufficient preparation. A field left blank reports nothing, so the trainee submits only what they mean to. Feedback is standalone — recorded from the Logbook at any time. *) type feedback_flow = { step : int; answers : (string * string) list } let feedback_factors = [ ("sleep", "Sleep"); ("appetite", "Appetite"); ("readiness", "Readiness"); ("motivation", "Motivation"); ("difficulty", "Perceived difficulty"); ] (* Each subjective metric uses five unselected radio buttons styled as inline buttons. The server shows one metric at a time. *) let feedback_level_buttons field label ~selected = let choice code text = tag "label" [ class_ "feedback-choice"; Dream_html.attr "data-hito-feedback-choice" ] [ void "input" ([ type_ "radio"; Dream_html.string_attr "name" "choice"; Dream_html.string_attr "value" "%s" code; Dream_html.string_attr "id" "%s-%s" field code; ] @ if String.equal code selected then [ Dream_html.attr "checked" ] else []); tag "span" [] [ txt "%s" text ]; ] in tag "div" [ class_ "feedback-group" ] [ tag "p" [ class_ "feedback-group-label" ] [ txt "%s" label ]; tag "div" [ class_ "feedback-buttons"; Dream_html.string_attr "role" "group"; Dream_html.string_attr "aria-label" "%s" label; ] [ choice "1" "1 — very poor"; choice "2" "2"; choice "3" "3"; choice "4" "4"; choice "5" "5 — very good"; ]; ] let feedback_flag field label = tag "label" [ class_ "feedback-flag" ] [ void "input" [ type_ "checkbox"; Dream_html.string_attr "name" "%s" field; value "true"; ]; txt " %s" label; ] let feedback_progress step = let completed = min 5 (max 0 step) in tag "div" [ class_ "feedback-progress" ] [ tag "progress" [ Dream_html.string_attr "value" "%s" (string_of_int completed); Dream_html.string_attr "max" "5"; Dream_html.string_attr "aria-label" "Feedback progress"; ] [ txt "%d of 5 factors" completed ]; tag "p" [ class_ "ledger-meta" ] [ txt "%d of 5 factors" completed ]; ] let feedback_action_button ~action ~label ?(secondary = false) () = tag "button" ([ type_ "submit"; name "action"; value action; Dream_html.attr "data-hito-feedback-action"; ] @ if secondary then [ class_ "secondary" ] else []) [ txt "%s" label ] let feedback_flow_form request flow = let step = min 5 (max 0 flow.step) in let fields = [ void "input" [ type_ "hidden"; name "step"; Dream_html.string_attr "value" "%s" (string_of_int step); ]; void "input" [ type_ "hidden"; name "action"; Dream_html.string_attr "value" ""; Dream_html.attr "data-hito-feedback-action-value"; ]; Dream_html.csrf_tag request; ] in let body = if step < 5 then let field, label = List.nth feedback_factors step in fields @ [ tag "h3" [] [ txt "%s" label ]; feedback_level_buttons field label ~selected: (Option.value (List.assoc_opt field flow.answers) ~default:""); feedback_progress (step + 1); tag "div" [ class_ "feedback-actions" ] ((if step > 0 then let _, previous_label = List.nth feedback_factors (step - 1) in [ feedback_action_button ~action:"back" ~label:(Printf.sprintf "Back to %s" previous_label) ~secondary:true (); ] else []) @ [ feedback_action_button ~action:"skip" ~label:"Skip this factor" ~secondary:true (); ]); ] else fields @ [ tag "h3" [] [ txt "Anything else?" ]; tag "p" [] [ txt "Add an optional note about pain, injury, or preparation." ]; tag "div" [ class_ "field" ] [ feedback_flag "pain" "Pain"; feedback_flag "injury" "Injury"; feedback_flag "preparation" "Preparation was insufficient"; ]; feedback_progress 5; tag "div" [ class_ "feedback-actions" ] [ feedback_action_button ~action:"back" ~label:"Back to Perceived difficulty" ~secondary:true (); feedback_action_button ~action:"save" ~label:"Submit feedback" (); ]; ] in tag "form" [ action Routes.feedback; post_form; class_ "feedback-form"; Dream_html.attr "data-hito-feedback-form"; Dream_html.attr "data-hito-app-form"; ] [ tag "fieldset" [] body ] let feedback_modal request ~flow ~open_ = tag "dialog" ([ class_ "feedback-modal"; Dream_html.attr "data-hito-feedback-modal" ] @ if open_ then [ Dream_html.attr "open" ] else []) [ tag "div" [ class_ "feedback-modal-content" ] [ tag "div" [ class_ "feedback-modal-heading" ] [ tag "h2" [] [ txt "How are you feeling?" ]; (* Close cancels the flow: it submits the cancel form, so the partial progress is discarded rather than kept for later. *) tag "form" [ action Routes.cancel_feedback; post_form; class_ "feedback-close-form"; Dream_html.attr "data-hito-app-form"; ] [ Dream_html.csrf_tag request; tag "button" [ type_ "submit"; class_ "feedback-modal-close"; Dream_html.string_attr "aria-label" "Close feedback"; ] [ txt "×" ]; ]; ]; feedback_flow_form request flow; ]; ] (* A small inline-SVG line chart of leveled feedback over time, one polyline per factor. No script and no dependency: the logbook records, and this only draws what it already holds. Shown once at least two reports carry a leveled factor, since a single point is not a trend. *) let feedback_graph (reports : View_model.Feedback.report list) = let chronological = List.sort (fun (a : View_model.Feedback.report) (b : View_model.Feedback.report) -> Int.compare a.at_unix b.at_unix) reports in let count = List.length chronological in let score_of field (report : View_model.Feedback.report) = match List.assoc_opt field report.factor_scores with | Some s -> s | None -> None in let series = List.map (fun (field, label) -> ( label, List.mapi (fun i report -> (i, score_of field report)) chronological )) feedback_factors in (* A factor charts only if it holds at least two scored points. *) let plottable (_, points) = List.length (List.filter (fun (_, s) -> Option.is_some s) points) >= 2 in let series = List.filter plottable series in if count < 2 || series = [] then [] else let width = 480 and height = 180 in let pad_left = 28 and pad_right = 12 and pad_top = 12 and pad_bottom = 24 in let plot_w = width - pad_left - pad_right in let plot_h = height - pad_top - pad_bottom in let x_of i = if count = 1 then pad_left + (plot_w / 2) else pad_left + (i * plot_w / (count - 1)) in (* Score 1..5 maps low-to-high, so 5 sits at the top. *) let y_of score = pad_top + ((5 - score) * plot_h / 4) in let polyline label points = let coords = List.filter_map (fun (i, s) -> Option.map (fun s -> Printf.sprintf "%d,%d" (x_of i) (y_of s)) s) points in tag "polyline" [ class_ "feedback-graph-line"; Dream_html.string_attr "points" "%s" (String.concat " " coords); Dream_html.string_attr "fill" "none"; Dream_html.string_attr "data-factor" "%s" label; ] [] in let axis = List.map (fun score -> let y = y_of score in tag "text" [ class_ "feedback-graph-tick"; Dream_html.string_attr "x" "%d" (pad_left - 6); Dream_html.string_attr "y" "%d" (y + 3); Dream_html.string_attr "text-anchor" "end"; ] [ txt "%d" score ]) [ 1; 2; 3; 4; 5 ] in let legend = tag "ul" [ class_ "feedback-graph-legend" ] (List.map (fun (label, _) -> tag "li" [ Dream_html.string_attr "data-factor" "%s" label ] [ txt "%s" label ]) series) in [ tag "figure" [ class_ "feedback-graph" ] [ tag "figcaption" [] [ txt "Feedback over time" ]; tag "svg" [ class_ "feedback-graph-svg"; Dream_html.string_attr "viewBox" "0 0 %d %d" width height; Dream_html.string_attr "role" "img"; Dream_html.string_attr "aria-label" "Subjective feedback scores over time, one line per factor"; ] (axis @ List.map (fun (label, points) -> polyline label points) series); legend; ]; ] let feedback_list (reports : View_model.Feedback.report list) = if reports = [] then [] else [ tag "ul" [ class_ "feedback-list" ] (List.map (fun (report : View_model.Feedback.report) -> let signals = String.concat ", " report.signals in tag "li" [] [ txt "%s" (if signals = "" then "No signals" else signals) ]) reports); ] let logbook request ?(logging = false) ~viewer ?(feedback = []) ?(suggest_feedback = false) ?feedback_flow ?(feedback_open = false) records = let feedback_flow = Option.value feedback_flow ~default:{ step = 0; answers = [] } in html_page ~viewer ~request ~active:"logbook" ~logging "Logbook" [ tag "h1" [] [ txt "Logbook" ]; (if records = [] then tag "p" [] [ txt "Nothing logged yet." ] else tag "ul" [] (List.map (fun (entry : View_model.Logbook_entry.t) -> tag "li" [] [ tag "a" [ href Routes.record entry.id; Dream_html.attr "data-hito-app-link"; ] [ txt "%s — %d stimuli" entry.workout_name entry.stimuli_count; ]; tag "p" [ class_ "done" ] [ txt "%s" (if entry.complete then "complete" else "incomplete"); ]; ]) records)); tag "section" [ class_ "feedback-section" ] ([ tag "h2" [] [ txt "How are you feeling?" ]; (if suggest_feedback then tag "p" [ class_ "eyebrow" ] [ txt "Workout saved — add feedback while it is fresh." ] else txt ""); tag "p" [] [ txt "Report each factor in turn. Skip any factor or the full flow."; ]; tag "a" [ class_ "feedback-toggle"; Dream_html.string_attr "href" "/logbook?feedback=start"; Dream_html.attr "data-hito-feedback-open"; ] [ txt "Record feedback" ]; feedback_modal request ~flow:feedback_flow ~open_:feedback_open; ] @ feedback_graph feedback @ feedback_list feedback); ] (* The authenticated application feedback page. It keeps writing and reviewing feedback in separate tabs, while both tabs remain plain links for no-script use and progressive enhancement. *) let app_feedback_tab ~selected ~tab ~label = let path = match tab with | `Write -> "/app-feedback?tab=write" | `Submitted -> "/app-feedback?tab=submitted" in let attrs = [ class_ "feedback-tab"; Dream_html.string_attr "href" "%s" path; Dream_html.attr "data-hito-app-link"; ] in let attrs = if selected = tab then Dream_html.string_attr "aria-current" "page" :: attrs else attrs in tag "a" attrs [ txt "%s" label ] let app_feedback_form request ?error () = let error_block = match error with | None -> [] | Some message -> [ tag "p" [ class_ "warn"; Dream_html.string_attr "role" "alert" ] [ txt "%s" message ]; ] in tag "form" [ action Routes.submit_app_feedback; post_form; class_ "app-feedback-form"; Dream_html.attr "data-hito-app-form"; ] (Dream_html.csrf_tag request :: tag "label" [ Dream_html.string_attr "for" "app-feedback-message" ] [ txt "Your feedback" ] :: tag "textarea" [ name "message"; id "app-feedback-message"; Dream_html.string_attr "rows" "8"; required; Dream_html.string_attr "placeholder" "Tell us what works well or what needs attention."; ] [] :: error_block @ [ void "input" [ type_ "submit"; value "Submit feedback" ] ]) let app_feedback_vote_form request (report : View_model.App_feedback.t) = if report.viewer_owns then tag "p" [ class_ "app-feedback-own" ] [ txt "Your feedback" ] else let label = if report.viewer_upvoted then "Upvoted" else Printf.sprintf "Upvote (%d)" report.upvotes in let attrs = [ action Routes.upvote_app_feedback report.id; post_form; class_ "app-feedback-vote"; Dream_html.attr "data-hito-app-form"; ] in let attrs = if report.viewer_upvoted then Dream_html.attr "disabled" :: attrs else attrs in tag "form" attrs [ Dream_html.csrf_tag request; void "input" [ type_ "submit"; Dream_html.string_attr "value" "%s" label ]; ] let app_feedback_edit_form request (report : View_model.App_feedback.t) = tag "form" [ action Routes.edit_app_feedback report.id; post_form; class_ "app-feedback-edit-form"; Dream_html.attr "data-hito-app-form"; ] [ Dream_html.csrf_tag request; tag "label" [ Dream_html.string_attr "for" "app-feedback-edit-%s" report.id ] [ txt "Edit feedback" ]; tag "textarea" [ name "message"; Dream_html.string_attr "id" "app-feedback-edit-%s" report.id; Dream_html.string_attr "rows" "4"; required; ] [ txt "%s" report.message ]; void "input" [ type_ "submit"; value "Save edit" ]; ] let app_feedback_remove_form request (report : View_model.App_feedback.t) = tag "form" [ action Routes.remove_app_feedback report.id; post_form; class_ "app-feedback-remove-form"; Dream_html.attr "data-hito-app-form"; ] [ Dream_html.csrf_tag request; void "input" [ type_ "submit"; value "Remove feedback" ]; ] let app_feedback_actions request (report : View_model.App_feedback.t) = if report.viewer_owns then tag "div" [ class_ "app-feedback-actions" ] [ app_feedback_edit_form request report; app_feedback_remove_form request report; ] else tag "div" [ class_ "app-feedback-actions" ] [ app_feedback_vote_form request report ] let app_feedback request ?(logging = false) ~viewer ?(tab = `Write) ?error reports = let panel = match tab with | `Write -> [ tag "h2" [] [ txt "Write feedback" ]; tag "p" [] [ txt "Tell us about your experience using the application." ]; app_feedback_form request ?error (); ] | `Submitted -> [ tag "h2" [] [ txt "Submitted feedback" ]; (if reports = [] then tag "p" [] [ txt "You have not submitted any application feedback." ] else tag "ul" [ class_ "app-feedback-list" ] (List.map (fun (report : View_model.App_feedback.t) -> tag "li" [] [ tag "p" [ class_ "app-feedback-author" ] [ txt "%s — %d contributions" report.author report.contributions; ]; tag "time" [ class_ "app-feedback-time"; Dream_html.string_attr "datetime" "%s" report.submitted_at; ] [ txt "%s" report.submitted_at ]; tag "p" [ class_ "app-feedback-message" ] [ txt "%s" report.message ]; tag "p" [ class_ "app-feedback-upvotes" ] [ txt "Upvotes: %d" report.upvotes ]; app_feedback_actions request report; ]) reports)); ] in html_page ~viewer ~request ~active:"app-feedback" ~logging "App feedback" [ tag "div" [] ([ tag "h1" [] [ txt "App feedback" ]; tag "p" [] [ txt "Help us improve hito by sharing your experience." ]; tag "nav" [ class_ "feedback-tabs"; Dream_html.string_attr "aria-label" "App feedback tabs"; ] [ app_feedback_tab ~selected:tab ~tab:`Write ~label:"Write feedback"; app_feedback_tab ~selected:tab ~tab:`Submitted ~label:"Submitted feedback"; ]; ] @ panel); ] (* The account profile page. It names the signed-in trainee and offers two independent forms: rename the account, and change the password. Each form reports its own error inline. [notice] confirms a successful change. Both are plain authenticated app-forms, so they work with or without script. *) let profile request ?(logging = false) ~viewer ?username_error ?password_error ?notice () = let notice_block = match notice with | Some message -> [ tag "p" [ class_ "notice" ] [ txt "%s" message ] ] | None -> [] in let error_block = function | Some message -> [ tag "p" [ class_ "warn"; Dream_html.string_attr "role" "alert" ] [ txt "%s" message ]; ] | None -> [] in html_page ~viewer ~request ~active:"profile" ~logging "Profile" ([ tag "h1" [] [ txt "Profile" ] ] @ notice_block @ [ (* Username: show the current value and a button that opens the edit modal. The modal holds the rename form. A no-script client, or an error re-render, opens the dialog through the [open] attribute so the form stays reachable and its inline error shows. *) tag "section" [ class_ "profile-section" ] [ tag "h2" [] [ txt "Username" ]; tag "div" [ class_ "profile-value" ] [ tag "span" [ class_ "profile-value-label" ] [ txt "Username" ]; tag "span" [ class_ "profile-value-text" ] [ txt "%s" viewer.View_model.Viewer.username ]; tag "button" [ type_ "button"; class_ "profile-edit"; Dream_html.string_attr "data-hito-dialog-open" "username-dialog"; ] [ txt "Change username" ]; ]; tag "dialog" ([ Dream_html.string_attr "id" "username-dialog"; class_ "profile-dialog"; ] @ if Option.is_some username_error then [ Dream_html.attr "open" ] else []) [ tag "div" [ class_ "profile-dialog-content" ] ([ tag "h3" [] [ txt "Change username" ]; tag "form" [ action Routes.profile_username; post_form; class_ "profile-form"; Dream_html.attr "data-hito-app-form"; ] [ Dream_html.csrf_tag request; tag "div" [ class_ "field" ] [ tag "label" [ Dream_html.string_attr "for" "username" ] [ txt "Username" ]; void "input" [ type_ "text"; name "username"; Dream_html.string_attr "id" "username"; Dream_html.string_attr "value" "%s" viewer.View_model.Viewer.username; required; ]; ]; tag "div" [ class_ "profile-dialog-actions" ] [ tag "button" [ type_ "button"; class_ "secondary"; Dream_html.attr "data-hito-dialog-close"; ] [ txt "Cancel" ]; void "input" [ type_ "submit"; value "Change username" ]; ]; ]; ] @ error_block username_error); ]; ]; (* Password: a button opens the change-password modal. *) tag "section" [ class_ "profile-section" ] [ tag "h2" [] [ txt "Password" ]; tag "div" [ class_ "profile-value" ] [ tag "span" [ class_ "profile-value-label" ] [ txt "Password" ]; tag "span" [ class_ "profile-value-text" ] [ txt "••••••••" ]; tag "button" [ type_ "button"; class_ "profile-edit"; Dream_html.string_attr "data-hito-dialog-open" "password-dialog"; ] [ txt "Change password" ]; ]; tag "dialog" ([ Dream_html.string_attr "id" "password-dialog"; class_ "profile-dialog"; ] @ if Option.is_some password_error then [ Dream_html.attr "open" ] else []) [ tag "div" [ class_ "profile-dialog-content" ] ([ tag "h3" [] [ txt "Change password" ]; tag "form" [ action Routes.profile_password; post_form; class_ "profile-form"; Dream_html.attr "data-hito-app-form"; ] [ Dream_html.csrf_tag request; tag "div" [ class_ "field" ] [ tag "label" [ Dream_html.string_attr "for" "current" ] [ txt "Current password" ]; void "input" [ type_ "password"; name "current"; Dream_html.string_attr "id" "current"; required; ]; ]; tag "div" [ class_ "field" ] [ tag "label" [ Dream_html.string_attr "for" "next" ] [ txt "New password" ]; void "input" [ type_ "password"; name "next"; Dream_html.string_attr "id" "next"; required; ]; ]; tag "div" [ class_ "profile-dialog-actions" ] [ tag "button" [ type_ "button"; class_ "secondary"; Dream_html.attr "data-hito-dialog-close"; ] [ txt "Cancel" ]; void "input" [ type_ "submit"; value "Change password" ]; ]; ]; ] @ error_block password_error); ]; ]; (* Import: a multipart form uploads a native Hevy CSV export. The file field is [csv], the wall-clock offset is [utc_offset_seconds], and an optional checkbox overrides duplicate-source rejection. The form is a plain multipart POST with its CSRF token, so it needs no script. *) tag "section" [ class_ "profile-section" ] [ tag "h2" [] [ txt "Import" ]; tag "form" [ action Routes.import_upload; post_form; Dream_html.string_attr "enctype" "multipart/form-data"; class_ "profile-form"; ] [ Dream_html.csrf_tag request; tag "div" [ class_ "field" ] [ tag "label" [ Dream_html.string_attr "for" "csv" ] [ txt "Hevy CSV export" ]; void "input" [ type_ "file"; name "csv"; Dream_html.string_attr "id" "csv"; Dream_html.string_attr "accept" ".csv,text/csv"; required; ]; ]; tag "div" [ class_ "field" ] [ tag "label" [ Dream_html.string_attr "for" "utc_offset_seconds" ] [ txt "UTC offset in seconds" ]; void "input" [ type_ "number"; name "utc_offset_seconds"; Dream_html.string_attr "id" "utc_offset_seconds"; Dream_html.string_attr "value" "0"; required; ]; ]; tag "div" [ class_ "field" ] [ void "input" [ type_ "checkbox"; name "allow_duplicate"; Dream_html.string_attr "id" "allow_duplicate"; value "true"; ]; tag "label" [ Dream_html.string_attr "for" "allow_duplicate" ] [ txt "Import even if this export was imported before" ]; ]; void "input" [ type_ "submit"; value "Upload import" ]; ]; ]; ]) (* The settings page. It currently stores the user's light or dark theme choice in the session. *) let settings request ?(logging = false) ~viewer ~theme () = let next_theme, label = match theme with | "dark" -> ("light", "Use light theme") | _ -> ("dark", "Use dark theme") in html_page ~viewer ~request ~active:"settings" ~logging "Settings" [ tag "h1" [] [ txt "Settings" ]; tag "section" [ class_ "settings-section" ] [ tag "h2" [] [ txt "Theme" ]; tag "p" [] [ txt "Choose a light or dark theme for this session." ]; tag "form" [ action Routes.settings_theme; post_form; class_ "settings-form" ] [ Dream_html.csrf_tag request; void "input" [ type_ "hidden"; name "theme"; Dream_html.string_attr "value" "%s" next_theme; ]; void "input" [ type_ "submit"; Dream_html.string_attr "value" "%s" label ]; ]; ]; ] (* The review of a provisional import batch. It renders the parse warnings, then each workout with its sets, blockers, and forms. Every form is a plain POST carrying its CSRF token, so cleaning and promotion need no script. The page names only the view model: the controller has already phrased set types, blockers, and warnings, so no core entity crosses the boundary here. *) let import_review request ~viewer (vm : View_model.Import_review.t) = let warnings_block = match vm.View_model.Import_review.warnings with | [] -> [] | warnings -> [ tag "section" [ class_ "import-warnings" ] [ tag "h2" [] [ txt "Dropped rows" ]; tag "ul" [] (List.map (fun (w : View_model.Import_warning.t) -> tag "li" [] [ txt "Row %d: %s" w.View_model.Import_warning.row w.View_model.Import_warning.detail; ]) warnings); ]; ] in (* One row per set. A mapped set shows the catalog name it resolves to. *) let set_row (s : View_model.Import_set.t) = let mapping = match s.View_model.Import_set.mapping with | Some name -> Printf.sprintf " → %s" name | None -> " → unmapped" in tag "li" [] [ txt "Row %d: %s (%s) %s kg × %s reps%s" s.View_model.Import_set.row s.View_model.Import_set.exercise_name s.View_model.Import_set.set_type s.View_model.Import_set.weight s.View_model.Import_set.reps mapping; ] in (* One mapping form per distinct source name in the workout. The source name is fixed by a hidden field; the trainee supplies the catalog exercise id. *) let mapping_form batch_id workout_id source_name = tag "form" [ action Routes.import_map batch_id workout_id; post_form; class_ "import-map-form"; ] [ Dream_html.csrf_tag request; void "input" [ type_ "hidden"; name "source_name"; Dream_html.string_attr "value" "%s" source_name; ]; tag "div" [ class_ "field" ] [ tag "label" [] [ txt "Map %s to exercise id" source_name ]; void "input" [ type_ "text"; name "exercise_id"; required ]; ]; void "input" [ type_ "submit"; value "Map exercise" ]; ] in let confirm_form batch_id workout_id acknowledgement = tag "form" [ action Routes.import_confirm batch_id workout_id; post_form; class_ "import-confirm-form"; ] [ Dream_html.csrf_tag request; tag "div" [ class_ "field" ] [ tag "label" [] [ txt "Confirm normal sets" ]; void "input" ([ type_ "text"; name "acknowledgement"; required ] @ match acknowledgement with | Some ack -> [ Dream_html.string_attr "value" "%s" ack ] | None -> []); ]; void "input" [ type_ "submit"; value "Confirm normal sets" ]; ] in let promote_workout_form batch_id workout_id = tag "form" [ action Routes.import_promote_workout batch_id workout_id; post_form; class_ "import-promote-workout-form"; ] [ Dream_html.csrf_tag request; void "input" [ type_ "submit"; value "Promote workout" ]; ] in let blockers_block (w : View_model.Import_workout.t) = match w.View_model.Import_workout.blockers with | [] -> [ tag "p" [ class_ "import-ready" ] [ txt "Ready to promote." ] ] | blockers -> [ tag "p" [] [ txt "Blocked:" ]; tag "ul" [ class_ "import-blockers" ] (List.map (fun b -> tag "li" [] [ txt "%s" b ]) blockers); ] in let workout_section (w : View_model.Import_workout.t) = let batch_id = vm.View_model.Import_review.batch_id in let workout_id = w.View_model.Import_workout.id in (* Every distinct source name, in first-appearance order. *) let source_names = List.fold_left (fun acc (s : View_model.Import_set.t) -> let n = s.View_model.Import_set.exercise_name in if List.mem n acc then acc else acc @ [ n ]) [] w.View_model.Import_workout.sets in tag "section" [ class_ "import-workout" ] ([ tag "h2" [] [ txt "%s" w.View_model.Import_workout.title ]; tag "ul" [ class_ "import-sets" ] (List.map set_row w.View_model.Import_workout.sets); ] @ blockers_block w @ List.map (mapping_form batch_id workout_id) source_names @ [ confirm_form batch_id workout_id w.View_model.Import_workout.acknowledgement; promote_workout_form batch_id workout_id; ]) in let batch_promote_form = tag "form" [ action Routes.import_promote_batch vm.View_model.Import_review.batch_id; post_form; class_ "import-promote-batch-form"; ] [ Dream_html.csrf_tag request; void "input" [ type_ "submit"; value "Promote whole batch" ]; ] in html_page ~viewer ~request ~active:"profile" "Import review" ([ tag "h1" [] [ txt "Import review" ] ] @ warnings_block @ List.map workout_section vm.View_model.Import_review.workouts @ [ batch_promote_form ])