Merge pull request #4918 from rjbou/compare

Add non polymorphic comparison functions to some modules

master_changes.md

@@ -139,13 +139,15 @@ users)
 ## Internal
   * Add license and lowerbounds to opam files [#4714 @kit-ty-kate]
   * Bump version to 2.2.0~alpha~dev [#4725 @dra27]
+  * Add specific comparison function on several module (that includes `OpamStd.ABSTRACT`) [#4918 @rjbou]
 
 ## Internal: Windows
   * Support MSYS2: treat MSYS2 and Cygwin as equivalent [#4813 @jonahbeckford]
   * Process control: close stdin by default for Windows subprocesses and on all platforms for the download command [#4615 @dra27]
   * [BUG] handle converted variables correctly when no_undef_expand is true [#4811 @timbertson]
 
 ## Test
+  * Update crowbar with compare functions [#4918 @rjbou]
 
 ## Reftests
   * Add switch-invariant test [#4866 @rjbou]
@@ -179,9 +181,13 @@ users)
 
 # API updates
 ## opam-client
+  * `OpamStd.ABSTRACT`: add `compare` and `equal`, that added those functions to `OpamCLIVersion` [#4918 @rjbou]
 ## opam-repository
 ## opam-state
 ## opam-solver
 ## opam-format
+  * `OpamStd.ABSTRACT`: add `compare` and `equal`, that added those functions to `OpamSysPkg` and `OpamVariable` [#4918 @rjbou]
 ## opam-core
   * OpamSystem: avoid calling Unix.environment at top level [#4789 @hannesm]
+  * `OpamStd.ABSTRACT`: add `compare` and `equal`, that added those functions to `OpamFilename`, `OpamHash`, `OpamStd`, `OpamStd`, `OpamUrl`, and `OpamVersion` [#4918 @rjbou]
+

src/client/opamCLIVersion.ml

@@ -41,7 +41,12 @@ let of_json = function
 
 let ( >= ) = Stdlib.( >= )
 let ( < ) = Stdlib.( < )
-let compare = Stdlib.compare
+let compare (vm, vn) (wm, wn) =
+  let open OpamCompat in
+  let major = Int.compare vm wm in
+  if major <> 0 then major else
+    Int.compare vn wn
+let equal v w = compare v w = 0
 
 let previous cli =
   let f previous version =

src/core/opamCompat.ml

@@ -23,6 +23,15 @@ struct
 end
 #endif
 
+module Int =
+#if OCAML_VERSION >= (4, 8, 0)
+  Int
+#else
+struct
+  let compare : int -> int -> int = Stdlib.compare
+end
+#endif
+
 module Printexc =
 #if OCAML_VERSION >= (4, 5, 0)
   Printexc

src/core/opamCompat.mli

@@ -23,6 +23,15 @@ module Either
 end
 #endif
 
+module Int
+#if OCAML_VERSION >= (4, 12, 0)
+= Int
+#else
+: sig
+  val compare: int -> int -> int
+end
+#endif
+
 module Printexc
 #if OCAML_VERSION >= (4, 5, 0)
 = Printexc

src/core/opamFilename.ml

@@ -12,6 +12,9 @@
 module Base = struct
   include OpamStd.AbstractString
 
+  let compare = String.compare
+  let equal = String.equal
+
   let check_suffix filename s =
     Filename.check_suffix filename s
 
@@ -26,6 +29,9 @@ module Dir = struct
 
   include OpamStd.AbstractString
 
+  let compare = String.compare
+  let equal = String.equal
+
   let of_string dirname =
     let dirname =
       if dirname = "~" then OpamStd.Sys.home ()
@@ -473,6 +479,13 @@ let of_json = function
   | `String x -> (try Some (of_string x) with _ -> None)
   | _ -> None
 
+let compare {dirname; basename} f =
+  let dir = Dir.compare dirname f.dirname in
+  if dir <> 0 then dir else
+    Base.compare basename f.basename
+
+let equal f g = compare f g = 0
+
 module O = struct
   type tmp = t
   type t = tmp
@@ -561,6 +574,15 @@ module Attribute = struct
       end
     | _ -> None
 
+  let compare {base; md5; perm} a =
+    let base = Base.compare base a.base in
+    if base <> 0 then base else
+    let md5 = OpamHash.compare md5 a.md5 in
+    if md5 <> 0 then md5 else
+      OpamStd.Option.compare OpamCompat.Int.compare perm a.perm
+
+  let equal a b = compare a b = 0
+
   module O = struct
     type tmp = t
     type t = tmp

src/core/opamHash.ml

@@ -17,6 +17,14 @@ type t = kind * string
 let kind = fst
 let contents = snd
 
+let compare (k,h) (l,i) =
+  match k, l with
+  | `SHA512, `SHA512 | `SHA256, `SHA256 | `MD5, `MD5 -> String.compare h i
+  | `MD5, _ | _, `SHA512 -> -1
+  | `SHA512, _ | _, `MD5 -> 1
+
+let equal h h' = compare h h' = 0
+
 let log msg = OpamConsole.log "HASH" msg
 
 let pfx_sep_char = '='

src/core/opamStd.ml

@@ -50,6 +50,8 @@ module type MAP = sig
 end
 module type ABSTRACT = sig
   type t
+  val compare: t -> t -> int
+  val equal: t -> t -> bool
   val of_string: string -> t
   val to_string: t -> string
   val to_json: t -> OpamJson.t
@@ -384,6 +386,8 @@ end
 
 module AbstractString = struct
   type t = string
+  let compare = String.compare
+  let equal = String.equal
   let of_string x = x
   let to_string x = x
   let to_json x = `String x
@@ -404,7 +408,7 @@ end
 
 module OInt = struct
   type t = int
-  let compare = compare
+  let compare = OpamCompat.Int.compare
   let to_string = string_of_int
   let to_json i = `String (string_of_int i)
   let of_json = function
@@ -483,7 +487,7 @@ module OpamString = struct
 
   module OString = struct
     type t = string
-    let compare = compare
+    let compare = String.compare
     let to_string x = x
     let to_json x = `String x
     let of_json = function

src/core/opamStd.mli

@@ -100,6 +100,8 @@ module type ABSTRACT = sig
 
   type t
 
+  val compare: t -> t -> int
+  val equal: t -> t -> bool
   val of_string: string -> t
   val to_string: t -> string
   val to_json: t -> OpamJson.t

src/core/opamUrl.ml

@@ -29,6 +29,17 @@ let empty = {
   hash = None;
 }
 
+let compare {transport; path; hash; backend} u =
+  let transport = String.compare transport u.transport in
+  if transport <> 0 then transport else
+  let path = String.compare path u.path in
+  if path <> 0 then path else
+  let hash = OpamStd.Option.compare String.compare hash u.hash in
+  if hash <> 0 then hash else
+    compare backend u.backend
+
+let equal u v = compare u v = 0
+
 exception Parse_error of string
 let parse_error s = raise (Parse_error s)
 

src/core/opamVersion.ml

@@ -22,6 +22,7 @@ let of_json = function
 | _ -> None
 
 let compare v w = OpamVersionCompare.compare v w
+let equal v w = compare v w = 0
 
 module O = struct
   type t = string

src/crowbar/opamFilename_crowbar.ml

@@ -32,8 +32,8 @@ let filename : t gen =
 
 let check () =
   check_json_roundtrip ~name:"OpamFilename.Base.t"
-    base (=) Base.to_json Base.of_json;
+    base (eq_of_comp Base.compare) Base.to_json Base.of_json;
   check_json_roundtrip ~name:"OpamFilename.Dir.t"
-    dir (=) Dir.to_json Dir.of_json;
+    dir (eq_of_comp Dir.compare) Dir.to_json Dir.of_json;
   check_json_roundtrip ~name:"OpamFilename.t"
-    filename (=) to_json of_json;
+    filename (eq_of_comp OpamFilename.compare) to_json of_json;

src/crowbar/opamHash_crowbar.ml

@@ -23,4 +23,4 @@ let hash = map [kind; bytes] @@ fun kind string ->
 
 let check () =
   check_json_roundtrip ~name:"OpamHash.t"
-    hash (=) OpamHash.to_json OpamHash.of_json;
+    hash (eq_of_comp OpamHash.compare) OpamHash.to_json OpamHash.of_json;

src/crowbar/opamUrl_crowbar.ml

@@ -49,4 +49,4 @@ let url : OpamUrl.t gen = map [
 
 let check () =
   check_json_roundtrip ~name:"OpamUrl.t"
-    url (=) OpamUrl.to_json OpamUrl.of_json;
+    url (eq_of_comp OpamUrl.compare) OpamUrl.to_json OpamUrl.of_json;

src/crowbar/opamVariable_crowbar.ml

@@ -21,6 +21,5 @@ let full = choose [
 ]
 
 let check () =
-  let equal v1 v2 = Full.to_string v1 = Full.to_string v2 in
   check_json_roundtrip ~name:"OpamVariable.t"
-    full equal Full.to_json Full.of_json;
+    full (eq_of_comp OpamVariable.Full.compare) Full.to_json Full.of_json;

src/format/opamSysPkg.ml

@@ -15,6 +15,7 @@ type t = string
 let of_string s = s
 let to_string s = s
 let compare = OpamStd.String.compare_case
+let equal s r = compare s r = 0
 
 let to_json s =
   `O [ ("sys_package", `String s) ]

src/format/opamVariable.ml

@@ -108,6 +108,19 @@ module Full = struct
     | `String s -> (try Some (of_string s) with _ -> None)
     | _ -> None
 
+  let compare {scope; variable} fv =
+    match scope, fv.scope with
+    | Global, Global | Self, Self ->
+      String.compare variable fv.variable
+    | Package n, Package m ->
+      let package = OpamPackage.Name.compare n m in
+      if package <> 0 then package else
+        String.compare variable fv.variable
+    | Global, _ | _, Self -> 1
+    | Self, _ | _, Global -> -1
+
+  let equal f g = compare f g = 0
+
   module O = struct
     type tmp = t
     type t = tmp