patrick.sirref.org
1(** Link and person information types *)
2
3(** Main link type *)
4type t = {
5 href : string;
6 text : string option;
7 type_ : string option;
8}
9
10(** Person information *)
11and person = {
12 name : string option;
13 email : string option;
14 link : t option;
15}
16
17(** Copyright information *)
18and copyright = {
19 author : string;
20 year : int option;
21 license : string option;
22}
23
24(** {2 Link Operations} *)
25
26(** Create a link *)
27let make ~href ?text ?type_ () = { href; text; type_ }
28
29(** Get href from link *)
30let href t = t.href
31
32(** Get optional text from link *)
33let text t = t.text
34
35(** Get optional type from link *)
36let type_ t = t.type_
37
38(** Update text *)
39let with_text t text = { t with text = Some text }
40
41(** Update type *)
42let with_type t type_ = { t with type_ = Some type_ }
43
44(** Compare links *)
45let compare t1 t2 =
46 let href_cmp = String.compare t1.href t2.href in
47 if href_cmp <> 0 then href_cmp
48 else
49 let text_cmp = Option.compare String.compare t1.text t2.text in
50 if text_cmp <> 0 then text_cmp
51 else Option.compare String.compare t1.type_ t2.type_
52
53(** Test link equality *)
54let equal t1 t2 = compare t1 t2 = 0
55
56(** Pretty print link *)
57let pp ppf t =
58 match t.text with
59 | Some text -> Format.fprintf ppf "%s (%s)" text t.href
60 | None -> Format.fprintf ppf "%s" t.href
61
62(** {2 Person Operations} *)
63
64(** Create person *)
65let make_person ?name ?email ?link () = { name; email; link }
66
67(** Get person name *)
68let person_name (p : person) = p.name
69
70(** Get person email *)
71let person_email (p : person) = p.email
72
73(** Get person link *)
74let person_link (p : person) = p.link
75
76(** Compare persons *)
77let compare_person p1 p2 =
78 let name_cmp = Option.compare String.compare p1.name p2.name in
79 if name_cmp <> 0 then name_cmp
80 else
81 let email_cmp = Option.compare String.compare p1.email p2.email in
82 if email_cmp <> 0 then email_cmp
83 else Option.compare compare p1.link p2.link
84
85(** Test person equality *)
86let equal_person p1 p2 = compare_person p1 p2 = 0
87
88(** Pretty print person *)
89let pp_person ppf p =
90 match p.name, p.email with
91 | Some name, Some email -> Format.fprintf ppf "%s <%s>" name email
92 | Some name, None -> Format.fprintf ppf "%s" name
93 | None, Some email -> Format.fprintf ppf "<%s>" email
94 | None, None -> Format.fprintf ppf "(anonymous)"
95
96(** {2 Copyright Operations} *)
97
98(** Create copyright *)
99let make_copyright ~author ?year ?license () = { author; year; license }
100
101(** Get copyright author *)
102let copyright_author (c : copyright) = c.author
103
104(** Get copyright year *)
105let copyright_year (c : copyright) = c.year
106
107(** Get copyright license *)
108let copyright_license (c : copyright) = c.license
109
110(** Compare copyrights *)
111let compare_copyright c1 c2 =
112 let author_cmp = String.compare c1.author c2.author in
113 if author_cmp <> 0 then author_cmp
114 else
115 let year_cmp = Option.compare Int.compare c1.year c2.year in
116 if year_cmp <> 0 then year_cmp
117 else Option.compare String.compare c1.license c2.license
118
119(** Test copyright equality *)
120let equal_copyright c1 c2 = compare_copyright c1 c2 = 0
121
122(** Pretty print copyright *)
123let pp_copyright ppf c =
124 match c.year with
125 | Some year -> Format.fprintf ppf "© %d %s" year c.author
126 | None -> Format.fprintf ppf "© %s" c.author