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

@@ -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.

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

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))

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

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

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"}