File: compat_common.ml

package info (click to toggle)
ocaml-obuild 0.2.2-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 1,456 kB
  • sloc: ml: 14,491; sh: 211; ansic: 34; makefile: 11
file content (153 lines) | stat: -rw-r--r-- 3,470 bytes parent folder | download
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