The unpac monorepo manager self-hosting as a monorepo using unpac
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

Add Result.product and Result.Syntax (#13696)

authored by

Daniel Bünzli and committed by
GitHub
60b30b93 0dcb7507

+67
+3
Changes
··· 150 150 151 151 ### Standard library: 152 152 153 + - #13696: Add Result.product and Result.Syntax. 154 + (Daniel Bünzli, review by Gabriel Scherer, Nicolás Ojeda Bär) 155 + 153 156 - #13885: Add Dynarray.{exists2, for_all2}. 154 157 (T. Kinsart, review by Daniel Bünzli, Gabriel Scherer, and Nicolás Ojeda Bär) 155 158
+12
stdlib/result.ml
··· 23 23 let bind r f = match r with Ok v -> f v | Error _ as e -> e 24 24 let join = function Ok r -> r | Error _ as e -> e 25 25 let map f = function Ok v -> Ok (f v) | Error _ as e -> e 26 + let product r0 r1 = match r0, r1 with 27 + | (Error _ as r), _ 28 + | _, (Error _ as r) -> r 29 + | Ok v0, Ok v1 -> Ok (v0, v1) 30 + 26 31 let map_error f = function Error e -> Error (f e) | Ok _ as v -> v 27 32 let fold ~ok ~error = function Ok v -> ok v | Error e -> error e 28 33 let retract = function Ok v -> v | Error v -> v ··· 45 50 let to_option = function Ok v -> Some v | Error _ -> None 46 51 let to_list = function Ok v -> [v] | Error _ -> [] 47 52 let to_seq = function Ok v -> Seq.return v | Error _ -> Seq.empty 53 + 54 + module Syntax = struct 55 + let ( let* ) = bind 56 + let ( and* ) = product 57 + let ( let+ ) r f = map f r 58 + let ( and+ ) = product 59 + end
+26
stdlib/result.mli
··· 53 53 val map : ('a -> 'b) -> ('a, 'e) result -> ('b, 'e) result 54 54 (** [map f r] is [Ok (f v)] if [r] is [Ok v] and [r] if [r] is [Error _]. *) 55 55 56 + val product : ('a, 'e) result -> ('b, 'e) result -> ('a * 'b, 'e) result 57 + (** [product r0 r1] is [Ok (v0, v1)] if [r0] is [Ok v0] and [r1] is [Ok v2] 58 + and otherwise returns the error of [r0], if any, or the error of [r1]. 59 + 60 + @since 5.4 *) 61 + 56 62 val map_error : ('e -> 'f) -> ('a, 'e) result -> ('a, 'f) result 57 63 (** [map_error f r] is [Error (f e)] if [r] is [Error e] and [r] if 58 64 [r] is [Ok _]. *) ··· 106 112 val to_seq : ('a, 'e) result -> 'a Seq.t 107 113 (** [to_seq r] is [r] as a sequence. [Ok v] is the singleton sequence 108 114 containing [v] and [Error _] is the empty sequence. *) 115 + 116 + (** {1:syntax Syntax} *) 117 + 118 + (** Binding operators. 119 + 120 + @since 5.4 *) 121 + module Syntax : sig 122 + 123 + val ( let* ) : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result 124 + (** [( let* )] is {!Result.bind}. *) 125 + 126 + val ( and* ) : ('a, 'e) result -> ('b, 'e) result -> ('a * 'b, 'e) result 127 + (** [( and* )] is {!Result.product}. *) 128 + 129 + val ( let+ ) : ('a, 'e) result -> ('a -> 'b) -> ('b, 'e) result 130 + (** [( let+ )] is {!Result.map}. *) 131 + 132 + val ( and+ ) : ('a, 'e) result -> ('b, 'e) result -> ('a * 'b, 'e) result 133 + (** [( and+ )] is {!Result.product}. *) 134 + end
+26
testsuite/tests/lib-result/test.ml
··· 42 42 assert (Result.map_error succ (Ok 2) = Ok 2); 43 43 () 44 44 45 + let test_product () = 46 + assert (Result.product (Ok "a") (Ok 3) = Ok ("a", 3)); 47 + assert (Result.product (Ok "a") (Error "ha") = Error "ha"); 48 + assert (Result.product (Error "hi") (Error "ha") = Error "hi"); 49 + assert (Result.product (Error "hi") (Ok 3) = Error "hi"); 50 + () 51 + 45 52 let test_fold () = 46 53 assert (Result.fold ~ok:succ ~error:succ (Ok 1) = 2); 47 54 assert (Result.fold ~ok:succ ~error:succ (Error 1) = 2); ··· 115 122 assert ((Result.to_seq (Error "ha!")) () = Seq.Nil); 116 123 () 117 124 125 + let test_syntax () = 126 + let open Result.Syntax in 127 + assert (Ok 5 = 128 + let parse n = Ok n in 129 + let* n0 = parse 3 in 130 + let* n1 = parse 2 in 131 + Ok (n0 + n1)); 132 + assert (Ok 3 = 133 + let+ one = Ok 1 134 + and+ two = Ok 2 in 135 + one + two); 136 + assert (Ok 1 = 137 + let* three = Ok 3 in 138 + let+ two = Ok 2 in 139 + three - two); 140 + () 141 + 118 142 let tests () = 119 143 test_ok_error (); 120 144 test_value (); ··· 122 146 test_bind (); 123 147 test_join (); 124 148 test_maps (); 149 + test_product (); 125 150 test_fold (); 126 151 test_retract (); 127 152 test_iters (); ··· 129 154 test_equal (); 130 155 test_compare (); 131 156 test_to_option_list_seq (); 157 + test_syntax (); 132 158 () 133 159 134 160 let () =