Move OpamBuiltinZ3.Syntax to a new OpamCudfCriteria module and use it…

… in OpamBuiltin0install

src/solver/opamBuiltin0install.ml

@@ -104,23 +104,24 @@ let parse_criteria criteria =
       prefer_installed = false;
     }
   in
-  let rec parse default = function
-    | [] | [""] -> default
-    | "+removed"::xs ->
+  let rec parse default (criteria : OpamCudfCriteria.criterion list) =
+    match criteria with
+    | [] -> default
+    | (Plus, Removed, None)::xs ->
       parse {default with drop_installed_packages = true} xs
-    | "+count[version-lag"::"solution]"::xs ->
+    | (Plus, Solution, Some "version-lag")::xs ->
       parse {default with prefer_oldest = true} xs
-    | "-count[avoid-version"::"solution]"::xs ->
+    | (Minus, Solution, Some "avoid-version")::xs ->
       parse {default with handle_avoid_version = true} xs
-    | "-changed"::xs ->
+    | (Minus, Changed, None)::xs ->
       parse {default with prefer_installed = true} xs
-    | criteria::xs ->
+    | criterion::xs ->
       OpamConsole.warning
         "Criteria '%s' is not supported by the 0install solver"
-        criteria;
+        (OpamCudfCriteria.criterion_to_string criterion);
       parse default xs
   in
-  parse default (String.split_on_char ',' criteria)
+  parse default (OpamCudfCriteria.of_string criteria)
 
 let call ~criteria ?timeout:_ (preamble, universe, request) =
   let {

src/solver/opamBuiltinZ3.real.ml

@@ -273,17 +273,10 @@ let sum ctx (_, universe, _) filter value =
     []
     universe
 
-type filter = Installed | Changed | Removed | New |
-              Upgraded | Downgraded | Requested
-type property = string option
-type sign = Plus | Minus
-
-type criterion = sign * filter * property
-
 let def_criterion ctx opt (preamble, universe, request as cudf)
-    (sign, filter, property : criterion) =
+    (sign, filter, property : OpamCudfCriteria.criterion) =
   let filter_f = match filter with
-    | Installed -> fun p -> psym ctx p
+    | Installed | Solution -> fun p -> psym ctx p
     | Changed ->
       fun p ->
         if p.Cudf.installed then
@@ -367,82 +360,6 @@ let def_criterion ctx opt (preamble, universe, request as cudf)
 let def_criteria ctx opt cudf crits =
   List.iter (def_criterion ctx opt cudf) crits
 
-module Syntax = struct
-
-  let criterion_of_string (s,params) =
-    let sign = match s.[0] with
-      | '+' -> Plus
-      | '-' -> Minus
-      | c -> failwith (Printf.sprintf "criteria_of_string sign=%c" c)
-      | exception Invalid_argument _ ->
-        failwith "criteria_of_string sign=EOF"
-    in
-    let s = String.sub s 1 (String.length s - 1) in
-    let subset_of_string = function
-      | "new" -> New
-      | "removed" -> Removed
-      | "changed" -> Changed
-      | "up" -> Upgraded
-      | "down" -> Downgraded
-      | "installed" | "solution" -> Installed
-      | "request" -> Requested
-      | s -> failwith ("criteria_of_string subset="^s)
-    in
-    match s, params with
-    | "count", [field; subset] ->
-      sign, subset_of_string subset, Some field
-    | s, [] -> sign, subset_of_string s, None
-    | s, _ -> failwith ("criteria_of_string s="^s)
-(*
-  let string_of_criterion (sign, filter, property: criterion) =
-    Printf.sprintf "%c%s%s"
-      (match sign with Plus -> '+' | Minus -> '-')
-      (match filter with
-       | Installed -> "installed"
-       | Changed -> "changed"
-       | Removed -> "removed"
-       | New -> "new"
-       | Upgraded -> "up"
-       | Downgraded -> "down"
-       | Requested -> "request")
-      (match property with None -> "" | Some p -> "["^p^"]")
-*)
-  let criteria_of_string s =
-    let start = ref 0 in
-    let crits = ref [] in
-    let params = ref None in
-    for i = 0 to String.length s - 1 do
-      match s.[i] with
-      | ',' ->
-        let sub = String.sub s !start (i - !start) in
-        start := i + 1;
-        if sub <> "" then
-          (match !params with
-           | None -> crits := (sub, []) :: !crits
-           | Some (name, ps) -> params := Some (name, sub :: ps))
-      | '[' ->
-        let sub = String.sub s !start (i - !start) in
-        start := i + 1;
-        if !params <> None then failwith "criteria_of_string";
-        params := Some (sub, [])
-      | ']' ->
-        let sub = String.sub s !start (i - !start) in
-        start := i + 1;
-        (match !params with
-         | None -> failwith "criteria_of_string"
-         | Some (name, ps) ->
-           params := None;
-           crits := (name, List.rev (sub::ps)) :: !crits)
-      | _ -> ()
-    done;
-    if !start < String.length s then
-      crits := (String.sub s !start (String.length s - !start), []) :: !crits;
-    if !params <> None then failwith "criteria_of_string";
-    let r = List.rev_map criterion_of_string !crits in
-    r
-
-end
-
 let extract_solution_packages universe opt =
   match Z3.Optimize.get_model opt with
   | Some model ->
@@ -485,7 +402,7 @@ let call ~criteria ?timeout (preamble, universe, _ as cudf) =
   log "Generating optimization criteria";
   let opt = Z3.Optimize.mk_opt ctx.z3 in
   let _criteria_def_handles =
-    def_criteria ctx opt cudf (Syntax.criteria_of_string criteria)
+    def_criteria ctx opt cudf (OpamCudfCriteria.of_string criteria)
   in
   log "Sending the problem to Z3";
   let params =

src/solver/opamCudfCriteria.ml

@@ -0,0 +1,99 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright 2017-2019 OCamlPro                                        *)
+(*                                                                        *)
+(*  All rights reserved. This file is distributed under the terms of the  *)
+(*  GNU Lesser General Public License version 2.1, with the special       *)
+(*  exception on linking described in the file LICENSE.                   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type filter =
+  | Installed
+  | Solution
+  | Changed
+  | Removed
+  | New
+  | Upgraded
+  | Downgraded
+  | Requested
+
+type property = string option
+
+type sign = Plus | Minus
+
+type criterion = sign * filter * property
+
+let criterion_of_string (s,params) =
+  let sign = match s.[0] with
+    | '+' -> Plus
+    | '-' -> Minus
+    | c -> failwith (Printf.sprintf "criteria_of_string sign=%c" c)
+    | exception Invalid_argument _ ->
+      failwith "criteria_of_string sign=EOF"
+  in
+  let s = String.sub s 1 (String.length s - 1) in
+  let subset_of_string = function
+    | "new" -> New
+    | "removed" -> Removed
+    | "changed" -> Changed
+    | "up" -> Upgraded
+    | "down" -> Downgraded
+    | "installed" -> Installed
+    | "solution" -> Solution
+    | "request" -> Requested
+    | s -> failwith ("criteria_of_string subset="^s)
+  in
+  match s, params with
+  | "count", [field; subset] ->
+    sign, subset_of_string subset, Some field
+  | s, [] -> sign, subset_of_string s, None
+  | s, _ -> failwith ("criteria_of_string s="^s)
+
+let criterion_to_string (sign, filter, property: criterion) =
+  Printf.sprintf "%c%s%s"
+    (match sign with Plus -> '+' | Minus -> '-')
+    (match filter with
+     | Installed -> "installed"
+     | Solution -> "solution"
+     | Changed -> "changed"
+     | Removed -> "removed"
+     | New -> "new"
+     | Upgraded -> "up"
+     | Downgraded -> "down"
+     | Requested -> "request")
+    (match property with None -> "" | Some p -> "["^p^"]")
+
+let of_string s =
+  let start = ref 0 in
+  let crits = ref [] in
+  let params = ref None in
+  for i = 0 to String.length s - 1 do
+    match s.[i] with
+    | ',' ->
+      let sub = String.sub s !start (i - !start) in
+      start := i + 1;
+      if sub <> "" then
+        (match !params with
+         | None -> crits := (sub, []) :: !crits
+         | Some (name, ps) -> params := Some (name, sub :: ps))
+    | '[' ->
+      let sub = String.sub s !start (i - !start) in
+      start := i + 1;
+      if !params <> None then failwith "criteria_of_string";
+      params := Some (sub, [])
+    | ']' ->
+      let sub = String.sub s !start (i - !start) in
+      start := i + 1;
+      (match !params with
+       | None -> failwith "criteria_of_string"
+       | Some (name, ps) ->
+         params := None;
+         crits := (name, List.rev (sub::ps)) :: !crits)
+    | _ -> ()
+  done;
+  if !start < String.length s then
+    crits := (String.sub s !start (String.length s - !start), []) :: !crits;
+  if !params <> None then failwith "criteria_of_string";
+  let r = List.rev_map criterion_of_string !crits in
+  r

src/solver/opamCudfCriteria.mli

@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright 2017-2019 OCamlPro                                        *)
+(*                                                                        *)
+(*  All rights reserved. This file is distributed under the terms of the  *)
+(*  GNU Lesser General Public License version 2.1, with the special       *)
+(*  exception on linking described in the file LICENSE.                   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type filter =
+  | Installed
+  | Solution
+  | Changed
+  | Removed
+  | New
+  | Upgraded
+  | Downgraded
+  | Requested
+
+type property = string option
+
+type sign = Plus | Minus
+
+type criterion = sign * filter * property
+
+val criterion_to_string : criterion -> string
+
+(** [of_string s] Parses the string [s] as a CUDF optimization criteria.
+
+    @raise {!Stdlib.Failure} if the string is invalid *)
+val of_string : string -> criterion list