Source file rresult.ml
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
154
155
156
type ('a, 'b) result = ('a, 'b) Stdlib.result = Ok of 'a | Error of 'b
module R = struct
let err_error = "result value is (Error _)"
let err_ok = "result value is (Ok _)"
type ('a, 'b) t = ('a, 'b) result
let ok v = Ok v
let error e = Error e
let get_ok = function Ok v -> v | Error _ -> invalid_arg err_error
let get_error = function Error e -> e | Ok _ -> invalid_arg err_ok
let reword_error reword = function
| Ok _ as r -> r
| Error e -> Error (reword e)
let return = ok
let fail = error
let bind v f = match v with Ok v -> f v | Error _ as e -> e
let map f v = match v with Ok v -> Ok (f v) | Error _ as e -> e
let join r = match r with Ok v -> v | Error _ as e -> e
let ( >>= ) = bind
let ( >>| ) v f = match v with Ok v -> Ok (f v) | Error _ as e -> e
module Infix = struct
let ( >>= ) = ( >>= )
let ( >>| ) = ( >>| )
end
let pp_lines ppf s =
let left = ref 0 and right = ref 0 and len = String.length s in
let flush () =
Format.pp_print_string ppf (String.sub s !left (!right - !left));
incr right; left := !right;
in
while (!right <> len) do
if s.[!right] = '\n' then (flush (); Format.pp_force_newline ppf ()) else
incr right;
done;
if !left <> len then flush ()
type msg = [ `Msg of string ]
let msg s = `Msg s
let msgf fmt =
let kmsg _ = `Msg (Format.flush_str_formatter ()) in
Format.kfprintf kmsg Format.str_formatter fmt
let pp_msg ppf (`Msg msg) = pp_lines ppf msg
let error_msg s = Error (`Msg s)
let error_msgf fmt =
let kerr _ = Error (`Msg (Format.flush_str_formatter ())) in
Format.kfprintf kerr Format.str_formatter fmt
let reword_error_msg ?(replace = false) reword = function
| Ok _ as r -> r
| Error (`Msg e) ->
let (`Msg e' as v) = reword e in
if replace then Error v else error_msgf "%s\n%s" e e'
let error_to_msg ~pp_error = function
| Ok _ as r -> r
| Error e -> error_msgf "%a" pp_error e
let error_msg_to_invalid_arg = function
| Ok v -> v
| Error (`Msg m) -> invalid_arg m
let open_error_msg = function Ok _ as r -> r | Error (`Msg _) as r -> r
let failwith_error_msg = function Ok v -> v | Error (`Msg m) -> failwith m
type exn_trap = [ `Exn_trap of exn * Printexc.raw_backtrace ]
let pp_exn_trap ppf (`Exn_trap (exn, bt)) =
Format.fprintf ppf "%s@\n" (Printexc.to_string exn);
pp_lines ppf (Printexc.raw_backtrace_to_string bt)
let trap_exn f v = try Ok (f v) with
| e ->
let bt = Printexc.get_raw_backtrace () in
Error (`Exn_trap (e, bt))
let error_exn_trap_to_msg = function
| Ok _ as r -> r
| Error trap ->
error_msgf "Unexpected exception:@\n%a" pp_exn_trap trap
let open_error_exn_trap = function
| Ok _ as r -> r | Error (`Exn_trap _) as r -> r
let pp ~ok ~error ppf = function Ok v -> ok ppf v | Error e -> error ppf e
let dump ~ok ~error ppf = function
| Ok v -> Format.fprintf ppf "@[<2>Ok@ @[%a@]@]" ok v
| Error e -> Format.fprintf ppf "@[<2>Error@ @[%a@]@]" error e
let is_ok = function Ok _ -> true | Error _ -> false
let is_error = function Ok _ -> false | Error _ -> true
let equal ~ok ~error r r' = match r, r' with
| Ok v, Ok v' -> ok v v'
| Error e, Error e' -> error e e'
| _ -> false
let compare ~ok ~error r r' = match r, r' with
| Ok v, Ok v' -> ok v v'
| Error v, Error v' -> error v v'
| Ok _, Error _ -> -1
| Error _, Ok _ -> 1
let to_option = function Ok v -> Some v | Error e -> None
let of_option ~none = function None -> none () | Some v -> Ok v
let to_presult = function Ok v -> `Ok v | Error e -> `Error e
let of_presult = function `Ok v -> Ok v | `Error e -> Error e
let ignore_error ~use = function Ok v -> v | Error e -> use e
let kignore_error ~use = function Ok _ as r -> r | Error e -> use e
end
include R.Infix