From 01fab4c1c39d3d8e93610a26376b0f1d40c91cce Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Fri, 30 Mar 2018 16:55:44 -0400 Subject: [PATCH] Add Stdune.Or_exn --- src/arg_spec.mli | 4 ++-- src/build.mli | 4 ++-- src/inline_tests.ml | 4 ++-- src/lib.ml | 14 ++++++-------- src/lib.mli | 18 +++++++++--------- src/stdune/or_exn.ml | 1 + src/stdune/or_exn.mli | 3 +++ src/stdune/stdune.ml | 3 ++- src/sub_system_intf.ml | 14 +++++++------- 9 files changed, 34 insertions(+), 31 deletions(-) create mode 100644 src/stdune/or_exn.ml create mode 100644 src/stdune/or_exn.mli diff --git a/src/arg_spec.mli b/src/arg_spec.mli index 1c2ce11a..ac54d5f8 100644 --- a/src/arg_spec.mli +++ b/src/arg_spec.mli @@ -47,5 +47,5 @@ val expand : dir:Path.t -> 'a t list -> 'a -> string list * Path.Set.t (** [quote_args quote args] is [As \[quote; arg1; quote; arg2; ...\]] *) val quote_args : string -> string list -> _ t -val of_result : ('a t, exn) result -> 'a t -val of_result_map : ('a, exn) result -> f:('a -> 'b t) -> 'b t +val of_result : 'a t Or_exn.t -> 'a t +val of_result_map : 'a Or_exn.t -> f:('a -> 'b t) -> 'b t diff --git a/src/build.mli b/src/build.mli index 188bc29c..1268815d 100644 --- a/src/build.mli +++ b/src/build.mli @@ -116,12 +116,12 @@ val fail : ?targets:Path.t list -> fail -> (_, _) t val of_result : ?targets:Path.t list - -> (('a, 'b) t, exn) Result.t + -> ('a, 'b) t Or_exn.t -> ('a, 'b) t val of_result_map : ?targets:Path.t list - -> ('a, exn) Result.t + -> 'a Or_exn.t -> f:('a -> ('b, 'c) t) -> ('b, 'c) t diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 03a1f150..ffb8473f 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -56,8 +56,8 @@ module Backend = struct type t = { info : Info.t ; lib : Lib.t - ; runner_libraries : (Lib.t list, exn) result - ; extends : ( t list, exn) result + ; runner_libraries : Lib.t list Or_exn.t + ; extends : t list Or_exn.t } let desc ~plural = "inline tests backend" ^ if plural then "s" else "" diff --git a/src/lib.ml b/src/lib.ml index 1a755ae7..286d46b1 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -232,9 +232,9 @@ type t = ; plugins : Path.t list Mode.Dict.t ; foreign_archives : Path.t list Mode.Dict.t ; jsoo_runtime : Path.t list - ; requires : t list or_error - ; ppx_runtime_deps : t list or_error - ; pps : t list or_error + ; requires : t list Or_exn.t + ; ppx_runtime_deps : t list Or_exn.t + ; pps : t list Or_exn.t ; resolved_selects : Resolved_select.t list ; optional : bool ; user_written_deps : Jbuild.Lib_deps.t @@ -289,8 +289,6 @@ and private_deps_not_allowed = ; pd_loc : Loc.t } -and 'a or_error = ('a, exn) result - type lib = t module Error = struct @@ -919,9 +917,9 @@ module Compile = struct module Resolved_select = Resolved_select type nonrec t = - { direct_requires : t list or_error - ; requires : t list or_error - ; pps : t list or_error + { direct_requires : t list Or_exn.t + ; requires : t list Or_exn.t + ; pps : t list Or_exn.t ; resolved_selects : Resolved_select.t list ; optional : bool ; user_written_deps : Jbuild.Lib_deps.t diff --git a/src/lib.mli b/src/lib.mli index d42b4cbd..077d30c7 100644 --- a/src/lib.mli +++ b/src/lib.mli @@ -195,13 +195,13 @@ module Compile : sig (** Create a compilation context from a list of libraries. The list doesn't have to be transitively closed. *) - val make : (L.t, exn) result -> t + val make : L.t Or_exn.t -> t (** Return the list of dependencies needed for compiling this library *) - val requires : t -> (L.t, exn) result + val requires : t -> L.t Or_exn.t (** Dependencies listed by the user + runtime dependencies from ppx *) - val direct_requires : t -> (L.t, exn) result + val direct_requires : t -> L.t Or_exn.t module Resolved_select : sig type t = @@ -214,7 +214,7 @@ module Compile : sig val resolved_selects : t -> Resolved_select.t list (** Transitive closure of all used ppx rewriters *) - val pps : t -> (L.t, exn) result + val pps : t -> L.t Or_exn.t val optional : t -> bool val user_written_deps : t -> Jbuild.Lib_deps.t @@ -267,7 +267,7 @@ module DB : sig val find_many : t -> string list - -> (lib list, exn) result + -> lib list Or_exn.t val find_even_when_hidden : t -> string -> lib option @@ -277,7 +277,7 @@ module DB : sig for libraries that are optional and not available as well. *) val get_compile_info : t -> ?allow_overlaps:bool -> string -> Compile.t - val resolve : t -> Loc.t * string -> (lib, exn) result + val resolve : t -> Loc.t * string -> lib Or_exn.t (** Resolve libraries written by the user in a jbuild file. The resulting list of libraries is transitively closed and sorted by @@ -294,7 +294,7 @@ module DB : sig val resolve_pps : t -> (Loc.t * Jbuild.Pp.t) list - -> (L.t, exn) result + -> L.t Or_exn.t (** Return the list of all libraries in this database. If [recursive] is true, also include libraries in parent databases @@ -304,7 +304,7 @@ end with type lib := t (** {1 Transitive closure} *) -val closure : L.t -> (L.t, exn) result +val closure : L.t -> L.t Or_exn.t (** {1 Sub-systems} *) @@ -318,7 +318,7 @@ module Sub_system : sig type t type sub_system += T of t val instantiate - : resolve:(Loc.t * string -> (lib, exn) result) + : resolve:(Loc.t * string -> lib Or_exn.t) -> get:(lib -> t option) -> lib -> Info.t diff --git a/src/stdune/or_exn.ml b/src/stdune/or_exn.ml new file mode 100644 index 00000000..1cf0b244 --- /dev/null +++ b/src/stdune/or_exn.ml @@ -0,0 +1 @@ +type 'a t = ('a, exn) Result.t diff --git a/src/stdune/or_exn.mli b/src/stdune/or_exn.mli new file mode 100644 index 00000000..f233df34 --- /dev/null +++ b/src/stdune/or_exn.mli @@ -0,0 +1,3 @@ +(** Either a value or an exception *) + +type 'a t = ('a, exn) Result.t diff --git a/src/stdune/stdune.ml b/src/stdune/stdune.ml index 9e1c4541..944aafd1 100644 --- a/src/stdune/stdune.ml +++ b/src/stdune/stdune.ml @@ -6,16 +6,17 @@ module Exn = Exn module Filename = Filename module Hashtbl = Hashtbl module Int = Int +module Io = Io module List = List module Map = Map module Option = Option +module Or_exn = Or_exn module Ordering = Ordering module Pp = Pp module Result = Result module Set = Set module Staged = Staged module String = String -module Io = Io external reraise : exn -> _ = "%reraise" diff --git a/src/sub_system_intf.ml b/src/sub_system_intf.ml index 2a9b403d..6de0d79b 100644 --- a/src/sub_system_intf.ml +++ b/src/sub_system_intf.ml @@ -11,7 +11,7 @@ module type S = sig (** Create an instance of the sub-system *) val instantiate - : resolve:(Loc.t * string -> (Lib.t, exn) result) + : resolve:(Loc.t * string -> Lib.t Or_exn.t) -> get:(Lib.t -> t option) -> Lib.t -> Info.t @@ -43,7 +43,7 @@ module type Registered_backend = sig val get : Lib.t -> t option (** Resolve a backend name *) - val resolve : Lib.DB.t -> Loc.t * string -> (t, exn) result + val resolve : Lib.DB.t -> Loc.t * string -> t Or_exn.t (** Choose a backend by either using the ones written by the user or by scanning the dependencies. @@ -55,9 +55,9 @@ module type Registered_backend = sig val select_extensible_backends : loc:Loc.t -> ?written_by_user:t list - -> extends:(t -> (t list, exn) result) + -> extends:(t -> t list Or_exn.t) -> Lib.t list - -> (t list, exn) result + -> t list Or_exn.t (** Choose a backend by either using the ones written by the user or by scanning the dependencies. @@ -66,9 +66,9 @@ module type Registered_backend = sig val select_replaceable_backend : loc:Loc.t -> ?written_by_user:t list - -> replaces:(t -> (t list, exn) result) + -> replaces:(t -> t list Or_exn.t) -> Lib.t list - -> (t, exn) result + -> t Or_exn.t end (* This is probably what we'll give to plugins *) @@ -89,7 +89,7 @@ module type End_point = sig include Registered_backend (** Backends that this backends extends *) - val extends : t -> (t list, exn) result + val extends : t -> t list Or_exn.t end module Info : sig