Refactoring the source code

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
+    |> 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,7 +50,7 @@ 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")
+       |> (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
 
@@ -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)
@@ -173,9 +174,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.fold_left (fun acc (lib,path) ->
+      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

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

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

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 = []
     }
 
@@ -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))

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)
 
@@ -70,7 +70,7 @@ module Copy_rules = struct
 
   let get_copy_rules file =
     match Hashtbl.find_opt rules file with
-    | None when  Sys.file_exists file ->
+    | None when  OS.Path.exists file |> 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 []; []

main.ml

@@ -210,10 +210,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

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

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
@@ -52,7 +54,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 +66,7 @@ module Change_with_hint = struct
     in
     let hint =
       if Dir_set.is_empty dirs then hint
-      else Fmt.str "[from @[<h>%a@]]" Fmt.(list ~sep:comma string) (Dir_set.elements dirs) :: hint
+      else Fmt.str "[from @[<h>%a@]]" Fmt.(list ~sep:comma Fpath.pp) (Dir_set.elements dirs) :: hint
     in
     if hint = [] then
       Fmt.string f change