Introduce package type

- contains opam name, ocamlfind names, version constraints
- users provide lists of packages
- is combined into a single map (including merging of version numbers if possible)

Also provide, based on this, to print an opam file (well, the good parts - name
and dependencies)

app/functoria_app.ml

@@ -82,8 +82,7 @@ let keys (argv: argv impl) = impl @@ object
     method module_name = Key.module_name
     method !configure = Keys.configure
     method !clean = Keys.clean
-    method !libraries = Key.pure [ "functoria-runtime" ]
-    method !packages = Key.pure [ "functoria-runtime" ]
+    method !packages = Key.pure [package "functoria-runtime"]
     method !deps = [ abstract argv ]
     method !connect info modname = function
       | [ argv ] ->
@@ -98,6 +97,8 @@ let keys (argv: argv impl) = impl @@ object
 type info = Info
 let info = Type Info
 
+(* hannes is pretty sure the following pp needs adjustments, but unclear to me
+   what exactly to do here? i.e. who reads the formatted stuff in again? *)
 let pp_libraries fmt l =
   Fmt.pf fmt "[@ %a]"
     Fmt.(iter ~sep:(unit ";@ ") List.iter @@ fmt "%S") l
@@ -113,7 +114,7 @@ let pp_dump_info module_name fmt i =
     "%s.{@ name = %S;@ \
      @[<v 2>packages = %a@]@ ;@ @[<v 2>libraries = %a@]@ }"
     module_name (Info.name i)
-    pp_packages (Info.packages i)
+    pp_packages (Info.package_names i)
     pp_libraries (Info.libraries i)
 
 let app_info ?(type_modname="Functoria_info")  ?(gen_modname="Info_gen") () =
@@ -123,8 +124,7 @@ let app_info ?(type_modname="Functoria_info")  ?(gen_modname="Info_gen") () =
     method name = "info"
     val gen_file = String.Ascii.lowercase gen_modname  ^ ".ml"
     method module_name = gen_modname
-    method !libraries = Key.pure ["functoria-runtime"]
-    method !packages = Key.pure ["functoria-runtime"]
+    method !packages = Key.pure [package "functoria-runtime"]
     method !connect _ modname _ = Fmt.strf "return %s.info" modname
 
     method !clean i =
@@ -159,21 +159,15 @@ module Engine = struct
     | App     -> Key.Set.empty
 
   module M = struct
-    type t = String.Set.t Key.value
-    let union x y = Key.(pure String.Set.union $ x $ y)
-    let empty = Key.pure String.Set.empty
+    type t = package list Key.value
+    let union x y = Key.(pure List.append $ x $ y)
+    let empty = Key.pure []
   end
 
   let packages =
     let open Graph in
     Graph.collect (module M) @@ function
-    | Impl c     -> Key.map String.Set.of_list c#packages
-    | If _ | App -> M.empty
-
-  let libraries =
-    let open Graph in
-    Graph.collect (module M) @@ function
-    | Impl c     -> Key.map String.Set.of_list c#libraries
+    | Impl c     -> c#packages
     | If _ | App -> M.empty
 
   (* Return a unique variable name holding the state of the given
@@ -316,8 +310,7 @@ module Config = struct
   type t = {
     name     : string;
     root     : string;
-    libraries: String.Set.t Key.value;
-    packages: String.Set.t Key.value;
+    packages: package list Key.value;
     keys    : Key.Set.t;
     init    : job impl list;
     jobs    : Graph.t;
@@ -335,29 +328,25 @@ module Config = struct
     in
     Key.Set.fold f all_keys skeys
 
-  let make ?(keys=[]) ?(libraries=[]) ?(packages=[]) ?(init=[]) name root
+  let make ?(keys=[]) ?(packages=[]) ?(init=[]) name root
       main_dev =
     let jobs = Graph.create main_dev in
-    let libraries = Key.pure @@ String.Set.of_list libraries in
-    let packages = Key.pure @@ String.Set.of_list packages in
+    let packages = Key.pure @@ packages in
     let keys = Key.Set.(union (of_list keys) (get_if_context jobs)) in
-    { libraries; packages; keys; name; root; init; jobs }
+    { packages; keys; name; root; init; jobs }
 
   let eval ~partial context
-      { name = n; root; packages; libraries; keys; jobs; init }
+      { name = n; root; packages; keys; jobs; init }
     =
     let e = Graph.eval ~partial ~context jobs in
-    let pkgs = Key.(pure String.Set.union $ packages $ Engine.packages e) in
-    let libs = Key.(pure String.Set.union $ libraries $ Engine.libraries e) in
+    let packages = Key.(pure List.append $ packages $ Engine.packages e) in
     let keys = Key.Set.elements (Key.Set.union keys @@ Engine.keys e) in
-    Key.(pure (fun libraries packages _ context ->
+    Key.(pure (fun packages _ context ->
         ((init, e),
          Info.create
-           ~libraries:(String.Set.elements libraries)
-           ~packages:(String.Set.elements packages)
+           ~packages
            ~keys ~context ~name:n ~root))
-         $ libs
-         $ pkgs
+         $ packages
          $ of_deps (Set.of_list keys))
 
   (* Extract all the keys directly. Useful to pre-resolve the keys
@@ -402,11 +391,11 @@ module Make (P: S) = struct
 
   let get_root () = Filename.dirname @@ get_config_file ()
 
-  let register ?(packages=[]) ?(libraries=[]) ?keys ?(init=[]) name jobs =
+  let register ?(packages=[]) ?keys ?(init=[]) name jobs =
     let keys = match keys with None -> [] | Some x -> x in
     let root = get_root () in
     let main_dev = P.create (init @ jobs) in
-    let c = Config.make ~keys ~libraries ~packages ~init name root main_dev in
+    let c = Config.make ~keys ~packages ~init name root main_dev in
     configuration := Some c
 
   let registered () =
@@ -433,6 +422,7 @@ module Make (P: S) = struct
 
   let configure i jobs =
     Log.info "%a %s" Log.blue "Using configuration:"  (get_config_file ());
+    Log.info "opam: %a" (Info.opam ?name:None) i ;
     Cmd.in_dir (Info.root i) (fun () -> configure_main i jobs)
 
   let clean i (_init, job) =

app/functoria_app.mli

@@ -89,8 +89,7 @@ module Make (P: S): sig
   open Functoria
 
   val register:
-    ?packages:string list ->
-    ?libraries:string list ->
+    ?packages:package list ->
     ?keys:key list ->
     ?init:job impl list ->
     string -> job impl list -> unit

app/functoria_graph.ml

@@ -47,8 +47,7 @@ type subconf = <
   name: string;
   module_name: string;
   keys: Key.t list;
-  packages: string list Key.value;
-  libraries: string list Key.value;
+  packages: package list Key.value;
   connect: Info.t -> string -> string list -> string;
   configure: Info.t -> (unit, string) Rresult.result;
   clean: Info.t -> (unit, string) Rresult.result;

app/functoria_graph.mli

@@ -22,8 +22,7 @@ type subconf = <
   name       : string;
   module_name: string;
   keys       : key list;
-  packages   : string list value;
-  libraries  : string list value;
+  packages   : package list value ;
   connect    : Info.t -> string -> string list -> string;
   configure  : Info.t -> (unit, string) Rresult.result;
   clean      : Info.t -> (unit, string) Rresult.result;

lib/functoria.ml

@@ -21,39 +21,139 @@ open Functoria_misc
 
 module Key = Functoria_key
 
-module Info = struct
+type package = {
+  opam : string ;
+  ocamlfind : String.Set.t ;
+  min : string option ;
+  max : string option
+}
+
+module Package = struct
+  (* we could have copied code from opam, but that's LGPL *)
+  let version_of_string s =
+    let r = List.fold_left (fun acc v ->
+        match Astring.String.to_int v with
+        | Some n -> n :: acc
+        | None -> invalid_arg "cannot parse version number")
+        []
+        (Astring.String.cuts ~sep:"." s)
+    in
+    List.rev r
+
+  let compare_version v1 v2 =
+    let rec cmp a b =
+      match a, b with
+      | x::xs, y::ys when x = y -> cmp xs ys
+      | x::_, y::_ -> compare x y
+      | [], y::ys when y = 0 -> cmp [] ys
+      | [], y::_ -> compare 0 y
+      | x::xs, [] when x = 0 -> cmp xs []
+      | x::_, [] -> compare x 0
+      | [], [] -> 0
+    in
+    let v1 = version_of_string v1
+    and v2 = version_of_string v2
+    in
+    cmp v1 v2
+
+  let m_option f a b = match a, b with
+    | None, None -> None
+    | Some a, None -> Some a
+    | None, Some b -> Some b
+    | Some a, Some b -> Some (f a b)
+
+  let merge opam a b =
+    let ocamlfind = String.Set.union a.ocamlfind b.ocamlfind
+    and min =
+      m_option
+        (fun a b -> match compare_version a b with 0 -> a | 1 -> a | _ -> b)
+        a.min b.min
+    and max =
+      m_option
+        (fun a b -> match compare_version a b with 0 -> a | 1 -> b | _ -> a)
+        a.max b.max
+    in
+    match min, max with
+    | Some a, Some b when compare_version a b = 1 -> invalid_arg "version constraint min > max"
+    | _ -> Some { opam ; ocamlfind ; min ; max }
+
+  let package ?sub ?ocamlfind ?min ?max opam =
+    let ocamlfind = match sub, ocamlfind with
+      | None, None -> String.Set.singleton opam
+      | Some a, None -> String.Set.of_list [ opam ; opam ^ "." ^ a ]
+      | None, Some a -> String.Set.of_list a
+      | Some _, Some _ -> invalid_arg "only ~sub or ~ocamlfind may be specified"
+    in
+    match min, max with
+    | Some min, Some max when compare_version min max = 1 -> invalid_arg "min must be >= max"
+    | _ -> { opam ; ocamlfind ; min ; max }
+end
+
+let package = Package.package
 
+module Info = struct
   type t = {
     name: string;
     root: string;
     keys: Key.Set.t;
     context: Key.context;
-    libraries: String.Set.t;
-    packages: String.Set.t;
+    packages: package String.Map.t;
   }
 
   let name t = t.name
   let root t = t.root
-  let libraries t = String.Set.elements t.libraries
-  let packages t = String.Set.elements t.packages
+  let libraries t =
+    String.Set.elements
+      (List.fold_left String.Set.union String.Set.empty
+         (List.map (fun x -> x.ocamlfind) (List.map snd (String.Map.bindings t.packages))))
+  let package_names t = List.map fst (String.Map.bindings t.packages)
+  let packages t = List.map snd (String.Map.bindings t.packages)
   let keys t = Key.Set.elements t.keys
   let context t = t.context
 
-  let create ?(packages=[]) ?(libraries=[]) ?(keys=[]) ~context ~name ~root =
-    let libraries = String.Set.of_list libraries in
-    let packages = String.Set.of_list packages in
+  let create ~packages ~keys ~context ~name ~root =
     let keys = Key.Set.of_list keys in
-    { name; root; keys; libraries; packages; context }
-
-  let pp verbose ppf { name ; root ; keys ; context ; libraries ; packages } =
+    let packages = List.fold_left (fun m p ->
+        let n = p.opam in
+        match String.Map.find p.opam m with
+        | None -> String.Map.add n p m
+        | Some p' -> match Package.merge p.opam p p' with
+          | Some p -> String.Map.add n p m
+          | None -> invalid_arg "bad constraints")
+        String.Map.empty packages
+    in
+    { name; root; keys; packages; context }
+
+  let pp_constraint min max = match min, max with
+    | None, None -> ""
+    | Some a, None -> Printf.sprintf "{>=\"%s\"}" a
+    | None, Some b -> Printf.sprintf "{<\"%s\"}" b
+    | Some a, Some b -> Printf.sprintf "{>=\"%s\" & <\"%s\"}" a b
+
+  let pp_package t ppf p =
+    Fmt.pf ppf "%s%s%s@ %s" t p.opam t (pp_constraint p.min p.max)
+
+  let pp_packages tick ?sep ppf t =
+    let tick = if tick then "\"" else "" in
+    Fmt.pf ppf "%a" (Fmt.iter ?sep List.iter (pp_package tick)) (packages t)
+
+  let pp verbose ppf ({ name ; root ; keys ; context ; _ } as t) =
     let show name = Fmt.pf ppf "@[<2>%a@ %a@]@," Log.blue name in
-    let set = Fmt.iter ~sep:(Fmt.unit ",@ ") String.Set.iter Fmt.string in
+    let list = Fmt.iter ~sep:(Fmt.unit ",@ ") List.iter Fmt.string in
     show "Name      " Fmt.string name;
     show "Root      " Fmt.string root;
     show "Keys      " (Key.pps context) keys;
-    if verbose then show "Libraries " set libraries;
-    if verbose then show "Packages  " set packages
-
+    if verbose then show "Libraries " list (libraries t);
+    if verbose then show "Packages  " (pp_packages false ~sep:(Fmt.unit ",@ ")) t
+
+  let opam ?name ppf t =
+    let name = match name with None -> t.name | Some x -> x in
+    Fmt.pf ppf "opam-version: \"1.2\"@." ;
+    Fmt.pf ppf "name: \"%s\"@." name ;
+    Fmt.pf ppf "depends: [ @[<2>%s@ %s@ %a@]@ ]@,"
+      "\"ocamlbuild\" {build}"
+      "\"ocamlfind\" {build}"
+      (pp_packages true ~sep:(Fmt.unit "@ ")) t
 end
 
 type _ typ =
@@ -83,8 +183,7 @@ module rec Typ: sig
     method name: string
     method module_name: string
     method keys: Key.t list
-    method packages: string list Key.value
-    method libraries: string list Key.value
+    method packages: package list Key.value
     method connect: Info.t -> string -> string list -> string
     method configure: Info.t -> (unit, string) R.t
     method clean: Info.t -> (unit, string) R.t
@@ -105,8 +204,7 @@ let rec match_impl kv ~default = function
   | (f, i) :: t -> If (Key.(pure ((=) f) $ kv), i, match_impl kv ~default t)
 
 class base_configurable = object
-  method libraries: string list Key.value = Key.pure []
-  method packages: string list Key.value = Key.pure []
+  method packages: package list Key.value = Key.pure []
   method keys: Key.t list = []
   method connect (_:Info.t) (_:string) l =
     Printf.sprintf "return (%s)" (String.concat ~sep:", " l)
@@ -119,7 +217,7 @@ type job = JOB
 let job = Type JOB
 
 class ['ty] foreign
-     ?(packages=[]) ?(libraries=[]) ?(keys=[]) ?(deps=[]) module_name ty
+     ?(packages=[]) ?(keys=[]) ?(deps=[]) module_name ty
   : ['ty] configurable
   =
   let name = Name.create module_name ~prefix:"f" in
@@ -128,7 +226,6 @@ class ['ty] foreign
     method name = name
     method module_name = module_name
     method keys = keys
-    method libraries = Key.pure libraries
     method packages = Key.pure packages
     method connect _ modname args =
       Fmt.strf
@@ -140,8 +237,8 @@ class ['ty] foreign
     method deps = deps
   end
 
-let foreign ?packages ?libraries ?keys ?deps module_name ty =
-  Impl (new foreign ?packages ?libraries ?keys ?deps module_name ty)
+let foreign ?packages ?keys ?deps module_name ty =
+  Impl (new foreign ?packages ?keys ?deps module_name ty)
 
 (* {Misc} *)