Merge pull request #6381 from kit-ty-kate/OpamListCommand-no-poly-cmp

Avoid polymorphic comparison functions in OpamListCommand

master_changes.md

@@ -159,6 +159,7 @@ users)
   * Avoid issues when using wget2 where the requested url might return an html page instead of the expected content [#6303 @kit-ty-kate]
   * Ensure each repositories stored in repos-config is associated with an URL [#6249 @kit-ty-kate]
   * Run `Gc.compact` in OpamParallel, when the main process is waiting for the children processes for the first time [#5396 @kkeundotnet]
+  * Avoid polymorphic comparison functions in `OpamListCommand` [#6381 @kit-ty-kate]
 
 ## Internal: Unix
   * Use a C stub to call the `uname` function from the C standard library instead of calling the `uname` POSIX command [#6217 @kit-ty-kate]
@@ -250,6 +251,7 @@ users)
   * `OpamConsole.pause`: Ensure the function always prints a newline character at the end [#6376 @kit-ty-kate]
   * `OpamHash.all_kinds`: was added, which returns the list of all possible values of `OpamHash.kind` [#5960 @kit-ty-kate]
   * `OpamStd.List.split`: Improve performance [#6210 @kit-ty-kate]
+  * `OpamStd.Option.equal_some`: was added, which tests equality of an option with a value [#6381 @kit-ty-kate]
   * `OpamStd.Sys.{get_terminal_columns,uname,getconf,guess_shell_compat}`: Harden the process calls to account for failures [#6230 @kit-ty-kate - fix #6215]
   * `OpamStd.Sys.getconf`: was removed, replaced by `get_long_bit` [#6217 @kit-ty-kate]
   * `OpamStd.Sys.get_long_bit`: was added, which returns the output of the `getconf LONG_BIT` command [#6217 @kit-ty-kate]

src/client/opamListCommand.ml

@@ -348,7 +348,7 @@ let apply_selector ~base st = function
       base
   | Tag t ->
     OpamPackage.Set.filter (fun nv ->
-        get_opam st nv |> List.mem t @* OpamFile.OPAM.tags)
+        get_opam st nv |> List.exists (String.equal t) @* OpamFile.OPAM.tags)
       base
   | From_repository repos ->
     let rt = st.switch_repos in
@@ -358,7 +358,8 @@ let apply_selector ~base st = function
         let packages =
           OpamPackage.keys (OpamRepositoryName.Map.find r rt.repo_opams)
         in
-        if List.mem r repos then OpamPackage.Set.union packages (aux rl)
+        if List.exists (OpamRepositoryName.equal r) repos
+        then OpamPackage.Set.union packages (aux rl)
         else OpamPackage.Set.diff (aux rl) packages
     in
     aux (OpamSwitchState.repos_list st)
@@ -383,12 +384,13 @@ let apply_selector ~base st = function
              OpamStd.String.Map.exists
                (fun f -> function
                   | OpamDirTrack.Removed -> false
-                  | _ -> rel_name = f)
+                  | _ -> rel_name = (f : string))
                changes)
            (OpamFilename.files (OpamPath.Switch.install_dir root switch))
        in
        let selections =
-         if switch = st.switch then OpamSwitchState.selections st
+         if OpamSwitch.equal switch st.switch then
+           OpamSwitchState.selections st
          else
            OpamSwitchState.load_selections ~lock_kind:`Lock_none
              st.switch_global switch
@@ -504,7 +506,7 @@ let field_of_string ~raw =
     try
       OpamStd.List.assoc String.equal s names_fields
     with Not_found ->
-    match OpamStd.List.find_opt (fun x -> s = x) opam_fields with
+    match OpamStd.List.find_opt (String.equal s) opam_fields with
     | Some f -> Field f
     | None -> OpamConsole.error_and_exit `Bad_arguments "No printer for %S" s
 
@@ -569,7 +571,10 @@ let detail_printer ?prettify ?normalise ?(sort=false) st nv =
     (match OpamPinned.package_opt st nv.name with
      | Some nv ->
        let opam = get_opam st nv in
-       if Some opam = OpamPackage.Map.find_opt nv st.repos_package_index then
+       if
+         OpamStd.Option.equal_some OpamFile.OPAM.equal
+           opam (OpamPackage.Map.find_opt nv st.repos_package_index)
+       then
          Printf.sprintf "pinned to version %s"
            (OpamPackage.Version.to_string nv.version % [`blue])
        else

src/core/opamStd.ml

@@ -521,6 +521,10 @@ module Option = struct
     | None, None -> true
     | _ , _  -> false
 
+  let equal_some f v1 = function
+    | None -> false
+    | Some v2 -> f v1 v2
+
   let to_string ?(none="") f = function
     | Some x -> f x
     | None -> none

src/core/opamStd.mli

@@ -163,6 +163,8 @@ module Option: sig
 
   val equal: ('a -> 'a -> bool) -> 'a option -> 'a option -> bool
 
+  val equal_some : ('a -> 'a -> bool) -> 'a -> 'a option -> bool
+
   val to_string: ?none:string -> ('a -> string) -> 'a option -> string
 
   val to_list: 'a option -> 'a list