├── BRZO ├── src ├── rresult.mllib ├── rresult_top.mllib ├── rresult_top_init.ml ├── rresult_top.ml ├── rresult.ml └── rresult.mli ├── .merlin ├── .ocp-indent ├── .gitignore ├── doc └── index.mld ├── _tags ├── pkg ├── pkg.ml └── META ├── LICENSE.md ├── opam ├── README.md ├── CHANGES.md ├── B0.ml └── test └── test.ml /BRZO: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /src/rresult.mllib: -------------------------------------------------------------------------------- 1 | Rresult -------------------------------------------------------------------------------- /src/rresult_top.mllib: -------------------------------------------------------------------------------- 1 | Rresult_top 2 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | PKG b0.kit 2 | S src 3 | S test 4 | B _build/** 5 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | strict_with=always,match_clause=4,strict_else=never -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _b0 2 | _build 3 | tmp 4 | *.native 5 | *.byte 6 | *.install -------------------------------------------------------------------------------- /doc/index.mld: -------------------------------------------------------------------------------- 1 | {0 Rresult {%html: %%VERSION%%%}} 2 | 3 | {!modules: 4 | Rresult 5 | } 6 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | true : bin_annot, safe_string 2 | <_b0> : -traverse 3 | : include 4 | : package(compiler-libs.toplevel) 5 | : include 6 | -------------------------------------------------------------------------------- /pkg/pkg.ml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind";; 3 | #require "topkg" 4 | open Topkg 5 | 6 | let () = 7 | Pkg.describe "rresult" @@ fun c -> 8 | Ok [ Pkg.mllib ~api:["Rresult"] "src/rresult.mllib"; 9 | Pkg.mllib ~api:[] "src/rresult_top.mllib"; 10 | Pkg.lib "src/rresult_top_init.ml"; 11 | Pkg.doc "doc/index.mld" ~dst:"odoc-pages/index.mld"; 12 | Pkg.test "test/test"; ] 13 | -------------------------------------------------------------------------------- /pkg/META: -------------------------------------------------------------------------------- 1 | description = "Result value combinators for OCaml" 2 | version = "%%VERSION_NUM%%" 3 | requires = "" 4 | archive(byte) = "rresult.cma" 5 | archive(native) = "rresult.cmxa" 6 | plugin(byte) = "rresult.cma" 7 | plugin(native) = "rresult.cmxs" 8 | 9 | package "top" ( 10 | description = "Rresult toplevel support" 11 | version = "%%VERSION_NUM%%" 12 | requires = "rresult" 13 | archive(byte) = "rresult_top.cma" 14 | archive(native) = "rresult_top.cmxa" 15 | plugin(byte) = "rresult_top.cma" 16 | plugin(native) = "rresult_top.cmxs" 17 | ) 18 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014 The rresult programmers 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "rresult" 3 | synopsis: """Result value combinators for OCaml""" 4 | maintainer: ["Daniel Bünzli "] 5 | authors: ["The rresult programmers"] 6 | homepage: "https://erratique.ch/software/rresult" 7 | doc: "https://erratique.ch/software/rresult/doc/Rresult" 8 | dev-repo: "git+https://erratique.ch/repos/rresult.git" 9 | bug-reports: "https://github.com/dbuenzli/rresult/issues" 10 | license: ["ISC"] 11 | tags: ["result" "error" "org:erratique"] 12 | depends: ["ocaml" {>= "4.08.0"} 13 | "ocamlfind" {build} 14 | "ocamlbuild" {build} 15 | "topkg" {build & >= "1.0.3"}] 16 | build: [["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"]] 17 | description: """ 18 | Rresult is an OCaml module for handling computation results and errors 19 | in an explicit and declarative manner, without resorting to 20 | exceptions. It defines combinators to operate on the `result` type 21 | available from OCaml 4.03 in the standard library. 22 | 23 | OCaml 4.08 provides the `Stdlib.Result` module which you should prefer 24 | to Rresult. 25 | 26 | Rresult is distributed under the ISC license. 27 | 28 | Home page: http://erratique.ch/software/rresult 29 | Contact: Daniel Bünzli ``""" 30 | -------------------------------------------------------------------------------- /src/rresult_top_init.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2015 The rresult programmers. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Rresult;; 7 | 8 | (*--------------------------------------------------------------------------- 9 | Copyright (c) 2015 The rresult programmers 10 | 11 | Permission to use, copy, modify, and/or distribute this software for any 12 | purpose with or without fee is hereby granted, provided that the above 13 | copyright notice and this permission notice appear in all copies. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 16 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 17 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 18 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 19 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 20 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 21 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 22 | ---------------------------------------------------------------------------*) 23 | -------------------------------------------------------------------------------- /src/rresult_top.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2015 The rresult programmers. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | ---------------------------------------------------------------------------*) 5 | 6 | let () = ignore (Toploop.use_file Format.err_formatter "rresult_top_init.ml") 7 | 8 | (*--------------------------------------------------------------------------- 9 | Copyright (c) 2015 The rresult programmers 10 | 11 | Permission to use, copy, modify, and/or distribute this software for any 12 | purpose with or without fee is hereby granted, provided that the above 13 | copyright notice and this permission notice appear in all copies. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 16 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 17 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 18 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 19 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 20 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 21 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 22 | ---------------------------------------------------------------------------*) 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Rresult — Result value combinators for OCaml 2 | ------------------------------------------------------------------------------- 3 | %%VERSION%% 4 | 5 | Rresult is an OCaml module for handling computation results and errors 6 | in an explicit and declarative manner, without resorting to 7 | exceptions. It defines combinators to operate on the `result` type 8 | available from OCaml 4.03 in the standard library. 9 | 10 | OCaml 4.08 provides the `Stdlib.Result` module which you should prefer 11 | to Rresult. 12 | 13 | Rresult is distributed under the ISC license. 14 | 15 | Home page: http://erratique.ch/software/rresult 16 | Contact: Daniel Bünzli `` 17 | 18 | ## Installation 19 | 20 | Rresult can be installed with `opam`: 21 | 22 | opam install rresult 23 | 24 | If you don't use `opam` consult the [`opam`](opam) file for build 25 | instructions. 26 | 27 | ## Documentation 28 | 29 | The documentation and API reference is automatically generated by 30 | `ocamldoc` from the interfaces. It can be consulted [online][doc] 31 | 32 | [doc]: http://erratique.ch/software/rresult/doc/ 33 | 34 | 35 | ## Sample programs 36 | 37 | If you installed Rresult with `opam` sample programs are located in 38 | the directory `opam config var rresult:doc`. 39 | 40 | In the distribution sample programs and tests are located in the 41 | [`test`](test) directory of the distribution. They can be built and run 42 | with: 43 | 44 | topkg build --tests true && topkg test 45 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | v0.7.0 2021-10-04 Zagreb 2 | ------------------------ 3 | 4 | * Require OCaml >= 4.08. This drops the dependency on the `result` 5 | compatibility package. 6 | * Users are encouraged to move the `Stdlib.Result` module available in 7 | OCaml 4.08. 8 | 9 | v0.6.0 2018-10-07 Zagreb 10 | ------------------------ 11 | 12 | * Add `R.failwith_error_msg`. 13 | 14 | v0.5.0 2016-09-03 Zagreb 15 | ------------------------ 16 | 17 | * `R.[k]ignore_error` use a thunk for the `~use` argument. This is an 18 | incompatible change. Simply wrap occurences of `~use:e` with 19 | `~use:(fun _ -> e)`. 20 | 21 | v0.4.0 2016-05-23 La Forclaz (VS) 22 | --------------------------------- 23 | 24 | * Build depend on topkg. 25 | * Relicense from BSD3 to ISC. 26 | * `R.pp` remove the `pp_` prefix from the labels and do not print the 27 | constructors names, use to the newly introduced `R.dump` for this. 28 | This follows the conventions of `Fmt`. 29 | 30 | v0.3.0 2015-11-30 Cambridge (UK) 31 | -------------------------------- 32 | 33 | * Use the type provided by the `Result` compatibility library. Opening 34 | `Rresult` still gives you both unprefixed variant constructors and infix 35 | operators. 36 | * Remove the `R.{int,nativeint,int32,int64,float,bool}_of_string` functions. 37 | They do not belong here. 38 | * `R.map`, swap argument order. Thanks to Gabriel Radanne for suggesting. 39 | * Fix `R.bind` which had a more restrictive type than `>>=`. Thanks to 40 | Hezekiah M. Carty for the patch. 41 | 42 | 43 | v0.2.0 2015-05-20 La Forclaz (VS) 44 | --------------------------------- 45 | 46 | * The `Rresult_infix` module no longer exists. Open directly `Rresult` 47 | for using the library. 48 | 49 | 50 | v0.1.0 2015-03-19 La Forclaz (VS) 51 | --------------------------------- 52 | 53 | First release. 54 | -------------------------------------------------------------------------------- /B0.ml: -------------------------------------------------------------------------------- 1 | open B0_kit.V000 2 | open Result.Syntax 3 | 4 | (* OCaml library names *) 5 | 6 | let compiler_libs_toplevel = B0_ocaml.libname "compiler-libs.toplevel" 7 | 8 | let rresult = B0_ocaml.libname "rresult" 9 | let rresult_top = B0_ocaml.libname "rresult.top" 10 | 11 | (* Libraries *) 12 | 13 | let result_lib = 14 | let srcs = 15 | Fpath.[ `File (v "src/rresult.mli"); `File (v "src/rresult.ml"); ] 16 | in 17 | let requires = [] in 18 | B0_ocaml.lib rresult ~doc:"The rresult library" ~srcs ~requires 19 | 20 | let rresult_top = 21 | let srcs = Fpath.[ `File (v "src/rresult_top.ml") ] in 22 | let requires = [compiler_libs_toplevel] in 23 | B0_ocaml.lib rresult_top ~doc:"The rresult.top library" ~srcs ~requires 24 | 25 | (* Tests *) 26 | 27 | let test = 28 | let srcs = Fpath.[`File (v "test/test.ml")] in 29 | let meta = B0_meta.(empty |> tag test) in 30 | let requires = [ rresult ] in 31 | B0_ocaml.exe "test" ~doc:"Test suite" ~srcs ~meta ~requires 32 | 33 | (* Packs *) 34 | 35 | let default = 36 | let meta = 37 | B0_meta.empty 38 | |> B0_meta.(add authors) ["The rresult programmers"] 39 | |> B0_meta.(add maintainers) 40 | ["Daniel Bünzli "] 41 | |> B0_meta.(add homepage) "https://erratique.ch/software/rresult" 42 | |> B0_meta.(add online_doc) 43 | "https://erratique.ch/software/rresult/doc/Rresult" 44 | |> B0_meta.(add licenses) ["ISC"] 45 | |> B0_meta.(add repo) "git+https://erratique.ch/repos/rresult.git" 46 | |> B0_meta.(add issues) "https://github.com/dbuenzli/rresult/issues" 47 | |> B0_meta.(add description_tags) ["result"; "error"; "org:erratique"] 48 | |> B0_meta.tag B0_opam.tag 49 | |> B0_meta.add B0_opam.build 50 | {|[["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"]]|} 51 | |> B0_meta.add B0_opam.depends 52 | [ "ocaml", {|>= "4.08.0"|}; 53 | "ocamlfind", {|build|}; 54 | "ocamlbuild", {|build|}; 55 | "topkg", {|build & >= "1.0.3"|} ] 56 | in 57 | B0_pack.make "default" ~doc:"rresult package" ~meta ~locked:true @@ 58 | B0_unit.list () 59 | -------------------------------------------------------------------------------- /test/test.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2015 The rresult programmers. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Rresult 7 | 8 | let log f = Format.printf (f ^^ "@.") 9 | 10 | let raises_invalid_arg f x = 11 | try f x; raise Exit with 12 | | Invalid_argument _ -> () 13 | | e -> assert false 14 | 15 | let test_constructors () = 16 | log "Test R.{ok,error}"; 17 | assert (R.ok 3 = Ok 3); 18 | assert (R.error `An_error = Error `An_error); 19 | () 20 | 21 | let test_reword_error () = 22 | log "Test R.reword_error"; 23 | let reword `An_error = `Another_one in 24 | assert (R.reword_error reword (Ok 3) = Ok 3); 25 | assert (R.reword_error reword (Error `An_error) = (Error `Another_one)); 26 | () 27 | 28 | let test_gets () = 29 | log "Test R.get_{ok,error}"; 30 | assert (R.get_ok (Ok 2) = 2); 31 | assert (R.get_error (Error 3) = 3); 32 | raises_invalid_arg R.get_ok (Error 3); 33 | raises_invalid_arg R.get_error (Ok 2); 34 | () 35 | 36 | let test_bind () = 37 | log "Test R.bind"; 38 | assert (R.bind (Ok 3) (fun v -> Error (string_of_int v)) = Error "3"); 39 | assert (R.bind (Ok 3) (fun v -> Ok (string_of_int v)) = Ok "3"); 40 | assert (R.bind (Error 1) (fun v -> Ok (string_of_int v)) = Error 1); 41 | () 42 | 43 | let test_map () = 44 | log "Test R.map"; 45 | assert (R.map (fun v -> string_of_int v) (Ok 2) = Ok "2"); 46 | assert (R.map (fun v -> string_of_int v) (Error 2) = Error 2); 47 | () 48 | 49 | let test_join () = 50 | log "Test R.join"; 51 | assert (R.join (Ok (Ok 3)) = Ok 3); 52 | assert (R.join (Ok (Error 2)) = Error 2); 53 | assert (R.join (Error 3) = Error 3); 54 | assert (R.join (Error 4) = Error 4); 55 | () 56 | 57 | let test_msgs () = 58 | log "Test error messages."; 59 | assert (R.msg "bla" = `Msg "bla"); 60 | assert (R.msgf "bla%d" 3 = `Msg "bla3"); 61 | assert (R.error_msg "bla" = Error (`Msg "bla")); 62 | assert (R.error_msgf "bla%d" 3 = Error (`Msg "bla3")); 63 | let reword s = `Msg (s ^ "++") in 64 | assert (R.reword_error_msg ~replace:true reword (Ok 2) = Ok 2); 65 | assert (R.reword_error_msg ~replace:false reword (Ok 2) = Ok 2); 66 | assert (R.reword_error_msg ~replace:true reword 67 | (Error (`Msg "ha")) = (Error (`Msg "ha++"))); 68 | assert (R.reword_error_msg ~replace:false reword 69 | (Error (`Msg "ha")) = (Error (`Msg "ha\nha++"))); 70 | let pp_error ppf = function `E -> Format.fprintf ppf "E" in 71 | assert (R.error_to_msg ~pp_error (Ok 2) = (Ok 2)); 72 | assert (R.error_to_msg ~pp_error (Error `E) = (Error (`Msg "E"))); 73 | assert (R.error_msg_to_invalid_arg (Ok 2) = 2); 74 | raises_invalid_arg R.error_msg_to_invalid_arg (Error (`Msg "E")); 75 | () 76 | 77 | let test_exn_trap () = 78 | log "Test trapping unexpected exceptions."; 79 | let no_raise x = string_of_int x in 80 | let do_raise x = raise Exit in 81 | assert (R.trap_exn no_raise 3 = Ok "3"); 82 | begin match R.trap_exn do_raise 3 with 83 | | Ok _ -> assert false 84 | | Error (`Exn_trap (Exit, _)) -> () 85 | | Error _ -> assert false 86 | end; 87 | () 88 | 89 | let test_is () = 90 | log "Test R.is_{ok,error}"; 91 | assert (R.is_ok (Ok 2)); 92 | assert (not @@ R.is_ok (Error 2)); 93 | assert (R.is_error (Error 2)); 94 | assert (not @@ R.is_error (Ok 2)); 95 | () 96 | 97 | let test_converting () = 98 | log "Test R.{to,of}_{option,presult}"; 99 | assert (R.to_option (Ok 3) = Some 3); 100 | assert (R.to_option (Error 3) = None); 101 | assert (R.of_option ~none:(fun () -> Error "none") (Some 3) = Ok 3); 102 | assert (R.of_option ~none:(fun () -> Error "none") (None) = Error "none"); 103 | assert (R.to_presult (Ok 3) = (`Ok 3)); 104 | assert (R.to_presult (Error 3) = (`Error 3)); 105 | assert (R.of_presult (`Ok 3) = (Ok 3)); 106 | assert (R.of_presult (`Error 3) = (Error 3)); 107 | () 108 | 109 | let test_ignoring () = 110 | log "Test.[k]ignore_error"; 111 | assert (R.ignore_error ~use:(fun _ -> 3) (Ok 4) = 4); 112 | assert (R.ignore_error ~use:(fun _ -> 3) (Error 4) = 3); 113 | assert (R.kignore_error ~use:(fun _ -> Ok 3) (Ok 4) = (Ok 4)); 114 | assert (R.kignore_error ~use:(fun _ -> Ok 3) (Error 4) = (Ok 3)); 115 | assert (R.kignore_error ~use:(fun _ -> Error 3) (Ok 4) = (Ok 4)); 116 | assert (R.kignore_error ~use:(fun _ -> Error 3) (Error 4) = (Error 3)); 117 | () 118 | 119 | let tests () = 120 | test_constructors (); 121 | test_reword_error (); 122 | test_gets (); 123 | test_bind (); 124 | test_map (); 125 | test_join (); 126 | test_msgs (); 127 | test_exn_trap (); 128 | test_is (); 129 | test_converting (); 130 | test_ignoring (); 131 | () 132 | 133 | let () = 134 | tests (); 135 | log "All tests succeeded." 136 | 137 | (*--------------------------------------------------------------------------- 138 | Copyright (c) 2015 The rresult programmers 139 | 140 | Permission to use, copy, modify, and/or distribute this software for any 141 | purpose with or without fee is hereby granted, provided that the above 142 | copyright notice and this permission notice appear in all copies. 143 | 144 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 145 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 146 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 147 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 148 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 149 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 150 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 151 | ---------------------------------------------------------------------------*) 152 | -------------------------------------------------------------------------------- /src/rresult.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2015 The rresult programmers. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | ---------------------------------------------------------------------------*) 5 | 6 | type ('a, 'b) result = ('a, 'b) Stdlib.result = Ok of 'a | Error of 'b 7 | 8 | module R = struct 9 | 10 | let err_error = "result value is (Error _)" 11 | let err_ok = "result value is (Ok _)" 12 | 13 | (* Results *) 14 | 15 | type ('a, 'b) t = ('a, 'b) result 16 | let ok v = Ok v 17 | let error e = Error e 18 | let get_ok = function Ok v -> v | Error _ -> invalid_arg err_error 19 | let get_error = function Error e -> e | Ok _ -> invalid_arg err_ok 20 | let reword_error reword = function 21 | | Ok _ as r -> r 22 | | Error e -> Error (reword e) 23 | 24 | let return = ok 25 | let fail = error 26 | 27 | (* Composing results *) 28 | 29 | let bind v f = match v with Ok v -> f v | Error _ as e -> e 30 | let map f v = match v with Ok v -> Ok (f v) | Error _ as e -> e 31 | let join r = match r with Ok v -> v | Error _ as e -> e 32 | let ( >>= ) = bind 33 | let ( >>| ) v f = match v with Ok v -> Ok (f v) | Error _ as e -> e 34 | 35 | module Infix = struct 36 | let ( >>= ) = ( >>= ) 37 | let ( >>| ) = ( >>| ) 38 | end 39 | 40 | (* Error messages *) 41 | 42 | let pp_lines ppf s = (* hints new lines *) 43 | let left = ref 0 and right = ref 0 and len = String.length s in 44 | let flush () = 45 | Format.pp_print_string ppf (String.sub s !left (!right - !left)); 46 | incr right; left := !right; 47 | in 48 | while (!right <> len) do 49 | if s.[!right] = '\n' then (flush (); Format.pp_force_newline ppf ()) else 50 | incr right; 51 | done; 52 | if !left <> len then flush () 53 | 54 | type msg = [ `Msg of string ] 55 | let msg s = `Msg s 56 | let msgf fmt = 57 | let kmsg _ = `Msg (Format.flush_str_formatter ()) in 58 | Format.kfprintf kmsg Format.str_formatter fmt 59 | 60 | let pp_msg ppf (`Msg msg) = pp_lines ppf msg 61 | 62 | let error_msg s = Error (`Msg s) 63 | let error_msgf fmt = 64 | let kerr _ = Error (`Msg (Format.flush_str_formatter ())) in 65 | Format.kfprintf kerr Format.str_formatter fmt 66 | 67 | let reword_error_msg ?(replace = false) reword = function 68 | | Ok _ as r -> r 69 | | Error (`Msg e) -> 70 | let (`Msg e' as v) = reword e in 71 | if replace then Error v else error_msgf "%s\n%s" e e' 72 | 73 | let error_to_msg ~pp_error = function 74 | | Ok _ as r -> r 75 | | Error e -> error_msgf "%a" pp_error e 76 | 77 | let error_msg_to_invalid_arg = function 78 | | Ok v -> v 79 | | Error (`Msg m) -> invalid_arg m 80 | 81 | let open_error_msg = function Ok _ as r -> r | Error (`Msg _) as r -> r 82 | let failwith_error_msg = function Ok v -> v | Error (`Msg m) -> failwith m 83 | 84 | (* Trapping unexpected exceptions *) 85 | 86 | type exn_trap = [ `Exn_trap of exn * Printexc.raw_backtrace ] 87 | let pp_exn_trap ppf (`Exn_trap (exn, bt)) = 88 | Format.fprintf ppf "%s@\n" (Printexc.to_string exn); 89 | pp_lines ppf (Printexc.raw_backtrace_to_string bt) 90 | 91 | let trap_exn f v = try Ok (f v) with 92 | | e -> 93 | let bt = Printexc.get_raw_backtrace () in 94 | Error (`Exn_trap (e, bt)) 95 | 96 | let error_exn_trap_to_msg = function 97 | | Ok _ as r -> r 98 | | Error trap -> 99 | error_msgf "Unexpected exception:@\n%a" pp_exn_trap trap 100 | 101 | let open_error_exn_trap = function 102 | | Ok _ as r -> r | Error (`Exn_trap _) as r -> r 103 | 104 | (* Pretty-printing *) 105 | 106 | let pp ~ok ~error ppf = function Ok v -> ok ppf v | Error e -> error ppf e 107 | let dump ~ok ~error ppf = function 108 | | Ok v -> Format.fprintf ppf "@[<2>Ok@ @[%a@]@]" ok v 109 | | Error e -> Format.fprintf ppf "@[<2>Error@ @[%a@]@]" error e 110 | 111 | (* Predicates *) 112 | 113 | let is_ok = function Ok _ -> true | Error _ -> false 114 | let is_error = function Ok _ -> false | Error _ -> true 115 | 116 | let equal ~ok ~error r r' = match r, r' with 117 | | Ok v, Ok v' -> ok v v' 118 | | Error e, Error e' -> error e e' 119 | | _ -> false 120 | 121 | let compare ~ok ~error r r' = match r, r' with 122 | | Ok v, Ok v' -> ok v v' 123 | | Error v, Error v' -> error v v' 124 | | Ok _, Error _ -> -1 125 | | Error _, Ok _ -> 1 126 | 127 | (* Converting *) 128 | 129 | let to_option = function Ok v -> Some v | Error e -> None 130 | let of_option ~none = function None -> none () | Some v -> Ok v 131 | let to_presult = function Ok v -> `Ok v | Error e -> `Error e 132 | let of_presult = function `Ok v -> Ok v | `Error e -> Error e 133 | 134 | (* Ignoring errors *) 135 | 136 | let ignore_error ~use = function Ok v -> v | Error e -> use e 137 | let kignore_error ~use = function Ok _ as r -> r | Error e -> use e 138 | end 139 | 140 | include R.Infix 141 | 142 | (*--------------------------------------------------------------------------- 143 | Copyright (c) 2015 The rresult programmers 144 | 145 | Permission to use, copy, modify, and/or distribute this software for any 146 | purpose with or without fee is hereby granted, provided that the above 147 | copyright notice and this permission notice appear in all copies. 148 | 149 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 150 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 151 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 152 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 153 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 154 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 155 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 156 | ---------------------------------------------------------------------------*) 157 | -------------------------------------------------------------------------------- /src/rresult.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2014 The rresult programmers. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Result value combinators. 7 | 8 | {b Note.} OCaml 4.08 provides the {!Stdlib.Result} module 9 | which you should prefer to [Rresult]. 10 | 11 | [Rresult] is a module for handling computation results and errors 12 | in an explicit and declarative manner without resorting to 13 | exceptions. It defines a {!result} type equal to OCaml 4.03's 14 | [result] type and {{!R}combinators} to operate on these values. 15 | 16 | Open the module to use it, this defines the {{!result}result type}, 17 | the {!R.Infix} operators {!R} in your scope. 18 | 19 | Consult {{!usage}usage guidelines} for the type. *) 20 | 21 | (** {1 Results} *) 22 | 23 | (** The type for results. *) 24 | type ('a, 'b) result = ('a, 'b) Stdlib.result = Ok of 'a | Error of 'b 25 | 26 | val ( >>= ) : ('a, 'b) result -> ('a -> ('c, 'b) result) -> ('c, 'b) result 27 | (** [(>>=)] is {!R.(>>=)}. *) 28 | 29 | val ( >>| ) : ('a, 'b) result -> ('a -> 'c) -> ('c, 'b) result 30 | (** [(>>|)] is {!R.(>>|)}. *) 31 | 32 | (** Result value combinators. *) 33 | module R : sig 34 | 35 | (** {1 Results} *) 36 | 37 | type ('a, 'b) t = ('a, 'b) result 38 | (** The type for results. *) 39 | 40 | val ok : 'a -> ('a, 'b) result 41 | (** [ok v] is [Ok v]. *) 42 | 43 | val error : 'b -> ('a, 'b) result 44 | (** [error e] is [Error e]. *) 45 | 46 | val reword_error : ('b -> 'c) -> ('a, 'b) result -> ('a, 'c) result 47 | (** [reword_error reword r] is: 48 | {ul 49 | {- [r] if [r = Ok v]} 50 | {- [Error (reword e)] if [r = Error e]}} *) 51 | 52 | val get_ok : ('a, 'b) result -> 'a 53 | (** [get_ok r] is [v] if [r = Ok v] and raises [Invalid_argument] 54 | otherwise. *) 55 | 56 | val get_error : ('a, 'b) result -> 'b 57 | (** [get_error r] is [e] if [r = Error e] and raises [Invalid_argument] 58 | otherwise. *) 59 | 60 | (**/**) 61 | val return : 'a -> ('a, 'b) result 62 | val fail : 'b -> ('a, 'b) result 63 | (**/**) 64 | 65 | (** {1 Composing results} *) 66 | 67 | val bind : ('a, 'b) result -> ('a -> ('c, 'b) result) -> ('c, 'b) result 68 | (** [bind r f] is [f v] if [r = Ok v] and [r] if [r = Error _]. *) 69 | 70 | val map : ('a -> 'c) -> ('a, 'b) result -> ('c, 'b) result 71 | (** [map f r] is [bind (fun v -> ret (f v))] r. *) 72 | 73 | val join : (('a, 'b) result, 'b) result -> ('a, 'b) result 74 | (** [join r] is [v] if [r = Ok v] and [r] otherwise. *) 75 | 76 | val ( >>= ) : ('a, 'b) result -> ('a -> ('c, 'b) result) -> ('c, 'b) result 77 | (** [r >>= f] is {!bind}[ r f]. *) 78 | 79 | val ( >>| ) : ('a, 'b) result -> ('a -> 'c) -> ('c, 'b) result 80 | (** [r >>| f] is {!map}[ r f]. *) 81 | 82 | (** Infix operators. 83 | 84 | Gathers {!R}'s infix operators. *) 85 | module Infix : sig 86 | 87 | (** {1 Infix operators} *) 88 | 89 | val ( >>= ) : ('a, 'b) result -> ('a -> ('c, 'b) result) -> ('c, 'b) result 90 | (** [(>>=)] is {!R.(>>=)}. *) 91 | 92 | val ( >>| ) : ('a, 'b) result -> ('a -> 'c) -> ('c, 'b) result 93 | (** [(>>|)] is {!R.(>>|)}. *) 94 | end 95 | 96 | (** {1:msgs Error messages} *) 97 | 98 | type msg = [ `Msg of string ] 99 | (** The type for (error) messages. *) 100 | 101 | val msg : string -> [> msg] 102 | (** [msg s] is [`Msg s]. *) 103 | 104 | val msgf : ('a, Format.formatter, unit, [> msg]) format4 -> 'a 105 | (** [msgf fmt ...] formats a message according to [fmt]. *) 106 | 107 | val pp_msg : Format.formatter -> msg -> unit 108 | (** [pp_msg ppf m] prints [m] on [ppf]. *) 109 | 110 | val error_msg : string -> ('a, [> msg]) result 111 | (** [error_msg s] is [error (`Msg s)]. *) 112 | 113 | val error_msgf : ('a, Format.formatter, unit, ('b, [> msg]) result) 114 | format4 -> 'a 115 | (** [error_msgf fmt ...] is an error message formatted according to [fmt]. *) 116 | 117 | val reword_error_msg : ?replace:bool -> (string -> msg) -> 118 | ('a, msg) result -> ('a, [> msg]) result 119 | (** [reword_error_msg ~replace reword r] is like {!reword_error} except 120 | if [replace] is [false] (default), the result of [reword old_msg] is 121 | concatened, on a new line to the old message. *) 122 | 123 | val error_to_msg : pp_error:(Format.formatter -> 'b -> unit) -> 124 | ('a, 'b) result -> ('a, [> msg]) result 125 | (** [error_to_msg ~pp_error r] converts errors in [r] with [pp_error] to 126 | an error message. *) 127 | 128 | val error_msg_to_invalid_arg : ('a, msg) result -> 'a 129 | (** [err_msg_to_invalid_arg r] is [v] if [r = Ok v] and 130 | 131 | @raise Invalid_argument with the error message otherwise. *) 132 | 133 | val open_error_msg : ('a, msg) result -> ('a, [> msg]) result 134 | (** [open_error_msg r] allows to combine a closed error message 135 | variant with other variants. *) 136 | 137 | val failwith_error_msg : ('a, msg) result -> 'a 138 | (** [failwith_error_msg r] raises [Failure m] if [r] is 139 | [Error (`Msg m)]. *) 140 | 141 | (** {1:exn Trapping unexpected exceptions} 142 | 143 | {e Getting rid of [null] was not enough}. *) 144 | 145 | type exn_trap = [ `Exn_trap of exn * Printexc.raw_backtrace ] 146 | (** The type for exception traps. *) 147 | 148 | val pp_exn_trap : Format.formatter -> exn_trap -> unit 149 | (** [pp_exn_trap ppf bt] prints [bt] on [ppf]. *) 150 | 151 | val trap_exn : ('a -> 'b) -> 'a -> ('b, [> exn_trap]) result 152 | (** [trap_exn f v] is [f v] and traps any exception that may occur as 153 | an exception trap error. *) 154 | 155 | val error_exn_trap_to_msg : ('a, exn_trap) result -> ('a, [> msg]) result 156 | (** [error_exn_trap_to_msg r] converts exception trap errors in 157 | [r] to an error message. *) 158 | 159 | val open_error_exn_trap : ('a, exn_trap) result -> ('a, [> exn_trap]) result 160 | (** [open_error_exn_trap r] allows to combine a closed exception trap error 161 | variant with other variants. *) 162 | 163 | (** {1:print Pretty printing} *) 164 | 165 | val pp : 166 | ok:(Format.formatter -> 'a -> unit) -> 167 | error:(Format.formatter -> 'b -> unit) -> Format.formatter -> 168 | ('a, 'b) result -> unit 169 | (** [pp ~ok ~error ppf r] prints [r] on [ppf] using [ok] and [error] 170 | according to [r]. *) 171 | 172 | val dump : 173 | ok:(Format.formatter -> 'a -> unit) -> 174 | error:(Format.formatter -> 'b -> unit) -> Format.formatter -> 175 | ('a, 'b) result -> unit 176 | (** [dump ~ok ~error] formats an OCaml result value using [ok] or [error] 177 | according to case, no parentheses are added. *) 178 | 179 | (** {1:pred Predicates and comparison} *) 180 | 181 | val is_ok : ('a, 'b) result -> bool 182 | (** [is_ok r] is [true] iff [r = Ok _]. *) 183 | 184 | val is_error : ('a, 'b) result -> bool 185 | (** [is_error r] is [true] iff [r = Error _]. *) 186 | 187 | val equal : ok:('a -> 'a -> bool) -> error:('b -> 'b -> bool) -> 188 | ('a, 'b) result -> ('a, 'b) result -> bool 189 | (** [equal ~ok ~error r r'] tests [r] and [r'] for equality using [ok] 190 | and [error]. *) 191 | 192 | val compare : ok:('a -> 'a -> int) -> error:('b -> 'b -> int) -> 193 | ('a, 'b) result -> ('a, 'b) result -> int 194 | (** [compare ~ok ~error r r'] totally orders [r] and [r'] using [ok] 195 | and [error]. *) 196 | 197 | (** {1:convert Converting} *) 198 | 199 | val to_option : ('a, 'b) result -> 'a option 200 | (** [to_option r] is [Some v] if [r = Ok v] and [None] otherwise. *) 201 | 202 | val of_option : none:(unit -> ('a, 'b) result) -> 'a option -> ('a, 'b) result 203 | (** [of_option ~none r] is [Ok v] if [r = Some v] and [none ()] otherwise. *) 204 | 205 | val to_presult : ('a, 'b) result -> [> `Ok of 'a | `Error of 'b ] 206 | (** [to_presult r] is [r] as a polymorphic variant result value. *) 207 | 208 | val of_presult : [< `Ok of 'a | `Error of 'b ] -> ('a, 'b) result 209 | (** [of_presult pr] is [pr] as a result value. *) 210 | 211 | (** {1:ignore Ignoring errors} 212 | 213 | {b Warning.} Using these functions is, most of the time, a bad idea. *) 214 | 215 | val ignore_error : use:('b -> 'a) -> ('a, 'b) result -> 'a 216 | (** [ignore_error ~use r] is [v] if [r = Ok v] and [use e] if 217 | [r = Error e]. *) 218 | 219 | val kignore_error : 220 | use:('b -> ('a, 'c) result) -> ('a, 'b) result -> ('a, 'c) result 221 | (** [kignore_error ~use r] is [r] if [r = Ok v] and [use e] if 222 | [r = Error e]. *) 223 | end 224 | 225 | (** {1:usage Usage design guidelines} 226 | 227 | These are rough design guidelines, don't forget to think. 228 | 229 | {2 Error messages} 230 | 231 | Use {{!R.msgs}error messages} if: 232 | {ol 233 | {- Your error messages don't need to be localized, e.g. scripts, 234 | command line programs.} 235 | {- The errors don't need to be processed. They are just meant to 236 | be logged at certain point in your program.}} 237 | 238 | If the above doesn't hold and your errors need to be processed for 239 | localization or error recovery then use a custom error type in your 240 | result values. 241 | 242 | {2 Custom error types} 243 | 244 | If your module has specific errors then define an error type, and 245 | a result type that tags this error type with the library name (or 246 | any other tag that may make sense, see for example {!R.exn}) along 247 | with the following functions: 248 | 249 | {[ 250 | module Mod : sig 251 | type error = ... 252 | type 'a result = ('a, [`Mod of error]) Rresult.result 253 | val pp_error : Format.formatter -> [`Mod of error] -> unit 254 | val open_error : 'a result -> ('a, [> `Mod of error]) Rresult.result 255 | val error_to_msg : 'a result -> ('a, Rresult.R.msg) Rresult.result 256 | 257 | val f : ... -> 'a result 258 | end 259 | ]} 260 | 261 | If your library has generic errors that may be useful in other context 262 | or shared among modules and to be composed together, then define your 263 | error type itself as being a variant and return these values 264 | without tagging them. 265 | {[ 266 | module Mod : sig 267 | type error = [`Generic of ... | ... ] 268 | type 'a result = ('a, error) Rresult.result 269 | val pp_error : Format.formatter -> error -> unit 270 | val open_error : 'a result -> ('a, [> error]) Rresult.result 271 | val error_to_msg : 'a result -> ('a, Rresult.R.msg) Rresult.result 272 | 273 | val f : ... -> 'a result 274 | end 275 | ]} 276 | In the latter case it may still be useful to provide a function to 277 | tag these errors whenever they reach a certain point of the program. 278 | For this the following function could be added to [Mod]: 279 | {[ 280 | val pack_error : 'a result -> ('a, [> `Mod of error]) Rresult.result 281 | ]} 282 | You should then provide the following functions aswell, so that 283 | the packed error composes well in the system: 284 | {[ 285 | val pp_pack_error : Format.formatter -> [ `Mod of error] -> unit 286 | val open_pack_error : ('a, [ `Mod of error]) Rresult.result -> 287 | ('a, [> `Mod of error]) Rresult.result 288 | 289 | val error_pack_to_msg : ('a, [ `Mod of error]) Rresult.result -> 290 | ('a, Rresult.R.msg) Rresult.result 291 | ]} 292 | *) 293 | 294 | (*--------------------------------------------------------------------------- 295 | Copyright (c) 2014 The rresult programmers 296 | 297 | Permission to use, copy, modify, and/or distribute this software for any 298 | purpose with or without fee is hereby granted, provided that the above 299 | copyright notice and this permission notice appear in all copies. 300 | 301 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 302 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 303 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 304 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 305 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 306 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 307 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 308 | ---------------------------------------------------------------------------*) 309 | --------------------------------------------------------------------------------