chore: Single data type definition for Event (ocaml#2559)

* Preparation * Data intf * Single type for Event --------- Co-authored-by: Cuihtlauac ALVARADO <[email protected]>
christinerose · Jun 28, 2024 · bc901a2 · bc901a2
1 parent 0b874cd
commit bc901a2
Show file tree

Hide file tree

Showing 5 changed files with 75 additions and 147 deletions.
diff --git a/src/ocamlorg_data/data.ml b/src/ocamlorg_data/data.ml
@@ -59,9 +59,12 @@ module Event = struct
   include Event
 
   module RecurringEvent = struct
-    include Event.RecurringEvent
+    type t = recurring_event
 
-    let get_by_slug slug = List.find_opt (fun x -> String.equal slug x.slug) all
+    let all = recurring_event_all
+
+    let get_by_slug slug =
+      List.find_opt (fun (x : t) -> String.equal slug x.slug) all
   end
 
   let get_by_slug slug = List.find_opt (fun x -> String.equal slug x.slug) all

diff --git a/src/ocamlorg_data/data.mli b/src/ocamlorg_data/data.mli
@@ -40,39 +40,15 @@ module Cookbook : sig
 end
 
 module Event : sig
-  type event_type = Meetup | Conference | Seminar | Hackathon | Retreat
-  type location = { lat : float; long : float }
+  include module type of Data_intf.Event
 
   module RecurringEvent : sig
-    type t = {
-      slug : string;
-      title : string;
-      url : string;
-      textual_location : string;
-      location : location option;
-      event_type : event_type;
-    }
+    type t = recurring_event
 
     val all : t list
     val get_by_slug : string -> t option
   end
 
-  type utc_datetime = { yyyy_mm_dd : string; utc_hh_mm : string option }
-
-  type t = {
-    title : string;
-    url : string;
-    slug : string;
-    textual_location : string;
-    location : location option;
-    starts : utc_datetime;
-    ends : utc_datetime option;
-    body_md : string;
-    body_html : string;
-    recurring_event : RecurringEvent.t option;
-    event_type : event_type;
-  }
-
   val all : t list
   val get_by_slug : string -> t option
 end

diff --git a/src/ocamlorg_data/data_intf.ml b/src/ocamlorg_data/data_intf.ml
@@ -88,8 +88,7 @@ module Changelog = struct
 end
 
 module Code_examples = struct
-  type t = { title : string; body : string }
-  [@@deriving show { with_path = false }]
+  type t = { title : string; body : string } [@@deriving show]
 end
 
 module Cookbook = struct
@@ -130,6 +129,53 @@ module Cookbook = struct
   [@@deriving show]
 end
 
+module Event = struct
+  type event_type = Meetup | Conference | Seminar | Hackathon | Retreat
+  [@@deriving show]
+
+  let event_type_of_string = function
+    | "meetup" -> Ok Meetup
+    | "conference" -> Ok Conference
+    | "seminar" -> Ok Seminar
+    | "hackathon" -> Ok Hackathon
+    | "retreat" -> Ok Retreat
+    | s -> Error (`Msg ("Unknown event type: " ^ s))
+
+  let event_type_of_yaml = function
+    | `String s -> event_type_of_string s
+    | _ -> Error (`Msg "Expected a string for difficulty type")
+
+  type location = { lat : float; long : float } [@@deriving of_yaml, show]
+
+  type recurring_event = {
+    title : string;
+    url : string;
+    slug : string;
+    textual_location : string;
+    location : location option;
+    event_type : event_type;
+  }
+  [@@deriving of_yaml, show]
+
+  type utc_datetime = { yyyy_mm_dd : string; utc_hh_mm : string option }
+  [@@deriving of_yaml, show]
+
+  type t = {
+    title : string;
+    url : string;
+    slug : string;
+    textual_location : string;
+    location : location option;
+    starts : utc_datetime;
+    ends : utc_datetime option;
+    body_md : string;
+    body_html : string;
+    recurring_event : recurring_event option;
+    event_type : event_type;
+  }
+  [@@deriving show]
+end
+
 module Exercise = struct
   type difficulty = Beginner | Intermediate | Advanced [@@deriving show]
 

diff --git a/tool/ood-gen/lib/event.ml b/tool/ood-gen/lib/event.ml
@@ -1,51 +1,7 @@
-module EventType = struct
-  type t = Meetup | Conference | Seminar | Hackathon | Retreat
-  [@@deriving show { with_path = false }]
+open Data_intf.Event
 
-  let of_string = function
-    | "meetup" -> Ok Meetup
-    | "conference" -> Ok Conference
-    | "seminar" -> Ok Seminar
-    | "hackathon" -> Ok Hackathon
-    | "retreat" -> Ok Retreat
-    | s -> Error (`Msg ("Unknown event type: " ^ s))
-
-  let of_yaml = Utils.of_yaml of_string "Expected a string for difficulty type"
-end
-
-type location = { lat : float; long : float }
-[@@deriving of_yaml, show { with_path = false }]
-
-module RecurringEvent = struct
-  type metadata = {
-    slug : string;
-    title : string;
-    url : string;
-    textual_location : string;
-    location : location option;
-    event_type : EventType.t;
-  }
-  [@@deriving of_yaml, show { with_path = false }]
-
-  type t = {
-    title : string;
-    url : string;
-    slug : string;
-    textual_location : string;
-    location : location option;
-    event_type : EventType.t;
-  }
-  [@@deriving stable_record ~version:metadata, show { with_path = false }]
-
-  let decode s =
-    let metadata = metadata_of_yaml s in
-    Result.map of_metadata metadata
-
-  let all () : t list = Utils.yaml_sequence_file decode "events/recurring.yml"
-end
-
-type utc_datetime = { yyyy_mm_dd : string; utc_hh_mm : string option }
-[@@deriving of_yaml, show { with_path = false }]
+let recurring_event_all () : recurring_event list =
+  Utils.yaml_sequence_file recurring_event_of_yaml "events/recurring.yml"
 
 type metadata = {
   title : string;
@@ -55,32 +11,18 @@ type metadata = {
   starts : utc_datetime;
   ends : utc_datetime option;
   recurring_event_slug : string option;
-  event_type : EventType.t option;
-}
-[@@deriving of_yaml, show { with_path = false }]
-
-type t = {
-  title : string;
-  url : string;
-  slug : string;
-  textual_location : string;
-  location : location option;
-  starts : utc_datetime;
-  ends : utc_datetime option;
-  body_md : string;
-  body_html : string;
-  recurring_event : RecurringEvent.t option;
-  event_type : EventType.t;
+  event_type : event_type option;
 }
 [@@deriving
-  stable_record ~version:metadata
-    ~remove:[ slug; body_md; body_html; recurring_event ]
-    ~add:[ recurring_event_slug ] ~set:[ event_type ],
+  of_yaml,
+    stable_record ~version:t
+      ~add:[ slug; body_md; body_html; recurring_event ]
+      ~remove:[ recurring_event_slug ] ~set:[ event_type ],
     show { with_path = false }]
 
-let of_metadata m = of_metadata m ~slug:(Utils.slugify m.title)
+let of_metadata m = metadata_to_t m ~slug:(Utils.slugify m.title)
 
-let decode (recurring_events : RecurringEvent.t list) (fpath, (head, body_md)) =
+let decode (recurring_events : recurring_event list) (fpath, (head, body_md)) =
   let metadata =
     metadata_of_yaml head |> Result.map_error (Utils.where fpath)
   in
@@ -93,15 +35,13 @@ let decode (recurring_events : RecurringEvent.t list) (fpath, (head, body_md)) =
         Option.map
           (fun recurring_event_slug ->
             List.find
-              (fun (recurring_event : RecurringEvent.t) ->
+              (fun (recurring_event : recurring_event) ->
                 recurring_event_slug = recurring_event.slug)
               recurring_events)
           metadata.recurring_event_slug
       in
       let recurring_event_type =
-        Option.map
-          (fun (re : RecurringEvent.t) -> re.event_type)
-          recurring_event
+        Option.map (fun (re : recurring_event) -> re.event_type) recurring_event
       in
       let event_type =
         match (metadata.event_type, recurring_event_type) with
@@ -119,17 +59,17 @@ let decode (recurring_events : RecurringEvent.t list) (fpath, (head, body_md)) =
                  "Upcoming event %s (%s) has type %s but its linked recurring \
                   event %s has type %s"
                  metadata.title metadata.starts.yyyy_mm_dd
-                 (EventType.show from_upcoming)
+                 (show_event_type from_upcoming)
                  (Option.get metadata.recurring_event_slug)
-                 (EventType.show from_recurring))
+                 (show_event_type from_recurring))
         | Some _, Some from_recurring -> from_recurring
       in
       of_metadata ~body_md ~body_html ~recurring_event ~event_type metadata)
     metadata
 
 let all () =
-  Utils.map_md_files (decode (RecurringEvent.all ())) "events/*.md"
-  |> List.sort (fun e1 e2 ->
+  Utils.map_md_files (decode (recurring_event_all ())) "events/*.md"
+  |> List.sort (fun (e1 : t) (e2 : t) ->
          (* Sort the events by reversed start date. *)
          let t1 =
            e1.starts.yyyy_mm_dd ^ " "
@@ -144,44 +84,11 @@ let all () =
 let template () =
   Format.asprintf
     {|
-type event_type = Meetup | Conference | Seminar | Hackathon | Retreat
-type location = { lat : float; long : float }
-
-module RecurringEvent = struct
-  type t = {
-    slug : string
-    ; title : string
-    ; url : string
-    ; textual_location : string
-    ; location : location option
-    ; event_type : event_type
-  }
-
-  let all = %a
-end
-
-type utc_datetime = {
-  yyyy_mm_dd: string;
-  utc_hh_mm: string option;
-}
-
-type t =
-  { title : string
-  ; url : string
-  ; slug : string
-  ; textual_location : string
-  ; location : location option
-  ; starts : utc_datetime
-  ; ends : utc_datetime option
-  ; body_md : string
-  ; body_html : string
-  ; recurring_event : RecurringEvent.t option
-  ; event_type : event_type
-  }
-
+include Data_intf.Event
+let recurring_event_all = %a
 let all = %a
 |}
-    (Fmt.brackets (Fmt.list RecurringEvent.pp ~sep:Fmt.semi))
-    (RecurringEvent.all ())
+    (Fmt.brackets (Fmt.list pp_recurring_event ~sep:Fmt.semi))
+    (recurring_event_all ())
     (Fmt.brackets (Fmt.list pp ~sep:Fmt.semi))
     (all ())
diff --git a/tool/ood-gen/lib/utils.ml b/tool/ood-gen/lib/utils.ml
@@ -95,7 +95,3 @@ let yaml_sequence_file ?key of_yaml filepath_str =
    List.fold_left (fun u x -> Ok List.cons <@> of_yaml x <@> u) (Ok []) list)
   |> Result.map_error (where (filepath |> Fpath.to_string))
   |> Result.get_ok ~error:(fun (`Msg msg) -> Exn.Decode_error msg)
-
-let of_yaml of_string error = function
-  | `String s -> of_string s
-  | _ -> Error (`Msg error)