[OCaml] High Intensity Training Online
refactor Cross the feedback boundary with a view model
The logbook presenter described Evidence.Feedback signal variants and sorted by a Recovery timestamp to draw the trend graph. Add a Feedback report DTO (sort key in Unix seconds, pre-described signals, per-factor scores) to view_model.ml, map it in the controller, and have Pages render only the DTO. The presenter no longer names Evidence.Feedback. Behavior-preserving; 243 tests pass.
lib/web/handlers.ml
@@ -548,6 +548,54 @@
548
548
optional_flag "preparation" Evidence.Feedback.Preparation_insufficient;
549
549
]
550
550
551
Added:
(* Describe one signal for the list, and compute a factor's score for the
552
Added:
graph. These read the Evidence.Feedback entity here in the controller, so
553
Added:
the presenter receives only strings and scores. *)
554
Added:
let describe_signal (signal : Evidence.Feedback.signal) =
555
Added:
let level l =
556
Added:
let score = Evidence.Feedback.level_to_score l in
557
Added:
match l with
558
Added:
| Evidence.Feedback.Very_poor -> Printf.sprintf "%d (very poor)" score
559
Added:
| Very_good -> Printf.sprintf "%d (very good)" score
560
Added:
| _ -> string_of_int score
561
Added:
in
562
Added:
match signal with
563
Added:
| Sleep l -> Printf.sprintf "Sleep %s" (level l)
564
Added:
| Appetite l -> Printf.sprintf "Appetite %s" (level l)
565
Added:
| Readiness l -> Printf.sprintf "Readiness %s" (level l)
566
Added:
| Motivation l -> Printf.sprintf "Motivation %s" (level l)
567
Added:
| Difficulty l -> Printf.sprintf "Difficulty %s" (level l)
568
Added:
| Pain -> "Pain"
569
Added:
| Injury -> "Injury"
570
Added:
| Preparation_insufficient -> "Preparation insufficient"
571
Added:
572
Added:
let factor_fields =
573
Added:
[ "sleep"; "appetite"; "readiness"; "motivation"; "difficulty" ]
574
Added:
575
Added:
let factor_score field (report : Evidence.Feedback.t) =
576
Added:
let of_signal (signal : Evidence.Feedback.signal) =
577
Added:
match (field, signal) with
578
Added:
| "sleep", Sleep l
579
Added:
| "appetite", Appetite l
580
Added:
| "readiness", Readiness l
581
Added:
| "motivation", Motivation l
582
Added:
| "difficulty", Difficulty l ->
583
Added:
Some (Evidence.Feedback.level_to_score l)
584
Added:
| _ -> None
585
Added:
in
586
Added:
List.find_map of_signal (Evidence.Feedback.signals report)
587
Added:
588
Added:
let feedback_view (report : Evidence.Feedback.t) :
589
Added:
View_model.Feedback.report =
590
Added:
{
591
Added:
at_unix =
592
Added:
Recovery.timestamp_to_unix_seconds
593
Added:
(Evidence.Feedback.reported_at report);
594
Added:
signals = List.map describe_signal (Evidence.Feedback.signals report);
595
Added:
factor_scores =
596
Added:
List.map (fun f -> (f, factor_score f report)) factor_fields;
597
Added:
}
598
Added:
551
599
let index t trainee request =
552
600
let viewer =
553
601
{
@@ -558,6 +606,7 @@
558
606
Service.in_progress t.service trainee.Trainee.id >>= fun in_progress ->
559
607
Service.history t.service trainee.Trainee.id >>= fun records ->
560
608
Service.feedback t.service trainee.Trainee.id >>= fun feedback ->
609
Added:
let feedback = List.map feedback_view feedback in
561
610
let saved_flow = feedback_flow request in
562
611
let feedback_open =
563
612
match
lib/web/pages.ml
@@ -1366,60 +1366,29 @@
1366
1366
];
1367
1367
]
1368
1368
1369
Removed:
let describe_signal (signal : Evidence.Feedback.signal) =
1370
Removed:
let level l =
1371
Removed:
let score = Evidence.Feedback.level_to_score l in
1372
Removed:
match l with
1373
Removed:
| Evidence.Feedback.Very_poor -> Printf.sprintf "%d (very poor)" score
1374
Removed:
| Very_good -> Printf.sprintf "%d (very good)" score
1375
Removed:
| _ -> string_of_int score
1376
Removed:
in
1377
Removed:
match signal with
1378
Removed:
| Sleep l -> Printf.sprintf "Sleep %s" (level l)
1379
Removed:
| Appetite l -> Printf.sprintf "Appetite %s" (level l)
1380
Removed:
| Readiness l -> Printf.sprintf "Readiness %s" (level l)
1381
Removed:
| Motivation l -> Printf.sprintf "Motivation %s" (level l)
1382
Removed:
| Difficulty l -> Printf.sprintf "Difficulty %s" (level l)
1383
Removed:
| Pain -> "Pain"
1384
Removed:
| Injury -> "Injury"
1385
Removed:
| Preparation_insufficient -> "Preparation insufficient"
1386
Removed:
1387
Removed:
(* The scored level a report gives one factor, if any. Only leveled factors
1388
Removed:
plot on the graph; flags such as pain are events, not scores. *)
1389
Removed:
let factor_score (field : string) (report : Evidence.Feedback.t) =
1390
Removed:
let of_signal (signal : Evidence.Feedback.signal) =
1391
Removed:
match (field, signal) with
1392
Removed:
| "sleep", Sleep l
1393
Removed:
| "appetite", Appetite l
1394
Removed:
| "readiness", Readiness l
1395
Removed:
| "motivation", Motivation l
1396
Removed:
| "difficulty", Difficulty l ->
1397
Removed:
Some (Evidence.Feedback.level_to_score l)
1398
Removed:
| _ -> None
1399
Removed:
in
1400
Removed:
List.find_map of_signal (Evidence.Feedback.signals report)
1401
Removed:
1402
1369
(* A small inline-SVG line chart of leveled feedback over time, one polyline per
1403
1370
factor. No script and no dependency: the logbook records, and this only draws
1404
1371
what it already holds. Shown once at least two reports carry a leveled
1405
1372
factor, since a single point is not a trend. *)
1406
Removed:
let feedback_graph reports =
1373
Added:
let feedback_graph (reports : View_model.Feedback.report list) =
1407
1374
let chronological =
1408
1375
List.sort
1409
Removed:
(fun a b ->
1410
Removed:
Int.compare
1411
Removed:
(Recovery.timestamp_to_unix_seconds (Evidence.Feedback.reported_at a))
1412
Removed:
(Recovery.timestamp_to_unix_seconds (Evidence.Feedback.reported_at b)))
1376
Added:
(fun (a : View_model.Feedback.report) (b : View_model.Feedback.report) ->
1377
Added:
Int.compare a.at_unix b.at_unix)
1413
1378
reports
1414
1379
in
1415
1380
let count = List.length chronological in
1381
Added:
let score_of field (report : View_model.Feedback.report) =
1382
Added:
match List.assoc_opt field report.factor_scores with
1383
Added:
| Some s -> s
1384
Added:
| None -> None
1385
Added:
in
1416
1386
let series =
1417
1387
List.map
1418
1388
(fun (field, label) ->
1419
1389
( label,
1420
Removed:
List.mapi
1421
Removed:
(fun i report -> (i, factor_score field report))
1422
Removed:
chronological ))
1390
Added:
List.mapi (fun i report -> (i, score_of field report)) chronological
1391
Added:
))
1423
1392
feedback_factors
1424
1393
in
1425
1394
(* A factor charts only if it holds at least two scored points. *)
@@ -1498,18 +1467,15 @@
1498
1467
];
1499
1468
]
1500
1469
1501
Removed:
let feedback_list reports =
1470
Added:
let feedback_list (reports : View_model.Feedback.report list) =
1502
1471
if reports = [] then []
1503
1472
else
1504
1473
[
1505
1474
tag "ul"
1506
1475
[ class_ "feedback-list" ]
1507
1476
(List.map
1508
Removed:
(fun report ->
1509
Removed:
let signals =
1510
Removed:
String.concat ", "
1511
Removed:
(List.map describe_signal (Evidence.Feedback.signals report))
1512
Removed:
in
1477
Added:
(fun (report : View_model.Feedback.report) ->
1478
Added:
let signals = String.concat ", " report.signals in
1513
1479
tag "li" []
1514
1480
[ txt "%s" (if signals = "" then "No signals" else signals) ])
1515
1481
reports);
lib/web/pages.mli
@@ -68,7 +68,7 @@
68
68
Dream.request ->
69
69
?logging:bool ->
70
70
viewer:View_model.Viewer.t ->
71
Removed:
?feedback:Evidence.Feedback.t list ->
71
Added:
?feedback:View_model.Feedback.report list ->
72
72
?suggest_feedback:bool ->
73
73
?feedback_flow:feedback_flow ->
74
74
?feedback_open:bool ->
lib/web/view_model.ml
@@ -6,8 +6,9 @@
6
6
entity into a view model, and the presenter ({!Pages}) renders the view
7
7
model without ever naming an inner-circle type.
8
8
9
Removed:
Migrated so far: application feedback. Other pages still take entities
10
Removed:
directly; they move here page by page. *)
9
Added:
Migrated so far: the signed-in viewer, application feedback, and subjective
10
Added:
feedback. Other pages still take entities directly; they move here page by
11
Added:
page. *)
11
12
12
13
module Viewer = struct
13
14
type t = { username : string }
@@ -28,4 +29,17 @@
28
29
}
29
30
(** One application-feedback entry, ready to render. Carries no timestamp
30
31
type, no opaque id, no repository record — only what the view shows. *)
32
Added:
end
33
Added:
34
Added:
module Feedback = struct
35
Added:
type report = {
36
Added:
at_unix : int; (** Report time in Unix seconds, for chronological order. *)
37
Added:
signals : string list; (** Each signal already described, for the list. *)
38
Added:
factor_scores : (string * int option) list;
39
Added:
(** Score per leveled factor field, aligned with the factor order the
40
Added:
presenter graphs. [None] where the report gave that factor no level.
41
Added:
Flags such as pain carry no score and are absent here. *)
42
Added:
}
43
Added:
(** One subjective-feedback report, ready to render. Carries no
44
Added:
[Evidence.Feedback] variant and no timestamp type. *)
31
45
end