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