anil.recoil.org
My personal data management layer
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** Video entry type for Bushel *)
7
8type t = {
9 slug : string;
10 title : string;
11 published_date : Ptime.t;
12 uuid : string;
13 description : string;
14 url : string;
15 talk : bool;
16 paper : string option;
17 project : string option;
18 tags : string list;
19}
20
21type ts = t list
22
23(** {1 Accessors} *)
24
25let slug { slug; _ } = slug
26let title { title; _ } = title
27let uuid { uuid; _ } = uuid
28let url { url; _ } = url
29let description { description; _ } = description
30let body = description (* Alias for consistency *)
31let talk { talk; _ } = talk
32let paper { paper; _ } = paper
33let project { project; _ } = project
34let tags { tags; _ } = tags
35
36let date { published_date; _ } = Ptime.to_date published_date
37let datetime { published_date; _ } = published_date
38
39(** {1 Comparison} *)
40
41let compare a b = Ptime.compare b.published_date a.published_date
42
43(** {1 Lookup} *)
44
45let lookup videos uuid = List.find_opt (fun v -> v.uuid = uuid) videos
46let lookup_by_slug videos slug = List.find_opt (fun v -> v.slug = slug) videos
47
48(** {1 Jsont Codec} *)
49
50let jsont : t Jsont.t =
51 let open Jsont in
52 let open Jsont.Object in
53 let make title published_date uuid url talk tags paper project =
54 { slug = uuid; title; published_date; uuid; description = ""; url;
55 talk; paper; project; tags }
56 in
57 map ~kind:"Video" make
58 |> mem "title" string ~enc:(fun v -> v.title)
59 |> mem "published_date" Bushel_types.ptime_jsont ~enc:(fun v -> v.published_date)
60 |> mem "uuid" string ~enc:(fun v -> v.uuid)
61 |> mem "url" string ~enc:(fun v -> v.url)
62 |> mem "talk" bool ~dec_absent:false ~enc:(fun v -> v.talk)
63 |> mem "tags" (list string) ~dec_absent:[] ~enc:(fun v -> v.tags)
64 |> mem "paper" Bushel_types.string_option_jsont ~dec_absent:None
65 ~enc_omit:Option.is_none ~enc:(fun v -> v.paper)
66 |> mem "project" Bushel_types.string_option_jsont ~dec_absent:None
67 ~enc_omit:Option.is_none ~enc:(fun v -> v.project)
68 |> finish
69
70(** {1 Parsing} *)
71
72let of_frontmatter (fm : Frontmatter.t) : (t, string) result =
73 match Frontmatter.decode jsont fm with
74 | Error e -> Error e
75 | Ok v ->
76 Ok { v with
77 slug = v.uuid;
78 description = Frontmatter.body fm }
79
80(** {1 YAML Serialization} *)
81
82let to_yaml t =
83 let open Yamlrw.Util in
84 let fields = [
85 ("title", string t.title);
86 ("description", string t.description);
87 ("url", string t.url);
88 ("uuid", string t.uuid);
89 ("slug", string t.slug);
90 ("published_date", string (Ptime.to_rfc3339 t.published_date));
91 ("talk", bool t.talk);
92 ("tags", strings t.tags);
93 ] in
94 let fields = match t.paper with
95 | None -> fields
96 | Some p -> ("paper", string p) :: fields
97 in
98 let fields = match t.project with
99 | None -> fields
100 | Some p -> ("project", string p) :: fields
101 in
102 obj fields
103
104(** {1 Pretty Printing} *)
105
106let pp ppf v =
107 let open Fmt in
108 pf ppf "@[<v>";
109 pf ppf "%a: %a@," (styled `Bold string) "Type" (styled `Cyan string) "Video";
110 pf ppf "%a: %a@," (styled `Bold string) "Slug" string (slug v);
111 pf ppf "%a: %a@," (styled `Bold string) "UUID" string (uuid v);
112 pf ppf "%a: %a@," (styled `Bold string) "Title" string (title v);
113 let (year, month, day) = date v in
114 pf ppf "%a: %04d-%02d-%02d@," (styled `Bold string) "Date" year month day;
115 pf ppf "%a: %a@," (styled `Bold string) "URL" string (url v);
116 pf ppf "%a: %b@," (styled `Bold string) "Talk" (talk v);
117 (match paper v with
118 | Some p -> pf ppf "%a: %a@," (styled `Bold string) "Paper" string p
119 | None -> ());
120 (match project v with
121 | Some p -> pf ppf "%a: %a@," (styled `Bold string) "Project" string p
122 | None -> ());
123 let t = tags v in
124 if t <> [] then
125 pf ppf "%a: @[<h>%a@]@," (styled `Bold string) "Tags" (list ~sep:comma string) t;
126 pf ppf "@,";
127 pf ppf "%a:@," (styled `Bold string) "Description";
128 pf ppf "%a@," string v.description;
129 pf ppf "@]"