Merge pull request #11121 from ElectreAAS/butcher-0install

[refactor] clean up 0install codebase further

src/0install-solver/diagnostics.ml

@@ -4,20 +4,20 @@
 
 (** Explaining why a solve failed or gave an unexpected answer. *)
 
-module List = Solver_core.List
+module List = Stdune.List
 
 let pf = Format.fprintf
 
-module Make
-    (Monad : S.Monad)
-    (Results : S.SOLVER_RESULT with type 'a Input.monad := 'a Monad.t) =
-struct
-  open Monad.O
+module Make (Results : S.SOLVER_RESULT) = struct
+  open Fiber.O
   module Model = Results.Input
   module RoleMap = Results.RoleMap
 
   let format_role = Model.Role.pp
-  let format_restrictions r = String.concat ", " (List.map Model.string_of_restriction r)
+
+  let format_restrictions r =
+    String.concat ", " (List.map ~f:Model.string_of_restriction r)
+  ;;
 
   module Note = struct
     type t =
@@ -89,13 +89,13 @@ struct
       (selected_impl : Model.impl option)
       =
       let { Model.impls; Model.replacement } = candidates in
-      let notes = List.map (fun x -> Note.Feed_problem x) feed_problems in
+      let notes = List.map ~f:(fun x -> Note.Feed_problem x) feed_problems in
       { role
       ; replacement
       ; orig_good = impls
       ; orig_bad
       ; good = impls
-      ; bad = List.map (fun (impl, reason) -> impl, `Model_rejection reason) orig_bad
+      ; bad = List.map ~f:(fun (impl, reason) -> impl, `Model_rejection reason) orig_bad
       ; notes
       ; diagnostics
       ; selected_impl
@@ -118,8 +118,7 @@ struct
     let filter_impls_ref ~note:n t get_problem =
       let old_good = List.rev t.good in
       t.good <- [];
-      old_good
-      |> List.iter (fun impl ->
+      List.iter old_good ~f:(fun impl ->
         match get_problem impl with
         | None -> t.good <- impl :: t.good
         | Some problem ->
@@ -141,8 +140,7 @@ struct
        Add removed items to [bad_impls], along with the cause. *)
     let apply_restrictions ~note t restrictions =
       let note = ref (Some note) in
-      restrictions
-      |> List.iter (fun r ->
+      List.iter restrictions ~f:(fun r ->
         filter_impls_ref ~note t (fun impl ->
           if Model.meets_restriction impl r then None else Some (`FailsRestriction r)))
     ;;
@@ -155,15 +153,14 @@ struct
       (* Completely remove non-matching impls.
          The user will only want to see the version they asked for. *)
       let new_bad =
-        t.bad
-        |> List.filter (fun (impl, _) ->
+        List.filter t.bad ~f:(fun (impl, _) ->
           if Model.meets_restriction impl r then true else false)
       in
       if new_bad <> [] || t.good <> [] then t.bad <- new_bad
     ;;
 
     let reject_all t reason =
-      t.bad <- List.map (fun impl -> impl, reason) t.good @ t.bad;
+      t.bad <- List.map ~f:(fun impl -> impl, reason) t.good @ t.bad;
       t.good <- []
     ;;
 
@@ -176,15 +173,14 @@ struct
     let reject_self_conflicts t =
       filter_impls t (fun impl ->
         let deps = Model.requires t.role impl in
-        deps
-        |> List.find_map (fun dep ->
+        List.find_map deps ~f:(fun dep ->
           let { Model.dep_role; _ } = Model.dep_info dep in
           if Model.Role.compare dep_role t.role <> 0
           then None
           else
             (* It depends on itself. *)
             Model.restrictions dep
-            |> List.find_map (fun r ->
+            |> List.find_map ~f:(fun r ->
               if Model.meets_restriction impl r
               then None
               else Some (`DepFailsRestriction (dep, r)))))
@@ -217,8 +213,10 @@ struct
     ;;
 
     let show_rejections ~verbose f rejected =
-      let by_version (a, _) (b, _) = Model.compare_version b a in
-      let rejected = List.sort by_version rejected in
+      let by_version (a, _) (b, _) =
+        Model.compare_version b a |> Stdune.Ordering.of_int
+      in
+      let rejected = List.sort ~compare:by_version rejected in
       let rec aux i = function
         | [] -> ()
         | _ when i = 5 && not verbose -> pf f "@,..."
@@ -307,10 +305,10 @@ struct
              then None
              else Some (`DepFailsRestriction (dep, r))
            in
-           List.find_map check_restriction (Model.restrictions dep))
+           List.find_map ~f:check_restriction (Model.restrictions dep))
     in
     let deps = Model.requires role impl in
-    List.find_map check_dep deps
+    List.find_map ~f:check_dep deps
   ;;
 
   (** A selected component has [dep] as a dependency. Use this to explain why some implementations
@@ -349,7 +347,7 @@ struct
     | Some our_impl ->
       (* For each dependency of our selected impl, explain why it rejected impls in the dependency's interface. *)
       let deps = Model.requires role our_impl in
-      List.iter (examine_dep role our_impl report) deps
+      List.iter ~f:(examine_dep role our_impl report) deps
     | None ->
       (* For each of our remaining unrejected impls, check whether a dependency prevented its selection. *)
       Component.filter_impls component (get_dependency_problem role report)
@@ -380,7 +378,7 @@ struct
           | None -> acc
           | Some impl ->
             Model.conflict_class impl
-            |> List.fold_left (fun acc x -> Classes.add x role acc) acc)
+            |> List.fold_left ~f:(fun acc x -> Classes.add x role acc) ~init:acc)
         report
         Classes.empty
     in
@@ -411,11 +409,11 @@ struct
         let+ rejects, feed_problems = Model.rejects role in
         Component.create ~role (impl_candidates, rejects, feed_problems) diagnostics impl
       in
-      RoleMap.to_seq impls
-      |> Monad.Seq.parallel_map (fun (k, v) ->
+      RoleMap.bindings impls
+      |> Fiber.parallel_map ~f:(fun (k, v) ->
         let+ v = get_selected k v in
         k, v)
-      >>| RoleMap.of_seq
+      |> Fiber.map ~f:(fun s -> RoleMap.of_seq (List.to_seq s))
     in
     examine_extra_restrictions report;
     check_conflict_classes report;

src/0install-solver/dune

@@ -1,2 +1,3 @@
 (library
- (name zeroinstall_solver))
+ (name zeroinstall_solver)
+ (libraries fiber stdune))

src/0install-solver/s.ml

@@ -1,30 +1,6 @@
 (* Copyright (C) 2013, Thomas Leonard
    See the README file for details, or visit http://0install.net. *)
 
-(** Some useful abstract module types. *)
-
-module type Monad = sig
-  type 'a t
-
-  val return : 'a -> 'a t
-
-  module List : sig
-    val iter : ('a -> unit t) -> 'a list -> unit t
-    val iter2 : ('a -> 'b -> unit t) -> 'a list -> 'b list -> unit t
-  end
-
-  module Seq : sig
-    val parallel_map : ('a -> 'b t) -> 'a Seq.t -> 'b Seq.t t
-  end
-
-  module O : sig
-    val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t
-    val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
-    val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
-    val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
-  end
-end
-
 module type CORE_MODEL = sig
   (** To use the solver with a particular packaging system (e.g. 0install), you need
       to provide an implementation of this module to map your system's concepts on to
@@ -73,7 +49,6 @@ end
 
 module type SOLVER_INPUT = sig
   (** This defines what the solver sees (hiding the raw XML, etc). *)
-  type 'a monad
 
   include CORE_MODEL
 
@@ -89,7 +64,7 @@ module type SOLVER_INPUT = sig
   val pp_impl : Format.formatter -> impl -> unit
 
   (** The list of candidates to fill a role. *)
-  val implementations : Role.t -> role_information monad
+  val implementations : Role.t -> role_information Fiber.t
 
   (** Restrictions on how the role is filled *)
   val restrictions : dependency -> restriction list
@@ -109,7 +84,7 @@ module type SOLVER_INPUT = sig
 
   (** Get the candidates which were rejected for a role (and not passed to the solver),
       as well as any general notes and warnings not tied to a particular impl. *)
-  val rejects : Role.t -> ((impl * rejection) list * string list) monad
+  val rejects : Role.t -> ((impl * rejection) list * string list) Fiber.t
 
   (** Used to sort the results. *)
   val compare_version : impl -> impl -> int