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 ])