[OCaml] High Intensity Training Online

refactor Cross the app-feedback boundary with a view model

The Clean Architecture rule is that data crossing a boundary is a plain structure, never an entity or a database row. The app-feedback page took Repository.app_feedback and formatted a Recovery timestamp inside the presenter. Introduce lib/web/view_model.ml with an App_feedback DTO of plain fields, map the repository record to it in the controller (formatting the timestamp there), and have Pages render only the DTO. The presenter no longer names Repository.app_feedback or any timestamp entity. Other pages migrate the same way in follow-up changes.

Commit
fbf006ff150b9e3c4a6e928a1df8c4ea0054bbee
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
lib/web/dune
index e3868a46..1daeff14 100644..100644
@@ -28,7 +28,14 @@
28 28 (library
29 29 (name hito_web)
30 30 (public_name hito.web)
31 Removed: (modules routes decode pages handlers stylesheet workout_client_asset)
31 Added: (modules
32 Added: routes
33 Added: decode
34 Added: view_model
35 Added: pages
36 Added: handlers
37 Added: stylesheet
38 Added: workout_client_asset)
32 39 (preprocess
33 40 (pps dream-html.ppx))
34 41 (libraries hito.core hito.app dream dream-html lwt unix))
lib/web/handlers.ml
index a5490215..5d39f17b 100644..100644
@@ -730,13 +730,35 @@
730 730 | Some "submitted" -> `Submitted
731 731 | _ -> `Write
732 732
733 Added: let time_to_string timestamp =
734 Added: let tm =
735 Added: Unix.gmtime
736 Added: (float_of_int (Recovery.timestamp_to_unix_seconds timestamp))
737 Added: in
738 Added: Printf.sprintf "%04d-%02d-%02d %02d:%02d" (tm.Unix.tm_year + 1900)
739 Added: (tm.Unix.tm_mon + 1) tm.Unix.tm_mday tm.Unix.tm_hour tm.Unix.tm_min
740 Added:
741 Added: (* Map a repository record into the view model the presenter renders, so no
742 Added: entity or record crosses the boundary into Pages. *)
743 Added: let view_of (report : Repository.app_feedback) : View_model.App_feedback.t =
744 Added: {
745 Added: id = Repository.app_feedback_id_to_string report.Repository.feedback_id;
746 Added: author = report.Repository.author;
747 Added: contributions = report.Repository.contributions;
748 Added: submitted_at = time_to_string report.Repository.submitted_at;
749 Added: message = report.Repository.message;
750 Added: upvotes = report.Repository.upvotes;
751 Added: viewer_upvoted = report.Repository.viewer_upvoted;
752 Added: viewer_owns = report.Repository.viewer_owns;
753 Added: }
754 Added:
733 755 let show t trainee request =
734 756 Service.in_progress t.service trainee.Trainee.id >>= fun in_progress ->
735 757 Service.app_feedback t.service trainee.Trainee.id >>= fun reports ->
736 758 html
737 759 (Pages.app_feedback request
738 760 ~logging:(Option.is_some in_progress)
739 Removed: ~trainee ~tab:(tab request) reports)
761 Added: ~trainee ~tab:(tab request) (List.map view_of reports))
740 762
741 763 let submit t trainee request =
742 764 decode_form Decode.app_feedback request >>= function
lib/web/pages.ml
index 479a3e14..ae425b00 100644..100644
@@ -1580,13 +1580,6 @@
1580 1580 (* The authenticated application feedback page. It keeps writing and reviewing
1581 1581 feedback in separate tabs, while both tabs remain plain links for no-script
1582 1582 use and progressive enhancement. *)
1583 Removed: let app_feedback_time timestamp =
1584 Removed: let tm =
1585 Removed: Unix.gmtime (float_of_int (Recovery.timestamp_to_unix_seconds timestamp))
1586 Removed: in
1587 Removed: Printf.sprintf "%04d-%02d-%02d %02d:%02d" (tm.Unix.tm_year + 1900)
1588 Removed: (tm.Unix.tm_mon + 1) tm.Unix.tm_mday tm.Unix.tm_hour tm.Unix.tm_min
1589 Removed:
1590 1583 let app_feedback_tab ~selected ~tab ~label =
1591 1584 let path =
1592 1585 match tab with
@@ -1641,26 +1634,24 @@
1641 1634 :: error_block
1642 1635 @ [ void "input" [ type_ "submit"; value "Submit feedback" ] ])
1643 1636
1644 Removed: let app_feedback_vote_form request report =
1645 Removed: if report.Repository.viewer_owns then
1637 Added: let app_feedback_vote_form request (report : View_model.App_feedback.t) =
1638 Added: if report.viewer_owns then
1646 1639 tag "p" [ class_ "app-feedback-own" ] [ txt "Your feedback" ]
1647 1640 else
1648 1641 let label =
1649 Removed: if report.Repository.viewer_upvoted then "Upvoted"
1650 Removed: else Printf.sprintf "Upvote (%d)" report.Repository.upvotes
1642 Added: if report.viewer_upvoted then "Upvoted"
1643 Added: else Printf.sprintf "Upvote (%d)" report.upvotes
1651 1644 in
1652 1645 let attrs =
1653 1646 [
1654 Removed: action Routes.upvote_app_feedback
1655 Removed: (Repository.app_feedback_id_to_string report.Repository.feedback_id);
1647 Added: action Routes.upvote_app_feedback report.id;
1656 1648 post_form;
1657 1649 class_ "app-feedback-vote";
1658 1650 Dream_html.attr "data-hito-app-form";
1659 1651 ]
1660 1652 in
1661 1653 let attrs =
1662 Removed: if report.Repository.viewer_upvoted then
1663 Removed: Dream_html.attr "disabled" :: attrs
1654 Added: if report.viewer_upvoted then Dream_html.attr "disabled" :: attrs
1664 1655 else attrs
1665 1656 in
1666 1657 tag "form" attrs
@@ -1670,11 +1661,10 @@
1670 1661 [ type_ "submit"; Dream_html.string_attr "value" "%s" label ];
1671 1662 ]
1672 1663
1673 Removed: let app_feedback_edit_form request report =
1664 Added: let app_feedback_edit_form request (report : View_model.App_feedback.t) =
1674 1665 tag "form"
1675 1666 [
1676 Removed: action Routes.edit_app_feedback
1677 Removed: (Repository.app_feedback_id_to_string report.Repository.feedback_id);
1667 Added: action Routes.edit_app_feedback report.id;
1678 1668 post_form;
1679 1669 class_ "app-feedback-edit-form";
1680 1670 Dream_html.attr "data-hito-app-form";
@@ -1682,28 +1672,23 @@
1682 1672 [
1683 1673 Dream_html.csrf_tag request;
1684 1674 tag "label"
1685 Removed: [
1686 Removed: Dream_html.string_attr "for" "app-feedback-edit-%s"
1687 Removed: (Repository.app_feedback_id_to_string report.Repository.feedback_id);
1688 Removed: ]
1675 Added: [ Dream_html.string_attr "for" "app-feedback-edit-%s" report.id ]
1689 1676 [ txt "Edit feedback" ];
1690 1677 tag "textarea"
1691 1678 [
1692 1679 name "message";
1693 Removed: Dream_html.string_attr "id" "app-feedback-edit-%s"
1694 Removed: (Repository.app_feedback_id_to_string report.Repository.feedback_id);
1680 Added: Dream_html.string_attr "id" "app-feedback-edit-%s" report.id;
1695 1681 Dream_html.string_attr "rows" "4";
1696 1682 required;
1697 1683 ]
1698 Removed: [ txt "%s" report.Repository.message ];
1684 Added: [ txt "%s" report.message ];
1699 1685 void "input" [ type_ "submit"; value "Save edit" ];
1700 1686 ]
1701 1687
1702 Removed: let app_feedback_remove_form request report =
1688 Added: let app_feedback_remove_form request (report : View_model.App_feedback.t) =
1703 1689 tag "form"
1704 1690 [
1705 Removed: action Routes.remove_app_feedback
1706 Removed: (Repository.app_feedback_id_to_string report.Repository.feedback_id);
1691 Added: action Routes.remove_app_feedback report.id;
1707 1692 post_form;
1708 1693 class_ "app-feedback-remove-form";
1709 1694 Dream_html.attr "data-hito-app-form";
@@ -1713,8 +1698,8 @@
1713 1698 void "input" [ type_ "submit"; value "Remove feedback" ];
1714 1699 ]
1715 1700
1716 Removed: let app_feedback_actions request report =
1717 Removed: if report.Repository.viewer_owns then
1701 Added: let app_feedback_actions request (report : View_model.App_feedback.t) =
1702 Added: if report.viewer_owns then
1718 1703 tag "div"
1719 1704 [ class_ "app-feedback-actions" ]
1720 1705 [
@@ -1747,7 +1732,7 @@
1747 1732 tag "ul"
1748 1733 [ class_ "app-feedback-list" ]
1749 1734 (List.map
1750 Removed: (fun (report : Repository.app_feedback) ->
1735 Added: (fun (report : View_model.App_feedback.t) ->
1751 1736 tag "li" []
1752 1737 [
1753 1738 tag "p"
@@ -1760,9 +1745,9 @@
1760 1745 [
1761 1746 class_ "app-feedback-time";
1762 1747 Dream_html.string_attr "datetime" "%s"
1763 Removed: (app_feedback_time report.submitted_at);
1748 Added: report.submitted_at;
1764 1749 ]
1765 Removed: [ txt "%s" (app_feedback_time report.submitted_at) ];
1750 Added: [ txt "%s" report.submitted_at ];
1766 1751 tag "p"
1767 1752 [ class_ "app-feedback-message" ]
1768 1753 [ txt "%s" report.message ];
lib/web/pages.mli
index 82e84f47..4e58a47a 100644..100644
@@ -104,7 +104,7 @@
104 104 trainee:Trainee.t ->
105 105 ?tab:[ `Write | `Submitted ] ->
106 106 ?error:string ->
107 Removed: Repository.app_feedback list ->
107 Added: View_model.App_feedback.t list ->
108 108 page
109 109 (** The authenticated application feedback page. One tab accepts a freeform
110 110 message; the other lists the trainee's submitted messages. *)
lib/web/view_model.ml
index 00000000..c95528ae 000000..100644
@@ -0,0 +1,25 @@
1 Added: (** View models: the simple data structures the presenter renders.
2 Added:
3 Added: The Clean Architecture rule for crossing a boundary is that the data passed
4 Added: is a plain structure, never an entity or a database row. These DTOs are that
5 Added: structure. A handler (the controller) maps a repository record or a core
6 Added: entity into a view model, and the presenter ({!Pages}) renders the view
7 Added: model without ever naming an inner-circle type.
8 Added:
9 Added: Migrated so far: application feedback. Other pages still take entities
10 Added: directly; they move here page by page. *)
11 Added:
12 Added: module App_feedback = struct
13 Added: type t = {
14 Added: id : string; (** Opaque feedback identity, already stringified. *)
15 Added: author : string;
16 Added: contributions : int;
17 Added: submitted_at : string; (** Pre-formatted "YYYY-MM-DD HH:MM" in UTC. *)
18 Added: message : string;
19 Added: upvotes : int;
20 Added: viewer_upvoted : bool;
21 Added: viewer_owns : bool;
22 Added: }
23 Added: (** One application-feedback entry, ready to render. Carries no timestamp
24 Added: type, no opaque id, no repository record — only what the view shows. *)
25 Added: end