1 open Dream_html 2 open Page_kit 3 open Page_shell 4 5 (* The review of a provisional import batch. It renders the parse warnings, then 6 each workout with its sets, blockers, and forms. Every form is a plain POST 7 carrying its CSRF token, so cleaning and promotion need no script. The page 8 names only the view model: the controller has already phrased set types, 9 blockers, and warnings, so no core entity crosses the boundary here. *) 10 let import_review request ~viewer (vm : View_model.Import_review.t) = 11 let warnings_block = 12 match vm.View_model.Import_review.warnings with 13 | [] -> [] 14 | warnings -> 15 [ 16 tag "section" 17 [ class_ "import-warnings" ] 18 [ 19 tag "h2" [] [ txt "Dropped rows" ]; 20 tag "ul" [] 21 (List.map 22 (fun (w : View_model.Import_warning.t) -> 23 tag "li" [] 24 [ 25 txt "Row %d: %s" w.View_model.Import_warning.row 26 w.View_model.Import_warning.detail; 27 ]) 28 warnings); 29 ]; 30 ] 31 in 32 (* One row per set. A mapped set shows the catalog name it resolves to. *) 33 let set_row (s : View_model.Import_set.t) = 34 let mapping = 35 match s.View_model.Import_set.mapping with 36 | Some name -> Printf.sprintf " → %s" name 37 | None -> " → unmapped" 38 in 39 tag "li" [] 40 [ 41 txt "Row %d: %s (%s) %s kg × %s reps%s" s.View_model.Import_set.row 42 s.View_model.Import_set.exercise_name s.View_model.Import_set.set_type 43 s.View_model.Import_set.weight s.View_model.Import_set.reps mapping; 44 ] 45 in 46 (* One mapping form per distinct source name in the workout. The source name 47 is fixed by a hidden field; the trainee supplies the catalog exercise id. *) 48 let mapping_form batch_id workout_id source_name = 49 tag "form" 50 [ 51 action Routes.import_map batch_id workout_id; 52 post_form; 53 class_ "import-map-form"; 54 ] 55 [ 56 Dream_html.csrf_tag request; 57 void "input" 58 [ 59 type_ "hidden"; 60 name "source_name"; 61 Dream_html.string_attr "value" "%s" source_name; 62 ]; 63 tag "div" 64 [ class_ "field" ] 65 [ 66 tag "label" [] [ txt "Map %s to exercise id" source_name ]; 67 void "input" [ type_ "text"; name "exercise_id"; required ]; 68 ]; 69 void "input" [ type_ "submit"; value "Map exercise" ]; 70 ] 71 in 72 let confirm_form batch_id workout_id acknowledgement = 73 tag "form" 74 [ 75 action Routes.import_confirm batch_id workout_id; 76 post_form; 77 class_ "import-confirm-form"; 78 ] 79 [ 80 Dream_html.csrf_tag request; 81 tag "div" 82 [ class_ "field" ] 83 [ 84 tag "label" [] [ txt "Confirm normal sets" ]; 85 void "input" 86 ([ type_ "text"; name "acknowledgement"; required ] 87 @ 88 match acknowledgement with 89 | Some ack -> [ Dream_html.string_attr "value" "%s" ack ] 90 | None -> []); 91 ]; 92 void "input" [ type_ "submit"; value "Confirm normal sets" ]; 93 ] 94 in 95 let promote_workout_form batch_id workout_id = 96 tag "form" 97 [ 98 action Routes.import_promote_workout batch_id workout_id; 99 post_form; 100 class_ "import-promote-workout-form"; 101 ] 102 [ 103 Dream_html.csrf_tag request; 104 void "input" [ type_ "submit"; value "Promote workout" ]; 105 ] 106 in 107 let blockers_block (w : View_model.Import_workout.t) = 108 match w.View_model.Import_workout.blockers with 109 | [] -> [ tag "p" [ class_ "import-ready" ] [ txt "Ready to promote." ] ] 110 | blockers -> 111 [ 112 tag "p" [] [ txt "Blocked:" ]; 113 tag "ul" 114 [ class_ "import-blockers" ] 115 (List.map (fun b -> tag "li" [] [ txt "%s" b ]) blockers); 116 ] 117 in 118 let workout_section (w : View_model.Import_workout.t) = 119 let batch_id = vm.View_model.Import_review.batch_id in 120 let workout_id = w.View_model.Import_workout.id in 121 (* Every distinct source name, in first-appearance order. *) 122 let source_names = 123 List.fold_left 124 (fun acc (s : View_model.Import_set.t) -> 125 let n = s.View_model.Import_set.exercise_name in 126 if List.mem n acc then acc else acc @ [ n ]) 127 [] w.View_model.Import_workout.sets 128 in 129 tag "section" 130 [ class_ "import-workout" ] 131 ([ 132 tag "h2" [] [ txt "%s" w.View_model.Import_workout.title ]; 133 tag "ul" 134 [ class_ "import-sets" ] 135 (List.map set_row w.View_model.Import_workout.sets); 136 ] 137 @ blockers_block w 138 @ List.map (mapping_form batch_id workout_id) source_names 139 @ [ 140 confirm_form batch_id workout_id 141 w.View_model.Import_workout.acknowledgement; 142 promote_workout_form batch_id workout_id; 143 ]) 144 in 145 let batch_promote_form = 146 tag "form" 147 [ 148 action Routes.import_promote_batch vm.View_model.Import_review.batch_id; 149 post_form; 150 class_ "import-promote-batch-form"; 151 ] 152 [ 153 Dream_html.csrf_tag request; 154 void "input" [ type_ "submit"; value "Promote whole batch" ]; 155 ] 156 in 157 html_page ~viewer ~request ~active:"profile" "Import review" 158 ([ tag "h1" [] [ txt "Import review" ] ] 159 @ warnings_block 160 @ List.map workout_section vm.View_model.Import_review.workouts 161 @ [ batch_promote_form ]) 162