1 open Dream_html 2 open Page_kit 3 open Page_shell 4 5 let choose_routine request ~workout_started ~viewer 6 ~(routines : View_model.Routine_choice.t list) = 7 html_page ~viewer ~request ~active:"home" ?workout_started "Choose a routine" 8 ([ tag "h1" [] [ txt "Routines" ] ] 9 @ List.map 10 (fun (choice : View_model.Routine_choice.t) -> 11 tag "form" 12 [ 13 action Routes.select_routine choice.id; 14 post_form; 15 Dream_html.attr "data-hito-app-form"; 16 ] 17 [ 18 Dream_html.csrf_tag request; 19 tag "fieldset" [] 20 [ 21 tag "legend" [] [ txt "%s" choice.name ]; 22 tag "p" [] 23 [ txt "%d workouts in the cycle." choice.workout_count ]; 24 void "input" [ type_ "submit"; value "Use this routine" ]; 25 ]; 26 ]) 27 routines) 28 29 (* Both begin forms post the same fields. Only the override flag differs. *) 30 let begin_fields request ~routine_id ~override = 31 [ 32 Dream_html.csrf_tag request; 33 void "input" 34 [ 35 type_ "hidden"; 36 name "routine"; 37 Dream_html.string_attr "value" "%s" routine_id; 38 ]; 39 void "input" 40 [ 41 type_ "hidden"; 42 name "override"; 43 Dream_html.string_attr "value" "%s" (string_of_bool override); 44 ]; 45 ] 46 47 let begin_form request ~routine_id ~override label = 48 tag "form" 49 [ action Routes.workout; post_form; Dream_html.attr "data-hito-app-form" ] 50 (begin_fields request ~routine_id ~override 51 @ [ void "input" [ type_ "submit"; value label ] ]) 52 53 (* Beginning under override needs an explicit acknowledgement, so its submit is 54 gated behind a confirmation modal. Without script the form submits at once — 55 the doctrine's deviation stays possible. The modal only makes it deliberate. 56 The client reuses the shared confirm machinery: [data-hito-confirm-cancel] 57 opens the dialog, [data-hito-confirm-form] is the form its accept submits. *) 58 let override_begin request ~routine_id = 59 [ 60 tag "form" 61 [ 62 action Routes.workout; 63 post_form; 64 Dream_html.attr "data-hito-app-form"; 65 Dream_html.attr "data-hito-confirm-form"; 66 ] 67 (begin_fields request ~routine_id ~override:true 68 @ [ 69 void "input" 70 [ 71 type_ "submit"; 72 class_ "outline"; 73 value "Begin under override"; 74 Dream_html.attr "data-hito-confirm-cancel"; 75 ]; 76 ]); 77 tag "dialog" 78 [ class_ "confirm-dialog"; Dream_html.attr "data-hito-confirm-modal" ] 79 [ 80 tag "h2" [] [ txt "Begin before recovery is complete?" ]; 81 tag "p" [] 82 [ 83 txt 84 "Heavy Duty grows muscle during recovery, not in the gym. \ 85 Training early can reduce it. The app records this as an \ 86 override."; 87 ]; 88 tag "div" 89 [ class_ "button-group" ] 90 [ 91 tag "button" 92 [ type_ "button"; Dream_html.attr "data-hito-confirm-accept" ] 93 [ txt "Begin under override" ]; 94 tag "button" 95 [ 96 type_ "button"; 97 class_ "secondary"; 98 Dream_html.attr "data-hito-confirm-dismiss"; 99 ] 100 [ txt "Wait to recover" ]; 101 ]; 102 ]; 103 ] 104 105 let home request ~viewer ~home:(vm : View_model.Home.t) = 106 let status, gate = 107 match vm.gate with 108 | View_model.Home.Ready -> 109 ( None, 110 [ 111 begin_form request ~routine_id:vm.routine_id ~override:false 112 "Begin next workout"; 113 ] ) 114 | View_model.Home.Recovering { status } -> 115 ( Some status, 116 [ 117 tag "div" 118 [ class_ "warn" ] 119 ([ 120 tag "p" [] 121 [ 122 txt "Heavy Duty requires recovery before the next workout."; 123 ]; 124 ] 125 @ override_begin request ~routine_id:vm.routine_id); 126 ] ) 127 in 128 html_page ~viewer ~request ~active:"home" "Home" 129 ([ 130 tag "h1" [] [ txt "Next Workout" ]; upcoming_workout_card vm.next_workout; 131 ] 132 @ Option.to_list 133 (Option.map (fun text -> tag "p" [] [ txt "%s" text ]) status) 134 @ gate) 135 136 (* Home while a workout is in progress. Rather than the recovery gate or the 137 routine chooser, Home shows a single card: the workout is under way and one 138 tap returns to it. The middle navigation action already reads "Current 139 workout" here, and this card is the matching Home affordance. *) 140 let workout_in_progress request ~viewer ~workout_started ~workout_name = 141 html_page ~viewer ~request ~active:"home" ~workout_started "Home" 142 [ 143 tag "a" 144 [ 145 class_ "in-progress"; 146 href Routes.workout; 147 Dream_html.attr "data-hito-app-link"; 148 ] 149 [ 150 tag "p" [ class_ "eyebrow" ] [ txt "Workout in progress" ]; 151 tag "h1" [] [ txt "%s" workout_name ]; 152 tag "p" [] [ txt "Return to the current workout to keep logging." ]; 153 ]; 154 ] 155 156 (* One workout stop on the timeline. The workout is a native [details], so it 157 works without script and needs no [name]: stops open independently and the 158 trainee can compare workouts. Only the next workout starts open. The rest 159 stays outside the [details], so a closed timeline still shows the gating. *) 160 let workout_stop (workout : View_model.Routine.workout) = 161 let next, recovery = 162 match workout.position with 163 | View_model.Routine.Next { recovery } -> (true, recovery) 164 | View_model.Routine.Elsewhere -> (false, None) 165 in 166 tag "li" 167 ([ class_ "routine-stop" ] 168 @ if next then [ Dream_html.string_attr "aria-current" "step" ] else []) 169 [ 170 tag "details" 171 ([ class_ "routine-workout" ] 172 @ if next then [ Dream_html.attr "open" ] else []) 173 [ 174 tag "summary" [] 175 ([ tag "h2" [ class_ "routine-day" ] [ txt "%s" workout.name ] ] 176 @ (if next then 177 [ tag "span" [ class_ "routine-next" ] [ txt "Next" ] ] 178 else []) 179 @ 180 match recovery with 181 | Some status -> 182 [ tag "span" [ class_ "routine-recovery" ] [ txt "%s" status ] ] 183 | None -> []); 184 (* The panel clips the content while the unfold animates. *) 185 tag "div" 186 [ class_ "routine-panel" ] 187 [ 188 tag "ol" 189 [ class_ "routine-exercises" ] 190 (List.map 191 (fun (exercise : View_model.Routine.exercise) -> 192 tag "li" [] 193 [ 194 tag "span" 195 [ class_ "routine-exercise" ] 196 [ txt "%s" exercise.name ]; 197 ]) 198 workout.exercises); 199 ]; 200 ]; 201 tag "p" [ class_ "routine-rest" ] [ txt "%s" workout.rest_after ]; 202 ] 203 204 let routine request ?workout_started ~viewer (vm : View_model.Routine.t) = 205 html_page ~viewer ~request ~active:"routine" ?workout_started "Routine" 206 [ 207 tag "h1" [] [ txt "%s" vm.name ]; 208 tag "p" [] 209 [ 210 tag "a" 211 [ href Routes.routines; Dream_html.attr "data-hito-app-link" ] 212 [ txt "Browse routines" ]; 213 ]; 214 tag "ol" [ class_ "routine-timeline" ] (List.map workout_stop vm.workouts); 215 ] 216