1 type page = Dream_html.node 2 3 let tag = Dream_html.std_tag 4 let void = Dream_html.void_tag 5 let class_ value = Dream_html.string_attr "class" value 6 let name value = Dream_html.string_attr "name" value 7 let value value = Dream_html.string_attr "value" value 8 let rel value = Dream_html.string_attr "rel" value 9 let type_ value = Dream_html.string_attr "type" value 10 let step value = Dream_html.string_attr "step" value 11 let id value = Dream_html.string_attr "id" value 12 let tabindex value = Dream_html.string_attr "tabindex" value 13 let required = Dream_html.attr "required" 14 let href path = Dream_html.path_attr (Dream_html.uri_attr "href") path 15 let src path = Dream_html.path_attr (Dream_html.uri_attr "src") path 16 let action path = Dream_html.path_attr (Dream_html.uri_attr "action") path 17 let post_form = Dream_html.string_attr "method" "post" 18 19 let alert message = 20 tag "p" 21 [ class_ "warn"; Dream_html.string_attr "role" "alert" ] 22 [ Dream_html.txt "%s" message ] 23 24 (* Render server-side link tabs. The active tab uses [aria-current] because 25 each tab navigates to a complete page rather than switching a client panel. *) 26 let link_tabs ~aria_label ~active tabs = 27 let tab_link (key, label, path) = 28 let attrs = 29 [ 30 class_ "page-tab"; 31 Dream_html.string_attr "href" "%s" path; 32 Dream_html.attr "data-hito-app-link"; 33 ] 34 in 35 let attrs = 36 if String.equal key active then 37 Dream_html.string_attr "aria-current" "page" :: attrs 38 else attrs 39 in 40 tag "a" attrs [ Dream_html.txt "%s" label ] 41 in 42 tag "nav" 43 [ class_ "page-tabs"; Dream_html.string_attr "aria-label" "%s" aria_label ] 44 (List.map tab_link tabs) 45 46 (* Render the common comparison table structure. The caller supplies grouped 47 bodies, so recorded and planned workouts keep their different values. *) 48 let workout_evidence_table ?(upcoming = false) ?(caption_class = "sr-only") 49 ~caption bodies = 50 let classes = 51 if upcoming then "workout-evidence-table upcoming-workout-table" 52 else "workout-evidence-table" 53 in 54 let column label = 55 tag "th" 56 [ Dream_html.string_attr "scope" "col" ] 57 [ Dream_html.txt "%s" label ] 58 in 59 let headers = 60 [ column "Exercise"; column "Load (kg)" ] 61 @ 62 if upcoming then [ column "Reps" ] 63 else [ column "Δ"; column "Reps"; column "Δ" ] 64 in 65 tag "table" 66 [ class_ "%s" classes ] 67 ([ 68 tag "caption" [ class_ "%s" caption_class ] caption; 69 tag "thead" [] [ tag "tr" [] headers ]; 70 ] 71 @ bodies) 72 73 (* Render a prescribed workout before it has a log. Both Home and Logbook use 74 this component, so the same upcoming workout shows the same evidence. *) 75 let upcoming_workout_card (planned : View_model.Upcoming_workout.t) = 76 let format_load load = Printf.sprintf "%g" load in 77 let format_reps reps = string_of_int reps in 78 let rows_of_group (group : View_model.Upcoming_workout.group) = 79 List.map 80 (fun (exercise : View_model.Upcoming_workout.exercise) -> 81 tag "tr" [] 82 [ 83 tag "th" 84 [ 85 Dream_html.string_attr "scope" "row"; class_ "evidence-exercise"; 86 ] 87 [ Dream_html.txt "%s" exercise.name ]; 88 tag "td" 89 [ class_ "observation-latest" ] 90 [ 91 Dream_html.txt "%s" 92 (Option.fold ~none:"—" ~some:format_load exercise.latest_load); 93 ]; 94 tag "td" 95 [ class_ "observation-latest" ] 96 [ 97 Dream_html.txt "%s" 98 (Option.fold ~none:"—" ~some:format_reps exercise.latest_reps); 99 ]; 100 ]) 101 group.exercises 102 in 103 let caption = 104 [ 105 tag "strong" 106 [ class_ "workout-evidence-caption-name" ] 107 [ Dream_html.txt "%s, %s" planned.routine_name planned.name ]; 108 tag "span" 109 [ class_ "workout-evidence-caption-status upcoming" ] 110 [ Dream_html.txt "Planned on %s" planned.scheduled_on ]; 111 ] 112 in 113 tag "article" 114 [ class_ "selected-upcoming-workout" ] 115 [ 116 workout_evidence_table ~upcoming:true 117 ~caption_class:"upcoming-workout-caption" ~caption 118 (List.map 119 (fun group -> tag "tbody" [] (rows_of_group group)) 120 planned.groups); 121 ] 122