From 34b777ea10caefb3992ab77fb5bf72607cb94277 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Tue, 20 Sep 2022 10:43:55 +0200 Subject: [PATCH 01/30] Replace "dune external-lib-deps" command The new version of dune (from 3.0.0) removed "dune external-lib-deps" and this is a patch that work with a patch of dune from "https://github.com/moyodiallo/dune/tree/opam-dune-lint". There's already a PR(https://github.com/ocaml/dune/pull/6045) in dune about this patch, but not guarantee to be merged. The command may change also. --- dune_project.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/dune_project.ml b/dune_project.ml index 7f74c51..9fa06c8 100644 --- a/dune_project.ml +++ b/dune_project.ml @@ -118,9 +118,8 @@ module Deps = struct (* We use [tmp_dir] so that "--only-packages" doesn't invalidate the existing build. *) let dune_external_lib_deps ~tmp_dir ~pkg ~target = let tmp_dir = Fpath.to_string tmp_dir in - Bos.Cmd.(v "dune" % "external-lib-deps" % "--only-packages" % pkg + Bos.Cmd.(v "dune" % "build" % "--external-lib-deps=sexp" % "--only-packages" % pkg % "--build-dir" % tmp_dir - % "--sexp" % "--unstable-by-dir" % target) let has_dune_subproject = function From c545a644da8361c6f23d4264c365af4f582ca876 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Mon, 28 Nov 2022 17:51:27 +0100 Subject: [PATCH 02/30] Replace dune-lang by sexplib The library dune-lang is not exposed anymore. It started at 3.0.0 . --- dune | 2 +- dune-project | 1 - dune_project.ml | 77 +++++++++++++++++++-------------------------- opam-dune-lint.opam | 1 - types.ml | 4 +++ 5 files changed, 38 insertions(+), 47 deletions(-) diff --git a/dune b/dune index 36c90a1..79eeaa6 100644 --- a/dune +++ b/dune @@ -1,4 +1,4 @@ (executable (public_name opam-dune-lint) (name main) - (libraries astring fmt fmt.tty bos opam-format opam-state dune-private-libs.dune-lang cmdliner sexplib)) + (libraries astring fmt fmt.tty bos opam-format opam-state cmdliner stdune sexplib)) diff --git a/dune-project b/dune-project index 2a00bb8..bffdb71 100644 --- a/dune-project +++ b/dune-project @@ -16,7 +16,6 @@ (astring (>= 0.8.5)) (sexplib (>= v0.14.0)) (cmdliner (>= 1.1.0)) - (dune-private-libs (and (>= 2.8.0) (< 3.0))) (dune (< 3.0)) (ocaml (>= 4.10.0)) (bos (>= 0.2.0)) diff --git a/dune_project.ml b/dune_project.ml index 9fa06c8..08b09ad 100644 --- a/dune_project.ml +++ b/dune_project.ml @@ -1,76 +1,74 @@ open Types -type t = Dune_lang.t list +type t = Sexp.t list -let atom = Dune_lang.atom -let dune_and x y = Dune_lang.(List [atom "and"; x; y]) -let lower_bound v = Dune_lang.(List [atom ">="; atom (OpamPackage.Version.to_string v)]) +let atom s = Sexp.Atom s +let dune_and x y = Sexp.(List [atom "and"; x; y]) +let lower_bound v = Sexp.(List [atom ">="; atom (OpamPackage.Version.to_string v)]) let or_die = function | Ok x -> x | Error (`Msg m) -> failwith m let parse () = - Stdune.Path.Build.(set_build_dir (Kind.of_string (Sys.getcwd ()))); - let path = Stdune.Path.of_string "dune-project" in - Dune_lang.Parser.load path ~mode:Dune_lang.Parser.Mode.Many - |> List.map Dune_lang.Ast.remove_locs + Stdune.Path.Build.(set_build_dir (Stdune.Path.Outside_build_dir.of_string (Sys.getcwd ()))); + Sexp.input_sexps (open_in "dune-project") let generate_opam_enabled = List.exists (function - | Dune_lang.List [Dune_lang.Atom (A "generate_opam_files"); Atom (A v)] -> bool_of_string v + | Sexp.List [Sexp.Atom "generate_opam_files"; Atom v] -> bool_of_string v | _ -> false ) (* ("foo" args) -> ("foo" (f args)) *) let map_if name f = function - | Dune_lang.List (Atom (A head) as x :: xs) when head = name -> - Dune_lang.List (x :: f xs) + | Sexp.List (Atom head as x :: xs) when head = name -> + Sexp.List (x :: f xs) | x -> x (* (... ("foo" args) ...) -> (... ("foo" (f args)) ...) (...) -> (... ("foo" (f [] )) ) *) let rec update_or_create name f = function - | Dune_lang.List (Atom (A head) as x :: xs) :: rest when head = name -> - Dune_lang.List (x :: f xs) :: rest + | Sexp.List (Atom head as x :: xs) :: rest when head = name -> + Sexp.List (x :: f xs) :: rest | [] -> - Dune_lang.List (atom name :: f []) :: [] + Sexp.List (atom name :: f []) :: [] | head :: rest -> head :: update_or_create name f rest (* [package_name xs] returns the value of the (name foo) item in [xs]. *) let package_name = List.find_map (function - | Dune_lang.List [Atom (A "name"); Atom (A name)] -> Some name + | Sexp.List [Atom "name"; Atom name] -> Some name | _ -> None ) let rec simplify_and = function - | Dune_lang.List [Atom (A "and"); x] -> x - | Dune_lang.List xs -> List (List.map simplify_and xs) + | Sexp.List [Atom "and"; x] -> x + | Sexp.List xs -> List (List.map simplify_and xs) | x -> x (* (foo) -> foo (foo (and x)) -> (foo x) *) let simplify = function - | Dune_lang.List [Atom _ as x] -> x - | Dune_lang.List xs -> List (List.map simplify_and xs) + | Sexp.List [Atom _ as x] -> x + | Sexp.List xs -> List (List.map simplify_and xs) | x -> x let rec remove_with_test = function | [] -> [] - | Dune_lang.Atom (A ":with-test") :: xs -> xs + | Sexp.Atom ":with-test" :: xs -> xs | List x :: xs -> List (remove_with_test x) :: remove_with_test xs | x :: xs -> x :: remove_with_test xs let apply_change items = function | `Add_build_dep dep -> - let item = Dune_lang.(List [atom (OpamPackage.name_to_string dep); + let item = Sexp.(List [atom (OpamPackage.name_to_string dep); lower_bound (OpamPackage.version dep)]) in item :: items | `Add_test_dep dep -> - let item = Dune_lang.(List [atom (OpamPackage.name_to_string dep); + let item = Sexp.(List [atom (OpamPackage.name_to_string dep); dune_and (lower_bound (OpamPackage.version dep)) (atom ":with-test") @@ -83,10 +81,10 @@ let apply_change items = function | `Add_with_test name -> let name = OpamPackage.Name.to_string name in items |> List.map (function - | Dune_lang.List [Atom (A name2) as a; expr] when name = name2 -> - Dune_lang.List [a; dune_and (atom ":with-test") expr] - | Atom (A name2) as a when name = name2 -> - Dune_lang.List [a; atom ":with-test"] + | Sexp.List [Atom name2 as a; expr] when name = name2 -> + Sexp.List [a; dune_and (atom ":with-test") expr] + | Atom name2 as a when name = name2 -> + Sexp.List [a; atom ":with-test"] | x -> x ) @@ -108,7 +106,7 @@ let write_project_file t = let path = "dune-project" in let ch = open_out path in let f = Format.formatter_of_out_channel ch in - Fmt.pf f "@[%a@]@." (Fmt.list ~sep:Fmt.cut (Fmt.using Dune_lang.pp Stdune.Pp.to_fmt)) t; + Fmt.pf f "@[%a@]@." (Fmt.list ~sep:Fmt.cut Sexp.pp) t; close_out ch; Fmt.pr "Wrote %S@." path @@ -194,28 +192,19 @@ module Deps = struct | sexp -> parse ~pkg (Sexplib.Sexp.of_string sexp) end -module Csexp = struct - type t = - | Atom of string - | List of t list -end - -module Sexp = Dune_csexp.Csexp.Make(Csexp) module Library_map = Map.Make(String) -open Csexp - type index = [`Internal | `External] Library_map.t let rec field name = function | [] -> Fmt.failwith "Field %S is missing!" name - | List [Atom n; v] :: _ when n = name -> v + | Sexp.List [Atom n; v] :: _ when n = name -> v | _ :: xs -> field name xs let field_atom name xs = match field name xs with | Atom a -> a - | List _ -> Fmt.failwith "Expected %S to be an atom!" name + | Sexp.List _ -> Fmt.failwith "Expected %S to be an atom!" name let field_bool name xs = bool_of_string (field_atom name xs) @@ -226,20 +215,20 @@ let index_lib acc fields = Library_map.add name local acc let index_item acc = function - | List [Atom "library"; List fields] -> index_lib acc fields + | Sexp.List [Atom "library"; List fields] -> index_lib acc fields | _ -> acc let make_index = function - | List libs -> List.fold_left index_item Library_map.empty libs + | Sexp.List libs -> List.fold_left index_item Library_map.empty libs | Atom _ -> failwith "Bad 'dune describe' output!" let describe () = Bos.OS.Cmd.run_out (Bos.Cmd.(v "dune" % "describe" % "--format=csexp" % "--lang=0.1")) |> Bos.OS.Cmd.to_string |> or_die - |> Sexp.parse_string - |> function - | Error (_, e) -> Fmt.failwith "Error parsing 'dune describe' output: %s" e - | Ok x -> make_index x + |> (fun s -> + try Sexp.of_string s with + | Sexp.Parse_error _ as e -> Fmt.pr "Error parsing 'dune describe' output:\n"; raise e) + |> make_index let lookup = Library_map.find_opt diff --git a/opam-dune-lint.opam b/opam-dune-lint.opam index 2859c7b..eef9634 100644 --- a/opam-dune-lint.opam +++ b/opam-dune-lint.opam @@ -12,7 +12,6 @@ depends: [ "astring" {>= "0.8.5"} "sexplib" {>= "v0.14.0"} "cmdliner" {>= "1.1.0"} - "dune-private-libs" {>= "2.8.0" & < "3.0"} "dune" {>= "2.7" & < "3.0"} "ocaml" {>= "4.10.0"} "bos" {>= "0.2.0"} diff --git a/types.ml b/types.ml index 974acce..6417a8b 100644 --- a/types.ml +++ b/types.ml @@ -4,6 +4,10 @@ module Paths = Map.Make(String) module Libraries = Map.Make(String) +module Sexp = Sexplib.Sexp + +module Stdune = Stdune + module Change = struct type t = [ `Remove_with_test of OpamPackage.Name.t From ddb6b533ebefd0de09524a152dc0b6511e1b853d Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Thu, 12 Jan 2023 16:27:20 +0100 Subject: [PATCH 03/30] Replacing 'dune external-lib-deps' In this stage, opam-dune-lint can only works with this dune PR "https://github.com/ocaml/dune/pull/6839". Not ready yet, works is needed at this stage. --- dune_items.ml | 107 +++++++++++++++++++++++++++++++++++++++++++++++ dune_project.ml | 91 ++++++++++++++++------------------------ dune_project.mli | 2 +- main.ml | 4 +- types.ml | 2 + 5 files changed, 149 insertions(+), 57 deletions(-) create mode 100644 dune_items.ml diff --git a/dune_items.ml b/dune_items.ml new file mode 100644 index 0000000..4704c41 --- /dev/null +++ b/dune_items.ml @@ -0,0 +1,107 @@ +open Types + +module Kind = struct + type t = Required | Optional + + let merge x y = + match (x, y) with + | Required,_ | _, Required -> Required + | _ -> Optional +end + +module Item = struct + type t = + { + names: string list; + package: string option; + external_deps : (string * Kind.t) list; + source_dir: string + } + + let dump = + { + names = []; + package = None; + external_deps = []; + source_dir = "" + } +end + +open Sexp + +type t = Lib of Item.t | Exes of Item.t | Tests of Item.t + +let get_item = function + | Lib item | Exes item | Tests item -> item + + +let string_of_atom = + function + | Atom s -> s + | s -> Fmt.failwith "%s is an atom" (Sexp.to_string s) + +let string_of_external_dep_sexp = function + | List [Atom name; Atom kind] -> + if String.equal "required" kind then + (name, Kind.Required) + else + (name, Kind.Optional) + | s -> Fmt.failwith "%s is not 'List[Atom _; Atom _]'" (Sexp.to_string s) + +let decode_item = + List.fold_left (fun (item:Item.t) sexps -> + match sexps with + | Sexp.List [Atom "name"; Atom n] -> {item with names = [n]} + | Sexp.List [Atom "package"; Atom p] -> {item with package = Some p} + | Sexp.List [Atom "source_dir"; Atom s] -> {item with source_dir = s} + | Sexp.List [Atom "names"; List sexps] -> + {item with names = List.map string_of_atom sexps} + | Sexp.List [Atom "external_deps" ; List sexps] -> + {item with external_deps = List.map string_of_external_dep_sexp sexps} + | s -> Fmt.failwith "%s is not a good format decoding an item" (Sexp.to_string s) + ) Item.dump + +let extract_items : Sexp.t list -> t list = + List.map (function + | Sexp.List [Atom "library"; List sexps] -> Lib (decode_item sexps) + | Sexp.List [Atom "tests"; List sexps] -> Tests (decode_item sexps) + | Sexp.List [Atom "executables"; List sexps] -> Exes (decode_item sexps) + | s -> Fmt.failwith "%s is not a good format decoding items" (Sexp.to_string s)) + +let items_of_sexp : Sexp.t -> t list = function + | Sexp.List [Atom _ctx; List sexps] -> extract_items sexps + | _ -> Fmt.failwith "Invalid format" + +let deps_merge deps_x deps_y = + Libraries.merge + (fun _ x y -> + match (x,y) with + | Some k1, Some k2 -> Some (Kind.merge k1 k2) + | _ -> None) deps_x deps_y + +let items_deps_by_dir = + List.fold_left + (fun dir_map (item:Item.t) -> + match Dir_map.find_opt item.source_dir dir_map with + | Some deps -> + Dir_map.add + item.source_dir + (deps_merge deps (Libraries.of_seq (List.to_seq item.external_deps))) + dir_map + | None -> + Dir_map.add + item.source_dir + (Libraries.of_seq (List.to_seq item.external_deps)) + dir_map) + Dir_map.empty + +let items_by_package = + List.fold_left + (fun dir_map (item:Item.t) -> + match item.package with + | Some package -> + (match Dir_map.find_opt package dir_map with + | Some items -> Dir_map.add package (item::items) dir_map + | None -> Dir_map.add item.source_dir [item] dir_map) + | None -> dir_map) + Dir_map.empty diff --git a/dune_project.ml b/dune_project.ml index 08b09ad..385180b 100644 --- a/dune_project.ml +++ b/dune_project.ml @@ -113,12 +113,11 @@ let write_project_file t = module Deps = struct type t = Dir_set.t Libraries.t - (* We use [tmp_dir] so that "--only-packages" doesn't invalidate the existing build. *) - let dune_external_lib_deps ~tmp_dir ~pkg ~target = - let tmp_dir = Fpath.to_string tmp_dir in - Bos.Cmd.(v "dune" % "build" % "--external-lib-deps=sexp" % "--only-packages" % pkg - % "--build-dir" % tmp_dir - % target) + let or_die = function + | Ok x -> x + | Error (`Msg m) -> failwith m + + let dune_external_lib_deps = Bos.Cmd.(v "dune" % "describe" % "external-lib-deps") let has_dune_subproject = function | "." | "" -> false @@ -140,56 +139,40 @@ module Deps = struct Hashtbl.add dir_types path r; r - let merge_dep ~pkg ~path acc = function - | Sexplib.Sexp.List (Atom lib :: _) -> - if Astring.String.take ~sat:((<>) '.') lib <> pkg then - let dirs = Libraries.find_opt lib acc |> Option.value ~default:Dir_set.empty in - Libraries.add lib (Dir_set.add path dirs) acc - else - acc - | x -> Fmt.failwith "Bad output from 'dune external-lib-deps': %a" Sexplib.Sexp.pp_hum x - - (* Dune sometimes gives made-up paths. Search upwards until we find a real directory. *) - let rec find_real_dir = function - | ".ppx" -> "(ppx)" - | path -> - match Unix.stat path with - | _ -> path - | exception Unix.Unix_error(Unix.ENOENT, _, _) -> - let parent = Filename.dirname path in - if parent <> path then find_real_dir parent - else path - - let merge_dir ~pkg ~dir_types acc = function - | Sexplib.Sexp.List [Atom path; List deps] -> - let path = find_real_dir path in - if should_use_dir ~dir_types path then ( - (* Fmt.pr "Process %S@." path; *) - List.fold_left (merge_dep ~pkg ~path) acc deps - ) else ( - (* Fmt.pr "Skip %S@." path; *) - acc - ) - | x -> Fmt.failwith "Bad output from 'dune external-lib-deps': %a" Sexplib.Sexp.pp_hum x - - let parse ~pkg = function - | Sexplib.Sexp.List [Atom _ctx; List dirs] -> - let dir_types = Hashtbl.create 10 in - List.fold_left (merge_dir ~pkg ~dir_types) Libraries.empty dirs - | x -> Fmt.failwith "Bad output from 'dune external-lib-deps': %a" Sexplib.Sexp.pp_hum x - - (* Get the ocamlfind dependencies of [pkg]. *) - let get_external_lib_deps ~pkg ~target : t = - Bos.OS.Dir.with_tmp "opam-dune-lint-%s" (fun tmp_dir () -> - Bos.OS.Cmd.run_out (dune_external_lib_deps ~tmp_dir ~pkg ~target) - |> Bos.OS.Cmd.to_string - |> or_die - ) () + let get_dune_items dir_types ~sexp ~pkg ~target = + Dune_items.items_of_sexp sexp + |> List.filter (fun item -> + match (item,target) with + | Dune_items.Tests _, `Install -> false + | Dune_items.Tests _, `Runtest -> true + | _ , `Runtest -> false + | _, `Install -> true) + |> List.map Dune_items.get_item + |> List.filter (fun (item:Dune_items.Item.t) -> should_use_dir ~dir_types item.source_dir) + |> List.filter (fun (item:Dune_items.Item.t) -> Option.equal String.equal (Some pkg) item.package) + + let lib_deps sexp ~pkg ~target = + get_dune_items (Hashtbl.create 10) ~sexp ~pkg ~target + |> List.fold_left (fun acc (item:Dune_items.Item.t) -> + List.map (fun dep -> (fst dep, item.source_dir)) item.external_deps @ acc) [] + |> List.fold_left (fun acc (lib,path) -> + if Astring.String.take ~sat:((<>) '.') lib <> pkg then + let dirs = Libraries.find_opt lib acc |> Option.value ~default:Dir_set.empty in + Libraries.add lib (Dir_set.add path dirs) acc + else + acc) Libraries.empty + + let sexp = + Bos.OS.Cmd.run_out (dune_external_lib_deps) + |> Bos.OS.Cmd.to_string |> or_die |> String.trim - |> function - | "" -> Libraries.empty - | sexp -> parse ~pkg (Sexplib.Sexp.of_string sexp) + |> (fun s -> + try Sexp.of_string s with + | Sexp.Parse_error _ as e -> Fmt.pr "Error parsing 'dune describe external-lib-deps' output:\n"; raise e) + + let get_external_lib_deps ~pkg ~target : t = sexp |> lib_deps ~pkg ~target + end module Library_map = Map.Make(String) diff --git a/dune_project.mli b/dune_project.mli index 19a31fc..3c8f115 100644 --- a/dune_project.mli +++ b/dune_project.mli @@ -24,5 +24,5 @@ module Deps : sig type t = Dir_set.t Libraries.t (** The set of OCamlfind libraries needed, each with the directories needing it. *) - val get_external_lib_deps : pkg:string -> target:string -> t + val get_external_lib_deps : pkg:string -> target:[`Install | `Runtest] -> t end diff --git a/main.ml b/main.ml index 1d3070e..cee84c1 100644 --- a/main.ml +++ b/main.ml @@ -79,8 +79,8 @@ let display path (_opam, problems) = pp_problems problems let generate_report ~project ~index ~opam pkg = - let build = get_libraries ~pkg ~target:"@install" |> to_opam_set ~project ~index in - let test = get_libraries ~pkg ~target:"@runtest" |> to_opam_set ~project ~index in + let build = get_libraries ~pkg ~target:`Install |> to_opam_set ~project ~index in + let test = get_libraries ~pkg ~target:`Runtest |> to_opam_set ~project ~index in let opam_deps = OpamFormula.And (OpamFile.OPAM.depends opam, OpamFile.OPAM.depopts opam) |> Formula.classify in diff --git a/types.ml b/types.ml index 6417a8b..e091ac5 100644 --- a/types.ml +++ b/types.ml @@ -4,6 +4,8 @@ module Paths = Map.Make(String) module Libraries = Map.Make(String) +module Dir_map = Map.Make(String) + module Sexp = Sexplib.Sexp module Stdune = Stdune From 196c27e003a9bc99d391a6cbd83837da3ea51cea Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Thu, 9 Feb 2023 11:42:28 +0100 Subject: [PATCH 04/30] Remove 'dune describe' command The command 'dune describe external-lib-deps' is used to print out external-libs and does not print an internal lib. --- dune_project.ml | 45 --------------------------------------------- dune_project.mli | 8 -------- main.ml | 12 +++++------- 3 files changed, 5 insertions(+), 60 deletions(-) diff --git a/dune_project.ml b/dune_project.ml index 385180b..302c480 100644 --- a/dune_project.ml +++ b/dune_project.ml @@ -6,10 +6,6 @@ let atom s = Sexp.Atom s let dune_and x y = Sexp.(List [atom "and"; x; y]) let lower_bound v = Sexp.(List [atom ">="; atom (OpamPackage.Version.to_string v)]) -let or_die = function - | Ok x -> x - | Error (`Msg m) -> failwith m - let parse () = Stdune.Path.Build.(set_build_dir (Stdune.Path.Outside_build_dir.of_string (Sys.getcwd ()))); Sexp.input_sexps (open_in "dune-project") @@ -174,44 +170,3 @@ module Deps = struct let get_external_lib_deps ~pkg ~target : t = sexp |> lib_deps ~pkg ~target end - -module Library_map = Map.Make(String) - -type index = [`Internal | `External] Library_map.t - -let rec field name = function - | [] -> Fmt.failwith "Field %S is missing!" name - | Sexp.List [Atom n; v] :: _ when n = name -> v - | _ :: xs -> field name xs - -let field_atom name xs = - match field name xs with - | Atom a -> a - | Sexp.List _ -> Fmt.failwith "Expected %S to be an atom!" name - -let field_bool name xs = - bool_of_string (field_atom name xs) - -let index_lib acc fields = - let name = field_atom "name" fields in - let local = if field_bool "local" fields then `Internal else `External in - Library_map.add name local acc - -let index_item acc = function - | Sexp.List [Atom "library"; List fields] -> index_lib acc fields - | _ -> acc - -let make_index = function - | Sexp.List libs -> List.fold_left index_item Library_map.empty libs - | Atom _ -> failwith "Bad 'dune describe' output!" - -let describe () = - Bos.OS.Cmd.run_out (Bos.Cmd.(v "dune" % "describe" % "--format=csexp" % "--lang=0.1")) - |> Bos.OS.Cmd.to_string - |> or_die - |> (fun s -> - try Sexp.of_string s with - | Sexp.Parse_error _ as e -> Fmt.pr "Error parsing 'dune describe' output:\n"; raise e) - |> make_index - -let lookup = Library_map.find_opt diff --git a/dune_project.mli b/dune_project.mli index 3c8f115..4cf4fd1 100644 --- a/dune_project.mli +++ b/dune_project.mli @@ -12,14 +12,6 @@ val update : (_ * Change.t list) Paths.t -> t -> t val write_project_file : t -> unit -type index - -val describe : unit -> index -(** Create an index of the project's libraries, using "dune describe". *) - -val lookup : string -> index -> [`Internal | `External] option -(** [lookup lib index] returns information from "dune describe" about [lib]. *) - module Deps : sig type t = Dir_set.t Libraries.t (** The set of OCamlfind libraries needed, each with the directories needing it. *) diff --git a/main.ml b/main.ml index cee84c1..bea2ca7 100644 --- a/main.ml +++ b/main.ml @@ -42,8 +42,7 @@ let to_opam ~index lib = Some (OpamPackage.create (OpamPackage.Name.of_string lib) (OpamPackage.Version.of_string "0")) (* Convert a map of (ocamlfind-library -> hints) to a map of (opam-package -> hints). *) -let to_opam_set ~project ~index libs = - let libs = libs |> Libraries.filter (fun lib _ -> Dune_project.lookup lib project <> Some `Internal) in +let to_opam_set ~index libs = Libraries.fold (fun lib dirs acc -> match to_opam ~index lib with | Some pkg -> OpamPackage.Map.update pkg (Dir_set.union dirs) Dir_set.empty acc @@ -78,9 +77,9 @@ let display path (_opam, problems) = Fmt.(styled `Bold string) pkg pp_problems problems -let generate_report ~project ~index ~opam pkg = - let build = get_libraries ~pkg ~target:`Install |> to_opam_set ~project ~index in - let test = get_libraries ~pkg ~target:`Runtest |> to_opam_set ~project ~index in +let generate_report ~index ~opam pkg = + let build = get_libraries ~pkg ~target:`Install |> to_opam_set ~index in + let test = get_libraries ~pkg ~target:`Runtest |> to_opam_set ~index in let opam_deps = OpamFormula.And (OpamFile.OPAM.depends opam, OpamFile.OPAM.depopts opam) |> Formula.classify in @@ -144,9 +143,8 @@ let main force dir = if Paths.is_empty opam_files then failwith "No *.opam files found!"; let stale_files = Paths.merge check_identical old_opam_files opam_files in stale_files |> Paths.iter (fun path msg -> Fmt.pr "%s: %s after 'dune build @install'!@." path msg); - let project = Dune_project.describe () in opam_files |> Paths.mapi (fun path opam -> - (opam, generate_report ~project ~index ~opam (Filename.chop_suffix path ".opam")) + (opam, generate_report ~index ~opam (Filename.chop_suffix path ".opam")) ) |> fun report -> Paths.iter display report; From 0350774d229de47d89b3e460a6672135b12c3687 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Thu, 9 Feb 2023 11:55:02 +0100 Subject: [PATCH 05/30] Get the correct libs for target: @test. --- dune_project.ml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/dune_project.ml b/dune_project.ml index 302c480..9abbee0 100644 --- a/dune_project.ml +++ b/dune_project.ml @@ -145,7 +145,13 @@ module Deps = struct | _, `Install -> true) |> List.map Dune_items.get_item |> List.filter (fun (item:Dune_items.Item.t) -> should_use_dir ~dir_types item.source_dir) - |> List.filter (fun (item:Dune_items.Item.t) -> Option.equal String.equal (Some pkg) item.package) + |> List.filter (fun (item:Dune_items.Item.t) -> + if target = `Install then + Option.equal String.equal (Some pkg) item.package + else + Option.equal String.equal (Some pkg) item.package || Option.is_none item.package) + (* if an item has not package, we assume it's used for testing*) + let lib_deps sexp ~pkg ~target = get_dune_items (Hashtbl.create 10) ~sexp ~pkg ~target From 4244181ed4cd9a703aa454f63d0ad76bab9b3924 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Thu, 9 Feb 2023 14:43:16 +0100 Subject: [PATCH 06/30] Format before writing 'dune-project' file --- dune_project.ml | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/dune_project.ml b/dune_project.ml index 9abbee0..7db405e 100644 --- a/dune_project.ml +++ b/dune_project.ml @@ -2,6 +2,10 @@ open Types type t = Sexp.t list +let or_die = function + | Ok x -> x + | Error (`Msg m) -> failwith m + let atom s = Sexp.Atom s let dune_and x y = Sexp.(List [atom "and"; x; y]) let lower_bound v = Sexp.(List [atom ">="; atom (OpamPackage.Version.to_string v)]) @@ -98,21 +102,24 @@ let update (changes:(_ * Change.t list) Paths.t) (t:t) = in List.map (map_if "package" update_package) t +let dune_format dune = + Bos.OS.Cmd.(in_string dune |> run_io Bos.Cmd.(v "dune" % "format-dune-file") |> out_string) + |> Bos.OS.Cmd.success + |> or_die + let write_project_file t = let path = "dune-project" in let ch = open_out path in let f = Format.formatter_of_out_channel ch in Fmt.pf f "@[%a@]@." (Fmt.list ~sep:Fmt.cut Sexp.pp) t; + Fmt.str "%a" (Fmt.list ~sep:Fmt.cut Sexp.pp) t |> dune_format |> Fmt.pf f "%s"; + flush ch; close_out ch; Fmt.pr "Wrote %S@." path module Deps = struct type t = Dir_set.t Libraries.t - let or_die = function - | Ok x -> x - | Error (`Msg m) -> failwith m - let dune_external_lib_deps = Bos.Cmd.(v "dune" % "describe" % "external-lib-deps") let has_dune_subproject = function From c854b1d4e40ae0771fc8ae55441ef980741e77ab Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Thu, 9 Feb 2023 17:20:29 +0100 Subject: [PATCH 07/30] Fix test output format --- dune_items.ml | 6 +++--- dune_project.ml | 1 - tests/test_dune.t | 30 ++++++++++++++++++++++-------- tests/test_empty_dune.t | 18 ++++++++++++++---- tests/test_vendoring.t | 5 ++--- 5 files changed, 41 insertions(+), 19 deletions(-) diff --git a/dune_items.ml b/dune_items.ml index 4704c41..15dbb27 100644 --- a/dune_items.ml +++ b/dune_items.ml @@ -51,10 +51,10 @@ let string_of_external_dep_sexp = function let decode_item = List.fold_left (fun (item:Item.t) sexps -> match sexps with - | Sexp.List [Atom "name"; Atom n] -> {item with names = [n]} - | Sexp.List [Atom "package"; Atom p] -> {item with package = Some p} + | Sexp.List [Atom "package"; List [Atom p] ] -> {item with package = Some p} + | Sexp.List [Atom "package"; List [] ] -> {item with package = None} | Sexp.List [Atom "source_dir"; Atom s] -> {item with source_dir = s} - | Sexp.List [Atom "names"; List sexps] -> + | Sexp.List [Atom "names"; List sexps] -> {item with names = List.map string_of_atom sexps} | Sexp.List [Atom "external_deps" ; List sexps] -> {item with external_deps = List.map string_of_external_dep_sexp sexps} diff --git a/dune_project.ml b/dune_project.ml index 7db405e..5808828 100644 --- a/dune_project.ml +++ b/dune_project.ml @@ -111,7 +111,6 @@ let write_project_file t = let path = "dune-project" in let ch = open_out path in let f = Format.formatter_of_out_channel ch in - Fmt.pf f "@[%a@]@." (Fmt.list ~sep:Fmt.cut Sexp.pp) t; Fmt.str "%a" (Fmt.list ~sep:Fmt.cut Sexp.pp) t |> dune_format |> Fmt.pf f "%s"; flush ch; close_out ch; diff --git a/tests/test_dune.t b/tests/test_dune.t index 35227f0..ba4ac70 100644 --- a/tests/test_dune.t +++ b/tests/test_dune.t @@ -26,8 +26,6 @@ Create a simple dune project: $ touch main.ml test.ml $ dune build -Replace all version numbers with "1.0" to get predictable output. - $ export OPAM_DUNE_LINT_TESTS=y Check that the missing libraries are detected: @@ -53,15 +51,25 @@ Check that the missing libraries get added: $ cat dune-project | sed 's/= [^)}]*/= */g' (lang dune 2.7) + (generate_opam_files true) + (package (name test) (synopsis "Test package") (depends - (opam-state (and (>= *) :with-test)) - (bos (and (>= *) :with-test)) - (fmt (>= *)) - (ocamlfind (>= *)) + (opam-state + (and + (>= *) + :with-test)) + (bos + (and + (>= *) + :with-test)) + (fmt + (>= *)) + (ocamlfind + (>= *)) libfoo)) Check adding and removing of test markers: @@ -92,15 +100,21 @@ Check adding and removing of test markers: $ cat dune-project | sed 's/= [^)}]*/= */g' (lang dune 2.7) + (generate_opam_files true) + (package (name test) (synopsis "Test package") (depends (opam-state :with-test) - (bos (and :with-test (>= *))) + (bos + (and + :with-test + (>= *))) fmt - (ocamlfind (>= *)) + (ocamlfind + (>= *)) libfoo)) $ opam-dune-lint diff --git a/tests/test_empty_dune.t b/tests/test_empty_dune.t index b1575d7..727a0c9 100644 --- a/tests/test_empty_dune.t +++ b/tests/test_empty_dune.t @@ -40,12 +40,22 @@ Check that all the libraries get added: $ cat dune-project | sed 's/= [^)}]*/= */g' (lang dune 2.7) + (generate_opam_files true) + (package (name test) (synopsis "Test package") (depends - (opam-state (and (>= *) :with-test)) - (bos (and (>= *) :with-test)) - (ocamlfind (>= *)) - (fmt (>= *)))) + (opam-state + (and + (>= *) + :with-test)) + (bos + (and + (>= *) + :with-test)) + (ocamlfind + (>= *)) + (fmt + (>= *)))) diff --git a/tests/test_vendoring.t b/tests/test_vendoring.t index f903abc..6c1e144 100644 --- a/tests/test_vendoring.t +++ b/tests/test_vendoring.t @@ -54,9 +54,8 @@ Replace all version numbers with "1.0" to get predictable outut. Check configuration: $ dune external-lib-deps -p main @install - These are the external library dependencies in the default context: - - bos - - findlib + dune: This subcommand is no longer implemented. + [1] Check that the missing findlib for "lib" is detected, but not "vendored"'s dependency on "bos": From 50b2bca473937cacdbbc810dd3bd683205ccbdbc Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Thu, 9 Feb 2023 17:35:34 +0100 Subject: [PATCH 08/30] Clean some part of the code --- dune-project | 2 +- dune_items.ml | 13 +++++-------- opam-dune-lint.opam | 2 +- 3 files changed, 7 insertions(+), 10 deletions(-) diff --git a/dune-project b/dune-project index bffdb71..22fb27c 100644 --- a/dune-project +++ b/dune-project @@ -16,7 +16,7 @@ (astring (>= 0.8.5)) (sexplib (>= v0.14.0)) (cmdliner (>= 1.1.0)) - (dune (< 3.0)) + (dune (> 3.0)) (ocaml (>= 4.10.0)) (bos (>= 0.2.0)) (fmt (>= 0.8.9)) diff --git a/dune_items.ml b/dune_items.ml index 15dbb27..70d2175 100644 --- a/dune_items.ml +++ b/dune_items.ml @@ -6,7 +6,7 @@ module Kind = struct let merge x y = match (x, y) with | Required,_ | _, Required -> Required - | _ -> Optional + | Optional,Optional -> Optional end module Item = struct @@ -27,21 +27,18 @@ module Item = struct } end -open Sexp - type t = Lib of Item.t | Exes of Item.t | Tests of Item.t let get_item = function | Lib item | Exes item | Tests item -> item - let string_of_atom = function - | Atom s -> s + | Sexp.Atom s -> s | s -> Fmt.failwith "%s is an atom" (Sexp.to_string s) let string_of_external_dep_sexp = function - | List [Atom name; Atom kind] -> + | Sexp.List [Atom name; Atom kind] -> if String.equal "required" kind then (name, Kind.Required) else @@ -52,9 +49,9 @@ let decode_item = List.fold_left (fun (item:Item.t) sexps -> match sexps with | Sexp.List [Atom "package"; List [Atom p] ] -> {item with package = Some p} - | Sexp.List [Atom "package"; List [] ] -> {item with package = None} + | Sexp.List [Atom "package"; List [] ] -> {item with package = None} | Sexp.List [Atom "source_dir"; Atom s] -> {item with source_dir = s} - | Sexp.List [Atom "names"; List sexps] -> + | Sexp.List [Atom "names"; List sexps] -> {item with names = List.map string_of_atom sexps} | Sexp.List [Atom "external_deps" ; List sexps] -> {item with external_deps = List.map string_of_external_dep_sexp sexps} diff --git a/opam-dune-lint.opam b/opam-dune-lint.opam index eef9634..fdb2e1e 100644 --- a/opam-dune-lint.opam +++ b/opam-dune-lint.opam @@ -12,7 +12,7 @@ depends: [ "astring" {>= "0.8.5"} "sexplib" {>= "v0.14.0"} "cmdliner" {>= "1.1.0"} - "dune" {>= "2.7" & < "3.0"} + "dune" {>= "2.7" & > "3.0"} "ocaml" {>= "4.10.0"} "bos" {>= "0.2.0"} "fmt" {>= "0.8.9"} From e52b61254aa750a009b9421adba40bf8cc37b0f9 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Mon, 3 Apr 2023 20:05:58 +0200 Subject: [PATCH 09/30] Reorganize the code and improve the command * The command "dune describe package-entries" is used to know if a private executable is going to be installed. * Resolve all the internal dependencies. --- deps.ml | 143 +++++++++++++++++++ dune | 2 +- dune_items.ml | 232 +++++++++++++++++++------------ dune_logic.ml | 0 dune_project.ml | 75 +--------- tests/test_dune_stanza_install.t | 124 +++++++++++++++++ types.ml | 6 + 7 files changed, 424 insertions(+), 158 deletions(-) create mode 100644 deps.ml create mode 100644 dune_logic.ml create mode 100644 tests/test_dune_stanza_install.t diff --git a/deps.ml b/deps.ml new file mode 100644 index 0000000..7d9f00b --- /dev/null +++ b/deps.ml @@ -0,0 +1,143 @@ +open Types +open Dune_items + +type t = Dir_set.t Libraries.t + +let dune_describe_external_lib_deps = Bos.Cmd.(v "dune" % "describe" % "external-lib-deps") + +let dune_describe_entries = Bos.Cmd.(v "dune" % "describe" % "package-entries") + +let sexp cmd = + Bos.OS.Cmd.run_out (cmd) + |> Bos.OS.Cmd.to_string + |> or_die + |> String.trim + |> (fun s -> + try Sexp.of_string s with + | Sexp.Parse_error _ as e -> Fmt.pr "Error parsing 'dune describe external-lib-deps' output:\n"; raise e) + +let sexp_describe_external_lib_deps = sexp dune_describe_external_lib_deps + +let sexp_describe_entries = sexp dune_describe_entries + +let has_dune_subproject = function + | "." | "" -> false + | dir -> Sys.file_exists (Filename.concat dir "dune-project") + +let rec should_use_dir ~dir_types path = + match Hashtbl.find_opt dir_types path with + | Some x -> x + | None -> + let r = + match Astring.String.cut ~sep:"/" ~rev:true path with + | Some (parent, _) -> + if should_use_dir ~dir_types parent then ( + not (has_dune_subproject path) + ) else false + | None -> + not (has_dune_subproject path) + in + Hashtbl.add dir_types path r; + r +(* TODO When a private executable name is not directly found*) +let find_exe_name _pkg item = item + +(* After the items are filtered, we need to include their internal_deps in order to reach all the deps*) +let add_internal_deps d_items items_pkg = + let open Describe_external_lib in + let get_name = function + | Lib item -> String.cat item.name ".lib" + | Exe item -> String.cat item.name ".exe" + | Test item -> String.cat item.name ".test" + in + let items_lib = + d_items + |> List.filter is_lib_item + |> List.map get_item + |> List.map (fun (item:Describe_external_lib.item) -> + (String.cat item.name ".lib", Lib item)) + |> List.to_seq |> Hashtbl.of_seq + in + let rec add_internal acc = function + | [] -> Hashtbl.to_seq_values acc |> List.of_seq + | item::tl -> + if Hashtbl.mem acc (get_name item) then + add_internal acc tl + else begin + Hashtbl.add acc (get_name item) item; + (get_item item).internal_deps + |> List.filter (fun (_, k) -> Kind.is_required k) + |> List.filter_map (fun (name, _) -> + match Hashtbl.find_opt items_lib (String.cat name ".lib") with + | None -> None + | Some item_lib -> Some item_lib) + |> fun internals -> add_internal acc (tl @ internals) + end + in + add_internal (Hashtbl.create 10) items_pkg + +let items_entries describe_external_lib ~dir_types ~pkg = + let exe_name_items = + let open Describe_external_lib in + describe_external_lib + |> List.filter Describe_external_lib.is_exe_item + |> List.map Describe_external_lib.get_item + |> List.map (fun item -> item.name) + in + let open Describe_entries in + Describe_entries.entries_of_sexp sexp_describe_entries + |> Describe_entries.items_bin_of_entries pkg + |> Item_map.filter (fun _ item -> should_use_dir ~dir_types item.source_dir) + |> Item_map.partition (fun _ item -> List.mem item.bin_name exe_name_items) + |> (fun (found, not_found) -> + Item_map.union + (fun _ _ _ -> Fmt.failwith "Not supposed to to have same name") + found (Item_map.map (find_exe_name pkg) not_found)) + +let get_dune_items dir_types ~pkg ~target = + let describe_external = + Describe_external_lib.describe_extern_of_sexp sexp_describe_external_lib_deps + in + let items_entries = items_entries describe_external ~dir_types ~pkg in + describe_external + |> List.map (fun d_item -> + let item = Describe_external_lib.get_item d_item in + if Describe_external_lib.is_exe_item d_item + && Option.is_none item.package + then + match Item_map.find_opt item.name items_entries with + | None -> d_item + | Some _ -> Describe_external_lib.Exe { item with package = Some pkg } + else d_item) + |> List.filter (fun item -> + match (item,target) with + | Describe_external_lib.Test _, `Install -> false + | Describe_external_lib.Test _, `Runtest -> true + | _ , `Runtest -> false + | _, `Install -> true) + |> List.filter (fun d_item -> should_use_dir ~dir_types (Describe_external_lib.get_item d_item).source_dir) + |> (fun d_items -> + d_items + |> List.filter (fun d_item -> + let item = Describe_external_lib.get_item d_item in + (* if an item has not package, we assume it's used for testing*) + if target = `Install then + Option.equal String.equal (Some pkg) item.package + else + Option.equal String.equal (Some pkg) item.package || Option.is_none item.package) + |> add_internal_deps d_items) + + +let lib_deps ~pkg ~target = + get_dune_items (Hashtbl.create 10) ~pkg ~target + |> List.map Describe_external_lib.get_item + |> List.fold_left (fun acc (item:Describe_external_lib.item) -> + List.map (fun dep -> (fst dep, item.source_dir)) item.external_deps @ acc) [] + |> List.fold_left (fun acc (lib,path) -> + if Astring.String.take ~sat:((<>) '.') lib <> pkg then + let dirs = Libraries.find_opt lib acc |> Option.value ~default:Dir_set.empty in + Libraries.add lib (Dir_set.add path dirs) acc + else + acc) Libraries.empty + +let get_external_lib_deps ~pkg ~target : t = lib_deps ~pkg ~target diff --git a/dune b/dune index 79eeaa6..da88c50 100644 --- a/dune +++ b/dune @@ -1,4 +1,4 @@ (executable (public_name opam-dune-lint) (name main) - (libraries astring fmt fmt.tty bos opam-format opam-state cmdliner stdune sexplib)) + (libraries astring fmt fmt.tty bos opam-format opam-state cmdliner stdune sexplib str)) diff --git a/dune_items.ml b/dune_items.ml index 70d2175..2e975fa 100644 --- a/dune_items.ml +++ b/dune_items.ml @@ -1,104 +1,164 @@ open Types -module Kind = struct - type t = Required | Optional +module Describe_external_lib = struct + module Kind = struct + type t = Required | Optional - let merge x y = - match (x, y) with - | Required,_ | _, Required -> Required - | Optional,Optional -> Optional -end + let merge x y = + match (x, y) with + | Required,_ | _, Required -> Required + | Optional,Optional -> Optional + + let is_required = function + | Required -> true + | Optional -> false + end -module Item = struct - type t = + type item = { - names: string list; + name: string; package: string option; external_deps : (string * Kind.t) list; + internal_deps : (string * Kind.t) list; source_dir: string } - let dump = + let dump_item = { - names = []; + name = ""; package = None; external_deps = []; + internal_deps = []; source_dir = "" } -end -type t = Lib of Item.t | Exes of Item.t | Tests of Item.t - -let get_item = function - | Lib item | Exes item | Tests item -> item - -let string_of_atom = - function - | Sexp.Atom s -> s - | s -> Fmt.failwith "%s is an atom" (Sexp.to_string s) - -let string_of_external_dep_sexp = function - | Sexp.List [Atom name; Atom kind] -> - if String.equal "required" kind then - (name, Kind.Required) - else - (name, Kind.Optional) - | s -> Fmt.failwith "%s is not 'List[Atom _; Atom _]'" (Sexp.to_string s) - -let decode_item = - List.fold_left (fun (item:Item.t) sexps -> - match sexps with - | Sexp.List [Atom "package"; List [Atom p] ] -> {item with package = Some p} - | Sexp.List [Atom "package"; List [] ] -> {item with package = None} - | Sexp.List [Atom "source_dir"; Atom s] -> {item with source_dir = s} - | Sexp.List [Atom "names"; List sexps] -> - {item with names = List.map string_of_atom sexps} - | Sexp.List [Atom "external_deps" ; List sexps] -> - {item with external_deps = List.map string_of_external_dep_sexp sexps} - | s -> Fmt.failwith "%s is not a good format decoding an item" (Sexp.to_string s) - ) Item.dump - -let extract_items : Sexp.t list -> t list = - List.map (function - | Sexp.List [Atom "library"; List sexps] -> Lib (decode_item sexps) - | Sexp.List [Atom "tests"; List sexps] -> Tests (decode_item sexps) - | Sexp.List [Atom "executables"; List sexps] -> Exes (decode_item sexps) + type t = Lib of item | Exe of item | Test of item + + let get_item = function + | Lib item | Exe item | Test item -> item + + let is_exe_item = function + | Exe _ -> true | _ -> false + + let is_lib_item = function + | Lib _ -> true | _ -> false + + let string_of_atom = + function + | Sexp.Atom s -> s + | s -> Fmt.failwith "%s is an atom" (Sexp.to_string s) + + let string_of_list_dep_sexp = function + | Sexp.List [Atom name; Atom kind] -> + if String.equal "required" kind then + (name, Kind.Required) + else + (name, Kind.Optional) + | s -> Fmt.failwith "%s is not 'List[Atom _; Atom _]'" (Sexp.to_string s) + + let decode_item = + List.fold_left (fun items sexps -> + match sexps with + | Sexp.List [Atom "package"; List [Atom p] ] -> + List.map (fun item -> {item with package = Some p}) items + | Sexp.List [Atom "package"; List [] ] -> + List.map (fun item -> {item with package = None}) items + | Sexp.List [Atom "source_dir"; Atom s] -> + List.map (fun item -> {item with source_dir = s}) items + | Sexp.List [Atom "names"; List sexps] -> + let item = List.hd items in + List.map (fun name -> {item with name = name}) (List.map string_of_atom sexps) + | Sexp.List [Atom "external_deps" ; List sexps] -> + List.map (fun item -> + {item with external_deps = List.map string_of_list_dep_sexp sexps}) items + | Sexp.List [Atom "internal_deps" ; List sexps] -> + List.map (fun item -> + {item with internal_deps = List.map string_of_list_dep_sexp sexps}) items + | s -> Fmt.failwith "%s is not a good format decoding an item" (Sexp.to_string s) + ) [dump_item] + + let decode_items sexps : t list = + sexps + |> List.map (function + | Sexp.List [Atom "library"; List sexps] -> decode_item sexps |> List.map (fun item -> Lib item) + | Sexp.List [Atom "tests"; List sexps] -> decode_item sexps |> List.map (fun item -> Test item) + | Sexp.List [Atom "executables"; List sexps] -> decode_item sexps |> List.map (fun item -> Exe item) | s -> Fmt.failwith "%s is not a good format decoding items" (Sexp.to_string s)) + |> List.flatten + + let describe_extern_of_sexp : Sexp.t -> t list = function + | Sexp.List [Atom _ctx; List sexps] -> decode_items sexps + | _ -> Fmt.failwith "Invalid format" + +end -let items_of_sexp : Sexp.t -> t list = function - | Sexp.List [Atom _ctx; List sexps] -> extract_items sexps - | _ -> Fmt.failwith "Invalid format" - -let deps_merge deps_x deps_y = - Libraries.merge - (fun _ x y -> - match (x,y) with - | Some k1, Some k2 -> Some (Kind.merge k1 k2) - | _ -> None) deps_x deps_y - -let items_deps_by_dir = - List.fold_left - (fun dir_map (item:Item.t) -> - match Dir_map.find_opt item.source_dir dir_map with - | Some deps -> - Dir_map.add - item.source_dir - (deps_merge deps (Libraries.of_seq (List.to_seq item.external_deps))) - dir_map - | None -> - Dir_map.add - item.source_dir - (Libraries.of_seq (List.to_seq item.external_deps)) - dir_map) - Dir_map.empty - -let items_by_package = - List.fold_left - (fun dir_map (item:Item.t) -> - match item.package with - | Some package -> - (match Dir_map.find_opt package dir_map with - | Some items -> Dir_map.add package (item::items) dir_map - | None -> Dir_map.add item.source_dir [item] dir_map) - | None -> dir_map) - Dir_map.empty +module Describe_entries = struct + + type item = { + source_dir: string; + bin_name: string; + kind: string; + dst: string; + section: string; + } + + let dump_item = { + source_dir = ""; + bin_name = ""; + kind = ""; + dst = ""; + section = ""; + } + + type entry = Bin of item | Other of item + + type t = string * entry list + + let string_of_atom = + function + | Sexp.Atom s -> s + | s -> Fmt.failwith "%s is an atom" (Sexp.to_string s) + + (* With "default/lib/bin.exe" or "default/lib/bin.bc.js" gives bin, it gives "bin" *) + let bin_name s = + Str.split (Str.regexp "/") s + |> List.rev |> List.hd + |> Str.split (Str.regexp "\\.") + |> List.hd + + let source_dir s = Str.split (Str.regexp "[A-za-z0-9]+\\.exe") s |> List.hd + (* With "defautl/lib/bin.exe", it gives "default/lib/" *) + + let decode_item sexps = + List.fold_left (fun item sexps -> + match sexps with + | Sexp.List [Atom "src"; List [_; Atom p] ] -> + {item with source_dir = source_dir p; bin_name = bin_name p} + | Sexp.List [Atom "kind"; Atom p ] -> {item with kind = p} + | Sexp.List [Atom "dst"; Atom p ] -> {item with dst = p} + | Sexp.List [Atom "section"; Atom p ] -> {item with section = p} + | s -> Fmt.failwith "%s is not a good format decoding an item" (Sexp.to_string s) + ) dump_item sexps + |> (fun item -> match item.section with "BIN" -> Bin item | _ -> Other item) + + let decode_items : Sexp.t list -> entry list = + List.filter_map (function + | Sexp.List [Atom "user"; List sexps] -> Some (decode_item sexps) + | Sexp.List [Atom "dune"; List _] -> None + | s -> Fmt.failwith "%s is not a good format decoding items" (Sexp.to_string s)) + + let decode_entries : Sexp.t -> t = function + | Sexp.List [Atom package; List sexps] -> (package,decode_items sexps) + | _ -> Fmt.failwith "Invalid format" + + let entries_of_sexp : Sexp.t -> t list = function + | Sexp.List sexps -> List.map decode_entries sexps + | _ -> Fmt.failwith "Invalid format" + + let items_bin_of_entries pkg describe_entries = + List.find_opt (fun (package, _) -> String.equal package pkg) describe_entries + |> (function + | Some (_, entries) -> List.filter_map (function Bin item -> Some item | Other _ -> None) entries + | None -> []) + |> List.map (fun item -> item.bin_name,item) |> List.to_seq |> Item_map.of_seq +end diff --git a/dune_logic.ml b/dune_logic.ml new file mode 100644 index 0000000..e69de29 diff --git a/dune_project.ml b/dune_project.ml index 5808828..e81a76c 100644 --- a/dune_project.ml +++ b/dune_project.ml @@ -1,10 +1,10 @@ open Types -type t = Sexp.t list +module Deps = struct + include Deps +end -let or_die = function - | Ok x -> x - | Error (`Msg m) -> failwith m +type t = Sexp.t list let atom s = Sexp.Atom s let dune_and x y = Sexp.(List [atom "and"; x; y]) @@ -115,70 +115,3 @@ let write_project_file t = flush ch; close_out ch; Fmt.pr "Wrote %S@." path - -module Deps = struct - type t = Dir_set.t Libraries.t - - let dune_external_lib_deps = Bos.Cmd.(v "dune" % "describe" % "external-lib-deps") - - let has_dune_subproject = function - | "." | "" -> false - | dir -> Sys.file_exists (Filename.concat dir "dune-project") - - let rec should_use_dir ~dir_types path = - match Hashtbl.find_opt dir_types path with - | Some x -> x - | None -> - let r = - match Astring.String.cut ~sep:"/" ~rev:true path with - | Some (parent, _) -> - if should_use_dir ~dir_types parent then ( - not (has_dune_subproject path) - ) else false - | None -> - not (has_dune_subproject path) - in - Hashtbl.add dir_types path r; - r - - let get_dune_items dir_types ~sexp ~pkg ~target = - Dune_items.items_of_sexp sexp - |> List.filter (fun item -> - match (item,target) with - | Dune_items.Tests _, `Install -> false - | Dune_items.Tests _, `Runtest -> true - | _ , `Runtest -> false - | _, `Install -> true) - |> List.map Dune_items.get_item - |> List.filter (fun (item:Dune_items.Item.t) -> should_use_dir ~dir_types item.source_dir) - |> List.filter (fun (item:Dune_items.Item.t) -> - if target = `Install then - Option.equal String.equal (Some pkg) item.package - else - Option.equal String.equal (Some pkg) item.package || Option.is_none item.package) - (* if an item has not package, we assume it's used for testing*) - - - let lib_deps sexp ~pkg ~target = - get_dune_items (Hashtbl.create 10) ~sexp ~pkg ~target - |> List.fold_left (fun acc (item:Dune_items.Item.t) -> - List.map (fun dep -> (fst dep, item.source_dir)) item.external_deps @ acc) [] - |> List.fold_left (fun acc (lib,path) -> - if Astring.String.take ~sat:((<>) '.') lib <> pkg then - let dirs = Libraries.find_opt lib acc |> Option.value ~default:Dir_set.empty in - Libraries.add lib (Dir_set.add path dirs) acc - else - acc) Libraries.empty - - let sexp = - Bos.OS.Cmd.run_out (dune_external_lib_deps) - |> Bos.OS.Cmd.to_string - |> or_die - |> String.trim - |> (fun s -> - try Sexp.of_string s with - | Sexp.Parse_error _ as e -> Fmt.pr "Error parsing 'dune describe external-lib-deps' output:\n"; raise e) - - let get_external_lib_deps ~pkg ~target : t = sexp |> lib_deps ~pkg ~target - -end diff --git a/tests/test_dune_stanza_install.t b/tests/test_dune_stanza_install.t new file mode 100644 index 0000000..d0ba495 --- /dev/null +++ b/tests/test_dune_stanza_install.t @@ -0,0 +1,124 @@ +Create a simple dune project by using "install" stanza: + + $ cat > dune-project << EOF + > (lang dune 2.7) + > (generate_opam_files true) + > (package + > (name test) + > (synopsis "Test package") + > (depends + > (ocamlfind (>= 1.0)) + > libfoo)) + > EOF + + $ cat > dune << EOF + > (executable + > (name main) + > (modules main) + > (libraries findlib fmt)) + > (test + > (name test) + > (modules test) + > (libraries bos opam-state)) + > (install + > (section bin) + > (package test) + > (files main.exe)) + > EOF + + $ touch main.ml test.ml + $ dune build + + $ export OPAM_DUNE_LINT_TESTS=y + +Check that the missing libraries are detected: + + $ opam-dune-lint = "1.0"} [from /] + "bos" {with-test & >= "1.0"} [from /] + "opam-state" {with-test & >= "1.0"} [from /] + Note: version numbers are just suggestions based on the currently installed version. + Run with -f to apply changes in non-interactive mode. + [1] + +Check that the missing libraries get added: + + $ opam-dune-lint -f + test.opam: changes needed: + "fmt" {>= "1.0"} [from /] + "bos" {with-test & >= "1.0"} [from /] + "opam-state" {with-test & >= "1.0"} [from /] + Note: version numbers are just suggestions based on the currently installed version. + Wrote "dune-project" + + $ cat dune-project | sed 's/= [^)}]*/= */g' + (lang dune 2.7) + + (generate_opam_files true) + + (package + (name test) + (synopsis "Test package") + (depends + (opam-state + (and + (>= *) + :with-test)) + (bos + (and + (>= *) + :with-test)) + (fmt + (>= *)) + (ocamlfind + (>= *)) + libfoo)) + +Check adding and removing of test markers: + + $ cat > dune-project << EOF + > (lang dune 2.7) + > (generate_opam_files true) + > (package + > (name test) + > (synopsis "Test package") + > (depends + > opam-state + > (bos (>= 1.0)) + > (fmt :with-test) + > (ocamlfind (and (>= 1.0) :with-test)) + > libfoo)) + > EOF + + $ dune build @install + + $ opam-dune-lint -f + test.opam: changes needed: + "fmt" [from /] (remove {with-test}) + "ocamlfind" [from /] (remove {with-test}) + "bos" {with-test} [from /] (missing {with-test} annotation) + "opam-state" {with-test} [from /] (missing {with-test} annotation) + Wrote "dune-project" + + $ cat dune-project | sed 's/= [^)}]*/= */g' + (lang dune 2.7) + + (generate_opam_files true) + + (package + (name test) + (synopsis "Test package") + (depends + (opam-state :with-test) + (bos + (and + :with-test + (>= *))) + fmt + (ocamlfind + (>= *)) + libfoo)) + + $ opam-dune-lint + test.opam: OK diff --git a/types.ml b/types.ml index e091ac5..62dc289 100644 --- a/types.ml +++ b/types.ml @@ -6,6 +6,8 @@ module Libraries = Map.Make(String) module Dir_map = Map.Make(String) +module Item_map = Map.Make(String) + module Sexp = Sexplib.Sexp module Stdune = Stdune @@ -54,3 +56,7 @@ module Change_with_hint = struct let remove_hint (t:t) = fst t end + +let or_die = function + | Ok x -> x + | Error (`Msg m) -> failwith m From cb0d9061670545d013efc013ac17576236703ed2 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Tue, 4 Apr 2023 14:53:33 +0200 Subject: [PATCH 10/30] refactor: Avoid a recursive resolve on a public library or executable --- deps.ml | 14 +-- tests/test_dune_stanza_install.t | 2 +- tests/test_public_lib.t | 176 +++++++++++++++++++++++++++++++ 3 files changed, 185 insertions(+), 7 deletions(-) create mode 100644 tests/test_public_lib.t diff --git a/deps.ml b/deps.ml index 7d9f00b..6902f24 100644 --- a/deps.ml +++ b/deps.ml @@ -42,15 +42,16 @@ let rec should_use_dir ~dir_types path = (* TODO When a private executable name is not directly found*) let find_exe_name _pkg item = item -(* After the items are filtered, we need to include their internal_deps in order to reach all the deps*) -let add_internal_deps d_items items_pkg = +(* After the items are filtered, we need to include their internal_deps in order to reach all the + * deps. If the internal dep is a public library we skip a recursive resolve*) +let resolve_internal_deps d_items items_pkg = let open Describe_external_lib in let get_name = function | Lib item -> String.cat item.name ".lib" | Exe item -> String.cat item.name ".exe" | Test item -> String.cat item.name ".test" in - let items_lib = + let d_items_lib = d_items |> List.filter is_lib_item |> List.map get_item @@ -68,9 +69,10 @@ let add_internal_deps d_items items_pkg = (get_item item).internal_deps |> List.filter (fun (_, k) -> Kind.is_required k) |> List.filter_map (fun (name, _) -> - match Hashtbl.find_opt items_lib (String.cat name ".lib") with + match Hashtbl.find_opt d_items_lib (String.cat name ".lib") with | None -> None - | Some item_lib -> Some item_lib) + | Some d_item_lib -> + if Option.is_some (get_item d_item_lib).package then None else Some d_item_lib) |> fun internals -> add_internal acc (tl @ internals) end in @@ -125,7 +127,7 @@ let get_dune_items dir_types ~pkg ~target = Option.equal String.equal (Some pkg) item.package else Option.equal String.equal (Some pkg) item.package || Option.is_none item.package) - |> add_internal_deps d_items) + |> resolve_internal_deps d_items) let lib_deps ~pkg ~target = diff --git a/tests/test_dune_stanza_install.t b/tests/test_dune_stanza_install.t index d0ba495..1e2ca25 100644 --- a/tests/test_dune_stanza_install.t +++ b/tests/test_dune_stanza_install.t @@ -1,4 +1,4 @@ -Create a simple dune project by using "install" stanza: +Create a simple dune project and use "install" stanza: $ cat > dune-project << EOF > (lang dune 2.7) diff --git a/tests/test_public_lib.t b/tests/test_public_lib.t new file mode 100644 index 0000000..77e6160 --- /dev/null +++ b/tests/test_public_lib.t @@ -0,0 +1,176 @@ +Create a simple dune project and test when a public library as internal dep is not recursively +resolved: + + $ cat > dune-project << EOF + > (lang dune 2.7) + > (generate_opam_files true) + > (package + > (name test) + > (synopsis "Test package") + > (depends + > (ocamlfind (>= 1.0)) + > libfoo)) + > (package + > (name lib) + > (synopsis "Lib package") + > (depends sexplib)) + > EOF + + $ cat > dune << EOF + > (library + > (public_name lib) + > (modules lib) + > (libraries sexplib)) + > (executable + > (name main) + > (modules main) + > (libraries lib findlib fmt)) + > (test + > (name test) + > (modules test) + > (libraries lib bos opam-state)) + > (install + > (section bin) + > (package test) + > (files main.exe)) + > EOF + + $ touch main.ml test.ml lib.ml + $ dune build + + $ export OPAM_DUNE_LINT_TESTS=y + +Check that the missing libraries are detected: + + $ opam-dune-lint = "1.0"} [from /] + "opam-state" {with-test & >= "1.0"} [from /] + test.opam: changes needed: + "fmt" {>= "1.0"} [from /] + "bos" {with-test & >= "1.0"} [from /] + "opam-state" {with-test & >= "1.0"} [from /] + Note: version numbers are just suggestions based on the currently installed version. + Run with -f to apply changes in non-interactive mode. + [1] + +Check that the missing libraries get added: + + $ opam-dune-lint -f + lib.opam: changes needed: + "bos" {with-test & >= "1.0"} [from /] + "opam-state" {with-test & >= "1.0"} [from /] + test.opam: changes needed: + "fmt" {>= "1.0"} [from /] + "bos" {with-test & >= "1.0"} [from /] + "opam-state" {with-test & >= "1.0"} [from /] + Note: version numbers are just suggestions based on the currently installed version. + Wrote "dune-project" + + $ cat dune-project | sed 's/= [^)}]*/= */g' + (lang dune 2.7) + + (generate_opam_files true) + + (package + (name test) + (synopsis "Test package") + (depends + (opam-state + (and + (>= *) + :with-test)) + (bos + (and + (>= *) + :with-test)) + (fmt + (>= *)) + (ocamlfind + (>= *)) + libfoo)) + + (package + (name lib) + (synopsis "Lib package") + (depends + (opam-state + (and + (>= *) + :with-test)) + (bos + (and + (>= *) + :with-test)) + sexplib)) + +Check adding and removing of test markers: + + $ cat > dune-project << EOF + > (lang dune 2.7) + > (generate_opam_files true) + > (package + > (name test) + > (synopsis "Test package") + > (depends + > opam-state + > (bos (>= 1.0)) + > (fmt :with-test) + > (ocamlfind (and (>= 1.0) :with-test)) + > libfoo)) + > (package + > (name lib) + > (synopsis "Lib package") + > (depends sexplib)) + > EOF + + $ dune build @install + + $ opam-dune-lint -f + lib.opam: changes needed: + "bos" {with-test & >= "1.0"} [from /] + "opam-state" {with-test & >= "1.0"} [from /] + test.opam: changes needed: + "fmt" [from /] (remove {with-test}) + "ocamlfind" [from /] (remove {with-test}) + "bos" {with-test} [from /] (missing {with-test} annotation) + "opam-state" {with-test} [from /] (missing {with-test} annotation) + Note: version numbers are just suggestions based on the currently installed version. + Wrote "dune-project" + + $ cat dune-project | sed 's/= [^)}]*/= */g' + (lang dune 2.7) + + (generate_opam_files true) + + (package + (name test) + (synopsis "Test package") + (depends + (opam-state :with-test) + (bos + (and + :with-test + (>= *))) + fmt + (ocamlfind + (>= *)) + libfoo)) + + (package + (name lib) + (synopsis "Lib package") + (depends + (opam-state + (and + (>= *) + :with-test)) + (bos + (and + (>= *) + :with-test)) + sexplib)) + + $ opam-dune-lint + lib.opam: OK + test.opam: OK From 6fb36c8b67c7227849f03c2f4bd1a023fc119f09 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Fri, 7 Apr 2023 19:02:31 +0200 Subject: [PATCH 11/30] refactor the source code --- deps.ml | 77 ++++++++++++++++++++++++++------------------------- dune_logic.ml | 0 2 files changed, 39 insertions(+), 38 deletions(-) delete mode 100644 dune_logic.ml diff --git a/deps.ml b/deps.ml index 6902f24..f4ca884 100644 --- a/deps.ml +++ b/deps.ml @@ -42,42 +42,6 @@ let rec should_use_dir ~dir_types path = (* TODO When a private executable name is not directly found*) let find_exe_name _pkg item = item -(* After the items are filtered, we need to include their internal_deps in order to reach all the - * deps. If the internal dep is a public library we skip a recursive resolve*) -let resolve_internal_deps d_items items_pkg = - let open Describe_external_lib in - let get_name = function - | Lib item -> String.cat item.name ".lib" - | Exe item -> String.cat item.name ".exe" - | Test item -> String.cat item.name ".test" - in - let d_items_lib = - d_items - |> List.filter is_lib_item - |> List.map get_item - |> List.map (fun (item:Describe_external_lib.item) -> - (String.cat item.name ".lib", Lib item)) - |> List.to_seq |> Hashtbl.of_seq - in - let rec add_internal acc = function - | [] -> Hashtbl.to_seq_values acc |> List.of_seq - | item::tl -> - if Hashtbl.mem acc (get_name item) then - add_internal acc tl - else begin - Hashtbl.add acc (get_name item) item; - (get_item item).internal_deps - |> List.filter (fun (_, k) -> Kind.is_required k) - |> List.filter_map (fun (name, _) -> - match Hashtbl.find_opt d_items_lib (String.cat name ".lib") with - | None -> None - | Some d_item_lib -> - if Option.is_some (get_item d_item_lib).package then None else Some d_item_lib) - |> fun internals -> add_internal acc (tl @ internals) - end - in - add_internal (Hashtbl.create 10) items_pkg - let items_entries describe_external_lib ~dir_types ~pkg = let exe_name_items = let open Describe_external_lib in @@ -97,6 +61,44 @@ let items_entries describe_external_lib ~dir_types ~pkg = found (Item_map.map (find_exe_name pkg) not_found)) let get_dune_items dir_types ~pkg ~target = + let resolve_internal_deps d_items items_pkg = + (* After the d_items are filtered to the corresponding package request, + * we need to include the internal_deps in order to reach all the deps. + * If the internal dep is a public library we skip a recursive resolve + * because it will be resolve with separate request*) + let open Describe_external_lib in + let get_name = function + | Lib item -> String.cat item.name ".lib" + | Exe item -> String.cat item.name ".exe" + | Test item -> String.cat item.name ".test" + in + let d_items_lib = + d_items + |> List.filter is_lib_item + |> List.map get_item + |> List.map (fun (item:Describe_external_lib.item) -> + (String.cat item.name ".lib", Lib item)) + |> List.to_seq |> Hashtbl.of_seq + in + let rec add_internal acc = function + | [] -> Hashtbl.to_seq_values acc |> List.of_seq + | item::tl -> + if Hashtbl.mem acc (get_name item) then + add_internal acc tl + else begin + Hashtbl.add acc (get_name item) item; + (get_item item).internal_deps + |> List.filter (fun (_, k) -> Kind.is_required k) + |> List.filter_map (fun (name, _) -> + match Hashtbl.find_opt d_items_lib (String.cat name ".lib") with + | None -> None + | Some d_item_lib -> + if Option.is_some (get_item d_item_lib).package then None else Some d_item_lib) + |> fun internals -> add_internal acc (tl @ internals) + end + in + add_internal (Hashtbl.create 10) items_pkg + in let describe_external = Describe_external_lib.describe_extern_of_sexp sexp_describe_external_lib_deps in @@ -104,8 +106,7 @@ let get_dune_items dir_types ~pkg ~target = describe_external |> List.map (fun d_item -> let item = Describe_external_lib.get_item d_item in - if Describe_external_lib.is_exe_item d_item - && Option.is_none item.package + if Describe_external_lib.is_exe_item d_item && Option.is_none item.package then match Item_map.find_opt item.name items_entries with | None -> d_item diff --git a/dune_logic.ml b/dune_logic.ml deleted file mode 100644 index e69de29..0000000 From 3b75eaf1163e6264bb0f9407c16a6b9eb9a76009 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Fri, 14 Apr 2023 12:43:52 +0200 Subject: [PATCH 12/30] When an executable is copied before installed in dune This case is a hack to make dependency on an executable. It's trying to copy in another name before to install it. OCaml-CI raised this issue which can be found here `https://github.com/ocaml/dune/issues/3499` This commit try solve the case but not perfect because to get the rules, we are parsing the dune source and there's some limitation on that, like dune variables. --- CHANGES.md | 5 + deps.ml | 60 ++++++------ dune-project | 1 + dune_items.ml | 37 ++++--- dune_rules.ml | 71 ++++++++++++++ opam-dune-lint.opam | 1 + tests/test_dune_copy_install.t | 173 +++++++++++++++++++++++++++++++++ tests/test_public_lib.t | 3 +- 8 files changed, 306 insertions(+), 45 deletions(-) create mode 100644 dune_rules.ml create mode 100644 tests/test_dune_copy_install.t diff --git a/CHANGES.md b/CHANGES.md index e033966..18830d4 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,8 @@ +### Unreleased + +- Add support for dune 3.0 (@moyodiallo #46), the command `dune external-lib-deps` was remove from + dune + ### v0.2 - Cope with missing `(depends ...)` in `dune-project` (@talex5 #33). We tried to add the missing packages to an existing depends field, but if there wasn't one at all then we did nothing. diff --git a/deps.ml b/deps.ml index f4ca884..2bcc8d1 100644 --- a/deps.ml +++ b/deps.ml @@ -16,9 +16,13 @@ let sexp cmd = try Sexp.of_string s with | Sexp.Parse_error _ as e -> Fmt.pr "Error parsing 'dune describe external-lib-deps' output:\n"; raise e) -let sexp_describe_external_lib_deps = sexp dune_describe_external_lib_deps +let describe_external_lib_deps = + sexp dune_describe_external_lib_deps + |> Describe_external_lib.describe_extern_of_sexp -let sexp_describe_entries = sexp dune_describe_entries +let describe_entries = + sexp dune_describe_entries + |> Describe_entries.entries_of_sexp let has_dune_subproject = function | "." | "" -> false @@ -39,32 +43,32 @@ let rec should_use_dir ~dir_types path = in Hashtbl.add dir_types path r; r -(* TODO When a private executable name is not directly found*) -let find_exe_name _pkg item = item -let items_entries describe_external_lib ~dir_types ~pkg = - let exe_name_items = - let open Describe_external_lib in - describe_external_lib - |> List.filter Describe_external_lib.is_exe_item - |> List.map Describe_external_lib.get_item - |> List.map (fun item -> item.name) - in - let open Describe_entries in - Describe_entries.entries_of_sexp sexp_describe_entries - |> Describe_entries.items_bin_of_entries pkg - |> Item_map.filter (fun _ item -> should_use_dir ~dir_types item.source_dir) - |> Item_map.partition (fun _ item -> List.mem item.bin_name exe_name_items) - |> (fun (found, not_found) -> - Item_map.union - (fun _ _ _ -> Fmt.failwith "Not supposed to to have same name") - found (Item_map.map (find_exe_name pkg) not_found)) +let copy_rules = + describe_external_lib_deps + |> List.map Describe_external_lib.get_item + |> List.map (fun (item:Describe_external_lib.item) -> String.cat item.source_dir "/dune") + |> List.map (Dune_rules.Copy_rules.get_copy_rules) + |> List.flatten + |> Dune_rules.Copy_rules.copy_rules_map + +let bin_of_entries = Describe_entries.items_bin_of_entries describe_entries + +let find_exe_item_package (item:Describe_external_lib.item) = + match item.package with + | Some p -> Some p + | None -> + (* Only allow for private executables to find the package *) + let bin_name = + Dune_rules.Copy_rules.find_dest_name ~name:(String.cat item.name ".exe") copy_rules + in + Option.map (fun (item:Describe_entries.item) -> item.package) (Item_map.find_opt bin_name bin_of_entries) let get_dune_items dir_types ~pkg ~target = let resolve_internal_deps d_items items_pkg = (* After the d_items are filtered to the corresponding package request, * we need to include the internal_deps in order to reach all the deps. - * If the internal dep is a public library we skip a recursive resolve + * If the internal dep is a public library we skip the recursive resolve * because it will be resolve with separate request*) let open Describe_external_lib in let get_name = function @@ -99,18 +103,14 @@ let get_dune_items dir_types ~pkg ~target = in add_internal (Hashtbl.create 10) items_pkg in - let describe_external = - Describe_external_lib.describe_extern_of_sexp sexp_describe_external_lib_deps - in - let items_entries = items_entries describe_external ~dir_types ~pkg in - describe_external + describe_external_lib_deps |> List.map (fun d_item -> let item = Describe_external_lib.get_item d_item in if Describe_external_lib.is_exe_item d_item && Option.is_none item.package then - match Item_map.find_opt item.name items_entries with - | None -> d_item - | Some _ -> Describe_external_lib.Exe { item with package = Some pkg } + match find_exe_item_package item with + | None -> d_item + | Some pkg -> Describe_external_lib.Exe { item with package = Some pkg } else d_item) |> List.filter (fun item -> match (item,target) with diff --git a/dune-project b/dune-project index 22fb27c..ed08014 100644 --- a/dune-project +++ b/dune-project @@ -17,6 +17,7 @@ (sexplib (>= v0.14.0)) (cmdliner (>= 1.1.0)) (dune (> 3.0)) + (stdune (> 3.0)) (ocaml (>= 4.10.0)) (bos (>= 0.2.0)) (fmt (>= 0.8.9)) diff --git a/dune_items.ml b/dune_items.ml index 2e975fa..157b8bb 100644 --- a/dune_items.ml +++ b/dune_items.ml @@ -100,6 +100,7 @@ module Describe_entries = struct kind: string; dst: string; section: string; + package: string } let dump_item = { @@ -108,6 +109,7 @@ module Describe_entries = struct kind = ""; dst = ""; section = ""; + package = "" } type entry = Bin of item | Other of item @@ -121,13 +123,18 @@ module Describe_entries = struct (* With "default/lib/bin.exe" or "default/lib/bin.bc.js" gives bin, it gives "bin" *) let bin_name s = - Str.split (Str.regexp "/") s - |> List.rev |> List.hd - |> Str.split (Str.regexp "\\.") - |> List.hd - - let source_dir s = Str.split (Str.regexp "[A-za-z0-9]+\\.exe") s |> List.hd - (* With "defautl/lib/bin.exe", it gives "default/lib/" *) + Astring.String.cut ~sep:"/" ~rev:true s + |> Option.map snd |> Option.get + (* |> Option.map (Astring.String.cut ~sep:"." ~rev:false) |> Option.join *) + (* |> Option.get |> fst *) + + (* With "defautl/lib/bin.exe", it gives "default/lib" *) + let source_dir s = + Astring.String.cut ~sep:"/" ~rev:true s + |> Option.map fst + |> Option.map (Astring.String.cut ~sep:"/" ~rev:false) |> Option.join + |> Option.map snd + |> function None -> "." | Some dir -> dir let decode_item sexps = List.fold_left (fun item sexps -> @@ -152,13 +159,17 @@ module Describe_entries = struct | _ -> Fmt.failwith "Invalid format" let entries_of_sexp : Sexp.t -> t list = function - | Sexp.List sexps -> List.map decode_entries sexps + | Sexp.List sexps -> + List.map decode_entries sexps + |> List.map (fun (package, entries) -> + (package, List.map (function + | Bin item -> Bin {item with package = package} + | Other item -> Other {item with package = package}) entries)) | _ -> Fmt.failwith "Invalid format" - let items_bin_of_entries pkg describe_entries = - List.find_opt (fun (package, _) -> String.equal package pkg) describe_entries - |> (function - | Some (_, entries) -> List.filter_map (function Bin item -> Some item | Other _ -> None) entries - | None -> []) + let items_bin_of_entries describe_entries = + List.map snd describe_entries + |> List.flatten + |> List.filter_map (function Bin item -> Some item | Other _ -> None) |> List.map (fun item -> item.bin_name,item) |> List.to_seq |> Item_map.of_seq end diff --git a/dune_rules.ml b/dune_rules.ml new file mode 100644 index 0000000..59bb76d --- /dev/null +++ b/dune_rules.ml @@ -0,0 +1,71 @@ +open Types + +module Copy_rules = struct + + let sexp_of_file file = + try Sexp.load_sexps file with + | Sexp.Parse_error _ as e -> + (Fmt.pr "Error parsing 'dune describe external-lib-deps' output:\n"; raise e) + + type t = + { + target: string; + from_name: string; + to_name: string; + package: string + } + + let dump_copy = { + target = ""; + from_name = ""; + to_name = ""; + package = "" + } + + let rules = Hashtbl.create 10 + + let copy_rules_of_sexp sexps = + let is_action_copy sexp = + sexp + |> (function + | Sexp.List l -> l + | _ -> Fmt.failwith "This is not a Sexp.List") + |> (fun l -> if List.mem (Sexp.Atom "rule") l then Some l else None) + |> Option.map (fun l -> + List.exists (function + | Sexp.List [ Atom "action"; List [ Atom "copy"; _]] -> true + | _ -> false) l) + |> Option.is_some + in + let copy_rule_of_sexp sexp = + match sexp with + | Sexp.List sexps -> + List.fold_left (fun copy sexp -> + match sexp with + | Sexp.List [Atom "action"; List [ _; Atom f; Atom t]] -> {{copy with from_name = f } with to_name = t} + | Sexp.List [Atom "deps"; List [_; Atom s]] -> {copy with package = s} + | Sexp.List [Atom "target"; Atom s ] -> { copy with target = s } + | Sexp.Atom "rule" -> copy + | s -> Fmt.failwith "%s is not a good format decoding an item" (Sexp.to_string s) + ) dump_copy sexps + | s -> Fmt.failwith "%s is not a rule" (Sexp.to_string s) + in + sexps + |> List.filter is_action_copy + |> List.map copy_rule_of_sexp + + let copy_rules_map = + List.fold_left (fun map copy -> Item_map.add copy.from_name copy map) Item_map.empty + + let get_copy_rules file = + match Hashtbl.find_opt rules file with + | None -> + let copy_rules = copy_rules_of_sexp (sexp_of_file file) in + Hashtbl.add rules file copy_rules; copy_rules + | Some copy_rules -> copy_rules + + let rec find_dest_name ~name rules = + match Item_map.find_opt name rules with + | None -> name + | Some t -> find_dest_name ~name:t.to_name rules +end diff --git a/opam-dune-lint.opam b/opam-dune-lint.opam index fdb2e1e..89eb1ae 100644 --- a/opam-dune-lint.opam +++ b/opam-dune-lint.opam @@ -13,6 +13,7 @@ depends: [ "sexplib" {>= "v0.14.0"} "cmdliner" {>= "1.1.0"} "dune" {>= "2.7" & > "3.0"} + "stdune" {> "3.0"} "ocaml" {>= "4.10.0"} "bos" {>= "0.2.0"} "fmt" {>= "0.8.9"} diff --git a/tests/test_dune_copy_install.t b/tests/test_dune_copy_install.t new file mode 100644 index 0000000..de18695 --- /dev/null +++ b/tests/test_dune_copy_install.t @@ -0,0 +1,173 @@ +Create a simple dune project and use "install" stanza: + + $ cat > dune-project << EOF + > (lang dune 2.7) + > (generate_opam_files true) + > (package + > (name test) + > (synopsis "Test package") + > (depends + > (ocamlfind (>= 1.0)) + > libfoo)) + > (package + > (name zombie) + > (synopsis "Zombie package")) + > EOF + + $ cat > dune << EOF + > (executable + > (name main) + > (modules main) + > (libraries findlib fmt)) + > (test + > (name test) + > (modules test) + > (libraries bos opam-state)) + > (rule + > (target main-copy.exe) + > (deps + > (package zombie)) + > (action + > (copy main.exe main-copy.exe))) + > (install + > (section bin) + > (package test) + > (files (main-copy.exe as main.exe))) + > EOF + + $ touch main.ml test.ml + $ dune build + + $ export OPAM_DUNE_LINT_TESTS=y + +Check that the missing libraries are detected: + + $ opam-dune-lint = "1.0"} [from /] + "bos" {with-test & >= "1.0"} [from /] + "opam-state" {with-test & >= "1.0"} [from /] + zombie.opam: changes needed: + "bos" {with-test & >= "1.0"} [from /] + "opam-state" {with-test & >= "1.0"} [from /] + Note: version numbers are just suggestions based on the currently installed version. + Run with -f to apply changes in non-interactive mode. + [1] + +Check that the missing libraries get added: + + $ opam-dune-lint -f + test.opam: changes needed: + "fmt" {>= "1.0"} [from /] + "bos" {with-test & >= "1.0"} [from /] + "opam-state" {with-test & >= "1.0"} [from /] + zombie.opam: changes needed: + "bos" {with-test & >= "1.0"} [from /] + "opam-state" {with-test & >= "1.0"} [from /] + Note: version numbers are just suggestions based on the currently installed version. + Wrote "dune-project" + + $ cat dune-project | sed 's/= [^)}]*/= */g' + (lang dune 2.7) + + (generate_opam_files true) + + (package + (name test) + (synopsis "Test package") + (depends + (opam-state + (and + (>= *) + :with-test)) + (bos + (and + (>= *) + :with-test)) + (fmt + (>= *)) + (ocamlfind + (>= *)) + libfoo)) + + (package + (name zombie) + (synopsis "Zombie package") + (depends + (opam-state + (and + (>= *) + :with-test)) + (bos + (and + (>= *) + :with-test)))) + +Check adding and removing of test markers: + + $ cat > dune-project << EOF + > (lang dune 2.7) + > (generate_opam_files true) + > (package + > (name test) + > (synopsis "Test package") + > (depends + > opam-state + > (bos (>= 1.0)) + > (fmt :with-test) + > (ocamlfind (and (>= 1.0) :with-test)) + > libfoo)) + > (package + > (name zombie) + > (synopsis "Zombie package")) + > EOF + + $ dune build @install + + $ opam-dune-lint -f + test.opam: changes needed: + "fmt" [from /] (remove {with-test}) + "ocamlfind" [from /] (remove {with-test}) + "bos" {with-test} [from /] (missing {with-test} annotation) + "opam-state" {with-test} [from /] (missing {with-test} annotation) + zombie.opam: changes needed: + "bos" {with-test & >= "1.0"} [from /] + "opam-state" {with-test & >= "1.0"} [from /] + Note: version numbers are just suggestions based on the currently installed version. + Wrote "dune-project" + + $ cat dune-project | sed 's/= [^)}]*/= */g' + (lang dune 2.7) + + (generate_opam_files true) + + (package + (name test) + (synopsis "Test package") + (depends + (opam-state :with-test) + (bos + (and + :with-test + (>= *))) + fmt + (ocamlfind + (>= *)) + libfoo)) + + (package + (name zombie) + (synopsis "Zombie package") + (depends + (opam-state + (and + (>= *) + :with-test)) + (bos + (and + (>= *) + :with-test)))) + + $ opam-dune-lint + test.opam: OK + zombie.opam: OK diff --git a/tests/test_public_lib.t b/tests/test_public_lib.t index 77e6160..661e56b 100644 --- a/tests/test_public_lib.t +++ b/tests/test_public_lib.t @@ -1,5 +1,4 @@ -Create a simple dune project and test when a public library as internal dep is not recursively -resolved: +Create a simple dune project and test when a public library as internal dep is not recursively resolved: $ cat > dune-project << EOF > (lang dune 2.7) From 1c51ba4add79c8d47601f6bed75c041ae795bc8f Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Tue, 18 Apr 2023 15:41:22 +0200 Subject: [PATCH 13/30] Refactor: Add the extensions of executables Add the extensions of executables and fix the parsing format of dune commands output. --- deps.ml | 8 ++++---- dune-project | 3 +-- dune_items.ml | 32 ++++++++++++++++++++------------ opam-dune-lint.opam | 4 ++-- 4 files changed, 27 insertions(+), 20 deletions(-) diff --git a/deps.ml b/deps.ml index 2bcc8d1..b076b30 100644 --- a/deps.ml +++ b/deps.ml @@ -59,10 +59,10 @@ let find_exe_item_package (item:Describe_external_lib.item) = | Some p -> Some p | None -> (* Only allow for private executables to find the package *) - let bin_name = - Dune_rules.Copy_rules.find_dest_name ~name:(String.cat item.name ".exe") copy_rules - in - Option.map (fun (item:Describe_entries.item) -> item.package) (Item_map.find_opt bin_name bin_of_entries) + item.extensions + |> List.find_map (fun extension -> + let bin_name = Dune_rules.Copy_rules.find_dest_name ~name:(item.name ^ extension) copy_rules in + Option.map (fun (item:Describe_entries.item) -> item.package) (Item_map.find_opt bin_name bin_of_entries)) let get_dune_items dir_types ~pkg ~target = let resolve_internal_deps d_items items_pkg = diff --git a/dune-project b/dune-project index ed08014..a259d61 100644 --- a/dune-project +++ b/dune-project @@ -16,8 +16,7 @@ (astring (>= 0.8.5)) (sexplib (>= v0.14.0)) (cmdliner (>= 1.1.0)) - (dune (> 3.0)) - (stdune (> 3.0)) + (stdune (>= 3.0)) (ocaml (>= 4.10.0)) (bos (>= 0.2.0)) (fmt (>= 0.8.9)) diff --git a/dune_items.ml b/dune_items.ml index 157b8bb..0b04462 100644 --- a/dune_items.ml +++ b/dune_items.ml @@ -20,7 +20,8 @@ module Describe_external_lib = struct package: string option; external_deps : (string * Kind.t) list; internal_deps : (string * Kind.t) list; - source_dir: string + source_dir: string; + extensions: string list } let dump_item = @@ -29,7 +30,8 @@ module Describe_external_lib = struct package = None; external_deps = []; internal_deps = []; - source_dir = "" + source_dir = ""; + extensions = [] } type t = Lib of item | Exe of item | Test of item @@ -56,18 +58,25 @@ module Describe_external_lib = struct (name, Kind.Optional) | s -> Fmt.failwith "%s is not 'List[Atom _; Atom _]'" (Sexp.to_string s) - let decode_item = + let decode_item sexps = + let items = + List.fold_left (fun items sexps -> + match sexps with + | Sexp.List [Atom "names"; List sexps] -> + List.map (fun name -> {dump_item with name = name}) (List.map string_of_atom sexps) + | _ -> items) [] sexps + in List.fold_left (fun items sexps -> match sexps with + | Sexp.List [Atom "names"; List _] -> items | Sexp.List [Atom "package"; List [Atom p] ] -> List.map (fun item -> {item with package = Some p}) items | Sexp.List [Atom "package"; List [] ] -> List.map (fun item -> {item with package = None}) items | Sexp.List [Atom "source_dir"; Atom s] -> List.map (fun item -> {item with source_dir = s}) items - | Sexp.List [Atom "names"; List sexps] -> - let item = List.hd items in - List.map (fun name -> {item with name = name}) (List.map string_of_atom sexps) + | Sexp.List [Atom "extensions" ; List sexps] -> + List.map (fun item -> {item with extensions = List.map string_of_atom sexps}) items | Sexp.List [Atom "external_deps" ; List sexps] -> List.map (fun item -> {item with external_deps = List.map string_of_list_dep_sexp sexps}) items @@ -75,7 +84,7 @@ module Describe_external_lib = struct List.map (fun item -> {item with internal_deps = List.map string_of_list_dep_sexp sexps}) items | s -> Fmt.failwith "%s is not a good format decoding an item" (Sexp.to_string s) - ) [dump_item] + ) items sexps let decode_items sexps : t list = sexps @@ -121,12 +130,10 @@ module Describe_entries = struct | Sexp.Atom s -> s | s -> Fmt.failwith "%s is an atom" (Sexp.to_string s) - (* With "default/lib/bin.exe" or "default/lib/bin.bc.js" gives bin, it gives "bin" *) + (* With "default/lib/bin.exe" or "default/lib/bin.bc.js" gives bin, it gives "bin.exe" *) let bin_name s = Astring.String.cut ~sep:"/" ~rev:true s |> Option.map snd |> Option.get - (* |> Option.map (Astring.String.cut ~sep:"." ~rev:false) |> Option.join *) - (* |> Option.get |> fst *) (* With "defautl/lib/bin.exe", it gives "default/lib" *) let source_dir s = @@ -150,8 +157,9 @@ module Describe_entries = struct let decode_items : Sexp.t list -> entry list = List.filter_map (function - | Sexp.List [Atom "user"; List sexps] -> Some (decode_item sexps) - | Sexp.List [Atom "dune"; List _] -> None + | Sexp.List [List [Atom "source"; Atom "user"]; List [Atom "entry"; List sexps]] -> Some (decode_item sexps) + | Sexp.List [List [Atom "entry"; List sexps]; List [Atom "source"; Atom "user"]] -> Some (decode_item sexps) + | Sexp.List [List [Atom "source"; Atom "dune"]; List _ ] -> None | s -> Fmt.failwith "%s is not a good format decoding items" (Sexp.to_string s)) let decode_entries : Sexp.t -> t = function diff --git a/opam-dune-lint.opam b/opam-dune-lint.opam index 89eb1ae..0981c05 100644 --- a/opam-dune-lint.opam +++ b/opam-dune-lint.opam @@ -9,11 +9,11 @@ license: "ISC" homepage: "https://github.com/ocurrent/opam-dune-lint" bug-reports: "https://github.com/ocurrent/opam-dune-lint/issues" depends: [ + "dune" {>= "2.7"} "astring" {>= "0.8.5"} "sexplib" {>= "v0.14.0"} "cmdliner" {>= "1.1.0"} - "dune" {>= "2.7" & > "3.0"} - "stdune" {> "3.0"} + "stdune" {>= "3.0"} "ocaml" {>= "4.10.0"} "bos" {>= "0.2.0"} "fmt" {>= "0.8.9"} From f55312d9ccc9d2248f5637db7390f1113c9d182a Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Wed, 19 Apr 2023 14:33:10 +0200 Subject: [PATCH 14/30] Refactor the code --- deps.ml | 26 +++++++++++++++----------- dune_items.ml | 16 +++++++--------- 2 files changed, 22 insertions(+), 20 deletions(-) diff --git a/deps.ml b/deps.ml index b076b30..cb19824 100644 --- a/deps.ml +++ b/deps.ml @@ -46,10 +46,12 @@ let rec should_use_dir ~dir_types path = let copy_rules = describe_external_lib_deps - |> List.map Describe_external_lib.get_item - |> List.map (fun (item:Describe_external_lib.item) -> String.cat item.source_dir "/dune") - |> List.map (Dune_rules.Copy_rules.get_copy_rules) - |> List.flatten + |> List.concat_map + (fun d_item -> + d_item + |> Describe_external_lib.get_item + |> (fun (item:Describe_external_lib.item) -> item.source_dir ^ "/dune") + |> (Dune_rules.Copy_rules.get_copy_rules)) |> Dune_rules.Copy_rules.copy_rules_map let bin_of_entries = Describe_entries.items_bin_of_entries describe_entries @@ -72,16 +74,18 @@ let get_dune_items dir_types ~pkg ~target = * because it will be resolve with separate request*) let open Describe_external_lib in let get_name = function - | Lib item -> String.cat item.name ".lib" - | Exe item -> String.cat item.name ".exe" - | Test item -> String.cat item.name ".test" + | Lib item -> item.name ^ ".lib" + | Exe item -> item.name ^ ".exe" + | Test item -> item.name ^ ".test" in let d_items_lib = d_items |> List.filter is_lib_item - |> List.map get_item - |> List.map (fun (item:Describe_external_lib.item) -> - (String.cat item.name ".lib", Lib item)) + |> List.map (fun d_item -> + d_item + |> get_item + |> (fun (item:Describe_external_lib.item) -> + (item.name ^ ".lib", Lib item))) |> List.to_seq |> Hashtbl.of_seq in let rec add_internal acc = function @@ -94,7 +98,7 @@ let get_dune_items dir_types ~pkg ~target = (get_item item).internal_deps |> List.filter (fun (_, k) -> Kind.is_required k) |> List.filter_map (fun (name, _) -> - match Hashtbl.find_opt d_items_lib (String.cat name ".lib") with + match Hashtbl.find_opt d_items_lib (name ^ ".lib") with | None -> None | Some d_item_lib -> if Option.is_some (get_item d_item_lib).package then None else Some d_item_lib) diff --git a/dune_items.ml b/dune_items.ml index 0b04462..74a3633 100644 --- a/dune_items.ml +++ b/dune_items.ml @@ -88,12 +88,11 @@ module Describe_external_lib = struct let decode_items sexps : t list = sexps - |> List.map (function + |> List.concat_map (function | Sexp.List [Atom "library"; List sexps] -> decode_item sexps |> List.map (fun item -> Lib item) | Sexp.List [Atom "tests"; List sexps] -> decode_item sexps |> List.map (fun item -> Test item) | Sexp.List [Atom "executables"; List sexps] -> decode_item sexps |> List.map (fun item -> Exe item) | s -> Fmt.failwith "%s is not a good format decoding items" (Sexp.to_string s)) - |> List.flatten let describe_extern_of_sexp : Sexp.t -> t list = function | Sexp.List [Atom _ctx; List sexps] -> decode_items sexps @@ -138,9 +137,7 @@ module Describe_entries = struct (* With "defautl/lib/bin.exe", it gives "default/lib" *) let source_dir s = Astring.String.cut ~sep:"/" ~rev:true s - |> Option.map fst - |> Option.map (Astring.String.cut ~sep:"/" ~rev:false) |> Option.join - |> Option.map snd + |> Option.map fst |> Option.map (Astring.String.cut ~sep:"/" ~rev:false) |> Option.join |> Option.map snd |> function None -> "." | Some dir -> dir let decode_item sexps = @@ -176,8 +173,9 @@ module Describe_entries = struct | _ -> Fmt.failwith "Invalid format" let items_bin_of_entries describe_entries = - List.map snd describe_entries - |> List.flatten - |> List.filter_map (function Bin item -> Some item | Other _ -> None) - |> List.map (fun item -> item.bin_name,item) |> List.to_seq |> Item_map.of_seq + List.concat_map snd describe_entries + |> List.filter_map (fun d_item -> + d_item + |> (function Bin item -> Some (item.bin_name,item) | Other _ -> None)) + |> List.to_seq |> Item_map.of_seq end From dd60e7e2e6198b6eb08e40e4dc47b53208dc5319 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Thu, 20 Apr 2023 11:27:10 +0200 Subject: [PATCH 15/30] Remove "dune build" and improve parsing copy Building to upgrade the opam files is replaced by another dune command: `dune describe opam-files` which give all updated opam-files. Improve parsing dune file for dune copy rule --- CHANGES.md | 4 ++-- deps.ml | 9 ------- dune_items.ml | 17 ++++++++++++++ dune_rules.ml | 43 +++++++++++++++++++++------------- main.ml | 19 ++++++++++----- tests/test_dune_copy_install.t | 9 +++++-- types.ml | 10 ++++++++ 7 files changed, 76 insertions(+), 35 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 18830d4..2ad7ce0 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,7 +1,7 @@ ### Unreleased -- Add support for dune 3.0 (@moyodiallo #46), the command `dune external-lib-deps` was remove from - dune +- Add support for dune 3.0 , the command `dune external-lib-deps` was remove from + dune. Now, opam-dune-lint works without building anything (@moyodiallo #46). ### v0.2 diff --git a/deps.ml b/deps.ml index cb19824..af1d24b 100644 --- a/deps.ml +++ b/deps.ml @@ -7,15 +7,6 @@ let dune_describe_external_lib_deps = Bos.Cmd.(v "dune" % "describe" % "external let dune_describe_entries = Bos.Cmd.(v "dune" % "describe" % "package-entries") -let sexp cmd = - Bos.OS.Cmd.run_out (cmd) - |> Bos.OS.Cmd.to_string - |> or_die - |> String.trim - |> (fun s -> - try Sexp.of_string s with - | Sexp.Parse_error _ as e -> Fmt.pr "Error parsing 'dune describe external-lib-deps' output:\n"; raise e) - let describe_external_lib_deps = sexp dune_describe_external_lib_deps |> Describe_external_lib.describe_extern_of_sexp diff --git a/dune_items.ml b/dune_items.ml index 74a3633..4ad905d 100644 --- a/dune_items.ml +++ b/dune_items.ml @@ -179,3 +179,20 @@ module Describe_entries = struct |> (function Bin item -> Some (item.bin_name,item) | Other _ -> None)) |> List.to_seq |> Item_map.of_seq end + +module Describe_opam_files = struct + + type t = (string * OpamFile.OPAM.t ) list + + let decode_items = function + | Sexp.List sexps -> + sexps + |> List.map (function + | Sexp.List [Atom opam_file; Atom opam_content] -> + (opam_file, OpamFile.OPAM.read_from_string opam_content) + | s -> Fmt.failwith "%s is not a good format decoding an item" (Sexp.to_string s)) + | s -> Fmt.failwith "%s is not a good format decoding items" (Sexp.to_string s) + + let opam_files_of_sexp = decode_items + +end diff --git a/dune_rules.ml b/dune_rules.ml index 59bb76d..3068cbd 100644 --- a/dune_rules.ml +++ b/dune_rules.ml @@ -12,6 +12,7 @@ module Copy_rules = struct target: string; from_name: string; to_name: string; + dep: string; package: string } @@ -19,6 +20,7 @@ module Copy_rules = struct target = ""; from_name = ""; to_name = ""; + dep = ""; package = "" } @@ -28,31 +30,40 @@ module Copy_rules = struct let is_action_copy sexp = sexp |> (function - | Sexp.List l -> l - | _ -> Fmt.failwith "This is not a Sexp.List") - |> (fun l -> if List.mem (Sexp.Atom "rule") l then Some l else None) - |> Option.map (fun l -> - List.exists (function - | Sexp.List [ Atom "action"; List [ Atom "copy"; _]] -> true - | _ -> false) l) - |> Option.is_some + | Sexp.List l -> if List.mem (Sexp.Atom "rule") l then l else [] + | _ -> []) + |> List.exists (function + | Sexp.List [ Atom "action"; List [ Atom "copy"; _; _]] -> true + | _ -> false) in let copy_rule_of_sexp sexp = match sexp with | Sexp.List sexps -> - List.fold_left (fun copy sexp -> - match sexp with - | Sexp.List [Atom "action"; List [ _; Atom f; Atom t]] -> {{copy with from_name = f } with to_name = t} - | Sexp.List [Atom "deps"; List [_; Atom s]] -> {copy with package = s} - | Sexp.List [Atom "target"; Atom s ] -> { copy with target = s } - | Sexp.Atom "rule" -> copy - | s -> Fmt.failwith "%s is not a good format decoding an item" (Sexp.to_string s) + List.fold_left (fun copy _sexp -> + match _sexp with + | Sexp.List [Atom "action"; List [ _; Atom f; Atom t]] -> + {{copy with from_name = f } with to_name = t} + | Sexp.List [Atom "deps"; List [Atom "package"; Atom s]]-> {copy with package = s} + | Sexp.List [Atom "deps"; List [Atom "package"; Atom p]; Atom d] + | Sexp.List [Atom "deps"; Atom d; List [Atom "package"; Atom p]] -> + {{copy with package = p} with dep = d} + | Sexp.List [Atom "deps"; Atom s] -> {copy with dep = s} + | Sexp.List [Atom "target"; Atom s] -> {copy with target = s} + | Sexp.Atom "rule" -> copy + | _ -> copy ) dump_copy sexps | s -> Fmt.failwith "%s is not a rule" (Sexp.to_string s) in sexps |> List.filter is_action_copy - |> List.map copy_rule_of_sexp + |> List.map (fun rule -> + rule + |> copy_rule_of_sexp + |> fun copy -> + if String.equal copy.to_name "%{target}" && String.equal copy.from_name "%{deps}" then + (*when we got `(action (copy %{deps} %{target}))` *) + {{copy with to_name = copy.target} with from_name = copy.dep} + else copy) let copy_rules_map = List.fold_left (fun map copy -> Item_map.add copy.from_name copy map) Item_map.empty diff --git a/main.ml b/main.ml index bea2ca7..2b82f6d 100644 --- a/main.ml +++ b/main.ml @@ -4,6 +4,8 @@ let or_die = function | Ok x -> x | Error (`Msg m) -> failwith m +let dune_describe_opam_files = Bos.Cmd.(v "dune" % "describe" % "opam-files") + let () = (* When run as a plugin, opam helpfully scrubs the environment. Get the settings back again. *) @@ -22,9 +24,6 @@ let () = ) | x -> Fmt.epr "WARNING: bad sexp from opam config env: %a@." Sexplib.Sexp.pp_hum x -let dune_build_install = - Bos.Cmd.(v "dune" % "build" %% (on (Unix.(isatty stderr)) (v "--display=progress")) % "@install") - let get_libraries ~pkg ~target = Dune_project.Deps.get_external_lib_deps ~pkg ~target |> Libraries.add "dune" Dir_set.empty (* We always need dune *) @@ -58,6 +57,15 @@ let get_opam_files () = Paths.add path opam acc ) Paths.empty +let updated_opam_files () = + sexp dune_describe_opam_files + |> Dune_items.Describe_opam_files.opam_files_of_sexp + |> List.fold_left (fun acc (path,opam) -> Paths.add path opam acc) Paths.empty + +let write_opam_files = + Paths.iter (fun path opam -> + OpamFile.OPAM.write (OpamFile.make (OpamFilename.raw path)) opam) + let check_identical _path a b = match a, b with | Some a, Some b -> @@ -138,8 +146,7 @@ let main force dir = Sys.chdir dir; let index = Index.create () in let old_opam_files = get_opam_files () in - Bos.OS.Cmd.run dune_build_install |> or_die; - let opam_files = get_opam_files () in + let opam_files = updated_opam_files () in if Paths.is_empty opam_files then failwith "No *.opam files found!"; let stale_files = Paths.merge check_identical old_opam_files opam_files in stale_files |> Paths.iter (fun path msg -> Fmt.pr "%s: %s after 'dune build @install'!@." path msg); @@ -159,7 +166,7 @@ let main force dir = project |> Dune_project.update report |> Dune_project.write_project_file; - Bos.OS.Cmd.run dune_build_install |> or_die; + updated_opam_files () |> write_opam_files; ) else ( Paths.iter update_opam_file report ) diff --git a/tests/test_dune_copy_install.t b/tests/test_dune_copy_install.t index de18695..edbcebd 100644 --- a/tests/test_dune_copy_install.t +++ b/tests/test_dune_copy_install.t @@ -26,9 +26,14 @@ Create a simple dune project and use "install" stanza: > (rule > (target main-copy.exe) > (deps - > (package zombie)) + > (package zombie) main.exe) > (action - > (copy main.exe main-copy.exe))) + > (copy main.exe main-copy.exe))) + > (rule + > (alias runtest) + > (deps + > (package zombie)) + > (action (progn))) > (install > (section bin) > (package test) diff --git a/types.ml b/types.ml index 62dc289..a499580 100644 --- a/types.ml +++ b/types.ml @@ -60,3 +60,13 @@ end let or_die = function | Ok x -> x | Error (`Msg m) -> failwith m + +let sexp cmd = + Bos.OS.Cmd.run_out (cmd) + |> Bos.OS.Cmd.to_string + |> or_die + |> String.trim + |> (fun s -> + try Sexp.of_string s with + | Sexp.Parse_error _ as e -> + Fmt.pr "Error parsing '%s' output:\n" (Bos.Cmd.to_string cmd); raise e) From bcb5b46c0c4bcbb29ef81ecb13de1a3dd757c91e Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Thu, 20 Apr 2023 12:08:28 +0200 Subject: [PATCH 16/30] Add tests for "dune describe" command --- tests/test_dune_describe.t | 150 +++++++++++++++++++++++++++++++++++++ 1 file changed, 150 insertions(+) create mode 100644 tests/test_dune_describe.t diff --git a/tests/test_dune_describe.t b/tests/test_dune_describe.t new file mode 100644 index 0000000..45a8fc1 --- /dev/null +++ b/tests/test_dune_describe.t @@ -0,0 +1,150 @@ +Create a simple dune project: + + $ cat > dune-project << EOF + > (lang dune 2.8) + > (generate_opam_files true) + > (package + > (name test) + > (synopsis "Test package") + > (depends + > (ocamlfind (>= 1.0)) + > libfoo)) + > EOF + + $ cat > dune << EOF + > (executable + > (name main) + > (public_name main) + > (modules main) + > (libraries findlib fmt)) + > (library + > (name lib) + > (package test) + > (modules lib) + > (libraries bos)) + > (test + > (package test) + > (name test) + > (modules test) + > (libraries bos opam-state)) + > EOF + + $ touch main.ml test.ml lib.ml + $ dune build + $ dune describe external-lib-deps + (default + ((executables + ((names (main)) + (extensions (.exe)) + (package (test)) + (source_dir .) + (external_deps + ((findlib required) + (fmt required))) + (internal_deps ()))) + (library + ((names (lib)) + (extensions ()) + (package (test)) + (source_dir .) + (external_deps ((bos required))) + (internal_deps ()))) + (tests + ((names (test)) + (extensions + (.bc .exe)) + (package ()) + (source_dir .) + (external_deps + ((bos required) + (opam-state required))) + (internal_deps ()))))) + $ dune describe package-entries + ((test + (((source dune) + (entry + ((src + (In_build_dir default/META.test)) + (kind file) + (dst META) + (section LIB)))) + ((source user) + (entry + ((src + (In_build_dir default/.lib.objs/byte/lib.cmi)) + (kind file) + (dst __private__/lib/.public_cmi/lib.cmi) + (section LIB)))) + ((source user) + (entry + ((src + (In_build_dir default/.lib.objs/byte/lib.cmt)) + (kind file) + (dst __private__/lib/.public_cmi/lib.cmt) + (section LIB)))) + ((source user) + (entry + ((src + (In_build_dir default/lib.a)) + (kind file) + (dst __private__/lib/lib.a) + (section LIB)))) + ((source user) + (entry + ((src + (In_build_dir default/lib.cma)) + (kind file) + (dst __private__/lib/lib.cma) + (section LIB)))) + ((source user) + (entry + ((src + (In_build_dir default/.lib.objs/native/lib.cmx)) + (kind file) + (dst __private__/lib/lib.cmx) + (section LIB)))) + ((source user) + (entry + ((src + (In_build_dir default/lib.cmxa)) + (kind file) + (dst __private__/lib/lib.cmxa) + (section LIB)))) + ((source user) + (entry + ((src + (In_build_dir default/lib.ml)) + (kind file) + (dst __private__/lib/lib.ml) + (section LIB)))) + ((source dune) + (entry + ((src + (In_build_dir default/test.dune-package)) + (kind file) + (dst dune-package) + (section LIB)))) + ((source dune) + (entry + ((src + (In_build_dir default/test.opam)) + (kind file) + (dst opam) + (section LIB)))) + ((source user) + (entry + ((src + (In_build_dir default/lib.cmxs)) + (kind file) + (dst __private__/lib/lib.cmxs) + (section LIBEXEC)))) + ((source user) + (entry + ((src + (In_build_dir default/main.exe)) + (kind file) + (dst main) + (section BIN))))))) + $ dune describe opam-files + ((test.opam + "# This file is generated by dune, edit dune-project instead\nopam-version: \"2.0\"\nsynopsis: \"Test package\"\ndepends: [\n \"dune\" {>= \"2.8\"}\n \"ocamlfind\" {>= \"1.0\"}\n \"libfoo\"\n \"odoc\" {with-doc}\n]\nbuild: [\n [\"dune\" \"subst\"] {dev}\n [\n \"dune\"\n \"build\"\n \"-p\"\n name\n \"-j\"\n jobs\n \"@install\"\n \"@runtest\" {with-test}\n \"@doc\" {with-doc}\n ]\n]\n")) From 059ce20f185cbaee58849b530c52626a51cd9153 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Thu, 20 Apr 2023 16:14:21 +0200 Subject: [PATCH 17/30] Refactor the code --- deps.ml | 116 +++++++++++++++++++------------------ dune-project | 2 +- dune_project.ml | 6 +- opam-dune-lint.opam | 2 +- tests/test_dune_describe.t | 2 +- tests/test_vendoring.t | 2 +- 6 files changed, 66 insertions(+), 64 deletions(-) diff --git a/deps.ml b/deps.ml index af1d24b..e628bc2 100644 --- a/deps.ml +++ b/deps.ml @@ -3,16 +3,16 @@ open Dune_items type t = Dir_set.t Libraries.t -let dune_describe_external_lib_deps = Bos.Cmd.(v "dune" % "describe" % "external-lib-deps") +let dune_describe_external_lib_deps () = Bos.Cmd.(v "dune" % "describe" % "external-lib-deps") -let dune_describe_entries = Bos.Cmd.(v "dune" % "describe" % "package-entries") +let dune_describe_entries () = Bos.Cmd.(v "dune" % "describe" % "package-entries") -let describe_external_lib_deps = - sexp dune_describe_external_lib_deps +let describe_external_lib_deps () = + sexp @@ dune_describe_external_lib_deps () |> Describe_external_lib.describe_extern_of_sexp -let describe_entries = - sexp dune_describe_entries +let describe_entries () = + sexp @@ dune_describe_entries () |> Describe_entries.entries_of_sexp let has_dune_subproject = function @@ -36,16 +36,17 @@ let rec should_use_dir ~dir_types path = r let copy_rules = - describe_external_lib_deps + describe_external_lib_deps () |> List.concat_map (fun d_item -> d_item |> Describe_external_lib.get_item - |> (fun (item:Describe_external_lib.item) -> item.source_dir ^ "/dune") + |> (fun (item:Describe_external_lib.item) -> String.cat item.source_dir "/dune") |> (Dune_rules.Copy_rules.get_copy_rules)) |> Dune_rules.Copy_rules.copy_rules_map -let bin_of_entries = Describe_entries.items_bin_of_entries describe_entries +let bin_of_entries = + Describe_entries.items_bin_of_entries @@ describe_entries () let find_exe_item_package (item:Describe_external_lib.item) = match item.package with @@ -54,51 +55,54 @@ let find_exe_item_package (item:Describe_external_lib.item) = (* Only allow for private executables to find the package *) item.extensions |> List.find_map (fun extension -> - let bin_name = Dune_rules.Copy_rules.find_dest_name ~name:(item.name ^ extension) copy_rules in + let bin_name = Dune_rules.Copy_rules.find_dest_name ~name:(String.cat item.name extension) copy_rules in Option.map (fun (item:Describe_entries.item) -> item.package) (Item_map.find_opt bin_name bin_of_entries)) -let get_dune_items dir_types ~pkg ~target = - let resolve_internal_deps d_items items_pkg = - (* After the d_items are filtered to the corresponding package request, - * we need to include the internal_deps in order to reach all the deps. - * If the internal dep is a public library we skip the recursive resolve - * because it will be resolve with separate request*) - let open Describe_external_lib in - let get_name = function - | Lib item -> item.name ^ ".lib" - | Exe item -> item.name ^ ".exe" - | Test item -> item.name ^ ".test" - in - let d_items_lib = - d_items - |> List.filter is_lib_item - |> List.map (fun d_item -> +let resolve_internal_deps d_items items_pkg = + (* After the d_items are filtered to the corresponding package request, + * we need to include the internal_deps in order to reach all the deps. + * If the internal dep is a public library we skip the recursive resolve + * because it will be resolve with separate request*) + let open Describe_external_lib in + let get_name = function + | Lib item -> String.cat item.name ".lib" + | Exe item -> String.cat item.name ".exe" + | Test item -> String.cat item.name ".test" + in + let d_items_lib = + d_items + |> List.filter_map (fun d_item -> + match is_lib_item d_item with + | true -> d_item |> get_item |> (fun (item:Describe_external_lib.item) -> - (item.name ^ ".lib", Lib item))) - |> List.to_seq |> Hashtbl.of_seq - in - let rec add_internal acc = function - | [] -> Hashtbl.to_seq_values acc |> List.of_seq - | item::tl -> - if Hashtbl.mem acc (get_name item) then - add_internal acc tl - else begin - Hashtbl.add acc (get_name item) item; - (get_item item).internal_deps - |> List.filter (fun (_, k) -> Kind.is_required k) - |> List.filter_map (fun (name, _) -> - match Hashtbl.find_opt d_items_lib (name ^ ".lib") with - | None -> None - | Some d_item_lib -> - if Option.is_some (get_item d_item_lib).package then None else Some d_item_lib) - |> fun internals -> add_internal acc (tl @ internals) - end - in - add_internal (Hashtbl.create 10) items_pkg + (String.cat item.name ".lib", Lib item)) + |> Option.some + | false -> None) + |> List.to_seq |> Hashtbl.of_seq + in + let rec add_internal acc = function + | [] -> Hashtbl.to_seq_values acc |> List.of_seq + | item::tl -> + if Hashtbl.mem acc (get_name item) then + add_internal acc tl + else begin + Hashtbl.add acc (get_name item) item; + (get_item item).internal_deps + |> List.filter_map (fun (name, k) -> + match Hashtbl.find_opt d_items_lib (String.cat name ".lib") with + | None -> None + | Some d_item_lib -> + if Kind.is_required k && Option.is_some (get_item d_item_lib).package then None + else Some d_item_lib) + |> fun internals -> add_internal acc (tl @ internals) + end in - describe_external_lib_deps + add_internal (Hashtbl.create 10) items_pkg + +let get_dune_items dir_types ~pkg ~target = + describe_external_lib_deps () |> List.map (fun d_item -> let item = Describe_external_lib.get_item d_item in if Describe_external_lib.is_exe_item d_item && Option.is_none item.package @@ -129,13 +133,13 @@ let get_dune_items dir_types ~pkg ~target = let lib_deps ~pkg ~target = get_dune_items (Hashtbl.create 10) ~pkg ~target |> List.map Describe_external_lib.get_item - |> List.fold_left (fun acc (item:Describe_external_lib.item) -> - List.map (fun dep -> (fst dep, item.source_dir)) item.external_deps @ acc) [] - |> List.fold_left (fun acc (lib,path) -> - if Astring.String.take ~sat:((<>) '.') lib <> pkg then - let dirs = Libraries.find_opt lib acc |> Option.value ~default:Dir_set.empty in - Libraries.add lib (Dir_set.add path dirs) acc - else - acc) Libraries.empty + |> List.fold_left (fun libs (item:Describe_external_lib.item) -> + List.map (fun dep -> fst dep, item.source_dir) item.external_deps + |> List.fold_left (fun acc (lib,path) -> + if Astring.String.take ~sat:((<>) '.') lib <> pkg then + let dirs = Libraries.find_opt lib acc |> Option.value ~default:Dir_set.empty in + Libraries.add lib (Dir_set.add path dirs) acc + else + acc) libs) Libraries.empty let get_external_lib_deps ~pkg ~target : t = lib_deps ~pkg ~target diff --git a/dune-project b/dune-project index a259d61..eb4861a 100644 --- a/dune-project +++ b/dune-project @@ -17,7 +17,7 @@ (sexplib (>= v0.14.0)) (cmdliner (>= 1.1.0)) (stdune (>= 3.0)) - (ocaml (>= 4.10.0)) + (ocaml (>= 4.13.0)) (bos (>= 0.2.0)) (fmt (>= 0.8.9)) (opam-state (>= 2.0.9)) diff --git a/dune_project.ml b/dune_project.ml index e81a76c..b58fdfd 100644 --- a/dune_project.ml +++ b/dune_project.ml @@ -1,8 +1,6 @@ open Types -module Deps = struct - include Deps -end +module Deps = Deps type t = Sexp.t list @@ -96,7 +94,7 @@ let update (changes:(_ * Change.t list) Paths.t) (t:t) = match package_name items with | None -> failwith "Missing 'name' in (package)!" | Some name -> - match Paths.find_opt (name ^ ".opam") changes with + match Paths.find_opt (String.cat name ".opam") changes with | None -> items | Some (_opam, changes) -> update_or_create "depends" (apply_changes ~changes) items in diff --git a/opam-dune-lint.opam b/opam-dune-lint.opam index 0981c05..af4c219 100644 --- a/opam-dune-lint.opam +++ b/opam-dune-lint.opam @@ -14,7 +14,7 @@ depends: [ "sexplib" {>= "v0.14.0"} "cmdliner" {>= "1.1.0"} "stdune" {>= "3.0"} - "ocaml" {>= "4.10.0"} + "ocaml" {>= "4.13.0"} "bos" {>= "0.2.0"} "fmt" {>= "0.8.9"} "opam-state" {>= "2.0.9"} diff --git a/tests/test_dune_describe.t b/tests/test_dune_describe.t index 45a8fc1..4de9dab 100644 --- a/tests/test_dune_describe.t +++ b/tests/test_dune_describe.t @@ -53,7 +53,7 @@ Create a simple dune project: ((names (test)) (extensions (.bc .exe)) - (package ()) + (package (test)) (source_dir .) (external_deps ((bos required) diff --git a/tests/test_vendoring.t b/tests/test_vendoring.t index 6c1e144..ac3dbd2 100644 --- a/tests/test_vendoring.t +++ b/tests/test_vendoring.t @@ -54,7 +54,7 @@ Replace all version numbers with "1.0" to get predictable outut. Check configuration: $ dune external-lib-deps -p main @install - dune: This subcommand is no longer implemented. + dune: This subcommand has been moved to dune describe external-lib-deps. [1] Check that the missing findlib for "lib" is detected, but not "vendored"'s dependency From 023e508922650e68f0d08df9ba2e20b874755b14 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Wed, 7 Jun 2023 09:41:56 +0200 Subject: [PATCH 18/30] Make the top level expressions lazy and that also increase performance --- deps.ml | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/deps.ml b/deps.ml index e628bc2..c39aed1 100644 --- a/deps.ml +++ b/deps.ml @@ -7,13 +7,15 @@ let dune_describe_external_lib_deps () = Bos.Cmd.(v "dune" % "describe" % "exter let dune_describe_entries () = Bos.Cmd.(v "dune" % "describe" % "package-entries") -let describe_external_lib_deps () = - sexp @@ dune_describe_external_lib_deps () - |> Describe_external_lib.describe_extern_of_sexp +let describe_external_lib_deps = + Lazy.from_fun (fun _ -> + sexp @@ dune_describe_external_lib_deps () + |> Describe_external_lib.describe_extern_of_sexp) -let describe_entries () = - sexp @@ dune_describe_entries () - |> Describe_entries.entries_of_sexp +let describe_entries = + Lazy.from_fun (fun _ -> + sexp @@ dune_describe_entries () + |> Describe_entries.entries_of_sexp) let has_dune_subproject = function | "." | "" -> false @@ -35,8 +37,8 @@ let rec should_use_dir ~dir_types path = Hashtbl.add dir_types path r; r -let copy_rules = - describe_external_lib_deps () +let copy_rules () = + Lazy.force describe_external_lib_deps |> List.concat_map (fun d_item -> d_item @@ -45,8 +47,8 @@ let copy_rules = |> (Dune_rules.Copy_rules.get_copy_rules)) |> Dune_rules.Copy_rules.copy_rules_map -let bin_of_entries = - Describe_entries.items_bin_of_entries @@ describe_entries () +let bin_of_entries () = + Describe_entries.items_bin_of_entries @@ Lazy.force describe_entries let find_exe_item_package (item:Describe_external_lib.item) = match item.package with @@ -55,8 +57,12 @@ let find_exe_item_package (item:Describe_external_lib.item) = (* Only allow for private executables to find the package *) item.extensions |> List.find_map (fun extension -> - let bin_name = Dune_rules.Copy_rules.find_dest_name ~name:(String.cat item.name extension) copy_rules in - Option.map (fun (item:Describe_entries.item) -> item.package) (Item_map.find_opt bin_name bin_of_entries)) + let bin_name = + Dune_rules.Copy_rules.find_dest_name ~name:(String.cat item.name extension) @@ copy_rules () + in + Option.map + (fun (item:Describe_entries.item) -> item.package) + (Item_map.find_opt bin_name @@ bin_of_entries ())) let resolve_internal_deps d_items items_pkg = (* After the d_items are filtered to the corresponding package request, @@ -102,7 +108,7 @@ let resolve_internal_deps d_items items_pkg = add_internal (Hashtbl.create 10) items_pkg let get_dune_items dir_types ~pkg ~target = - describe_external_lib_deps () + Lazy.force describe_external_lib_deps |> List.map (fun d_item -> let item = Describe_external_lib.get_item d_item in if Describe_external_lib.is_exe_item d_item && Option.is_none item.package From 7140d99a0f121a6d75833fe7ef8c6bed9aa00802 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Thu, 8 Jun 2023 15:15:22 +0200 Subject: [PATCH 19/30] Add copy rules when 'dune' file exist --- dune_rules.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/dune_rules.ml b/dune_rules.ml index 3068cbd..3df1499 100644 --- a/dune_rules.ml +++ b/dune_rules.ml @@ -70,9 +70,10 @@ module Copy_rules = struct let get_copy_rules file = match Hashtbl.find_opt rules file with - | None -> + | None when Sys.file_exists file -> let copy_rules = copy_rules_of_sexp (sexp_of_file file) in Hashtbl.add rules file copy_rules; copy_rules + | None -> Hashtbl.add rules file []; [] | Some copy_rules -> copy_rules let rec find_dest_name ~name rules = From 2cb9578554fefde2d6775c01e59c528dde306523 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Thu, 8 Jun 2023 16:19:07 +0200 Subject: [PATCH 20/30] Add a correction about unresolved entries The entries are from the command "dune describe package-entries". --- deps.ml | 58 ++++++++++++++++++++++++------- dune_rules.ml | 11 ++++-- main.ml | 6 ++-- tests/test_dune_same_exe_name.t | 61 +++++++++++++++++++++++++++++++++ 4 files changed, 119 insertions(+), 17 deletions(-) create mode 100644 tests/test_dune_same_exe_name.t diff --git a/deps.ml b/deps.ml index c39aed1..a53ad97 100644 --- a/deps.ml +++ b/deps.ml @@ -12,10 +12,11 @@ let describe_external_lib_deps = sexp @@ dune_describe_external_lib_deps () |> Describe_external_lib.describe_extern_of_sexp) -let describe_entries = +let describe_bin_of_entries = Lazy.from_fun (fun _ -> sexp @@ dune_describe_entries () - |> Describe_entries.entries_of_sexp) + |> Describe_entries.entries_of_sexp + |> Describe_entries.items_bin_of_entries) let has_dune_subproject = function | "." | "" -> false @@ -47,22 +48,26 @@ let copy_rules () = |> (Dune_rules.Copy_rules.get_copy_rules)) |> Dune_rules.Copy_rules.copy_rules_map -let bin_of_entries () = - Describe_entries.items_bin_of_entries @@ Lazy.force describe_entries +let bin_of_entries () = Lazy.force describe_bin_of_entries -let find_exe_item_package (item:Describe_external_lib.item) = +let is_bin_name_of_describe_lib bin_name (item:Describe_external_lib.item) = + item.extensions + |> List.exists (fun extension -> + String.equal bin_name (String.cat item.name extension)) + +let find_package_of_exe (item:Describe_external_lib.item) = match item.package with | Some p -> Some p | None -> (* Only allow for private executables to find the package *) item.extensions |> List.find_map (fun extension -> - let bin_name = - Dune_rules.Copy_rules.find_dest_name ~name:(String.cat item.name extension) @@ copy_rules () - in Option.map - (fun (item:Describe_entries.item) -> item.package) - (Item_map.find_opt bin_name @@ bin_of_entries ())) + (fun bin_name -> + Option.map + (fun (item:Describe_entries.item) -> item.package) (Item_map.find_opt bin_name @@ bin_of_entries ())) + (Dune_rules.Copy_rules.find_dest_name ~name:(String.cat item.name extension) @@ copy_rules ())) + |> Option.join let resolve_internal_deps d_items items_pkg = (* After the d_items are filtered to the corresponding package request, @@ -113,10 +118,38 @@ let get_dune_items dir_types ~pkg ~target = let item = Describe_external_lib.get_item d_item in if Describe_external_lib.is_exe_item d_item && Option.is_none item.package then - match find_exe_item_package item with + match find_package_of_exe item with | None -> d_item | Some pkg -> Describe_external_lib.Exe { item with package = Some pkg } else d_item) + |> (fun d_items -> + let exe_items = + d_items |> List.filter_map (function + | Describe_external_lib.Exe item -> Some item + | _ -> None) + in + let unresolved_entries = + bin_of_entries () + |> Item_map.partition (fun _ (entry:Describe_entries.item) -> + exe_items + |> List.exists + (fun (item:Describe_external_lib.item) -> + is_bin_name_of_describe_lib entry.bin_name item + && Option.equal String.equal (Some entry.package) item.package)) + |> snd + in d_items, unresolved_entries) + |> (fun (d_items, unresolved_entries) -> + d_items + |> List.map (fun d_item -> + match d_item with + | Describe_external_lib.Exe item -> + item.extensions + |> List.find_map (fun extension -> + Item_map.find_opt (String.cat item.name extension) unresolved_entries) + |> (function + | None -> d_item + | Some entry -> Describe_external_lib.Exe { item with package = Some entry.package }) + | d_item -> d_item)) |> List.filter (fun item -> match (item,target) with | Describe_external_lib.Test _, `Install -> false @@ -140,7 +173,8 @@ let lib_deps ~pkg ~target = get_dune_items (Hashtbl.create 10) ~pkg ~target |> List.map Describe_external_lib.get_item |> List.fold_left (fun libs (item:Describe_external_lib.item) -> - List.map (fun dep -> fst dep, item.source_dir) item.external_deps + List.map (fun dep -> + (fst dep, item.source_dir)) item.external_deps |> List.fold_left (fun acc (lib,path) -> if Astring.String.take ~sat:((<>) '.') lib <> pkg then let dirs = Libraries.find_opt lib acc |> Option.value ~default:Dir_set.empty in diff --git a/dune_rules.ml b/dune_rules.ml index 3df1499..31a7535 100644 --- a/dune_rules.ml +++ b/dune_rules.ml @@ -76,8 +76,13 @@ module Copy_rules = struct | None -> Hashtbl.add rules file []; [] | Some copy_rules -> copy_rules - let rec find_dest_name ~name rules = + let find_dest_name ~name rules = + let rec find_dest_name name rules = + match Item_map.find_opt name rules with + | None -> Some name + | Some t -> find_dest_name t.to_name rules + in match Item_map.find_opt name rules with - | None -> name - | Some t -> find_dest_name ~name:t.to_name rules + | None -> None (* Not found in the first step *) + | Some t -> find_dest_name t.to_name rules end diff --git a/main.ml b/main.ml index 2b82f6d..0dd4b32 100644 --- a/main.ml +++ b/main.ml @@ -26,7 +26,9 @@ let () = let get_libraries ~pkg ~target = Dune_project.Deps.get_external_lib_deps ~pkg ~target - |> Libraries.add "dune" Dir_set.empty (* We always need dune *) + |> fun libs -> + if String.equal pkg "dune" then libs + else Libraries.add "dune" Dir_set.empty libs (* We always need dune *) let to_opam ~index lib = match Astring.String.take ~sat:((<>) '.') lib with @@ -149,7 +151,7 @@ let main force dir = let opam_files = updated_opam_files () in if Paths.is_empty opam_files then failwith "No *.opam files found!"; let stale_files = Paths.merge check_identical old_opam_files opam_files in - stale_files |> Paths.iter (fun path msg -> Fmt.pr "%s: %s after 'dune build @install'!@." path msg); + stale_files |> Paths.iter (fun path msg -> Fmt.pr "%s: %s after its upgrade from 'dune describe opam-files'!@." path msg); opam_files |> Paths.mapi (fun path opam -> (opam, generate_report ~index ~opam (Filename.chop_suffix path ".opam")) ) diff --git a/tests/test_dune_same_exe_name.t b/tests/test_dune_same_exe_name.t new file mode 100644 index 0000000..c25c319 --- /dev/null +++ b/tests/test_dune_same_exe_name.t @@ -0,0 +1,61 @@ +This is a test inspired when testing opam-dune-lint against +dune project "https://github.com/ocaml/dune/". There is 2 executables +with the same name in different directory. The public executable was also +taking the deps from the private library. + + $ mkdir bin bench + $ cat > dune-project << EOF + > (lang dune 2.7) + > (generate_opam_files true) + > (package + > (name test) + > (synopsis "Test package") + > (depends + > (ocamlfind (>= 1.0)) + > libfoo)) + > EOF + + $ cat > bench/dune << EOF + > (executable + > (name main) + > (modules main) + > (libraries sexplib cmdliner)) + > EOF + + $ cat > bin/dune << EOF + > (executable + > (name main) + > (public_name main) + > (modules main) + > (libraries findlib fmt)) + > (test + > (name test) + > (modules test) + > (libraries bos opam-state)) + > EOF + + $ touch bin/main.ml bin/test.ml bench/main.ml + $ dune build + + $ export OPAM_DUNE_LINT_TESTS=y + +Check that the missing libraries are detected: + + $ opam-dune-lint = "1.0"} [from bin] + "bos" {with-test & >= "1.0"} [from bin] + "opam-state" {with-test & >= "1.0"} [from bin] + Note: version numbers are just suggestions based on the currently installed version. + Run with -f to apply changes in non-interactive mode. + [1] + +Check that the missing libraries get added: + + $ opam-dune-lint -f + test.opam: changes needed: + "fmt" {>= "1.0"} [from bin] + "bos" {with-test & >= "1.0"} [from bin] + "opam-state" {with-test & >= "1.0"} [from bin] + Note: version numbers are just suggestions based on the currently installed version. + Wrote "dune-project" From ee1c7eae4b19b3f75b19245d758f321b1e673049 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Thu, 8 Jun 2023 17:35:36 +0200 Subject: [PATCH 21/30] The description is no longer valid --- README.md | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/README.md b/README.md index 5931d14..38f451e 100644 --- a/README.md +++ b/README.md @@ -26,18 +26,6 @@ Write changes? [y] y Wrote "dune-project" ``` -It works as follows: - -1. Lists the `*.opam` files in your project's root (ensuring they're up-to-date, if generated). -2. Runs `dune external-lib-deps --only-packages $PKG --unstable-by-dir @install` and `... @runtest` to get each package's ocamlfind dependencies. -3. Filters out local dependencies using `dune describe` (for now; would be good to lint these too in future, but needs a different code path). -4. Filters out vendored dependencies (by ignoring dependencies from subdirectories with their own `dune-project` file). -5. For each ocamlfind library, it finds the corresponding opam library by - finding its directory and then finding the `*.changes` file saying which - opam package added its `META` file. -6. Checks that each required opam package is listed in the opam file. -7. For any missing packages, it offers to add a suitable dependency, using the installed package's version as the default lower-bound. - `opam-dune-lint` can be run manually to update your project, or as part of CI to check for missing dependencies. It exits with a non-zero status if changes are needed, or if the opam files were not up-to-date with the `dune-project` file. When run interactively, it asks for confirmation before writing files. From 37b64c139699d5a963b992d9e765f3182ef9faea Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Fri, 7 Jul 2023 10:23:03 +0200 Subject: [PATCH 22/30] Upgrade to match the dune commands that used --- CHANGES.md | 2 +- dune_items.ml | 9 ++- tests/test_dune_describe.t | 150 +++++++++++++++++++++++++++++++------ 3 files changed, 133 insertions(+), 28 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 2ad7ce0..8d8bcd2 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,7 +1,7 @@ ### Unreleased - Add support for dune 3.0 , the command `dune external-lib-deps` was remove from - dune. Now, opam-dune-lint works without building anything (@moyodiallo #46). + dune. Now, `opam-dune-lint` command works without `dune build`. (@moyodiallo #46). ### v0.2 diff --git a/dune_items.ml b/dune_items.ml index 4ad905d..915c27c 100644 --- a/dune_items.ml +++ b/dune_items.ml @@ -108,6 +108,7 @@ module Describe_entries = struct kind: string; dst: string; section: string; + optional: string; package: string } @@ -117,6 +118,7 @@ module Describe_entries = struct kind = ""; dst = ""; section = ""; + optional = ""; package = "" } @@ -148,15 +150,16 @@ module Describe_entries = struct | Sexp.List [Atom "kind"; Atom p ] -> {item with kind = p} | Sexp.List [Atom "dst"; Atom p ] -> {item with dst = p} | Sexp.List [Atom "section"; Atom p ] -> {item with section = p} + | Sexp.List [Atom "optional"; Atom p ] -> {item with optional = p} | s -> Fmt.failwith "%s is not a good format decoding an item" (Sexp.to_string s) ) dump_item sexps |> (fun item -> match item.section with "BIN" -> Bin item | _ -> Other item) let decode_items : Sexp.t list -> entry list = List.filter_map (function - | Sexp.List [List [Atom "source"; Atom "user"]; List [Atom "entry"; List sexps]] -> Some (decode_item sexps) - | Sexp.List [List [Atom "entry"; List sexps]; List [Atom "source"; Atom "user"]] -> Some (decode_item sexps) - | Sexp.List [List [Atom "source"; Atom "dune"]; List _ ] -> None + | Sexp.List [List [Atom "source"; List [Atom "User" ; _ ]]; List [Atom "entry"; List sexps]] -> Some (decode_item sexps) + | Sexp.List [List [Atom "entry"; List sexps]; List [Atom "source"; Atom "User"]] -> Some (decode_item sexps) + | Sexp.List [List [Atom "source"; Atom "Dune"]; List _ ] -> None | s -> Fmt.failwith "%s is not a good format decoding items" (Sexp.to_string s)) let decode_entries : Sexp.t -> t = function diff --git a/tests/test_dune_describe.t b/tests/test_dune_describe.t index 4de9dab..7593cfd 100644 --- a/tests/test_dune_describe.t +++ b/tests/test_dune_describe.t @@ -61,90 +61,192 @@ Create a simple dune project: (internal_deps ()))))) $ dune describe package-entries ((test - (((source dune) + (((source Dune) (entry ((src (In_build_dir default/META.test)) (kind file) (dst META) - (section LIB)))) - ((source user) + (section LIB) + (optional false)))) + ((source + (User + ((pos_fname dune) + (start + ((pos_lnum 6) + (pos_bol 87) + (pos_cnum 87))) + (stop + ((pos_lnum 10) + (pos_bol 139) + (pos_cnum 156)))))) (entry ((src (In_build_dir default/.lib.objs/byte/lib.cmi)) (kind file) (dst __private__/lib/.public_cmi/lib.cmi) - (section LIB)))) - ((source user) + (section LIB) + (optional false)))) + ((source + (User + ((pos_fname dune) + (start + ((pos_lnum 6) + (pos_bol 87) + (pos_cnum 87))) + (stop + ((pos_lnum 10) + (pos_bol 139) + (pos_cnum 156)))))) (entry ((src (In_build_dir default/.lib.objs/byte/lib.cmt)) (kind file) (dst __private__/lib/.public_cmi/lib.cmt) - (section LIB)))) - ((source user) + (section LIB) + (optional false)))) + ((source + (User + ((pos_fname dune) + (start + ((pos_lnum 6) + (pos_bol 87) + (pos_cnum 87))) + (stop + ((pos_lnum 10) + (pos_bol 139) + (pos_cnum 156)))))) (entry ((src (In_build_dir default/lib.a)) (kind file) (dst __private__/lib/lib.a) - (section LIB)))) - ((source user) + (section LIB) + (optional false)))) + ((source + (User + ((pos_fname dune) + (start + ((pos_lnum 6) + (pos_bol 87) + (pos_cnum 87))) + (stop + ((pos_lnum 10) + (pos_bol 139) + (pos_cnum 156)))))) (entry ((src (In_build_dir default/lib.cma)) (kind file) (dst __private__/lib/lib.cma) - (section LIB)))) - ((source user) + (section LIB) + (optional false)))) + ((source + (User + ((pos_fname dune) + (start + ((pos_lnum 6) + (pos_bol 87) + (pos_cnum 87))) + (stop + ((pos_lnum 10) + (pos_bol 139) + (pos_cnum 156)))))) (entry ((src (In_build_dir default/.lib.objs/native/lib.cmx)) (kind file) (dst __private__/lib/lib.cmx) - (section LIB)))) - ((source user) + (section LIB) + (optional false)))) + ((source + (User + ((pos_fname dune) + (start + ((pos_lnum 6) + (pos_bol 87) + (pos_cnum 87))) + (stop + ((pos_lnum 10) + (pos_bol 139) + (pos_cnum 156)))))) (entry ((src (In_build_dir default/lib.cmxa)) (kind file) (dst __private__/lib/lib.cmxa) - (section LIB)))) - ((source user) + (section LIB) + (optional false)))) + ((source + (User + ((pos_fname dune) + (start + ((pos_lnum 6) + (pos_bol 87) + (pos_cnum 87))) + (stop + ((pos_lnum 10) + (pos_bol 139) + (pos_cnum 156)))))) (entry ((src (In_build_dir default/lib.ml)) (kind file) (dst __private__/lib/lib.ml) - (section LIB)))) - ((source dune) + (section LIB) + (optional false)))) + ((source Dune) (entry ((src (In_build_dir default/test.dune-package)) (kind file) (dst dune-package) - (section LIB)))) - ((source dune) + (section LIB) + (optional false)))) + ((source Dune) (entry ((src (In_build_dir default/test.opam)) (kind file) (dst opam) - (section LIB)))) - ((source user) + (section LIB) + (optional false)))) + ((source + (User + ((pos_fname dune) + (start + ((pos_lnum 6) + (pos_bol 87) + (pos_cnum 87))) + (stop + ((pos_lnum 10) + (pos_bol 139) + (pos_cnum 156)))))) (entry ((src (In_build_dir default/lib.cmxs)) (kind file) (dst __private__/lib/lib.cmxs) - (section LIBEXEC)))) - ((source user) + (section LIBEXEC) + (optional false)))) + ((source + (User + ((pos_fname dune) + (start + ((pos_lnum 2) + (pos_bol 12) + (pos_cnum 19))) + (stop + ((pos_lnum 2) + (pos_bol 12) + (pos_cnum 23)))))) (entry ((src (In_build_dir default/main.exe)) (kind file) (dst main) - (section BIN))))))) + (section BIN) + (optional false))))))) $ dune describe opam-files ((test.opam "# This file is generated by dune, edit dune-project instead\nopam-version: \"2.0\"\nsynopsis: \"Test package\"\ndepends: [\n \"dune\" {>= \"2.8\"}\n \"ocamlfind\" {>= \"1.0\"}\n \"libfoo\"\n \"odoc\" {with-doc}\n]\nbuild: [\n [\"dune\" \"subst\"] {dev}\n [\n \"dune\"\n \"build\"\n \"-p\"\n name\n \"-j\"\n jobs\n \"@install\"\n \"@runtest\" {with-test}\n \"@doc\" {with-doc}\n ]\n]\n")) From f59878ceb42c7bed5b593e53f4fb073461bb7c18 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Thu, 3 Aug 2023 15:48:22 +0200 Subject: [PATCH 23/30] Update dependencies --- dune-project | 4 ++-- dune_rules.ml | 2 +- opam-dune-lint.opam | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/dune-project b/dune-project index eb4861a..4356547 100644 --- a/dune-project +++ b/dune-project @@ -1,4 +1,4 @@ -(lang dune 2.7) +(lang dune 3.10) (name opam-dune-lint) (formatting disabled) (generate_opam_files true) @@ -16,7 +16,7 @@ (astring (>= 0.8.5)) (sexplib (>= v0.14.0)) (cmdliner (>= 1.1.0)) - (stdune (>= 3.0)) + (stdune (>= 3.10.0)) (ocaml (>= 4.13.0)) (bos (>= 0.2.0)) (fmt (>= 0.8.9)) diff --git a/dune_rules.ml b/dune_rules.ml index 31a7535..eb2f75d 100644 --- a/dune_rules.ml +++ b/dune_rules.ml @@ -5,7 +5,7 @@ module Copy_rules = struct let sexp_of_file file = try Sexp.load_sexps file with | Sexp.Parse_error _ as e -> - (Fmt.pr "Error parsing 'dune describe external-lib-deps' output:\n"; raise e) + (Fmt.pr "Error parsing 'dune file' output:\n"; raise e) type t = { diff --git a/opam-dune-lint.opam b/opam-dune-lint.opam index af4c219..830e58e 100644 --- a/opam-dune-lint.opam +++ b/opam-dune-lint.opam @@ -9,11 +9,11 @@ license: "ISC" homepage: "https://github.com/ocurrent/opam-dune-lint" bug-reports: "https://github.com/ocurrent/opam-dune-lint/issues" depends: [ - "dune" {>= "2.7"} + "dune" {>= "3.10"} "astring" {>= "0.8.5"} "sexplib" {>= "v0.14.0"} "cmdliner" {>= "1.1.0"} - "stdune" {>= "3.0"} + "stdune" {>= "3.10.0"} "ocaml" {>= "4.13.0"} "bos" {>= "0.2.0"} "fmt" {>= "0.8.9"} From aa488d0b0b4dc668dc4202130de7f4d8305144c6 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Fri, 4 Aug 2023 17:10:38 +0200 Subject: [PATCH 24/30] Set the minimal version of OCaml to 4.08.0 --- dune-project | 2 +- opam-dune-lint.opam | 2 +- types.ml | 15 +++++++++++++++ 3 files changed, 17 insertions(+), 2 deletions(-) diff --git a/dune-project b/dune-project index 4356547..eb7bd5a 100644 --- a/dune-project +++ b/dune-project @@ -17,7 +17,7 @@ (sexplib (>= v0.14.0)) (cmdliner (>= 1.1.0)) (stdune (>= 3.10.0)) - (ocaml (>= 4.13.0)) + (ocaml (>= 4.08.0)) (bos (>= 0.2.0)) (fmt (>= 0.8.9)) (opam-state (>= 2.0.9)) diff --git a/opam-dune-lint.opam b/opam-dune-lint.opam index 830e58e..da30215 100644 --- a/opam-dune-lint.opam +++ b/opam-dune-lint.opam @@ -14,7 +14,7 @@ depends: [ "sexplib" {>= "v0.14.0"} "cmdliner" {>= "1.1.0"} "stdune" {>= "3.10.0"} - "ocaml" {>= "4.13.0"} + "ocaml" {>= "4.08.0"} "bos" {>= "0.2.0"} "fmt" {>= "0.8.9"} "opam-state" {>= "2.0.9"} diff --git a/types.ml b/types.ml index a499580..7921282 100644 --- a/types.ml +++ b/types.ml @@ -20,6 +20,21 @@ module Change = struct | `Add_test_dep of OpamPackage.t ] end +module List = struct + include List + let concat_map f l = List.map f l |> List.flatten + let find_map f l = + let rec find f = function + | [] -> None + | x::tl -> let v = f x in if Option.is_some v then v else find f tl + in find f l +end + +module String = struct + include String + let cat = (^) +end + module Change_with_hint = struct type t = Change.t * Dir_set.t From 1e81f813a1d233c0d3bd831a8eef6d5638d8be7c Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Sat, 5 Aug 2023 14:34:41 +0200 Subject: [PATCH 25/30] Refactoring the code --- README.md | 13 +++++++++++++ deps.ml | 4 ++-- dune_items.ml | 30 +++++++++++++++--------------- 3 files changed, 30 insertions(+), 17 deletions(-) diff --git a/README.md b/README.md index 38f451e..cb2ddf3 100644 --- a/README.md +++ b/README.md @@ -26,6 +26,19 @@ Write changes? [y] y Wrote "dune-project" ``` +It works as follows: + +1. Lists the `*.opam` files in your project's root (ensuring they're up-to-date, if generated). +2. Runs `dune describe external-lib-deps` to get all externals and internals ocamlfind libraries for all dune libraries, executables and tests. The information about the package is also known except for the private executables. +3. Runs `dune describe package-entries` to get all packages entries, this is for considering the external ocamlfind libraries of a private executable, because in dune it possible to install an private executable. +4. Resolve for each opam library its internal and external ocamlfind library dependencies using the information of 1. and 2. +5. Filters out vendored dependencies (by ignoring dependencies from subdirectories with their own `dune-project` file). +6. For each ocamlfind library, it finds the corresponding opam library by + finding its directory and then finding the `*.changes` file saying which + opam package added its `META` file. +7. Checks that each required opam package is listed in the opam file. +8. For any missing packages, it offers to add a suitable dependency, using the installed package's version as the default lower-bound. + `opam-dune-lint` can be run manually to update your project, or as part of CI to check for missing dependencies. It exits with a non-zero status if changes are needed, or if the opam files were not up-to-date with the `dune-project` file. When run interactively, it asks for confirmation before writing files. diff --git a/deps.ml b/deps.ml index a53ad97..4c61b21 100644 --- a/deps.ml +++ b/deps.ml @@ -73,7 +73,7 @@ let resolve_internal_deps d_items items_pkg = (* After the d_items are filtered to the corresponding package request, * we need to include the internal_deps in order to reach all the deps. * If the internal dep is a public library we skip the recursive resolve - * because it will be resolve with separate request*) + * because it will be resolve with separate request *) let open Describe_external_lib in let get_name = function | Lib item -> String.cat item.name ".lib" @@ -161,7 +161,7 @@ let get_dune_items dir_types ~pkg ~target = d_items |> List.filter (fun d_item -> let item = Describe_external_lib.get_item d_item in - (* if an item has not package, we assume it's used for testing*) + (* if an item has no package, we assume it's used for testing *) if target = `Install then Option.equal String.equal (Some pkg) item.package else diff --git a/dune_items.ml b/dune_items.ml index 915c27c..9812493 100644 --- a/dune_items.ml +++ b/dune_items.ml @@ -1,11 +1,10 @@ open Types -module Describe_external_lib = struct +module Describe_external_lib = struct module Kind = struct type t = Required | Optional - let merge x y = - match (x, y) with + let merge = function | Required,_ | _, Required -> Required | Optional,Optional -> Optional @@ -45,8 +44,7 @@ module Describe_external_lib = struct let is_lib_item = function | Lib _ -> true | _ -> false - let string_of_atom = - function + let string_of_atom = function | Sexp.Atom s -> s | s -> Fmt.failwith "%s is an atom" (Sexp.to_string s) @@ -126,8 +124,7 @@ module Describe_entries = struct type t = string * entry list - let string_of_atom = - function + let string_of_atom = function | Sexp.Atom s -> s | s -> Fmt.failwith "%s is an atom" (Sexp.to_string s) @@ -136,7 +133,7 @@ module Describe_entries = struct Astring.String.cut ~sep:"/" ~rev:true s |> Option.map snd |> Option.get - (* With "defautl/lib/bin.exe", it gives "default/lib" *) + (* With "default/lib/bin.exe", it gives "default/lib" *) let source_dir s = Astring.String.cut ~sep:"/" ~rev:true s |> Option.map fst |> Option.map (Astring.String.cut ~sep:"/" ~rev:false) |> Option.join |> Option.map snd @@ -168,11 +165,11 @@ module Describe_entries = struct let entries_of_sexp : Sexp.t -> t list = function | Sexp.List sexps -> - List.map decode_entries sexps - |> List.map (fun (package, entries) -> + sexps + |> List.map (fun x -> decode_entries x |> (fun (package, entries) -> (package, List.map (function | Bin item -> Bin {item with package = package} - | Other item -> Other {item with package = package}) entries)) + | Other item -> Other {item with package = package}) entries))) | _ -> Fmt.failwith "Invalid format" let items_bin_of_entries describe_entries = @@ -185,9 +182,14 @@ end module Describe_opam_files = struct - type t = (string * OpamFile.OPAM.t ) list + (** String representing an opam file name eg. foo.opam *) + type opam_file = string + + (** Representing the name and the content of an opam file *) + type t = (opam_file * OpamFile.OPAM.t ) list - let decode_items = function + (** Decode opam files from the command "dune describe opam-files" output. *) + let opam_files_of_sexp = function | Sexp.List sexps -> sexps |> List.map (function @@ -196,6 +198,4 @@ module Describe_opam_files = struct | s -> Fmt.failwith "%s is not a good format decoding an item" (Sexp.to_string s)) | s -> Fmt.failwith "%s is not a good format decoding items" (Sexp.to_string s) - let opam_files_of_sexp = decode_items - end From 895275ede05fcb644d59ca8668aa7043331c1b0d Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Wed, 30 Aug 2023 10:37:12 +0200 Subject: [PATCH 26/30] Fix the update of opam files --- dune_items.ml | 15 ++++++++----- dune_project.ml | 12 ++++++++++ dune_project.mli | 2 ++ main.ml | 58 ++++++++++++++++++++++++++++++++++++++---------- 4 files changed, 70 insertions(+), 17 deletions(-) diff --git a/dune_items.ml b/dune_items.ml index 9812493..daa99fc 100644 --- a/dune_items.ml +++ b/dune_items.ml @@ -183,19 +183,24 @@ end module Describe_opam_files = struct (** String representing an opam file name eg. foo.opam *) - type opam_file = string + type path = string - (** Representing the name and the content of an opam file *) - type t = (opam_file * OpamFile.OPAM.t ) list + (** String representing the content of an opam file *) + type content = string + + (** Representing a list of name and content of an opam file *) + type t = (path * content) list (** Decode opam files from the command "dune describe opam-files" output. *) let opam_files_of_sexp = function | Sexp.List sexps -> sexps |> List.map (function - | Sexp.List [Atom opam_file; Atom opam_content] -> - (opam_file, OpamFile.OPAM.read_from_string opam_content) + | Sexp.List [Atom path; Atom content] -> + (path, content) | s -> Fmt.failwith "%s is not a good format decoding an item" (Sexp.to_string s)) | s -> Fmt.failwith "%s is not a good format decoding items" (Sexp.to_string s) + let opamfile_of_content content = OpamFile.OPAM.read_from_string content + end diff --git a/dune_project.ml b/dune_project.ml index b58fdfd..9f803a9 100644 --- a/dune_project.ml +++ b/dune_project.ml @@ -100,6 +100,18 @@ let update (changes:(_ * Change.t list) Paths.t) (t:t) = in List.map (map_if "package" update_package) t +let packages t = + List.filter_map (function + | Sexp.List ((Atom "package")::sexps) -> + Option.some @@ List.filter_map (function + | Sexp.List [Atom "name"; Atom name] -> Some (name ^ ".opam") + | _ -> None) sexps + | _ -> None) t + |> List.flatten + |> fun v -> List.combine v v + |> List.to_seq + |> Libraries.of_seq + let dune_format dune = Bos.OS.Cmd.(in_string dune |> run_io Bos.Cmd.(v "dune" % "format-dune-file") |> out_string) |> Bos.OS.Cmd.success diff --git a/dune_project.mli b/dune_project.mli index 4cf4fd1..2f01229 100644 --- a/dune_project.mli +++ b/dune_project.mli @@ -12,6 +12,8 @@ val update : (_ * Change.t list) Paths.t -> t -> t val write_project_file : t -> unit +val packages : t -> string Paths.t + module Deps : sig type t = Dir_set.t Libraries.t (** The set of OCamlfind libraries needed, each with the directories needing it. *) diff --git a/main.ml b/main.ml index 0dd4b32..1064549 100644 --- a/main.ml +++ b/main.ml @@ -1,5 +1,12 @@ open Types +type check = Added | Deleted | Changed + +let string_of_check = function + | Added -> "added" + | Deleted -> "deleted" + | Changed -> "changed" + let or_die = function | Ok x -> x | Error (`Msg m) -> failwith m @@ -59,22 +66,18 @@ let get_opam_files () = Paths.add path opam acc ) Paths.empty -let updated_opam_files () = +let updated_opam_files_content () = sexp dune_describe_opam_files |> Dune_items.Describe_opam_files.opam_files_of_sexp |> List.fold_left (fun acc (path,opam) -> Paths.add path opam acc) Paths.empty -let write_opam_files = - Paths.iter (fun path opam -> - OpamFile.OPAM.write (OpamFile.make (OpamFilename.raw path)) opam) - let check_identical _path a b = match a, b with | Some a, Some b -> if OpamFile.OPAM.effectively_equal a b then None - else Some "changed" - | Some _, None -> Some "deleted" - | None, Some _ -> Some "added" + else Some Changed + | Some _, None -> Some Deleted + | None, Some _ -> Some Added | None, None -> assert false let pp_problems f = function @@ -144,14 +147,46 @@ let confirm_with_user () = false ) +let write_file path content = + let chan = open_out path in + output_string chan content; + flush chan; + close_out chan + let main force dir = Sys.chdir dir; let index = Index.create () in + let project = Dune_project.parse () in let old_opam_files = get_opam_files () in - let opam_files = updated_opam_files () in + let packages = Dune_project.packages project in + Paths.iter (fun path _ -> + if Paths.mem path packages then () + else + (* prevent `dune describe opam-files` crashing when there is a opam file `*.opam` + * and its package description is missing in dune-project file.*) + Sys.remove path) old_opam_files; + let opam_files_content = updated_opam_files_content () in + let opam_files = + opam_files_content + |> Paths.mapi (fun path content -> + let opamfile = Dune_items.Describe_opam_files.opamfile_of_content content in + match Paths.find_opt path old_opam_files with + | None -> opamfile + | Some opam -> + let depends = OpamFile.OPAM.depends opam in + OpamFile.OPAM.with_depends depends opamfile) + in if Paths.is_empty opam_files then failwith "No *.opam files found!"; let stale_files = Paths.merge check_identical old_opam_files opam_files in - stale_files |> Paths.iter (fun path msg -> Fmt.pr "%s: %s after its upgrade from 'dune describe opam-files'!@." path msg); + stale_files |> Paths.iter (fun path msg -> + (match msg with + | Added -> write_file path (Paths.find path opam_files_content) + | Deleted -> () (* Already removed*) + | Changed -> + OpamFile.OPAM.write_with_preserved_format (OpamFile.make (OpamFilename.raw (path))) (Paths.find path opam_files) + ); + Fmt.pr "%s: %s after its upgrade from 'dune describe opam-files'!@." path (string_of_check msg) + ); opam_files |> Paths.mapi (fun path opam -> (opam, generate_report ~index ~opam (Filename.chop_suffix path ".opam")) ) @@ -163,12 +198,11 @@ let main force dir = let have_changes = Paths.exists (fun _ -> function (_, []) -> false | _ -> true) report in if have_changes then ( if force || confirm_with_user () then ( - let project = Dune_project.parse () in if Dune_project.generate_opam_enabled project then ( project |> Dune_project.update report |> Dune_project.write_project_file; - updated_opam_files () |> write_opam_files; + updated_opam_files_content () |> Paths.iter (fun path content -> write_file path content); ) else ( Paths.iter update_opam_file report ) From 86ba28c4b6754dac6a455d870b560bcd98d0645d Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Tue, 5 Sep 2023 17:00:09 +0200 Subject: [PATCH 27/30] check if the dune constraint matches the dune-project file --- dune_constraints.ml | 81 +++++++++++++++++++++++++++++++++++++++++++++ dune_project.ml | 8 +++++ dune_project.mli | 2 ++ main.ml | 15 ++++++--- 4 files changed, 101 insertions(+), 5 deletions(-) create mode 100644 dune_constraints.ml diff --git a/dune_constraints.ml b/dune_constraints.ml new file mode 100644 index 0000000..5133454 --- /dev/null +++ b/dune_constraints.ml @@ -0,0 +1,81 @@ +(* This source code is comming from https://github.com/ocurrent/opam-repo-ci/blob/master/lib/lint.ml + * with a slight modification *) + +type error = + | DuneConstraintMissing + | DuneIsBuild + | BadDuneConstraint of string * string + +let is_dune name = + OpamPackage.Name.equal name (OpamPackage.Name.of_string "dune") + +let get_dune_constraint opam = + let get_max = function + | None, None -> None + | Some x, None -> Some x + | None, Some x -> Some x + | Some x, Some y when OpamVersionCompare.compare x y >= 0 -> Some x + | Some _, Some y -> Some y + in + let get_min = function + | None, None | Some _, None | None, Some _ -> None + | Some x, Some y when OpamVersionCompare.compare x y >= 0 -> Some y + | Some x, Some _ -> Some x + in + let is_build = ref false in + let rec get_lower_bound = function + | OpamFormula.Atom (OpamTypes.Constraint ((`Gt | `Geq), OpamTypes.FString version)) -> Some version + | Atom (Filter (FIdent (_, var, _))) when String.equal (OpamVariable.to_string var) "build" -> is_build := true; None (* TODO: remove this hack *) + | Empty | Atom (Filter _) | Atom (Constraint _) -> None + | Block x -> get_lower_bound x + | And (x, y) -> get_max (get_lower_bound x, get_lower_bound y) + | Or (x, y) -> get_min (get_lower_bound x, get_lower_bound y) + in + let rec aux = function + | OpamFormula.Atom (pkg, constr) -> + if is_dune pkg then + let v = get_lower_bound constr in + Some (Option.value ~default:"1.0" v) + else + None + | Empty -> None + | Block x -> aux x + | And (x, y) -> get_max (aux x, aux y) + | Or (x, y) -> get_min (aux x, aux y) + in + (!is_build, aux opam.OpamFile.OPAM.depends) + +let check_dune_constraints ~errors ~dune_version pkg_name opam = + let is_build, dune_constraint = get_dune_constraint opam in + let errors = + match dune_constraint with + | None -> + if is_dune pkg_name then + errors + else + (pkg_name, DuneConstraintMissing) :: errors + | Some dep -> + if OpamVersionCompare.compare dep dune_version >= 0 then + errors + else + (pkg_name, BadDuneConstraint (dep, dune_version)) :: errors + in + if is_build then (pkg_name, DuneIsBuild) :: errors else errors + +let msg_of_errors = + List.iter (fun (package, err) -> + let pkg = OpamPackage.Name.to_string package in + match err with + | DuneConstraintMissing -> + Fmt.epr "Warning in %s: The package has a dune-project file but no explicit dependency on dune was found." pkg + | DuneIsBuild -> + Fmt.epr "Warning in %s: The package tagged dune as a build dependency. \ + Due to a bug in dune (https://github.com/ocaml/dune/issues/2147) this should never be the case. \ + Please remove the {build} tag from its filter." + pkg + | BadDuneConstraint (dep, ver) -> + Fmt.failwith + "Error in %s: Your dune-project file indicates that this package requires at least dune %s \ + but your opam file only requires dune >= %s. Please check which requirement is the right one, and fix the other." + pkg ver dep + ) diff --git a/dune_project.ml b/dune_project.ml index 9f803a9..4848cf5 100644 --- a/dune_project.ml +++ b/dune_project.ml @@ -112,6 +112,14 @@ let packages t = |> List.to_seq |> Libraries.of_seq +let version t = + List.find_map (function + | Sexp.List [Atom "lang"; Atom "dune"; Atom version] -> Some version + | _ -> None) t + |> function + | None -> Fmt.failwith "dune-project file without `(lang dune _)` stanza" + | Some version -> version + let dune_format dune = Bos.OS.Cmd.(in_string dune |> run_io Bos.Cmd.(v "dune" % "format-dune-file") |> out_string) |> Bos.OS.Cmd.success diff --git a/dune_project.mli b/dune_project.mli index 2f01229..0980aba 100644 --- a/dune_project.mli +++ b/dune_project.mli @@ -14,6 +14,8 @@ val write_project_file : t -> unit val packages : t -> string Paths.t +val version : t -> string + module Deps : sig type t = Dir_set.t Libraries.t (** The set of OCamlfind libraries needed, each with the directories needing it. *) diff --git a/main.ml b/main.ml index 1064549..0f100f0 100644 --- a/main.ml +++ b/main.ml @@ -31,11 +31,7 @@ let () = ) | x -> Fmt.epr "WARNING: bad sexp from opam config env: %a@." Sexplib.Sexp.pp_hum x -let get_libraries ~pkg ~target = - Dune_project.Deps.get_external_lib_deps ~pkg ~target - |> fun libs -> - if String.equal pkg "dune" then libs - else Libraries.add "dune" Dir_set.empty libs (* We always need dune *) +let get_libraries ~pkg ~target = Dune_project.Deps.get_external_lib_deps ~pkg ~target let to_opam ~index lib = match Astring.String.take ~sat:((<>) '.') lib with @@ -210,6 +206,15 @@ let main force dir = exit 1 ) ); + let dune_version = Dune_project.version project in + get_opam_files () + |> Paths.to_seq + |> List.of_seq + |> List.map (fun (path, opam) -> + let pkg_name = (OpamPackage.Name.of_string (Filename.chop_suffix path ".opam")) in + Dune_constraints.check_dune_constraints ~errors:[] ~dune_version pkg_name opam) + |> List.flatten + |> Dune_constraints.msg_of_errors; if not (Paths.is_empty stale_files) then exit 1 open Cmdliner From 02ae26b7129eacc63fb3505564b28565f65329c4 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Thu, 7 Sep 2023 11:53:02 +0200 Subject: [PATCH 28/30] Add some tests --- dune-project | 2 +- dune_constraints.ml | 9 +-- main.ml | 5 +- opam-dune-lint.opam | 2 +- tests/test_dune_constraints.t | 122 ++++++++++++++++++++++++++++++++++ tests/test_opam.t | 2 +- tests/test_opam_update.t | 92 +++++++++++++++++++++++++ 7 files changed, 226 insertions(+), 8 deletions(-) create mode 100644 tests/test_dune_constraints.t create mode 100644 tests/test_opam_update.t diff --git a/dune-project b/dune-project index eb7bd5a..f37362a 100644 --- a/dune-project +++ b/dune-project @@ -20,5 +20,5 @@ (ocaml (>= 4.08.0)) (bos (>= 0.2.0)) (fmt (>= 0.8.9)) - (opam-state (>= 2.0.9)) + (opam-state (>= 2.1.0)) opam-format)) diff --git a/dune_constraints.ml b/dune_constraints.ml index 5133454..b3f0819 100644 --- a/dune_constraints.ml +++ b/dune_constraints.ml @@ -62,20 +62,21 @@ let check_dune_constraints ~errors ~dune_version pkg_name opam = in if is_build then (pkg_name, DuneIsBuild) :: errors else errors -let msg_of_errors = +let print_msg_of_errors = List.iter (fun (package, err) -> let pkg = OpamPackage.Name.to_string package in match err with | DuneConstraintMissing -> - Fmt.epr "Warning in %s: The package has a dune-project file but no explicit dependency on dune was found." pkg + Fmt.epr "Warning in %s: The package has a dune-project file but no explicit dependency on dune was found.@." pkg | DuneIsBuild -> Fmt.epr "Warning in %s: The package tagged dune as a build dependency. \ Due to a bug in dune (https://github.com/ocaml/dune/issues/2147) this should never be the case. \ - Please remove the {build} tag from its filter." + Please remove the {build} tag from its filter.@." pkg | BadDuneConstraint (dep, ver) -> Fmt.failwith "Error in %s: Your dune-project file indicates that this package requires at least dune %s \ - but your opam file only requires dune >= %s. Please check which requirement is the right one, and fix the other." + but your opam file only requires dune >= %s. Please check which requirement is the right one, and fix the other." pkg ver dep + ) diff --git a/main.ml b/main.ml index 0f100f0..d498009 100644 --- a/main.ml +++ b/main.ml @@ -214,7 +214,10 @@ let main force dir = let pkg_name = (OpamPackage.Name.of_string (Filename.chop_suffix path ".opam")) in Dune_constraints.check_dune_constraints ~errors:[] ~dune_version pkg_name opam) |> List.flatten - |> Dune_constraints.msg_of_errors; + |> (fun errors -> + try Dune_constraints.print_msg_of_errors errors with + | Failure msg -> Fmt.epr "%s@." msg; exit 1 + | _ -> Fmt.epr "Error from dune_constraints errors printing"; exit 1); if not (Paths.is_empty stale_files) then exit 1 open Cmdliner diff --git a/opam-dune-lint.opam b/opam-dune-lint.opam index da30215..8573885 100644 --- a/opam-dune-lint.opam +++ b/opam-dune-lint.opam @@ -17,7 +17,7 @@ depends: [ "ocaml" {>= "4.08.0"} "bos" {>= "0.2.0"} "fmt" {>= "0.8.9"} - "opam-state" {>= "2.0.9"} + "opam-state" {>= "2.1.0"} "opam-format" "odoc" {with-doc} ] diff --git a/tests/test_dune_constraints.t b/tests/test_dune_constraints.t new file mode 100644 index 0000000..09d288b --- /dev/null +++ b/tests/test_dune_constraints.t @@ -0,0 +1,122 @@ +Create a simple dune project: for testing opam-dune-lint, if dune constraint matches +the dune-project file + + + $ cat > dune-project << EOF + > (lang dune 2.7) + > (package + > (name test) + > (synopsis "Test package")) + > EOF + + $ cat > test.opam << EOF + > # Preserve comments + > opam-version: "2.0" + > synopsis: "Test package" + > build: [ + > ["dune" "build"] + > ] + > depends: [ + > "ocamlfind" {>= "1.0"} + > "libfoo" + > ] + > EOF + + $ cat > dune << EOF + > (executable + > (name main) + > (public_name main) + > (modules main) + > (libraries findlib fmt)) + > (test + > (name test) + > (modules test) + > (libraries bos opam-state)) + > EOF + + $ touch main.ml test.ml + $ dune build + +Replace all version numbers with "1.0" to get predictable output. + + $ export OPAM_DUNE_LINT_TESTS=y + +Check that the missing libraries get added: + + $ opam-dune-lint -f + test.opam: changes needed: + "fmt" {>= "1.0"} [from /] + "bos" {with-test & >= "1.0"} [from /] + "opam-state" {with-test & >= "1.0"} [from /] + Note: version numbers are just suggestions based on the currently installed version. + Wrote "./test.opam" + Warning in test: The package has a dune-project file but no explicit dependency on dune was found. + + $ cat test.opam | sed 's/= [^&)}]*/= */g' + # Preserve comments + opam-version: "2.0" + synopsis: "Test package" + build: [ + ["dune" "build"] + ] + depends: [ + "ocamlfind" {>= *} + "libfoo" + "fmt" {>= *} + "bos" {>= *& with-test} + "opam-state" {>= *& with-test} + ] + + $ cat > test.opam << EOF + > # Preserve comments + > opam-version: "2.0" + > synopsis: "Test package" + > build: [ + > ["dune" "build"] + > ] + > depends: [ + > "ocamlfind" {>= "1.0"} + > "libfoo" + > "dune" {> "2.7" & build} + > ] + > EOF + $ dune build + +Check that the missing libraries get added: + + $ opam-dune-lint -f + test.opam: changes needed: + "fmt" {>= "1.0"} [from /] + "bos" {with-test & >= "1.0"} [from /] + "opam-state" {with-test & >= "1.0"} [from /] + Note: version numbers are just suggestions based on the currently installed version. + Wrote "./test.opam" + Warning in test: The package tagged dune as a build dependency. Due to a bug in dune (https://github.com/ocaml/dune/issues/2147) this should never be the case. Please remove the {build} tag from its filter. + + $ cat > test.opam << EOF + > # Preserve comments + > opam-version: "2.0" + > synopsis: "Test package" + > build: [ + > ["dune" "build"] + > ] + > depends: [ + > "ocamlfind" {>= "1.0"} + > "libfoo" + > "dune" {> "1.0" & build} + > ] + > EOF + $ dune build + +Check that the missing libraries get added: + + $ opam-dune-lint -f + test.opam: changes needed: + "fmt" {>= "1.0"} [from /] + "bos" {with-test & >= "1.0"} [from /] + "opam-state" {with-test & >= "1.0"} [from /] + Note: version numbers are just suggestions based on the currently installed version. + Wrote "./test.opam" + Warning in test: The package tagged dune as a build dependency. Due to a bug in dune (https://github.com/ocaml/dune/issues/2147) this should never be the case. Please remove the {build} tag from its filter. + Error in test: Your dune-project file indicates that this package requires at least dune 2.7 but your opam file only requires dune >= 1.0. Please check which requirement is the right one, and fix the other. + [1] diff --git a/tests/test_opam.t b/tests/test_opam.t index 39e2c31..34d1e3a 100644 --- a/tests/test_opam.t +++ b/tests/test_opam.t @@ -17,6 +17,7 @@ Create a simple dune project: > depends: [ > "ocamlfind" {>= "1.0"} > "libfoo" + > "dune" {>= "2.7"} > ] > EOF @@ -43,7 +44,6 @@ Check that the missing libraries get added: $ opam-dune-lint -f test.opam: changes needed: - "dune" {>= "1.0"} "fmt" {>= "1.0"} [from /] "bos" {with-test & >= "1.0"} [from /] "opam-state" {with-test & >= "1.0"} [from /] diff --git a/tests/test_opam_update.t b/tests/test_opam_update.t new file mode 100644 index 0000000..15a9827 --- /dev/null +++ b/tests/test_opam_update.t @@ -0,0 +1,92 @@ +Create a simple dune project: testing if opam-dune-lint update opam files +using the dune-project file, before the linting process. + + $ cat > dune-project << EOF + > (lang dune 2.7) + > (generate_opam_files true) + > (package + > (name test) + > (synopsis "Test package") + > (depends cmdliner)) + > EOF + + $ cat > dune << EOF + > (executable + > (name main) + > (public_name main) + > (modules main) + > (libraries findlib fmt)) + > (test + > (name test) + > (modules test) + > (libraries bos opam-state)) + > EOF + + $ touch main.ml test.ml + $ dune build + $ cat test.opam + # This file is generated by dune, edit dune-project instead + opam-version: "2.0" + synopsis: "Test package" + depends: [ + "dune" {>= "2.7"} + "cmdliner" + "odoc" {with-doc} + ] + build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ] + +Replace all version numbers with "1.0" to get predictable output. + + $ export OPAM_DUNE_LINT_TESTS=y + +Check that the missing libraries get added: + + $ opam-dune-lint -f + test.opam: changes needed: + "fmt" {>= "1.0"} [from /] + "ocamlfind" {>= "1.0"} [from /] + "bos" {with-test & >= "1.0"} [from /] + "opam-state" {with-test & >= "1.0"} [from /] + Note: version numbers are just suggestions based on the currently installed version. + Wrote "dune-project" + + $ cat test.opam | sed 's/= [^&)}]*/= */g' + # This file is generated by dune, edit dune-project instead + opam-version: "2.0" + synopsis: "Test package" + depends: [ + "dune" {>= *} + "opam-state" {>= *& with-test} + "bos" {>= *& with-test} + "ocamlfind" {>= *} + "fmt" {>= *} + "cmdliner" + "odoc" {with-doc} + ] + build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ] From 6b249158a6603f75e0719b2faf18337b3a53eab7 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Mon, 18 Sep 2023 19:38:04 +0200 Subject: [PATCH 29/30] Refactoring the source code --- CHANGES.md | 4 ++-- README.md | 2 +- deps.ml | 50 ++++++++++++++++++++++----------------------- dune | 2 +- dune-project | 44 ++++++++++++++++++++++++++++----------- dune_items.ml | 45 ++++++++++++++++------------------------ dune_project.ml | 2 +- dune_rules.ml | 24 ++++++++++++---------- main.ml | 12 +++++------ opam-dune-lint.opam | 1 + types.ml | 36 ++++++++++++++++++++------------ 11 files changed, 122 insertions(+), 100 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 8d8bcd2..826002c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,7 +1,7 @@ ### Unreleased -- Add support for dune 3.0 , the command `dune external-lib-deps` was remove from - dune. Now, `opam-dune-lint` command works without `dune build`. (@moyodiallo #46). +- Add support for dune 3.0 , the command `dune external-lib-deps` was removed from + dune. Now, the `opam-dune-lint` command works without `dune build`. (@moyodiallo #46). ### v0.2 diff --git a/README.md b/README.md index cb2ddf3..7609cba 100644 --- a/README.md +++ b/README.md @@ -30,7 +30,7 @@ It works as follows: 1. Lists the `*.opam` files in your project's root (ensuring they're up-to-date, if generated). 2. Runs `dune describe external-lib-deps` to get all externals and internals ocamlfind libraries for all dune libraries, executables and tests. The information about the package is also known except for the private executables. -3. Runs `dune describe package-entries` to get all packages entries, this is for considering the external ocamlfind libraries of a private executable, because in dune it possible to install an private executable. +3. Runs `dune describe package-entries` to get all packages entries, this is for considering the external ocamlfind libraries of a private executable, because in Dune it is possible to install a private executable. 4. Resolve for each opam library its internal and external ocamlfind library dependencies using the information of 1. and 2. 5. Filters out vendored dependencies (by ignoring dependencies from subdirectories with their own `dune-project` file). 6. For each ocamlfind library, it finds the corresponding opam library by diff --git a/deps.ml b/deps.ml index 4c61b21..7c15e0b 100644 --- a/deps.ml +++ b/deps.ml @@ -18,17 +18,23 @@ let describe_bin_of_entries = |> Describe_entries.entries_of_sexp |> Describe_entries.items_bin_of_entries) -let has_dune_subproject = function - | "." | "" -> false - | dir -> Sys.file_exists (Filename.concat dir "dune-project") +let has_dune_subproject path = + if Fpath.is_current_dir path then false + else + Fpath.(path / "dune-project") + |> Bos.OS.Path.exists + |> Stdlib.Result.get_ok + + +let parent_path path = if Fpath.is_current_dir path then None else Some (Fpath.parent path) let rec should_use_dir ~dir_types path = match Hashtbl.find_opt dir_types path with | Some x -> x | None -> let r = - match Astring.String.cut ~sep:"/" ~rev:true path with - | Some (parent, _) -> + match parent_path path with + | Some parent -> if should_use_dir ~dir_types parent then ( not (has_dune_subproject path) ) else false @@ -44,8 +50,8 @@ let copy_rules () = (fun d_item -> d_item |> Describe_external_lib.get_item - |> (fun (item:Describe_external_lib.item) -> String.cat item.source_dir "/dune") - |> (Dune_rules.Copy_rules.get_copy_rules)) + |> (fun (item:Describe_external_lib.item) -> Fpath.(item.source_dir / "dune")) + |> Dune_rules.Copy_rules.get_copy_rules) |> Dune_rules.Copy_rules.copy_rules_map let bin_of_entries () = Lazy.force describe_bin_of_entries @@ -83,14 +89,10 @@ let resolve_internal_deps d_items items_pkg = let d_items_lib = d_items |> List.filter_map (fun d_item -> - match is_lib_item d_item with - | true -> - d_item - |> get_item - |> (fun (item:Describe_external_lib.item) -> - (String.cat item.name ".lib", Lib item)) - |> Option.some - | false -> None) + if is_lib_item d_item then + let item = get_item d_item in + Some (item.Describe_external_lib.name ^ ".lib", Lib item) + else None) |> List.to_seq |> Hashtbl.of_seq in let rec add_internal acc = function @@ -118,8 +120,8 @@ let get_dune_items dir_types ~pkg ~target = let item = Describe_external_lib.get_item d_item in if Describe_external_lib.is_exe_item d_item && Option.is_none item.package then - match find_package_of_exe item with - | None -> d_item + match find_package_of_exe item with + | None -> d_item | Some pkg -> Describe_external_lib.Exe { item with package = Some pkg } else d_item) |> (fun d_items -> @@ -140,9 +142,8 @@ let get_dune_items dir_types ~pkg ~target = in d_items, unresolved_entries) |> (fun (d_items, unresolved_entries) -> d_items - |> List.map (fun d_item -> - match d_item with - | Describe_external_lib.Exe item -> + |> List.map (function + | Describe_external_lib.Exe item as d_item -> item.extensions |> List.find_map (fun extension -> Item_map.find_opt (String.cat item.name extension) unresolved_entries) @@ -171,11 +172,10 @@ let get_dune_items dir_types ~pkg ~target = let lib_deps ~pkg ~target = get_dune_items (Hashtbl.create 10) ~pkg ~target - |> List.map Describe_external_lib.get_item - |> List.fold_left (fun libs (item:Describe_external_lib.item) -> - List.map (fun dep -> - (fst dep, item.source_dir)) item.external_deps - |> List.fold_left (fun acc (lib,path) -> + |> List.fold_left (fun libs item -> + let item = Describe_external_lib.get_item item in + List.map (fun dep -> fst dep, item.source_dir) item.external_deps + |> List.fold_left (fun acc (lib, path) -> if Astring.String.take ~sat:((<>) '.') lib <> pkg then let dirs = Libraries.find_opt lib acc |> Option.value ~default:Dir_set.empty in Libraries.add lib (Dir_set.add path dirs) acc diff --git a/dune b/dune index da88c50..883b858 100644 --- a/dune +++ b/dune @@ -1,4 +1,4 @@ (executable (public_name opam-dune-lint) (name main) - (libraries astring fmt fmt.tty bos opam-format opam-state cmdliner stdune sexplib str)) + (libraries astring fmt fmt.tty bos opam-format opam-state cmdliner stdune sexplib str fpath)) diff --git a/dune-project b/dune-project index f37362a..963dbd2 100644 --- a/dune-project +++ b/dune-project @@ -1,24 +1,44 @@ (lang dune 3.10) + (name opam-dune-lint) + (formatting disabled) + (generate_opam_files true) -(source (github ocurrent/opam-dune-lint)) -(authors "talex5@gmail.com") -(maintainers "talex5@gmail.com") + +(source + (github ocurrent/opam-dune-lint)) + +(authors talex5@gmail.com) + +(maintainers talex5@gmail.com) + (license ISC) + (cram enable) + (package (name opam-dune-lint) (synopsis "Ensure dune and opam dependencies are consistent") (description "opam-dune-lint checks that all ocamlfind libraries listed as dune dependencies have corresponding opam dependencies listed in the opam files. If not, it offers to add them (either to your opam files, or to your dune-project if you're generating your opam files from that).") (depends - (astring (>= 0.8.5)) - (sexplib (>= v0.14.0)) - (cmdliner (>= 1.1.0)) - (stdune (>= 3.10.0)) - (ocaml (>= 4.08.0)) - (bos (>= 0.2.0)) - (fmt (>= 0.8.9)) - (opam-state (>= 2.1.0)) - opam-format)) + (fpath + (>= 0.7.3)) + (astring + (>= 0.8.5)) + (sexplib + (>= v0.14.0)) + (cmdliner + (>= 1.1.0)) + (stdune + (>= 3.10.0)) + (ocaml + (>= 4.08.0)) + (bos + (>= 0.2.0)) + (fmt + (>= 0.8.9)) + (opam-state + (>= 2.1.0)) + opam-format)) \ No newline at end of file diff --git a/dune_items.ml b/dune_items.ml index daa99fc..99b50d6 100644 --- a/dune_items.ml +++ b/dune_items.ml @@ -19,7 +19,7 @@ module Describe_external_lib = struct package: string option; external_deps : (string * Kind.t) list; internal_deps : (string * Kind.t) list; - source_dir: string; + source_dir: Fpath.t; extensions: string list } @@ -29,7 +29,7 @@ module Describe_external_lib = struct package = None; external_deps = []; internal_deps = []; - source_dir = ""; + source_dir = Fpath.v "."; extensions = [] } @@ -46,7 +46,7 @@ module Describe_external_lib = struct let string_of_atom = function | Sexp.Atom s -> s - | s -> Fmt.failwith "%s is an atom" (Sexp.to_string s) + | s -> Fmt.failwith "%a is an atom" Sexp.pp_hum s let string_of_list_dep_sexp = function | Sexp.List [Atom name; Atom kind] -> @@ -58,21 +58,19 @@ module Describe_external_lib = struct let decode_item sexps = let items = - List.fold_left (fun items sexps -> - match sexps with + List.fold_left (fun items -> function | Sexp.List [Atom "names"; List sexps] -> List.map (fun name -> {dump_item with name = name}) (List.map string_of_atom sexps) | _ -> items) [] sexps in - List.fold_left (fun items sexps -> - match sexps with + List.fold_left (fun items -> function | Sexp.List [Atom "names"; List _] -> items | Sexp.List [Atom "package"; List [Atom p] ] -> List.map (fun item -> {item with package = Some p}) items | Sexp.List [Atom "package"; List [] ] -> List.map (fun item -> {item with package = None}) items | Sexp.List [Atom "source_dir"; Atom s] -> - List.map (fun item -> {item with source_dir = s}) items + List.map (fun item -> {item with source_dir = Fpath.v s}) items | Sexp.List [Atom "extensions" ; List sexps] -> List.map (fun item -> {item with extensions = List.map string_of_atom sexps}) items | Sexp.List [Atom "external_deps" ; List sexps] -> @@ -101,7 +99,7 @@ end module Describe_entries = struct type item = { - source_dir: string; + source_dir: Fpath.t; bin_name: string; kind: string; dst: string; @@ -111,7 +109,7 @@ module Describe_entries = struct } let dump_item = { - source_dir = ""; + source_dir = Fpath.v "."; bin_name = ""; kind = ""; dst = ""; @@ -128,22 +126,16 @@ module Describe_entries = struct | Sexp.Atom s -> s | s -> Fmt.failwith "%s is an atom" (Sexp.to_string s) - (* With "default/lib/bin.exe" or "default/lib/bin.bc.js" gives bin, it gives "bin.exe" *) - let bin_name s = - Astring.String.cut ~sep:"/" ~rev:true s - |> Option.map snd |> Option.get + (* With "default/lib/bin.exe" or "default/lib/bin.bc.js", it gives "bin.exe" or "bin.bc.js" *) + let bin_name = Filename.basename (* With "default/lib/bin.exe", it gives "default/lib" *) - let source_dir s = - Astring.String.cut ~sep:"/" ~rev:true s - |> Option.map fst |> Option.map (Astring.String.cut ~sep:"/" ~rev:false) |> Option.join |> Option.map snd - |> function None -> "." | Some dir -> dir + let source_dir = Fpath.parent let decode_item sexps = - List.fold_left (fun item sexps -> - match sexps with + List.fold_left (fun item -> function | Sexp.List [Atom "src"; List [_; Atom p] ] -> - {item with source_dir = source_dir p; bin_name = bin_name p} + {item with source_dir = source_dir (Fpath.v p); bin_name = bin_name p} | Sexp.List [Atom "kind"; Atom p ] -> {item with kind = p} | Sexp.List [Atom "dst"; Atom p ] -> {item with dst = p} | Sexp.List [Atom "section"; Atom p ] -> {item with section = p} @@ -154,7 +146,7 @@ module Describe_entries = struct let decode_items : Sexp.t list -> entry list = List.filter_map (function - | Sexp.List [List [Atom "source"; List [Atom "User" ; _ ]]; List [Atom "entry"; List sexps]] -> Some (decode_item sexps) + | Sexp.List [List [Atom "source"; List [Atom "User" ; _ ]]; List [Atom "entry"; List sexps]] | Sexp.List [List [Atom "entry"; List sexps]; List [Atom "source"; Atom "User"]] -> Some (decode_item sexps) | Sexp.List [List [Atom "source"; Atom "Dune"]; List _ ] -> None | s -> Fmt.failwith "%s is not a good format decoding items" (Sexp.to_string s)) @@ -166,17 +158,16 @@ module Describe_entries = struct let entries_of_sexp : Sexp.t -> t list = function | Sexp.List sexps -> sexps - |> List.map (fun x -> decode_entries x |> (fun (package, entries) -> + |> List.map (fun x -> + let package, entries = decode_entries x in (package, List.map (function | Bin item -> Bin {item with package = package} - | Other item -> Other {item with package = package}) entries))) + | Other item -> Other {item with package = package}) entries)) | _ -> Fmt.failwith "Invalid format" let items_bin_of_entries describe_entries = List.concat_map snd describe_entries - |> List.filter_map (fun d_item -> - d_item - |> (function Bin item -> Some (item.bin_name,item) | Other _ -> None)) + |> List.filter_map (function Bin item -> Some (item.bin_name,item) | Other _ -> None) |> List.to_seq |> Item_map.of_seq end diff --git a/dune_project.ml b/dune_project.ml index 4848cf5..5139cfa 100644 --- a/dune_project.ml +++ b/dune_project.ml @@ -121,7 +121,7 @@ let version t = | Some version -> version let dune_format dune = - Bos.OS.Cmd.(in_string dune |> run_io Bos.Cmd.(v "dune" % "format-dune-file") |> out_string) + Bos.OS.Cmd.(in_string dune |> run_io Bos.Cmd.(v "dune" % "format-dune-file") |> out_string) |> Bos.OS.Cmd.success |> or_die diff --git a/dune_rules.ml b/dune_rules.ml index eb2f75d..a6bbf97 100644 --- a/dune_rules.ml +++ b/dune_rules.ml @@ -3,7 +3,7 @@ open Types module Copy_rules = struct let sexp_of_file file = - try Sexp.load_sexps file with + try Sexp.load_sexps @@ Fpath.to_string file with | Sexp.Parse_error _ as e -> (Fmt.pr "Error parsing 'dune file' output:\n"; raise e) @@ -55,22 +55,24 @@ module Copy_rules = struct | s -> Fmt.failwith "%s is not a rule" (Sexp.to_string s) in sexps - |> List.filter is_action_copy - |> List.map (fun rule -> - rule - |> copy_rule_of_sexp - |> fun copy -> - if String.equal copy.to_name "%{target}" && String.equal copy.from_name "%{deps}" then - (*when we got `(action (copy %{deps} %{target}))` *) - {{copy with to_name = copy.target} with from_name = copy.dep} - else copy) + |> List.filter_map (fun rule -> + if not (is_action_copy rule) then + None + else + rule + |> copy_rule_of_sexp + |> fun copy -> + if String.equal copy.to_name "%{target}" && String.equal copy.from_name "%{deps}" then + (*when we got `(action (copy %{deps} %{target}))` *) + Some {{copy with to_name = copy.target} with from_name = copy.dep} + else Some copy) let copy_rules_map = List.fold_left (fun map copy -> Item_map.add copy.from_name copy map) Item_map.empty let get_copy_rules file = match Hashtbl.find_opt rules file with - | None when Sys.file_exists file -> + | None when OS.Path.exists file |> Stdlib.Result.get_ok -> let copy_rules = copy_rules_of_sexp (sexp_of_file file) in Hashtbl.add rules file copy_rules; copy_rules | None -> Hashtbl.add rules file []; [] diff --git a/main.ml b/main.ml index d498009..1fc5a06 100644 --- a/main.ml +++ b/main.ml @@ -156,11 +156,10 @@ let main force dir = let old_opam_files = get_opam_files () in let packages = Dune_project.packages project in Paths.iter (fun path _ -> - if Paths.mem path packages then () - else - (* prevent `dune describe opam-files` crashing when there is a opam file `*.opam` - * and its package description is missing in dune-project file.*) - Sys.remove path) old_opam_files; + (* prevent `dune describe opam-files` crashing when there is a opam file `*.opam` + * and its package description is missing in dune-project file. *) + if not (Paths.mem path packages) then Sys.remove path) + old_opam_files; let opam_files_content = updated_opam_files_content () in let opam_files = opam_files_content @@ -210,10 +209,9 @@ let main force dir = get_opam_files () |> Paths.to_seq |> List.of_seq - |> List.map (fun (path, opam) -> + |> List.concat_map (fun (path, opam) -> let pkg_name = (OpamPackage.Name.of_string (Filename.chop_suffix path ".opam")) in Dune_constraints.check_dune_constraints ~errors:[] ~dune_version pkg_name opam) - |> List.flatten |> (fun errors -> try Dune_constraints.print_msg_of_errors errors with | Failure msg -> Fmt.epr "%s@." msg; exit 1 diff --git a/opam-dune-lint.opam b/opam-dune-lint.opam index 8573885..c628aab 100644 --- a/opam-dune-lint.opam +++ b/opam-dune-lint.opam @@ -10,6 +10,7 @@ homepage: "https://github.com/ocurrent/opam-dune-lint" bug-reports: "https://github.com/ocurrent/opam-dune-lint/issues" depends: [ "dune" {>= "3.10"} + "fpath" {>= "0.7.3"} "astring" {>= "0.8.5"} "sexplib" {>= "v0.14.0"} "cmdliner" {>= "1.1.0"} diff --git a/types.ml b/types.ml index 7921282..219f3a2 100644 --- a/types.ml +++ b/types.ml @@ -1,4 +1,4 @@ -module Dir_set = Set.Make(String) +module Dir_set = Set.Make(Fpath) module Paths = Map.Make(String) @@ -12,6 +12,8 @@ module Sexp = Sexplib.Sexp module Stdune = Stdune +include Bos + module Change = struct type t = [ `Remove_with_test of OpamPackage.Name.t @@ -21,18 +23,24 @@ module Change = struct end module List = struct - include List - let concat_map f l = List.map f l |> List.flatten - let find_map f l = - let rec find f = function - | [] -> None - | x::tl -> let v = f x in if Option.is_some v then v else find f tl - in find f l + include List + let rec concat_map f = function + | [] -> [] + | x::xs -> prepend_concat_map (f x) f xs + and prepend_concat_map ys f xs = + match ys with + | [] -> concat_map f xs + | y::ys -> y::prepend_concat_map ys f xs + let find_map f l = + let rec find f = function + | [] -> None + | x::tl -> let v = f x in if Option.is_some v then v else find f tl + in find f l end module String = struct - include String - let cat = (^) + include String + let cat = (^) end module Change_with_hint = struct @@ -52,7 +60,9 @@ module Change_with_hint = struct | `Add_test_dep _ -> true let pp f (c, dirs) = - let dirs = Dir_set.map (function "." -> "/" | x -> x) dirs in + let dirs = + Dir_set.map (fun path -> if Fpath.is_current_dir path then Fpath.v "/" else path) dirs + in let change, hint = match c with | `Remove_with_test name -> Fmt.str "%a" pp_name name, ["(remove {with-test})"] @@ -62,7 +72,7 @@ module Change_with_hint = struct in let hint = if Dir_set.is_empty dirs then hint - else Fmt.str "[from @[%a@]]" Fmt.(list ~sep:comma string) (Dir_set.elements dirs) :: hint + else Fmt.str "[from @[%a@]]" Fmt.(list ~sep:comma Fpath.pp) (Dir_set.elements dirs) :: hint in if hint = [] then Fmt.string f change @@ -84,4 +94,4 @@ let sexp cmd = |> (fun s -> try Sexp.of_string s with | Sexp.Parse_error _ as e -> - Fmt.pr "Error parsing '%s' output:\n" (Bos.Cmd.to_string cmd); raise e) + Fmt.epr "Error parsing '%s' output:\n" (Bos.Cmd.to_string cmd); raise e) From 54a27d8e576ff991113edb77d3aaa321f90fc1a1 Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Fri, 22 Sep 2023 12:01:52 +0200 Subject: [PATCH 30/30] Refactoring the source code --- deps.ml | 85 ++++++++++++++++++++++++++-------------------------- dune-project | 2 +- 2 files changed, 43 insertions(+), 44 deletions(-) diff --git a/deps.ml b/deps.ml index 7c15e0b..ca0233f 100644 --- a/deps.ml +++ b/deps.ml @@ -115,22 +115,23 @@ let resolve_internal_deps d_items items_pkg = add_internal (Hashtbl.create 10) items_pkg let get_dune_items dir_types ~pkg ~target = - Lazy.force describe_external_lib_deps - |> List.map (fun d_item -> - let item = Describe_external_lib.get_item d_item in - if Describe_external_lib.is_exe_item d_item && Option.is_none item.package - then - match find_package_of_exe item with - | None -> d_item - | Some pkg -> Describe_external_lib.Exe { item with package = Some pkg } - else d_item) - |> (fun d_items -> + let d_items = + Lazy.force describe_external_lib_deps + |> List.map (fun d_item -> + let item = Describe_external_lib.get_item d_item in + if Describe_external_lib.is_exe_item d_item && Option.is_none item.package + then + match find_package_of_exe item with + | None -> d_item + | Some pkg -> Describe_external_lib.Exe { item with package = Some pkg } + else d_item) + in + let unresolved_entries = let exe_items = - d_items |> List.filter_map (function + List.filter_map (function | Describe_external_lib.Exe item -> Some item - | _ -> None) + | _ -> None) d_items in - let unresolved_entries = bin_of_entries () |> Item_map.partition (fun _ (entry:Describe_entries.item) -> exe_items @@ -139,36 +140,34 @@ let get_dune_items dir_types ~pkg ~target = is_bin_name_of_describe_lib entry.bin_name item && Option.equal String.equal (Some entry.package) item.package)) |> snd - in d_items, unresolved_entries) - |> (fun (d_items, unresolved_entries) -> - d_items - |> List.map (function - | Describe_external_lib.Exe item as d_item -> - item.extensions - |> List.find_map (fun extension -> - Item_map.find_opt (String.cat item.name extension) unresolved_entries) - |> (function - | None -> d_item - | Some entry -> Describe_external_lib.Exe { item with package = Some entry.package }) - | d_item -> d_item)) - |> List.filter (fun item -> - match (item,target) with - | Describe_external_lib.Test _, `Install -> false - | Describe_external_lib.Test _, `Runtest -> true - | _ , `Runtest -> false - | _, `Install -> true) - |> List.filter (fun d_item -> should_use_dir ~dir_types (Describe_external_lib.get_item d_item).source_dir) - |> (fun d_items -> - d_items - |> List.filter (fun d_item -> - let item = Describe_external_lib.get_item d_item in - (* if an item has no package, we assume it's used for testing *) - if target = `Install then - Option.equal String.equal (Some pkg) item.package - else - Option.equal String.equal (Some pkg) item.package || Option.is_none item.package) - |> resolve_internal_deps d_items) - + in + let d_items = + d_items + |> List.map (function + | Describe_external_lib.Exe item as d_item -> + item.extensions + |> List.find_map (fun extension -> + Item_map.find_opt (String.cat item.name extension) unresolved_entries) + |> (function + | None -> d_item + | Some entry -> Describe_external_lib.Exe { item with package = Some entry.package }) + | d_item -> d_item) + |> List.filter (fun item -> + match (item,target) with + | Describe_external_lib.Test _, `Install -> false + | Describe_external_lib.Test _, `Runtest -> true + | _ , `Runtest -> false + | _, `Install -> true) + |> List.filter (fun d_item -> should_use_dir ~dir_types (Describe_external_lib.get_item d_item).source_dir) + in + List.filter (fun d_item -> + let item = Describe_external_lib.get_item d_item in + (* if an item has no package, we assume it's used for testing *) + if target = `Install then + Option.equal String.equal (Some pkg) item.package + else + Option.equal String.equal (Some pkg) item.package || Option.is_none item.package) d_items + |> resolve_internal_deps d_items let lib_deps ~pkg ~target = get_dune_items (Hashtbl.create 10) ~pkg ~target diff --git a/dune-project b/dune-project index 963dbd2..7857143 100644 --- a/dune-project +++ b/dune-project @@ -41,4 +41,4 @@ (>= 0.8.9)) (opam-state (>= 2.1.0)) - opam-format)) \ No newline at end of file + opam-format))