-
Notifications
You must be signed in to change notification settings - Fork 21
Expand file tree
/
Copy pathcompat_common.ml
More file actions
153 lines (119 loc) · 3.39 KB
/
compat_common.ml
File metadata and controls
153 lines (119 loc) · 3.39 KB
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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
(* Result type definition - common across versions *)
type ('a, 'b) result = Ok of 'a | Error of 'b
module Result = struct
type ('a, 'b) t = ('a, 'b) result
let ok x = Ok x
let error e = Error e
let is_ok = function Ok _ -> true | Error _ -> false
let is_error = function Ok _ -> false | Error _ -> true
let map f = function
| Ok x -> Ok (f x)
| Error e -> Error e
let map_error f = function
| Ok x -> Ok x
| Error e -> Error (f e)
let bind r f = match r with
| Ok x -> f x
| Error e -> Error e
let value r ~default = match r with
| Ok x -> x
| Error _ -> default
let get_ok = function
| Ok x -> x
| Error _ -> invalid_arg "Result.get_ok"
let get_error = function
| Ok _ -> invalid_arg "Result.get_error"
| Error e -> e
end
(* Option helpers *)
module Option = struct
let map f = function
| Some x -> Some (f x)
| None -> None
let bind o f = match o with
| Some x -> f x
| None -> None
let value o ~default = match o with
| Some x -> x
| None -> default
let get = function
| Some x -> x
| None -> invalid_arg "Option.get"
let is_some = function
| Some _ -> true
| None -> false
let is_none = function
| Some _ -> false
| None -> true
end
(* SafeList - List module with exception-safe operations *)
module SafeList = struct
include List
let find_opt pred lst =
try Some (List.find pred lst)
with Not_found -> None
let assoc_opt key lst =
try Some (List.assoc key lst)
with Not_found -> None
let nth_opt lst n =
try Some (List.nth lst n)
with Failure _ | Invalid_argument _ -> None
let filter_map f lst =
let rec aux acc = function
| [] -> List.rev acc
| x :: xs ->
match f x with
| Some y -> aux (y :: acc) xs
| None -> aux acc xs
in
aux [] lst
let find_map f lst =
let rec aux = function
| [] -> None
| x :: xs ->
match f x with
| Some _ as result -> result
| None -> aux xs
in
aux lst
end
(* SafeHashtbl - Hashtbl module with exception-safe operations *)
module SafeHashtbl = struct
include Hashtbl
let find_opt tbl key =
try Some (Hashtbl.find tbl key)
with Not_found -> None
let update tbl key f =
match find_opt tbl key with
| Some v -> Hashtbl.replace tbl key (f (Some v))
| None -> Hashtbl.replace tbl key (f None)
let find_default tbl key default =
try Hashtbl.find tbl key
with Not_found -> default
let add_or_update tbl key ~default ~update =
match find_opt tbl key with
| Some v -> Hashtbl.replace tbl key (update v)
| None -> Hashtbl.add tbl key default
end
(* SafeString - String module with exception-safe operations *)
module SafeString = struct
include String
let index_opt str ch =
try Some (String.index str ch)
with Not_found -> None
let rindex_opt str ch =
try Some (String.rindex str ch)
with Not_found -> None
let index_from_opt str pos ch =
try Some (String.index_from str pos ch)
with Not_found | Invalid_argument _ -> None
let rindex_from_opt str pos ch =
try Some (String.rindex_from str pos ch)
with Not_found | Invalid_argument _ -> None
let sub_safe str start len =
try Some (String.sub str start len)
with Invalid_argument _ -> None
let get_opt str idx =
try Some (String.get str idx)
with Invalid_argument _ -> None
end