Add Support for unwrapped libraries (#107)

azzsal · Siddhi-agg · web-flow · commit aa854baa8b10 · 2025-01-16T14:53:00.000+01:00
* Add unwrapped library flag to api_diff command line tool

* Refactor Api_diff module

* Add more elaborate error messages for the api_diff CLI tool

* Update cram tests to match api-diff error messages

* Add Diff.library to diff entire libraries

* Add Library.load_unwrapped and make Library.load match it

* Format the changes

* Make changes to use load_unwrapped

* Extract warning printing and fix tests

* Extract Library.t and fix Library.load_unwrappped

* Add cram test for unwrapped libs

* Fix the cram test for unwrapped library

Signed-off-by: Siddhi-agg &lt;siddhiagrawalcool@gmail.com&gt;

* Minor fix

* Add changelog entry

---------

Signed-off-by: Siddhi-agg &lt;siddhiagrawalcool@gmail.com&gt;
Co-authored-by: Siddhi-agg &lt;siddhiagrawalcool@gmail.com&gt;
diff --git a/CHANGES.md b/CHANGES.md
@@ -6,6 +6,7 @@
 - Add detection of module_type declarations changes (#93, @NchamJosephMuam)
 - Add detection of classes addition and removal (#90, @marcndo)
 - Add detection of addition and removal of class type declarations (#103, @azzsal)
+- Add initial support for unwrapped libraries (#107, @Siddhi-agg, @azzsal)
 
 ### Changed
 
diff --git a/bin/api_diff.ml b/bin/api_diff.ml
@@ -1,45 +1,83 @@
 let tool_name = "api-diff"
 
-let run (`Main_module main_module) (`Ref_cmi reference) (`Current_cmi current) =
+type mode = Unwrapped | Wrapped of string | Cmi
+
+let both_directories reference current =
+  match (Sys.is_directory reference, Sys.is_directory current) with
+  | true, true -> Ok true
+  | false, false -> Ok false
+  | _ ->
+      Error
+        "Arguments must either both be directories or both single .cmi files."
+
+let print_warning main_module unwrapped =
+  match (main_module, unwrapped) with
+  | None, false -> ()
+  | Some _, false ->
+      Printf.eprintf
+        "%s: --main-module is ignored when diffing single .cmi files\n"
+        tool_name
+  | None, true ->
+      Printf.eprintf
+        "%s: --unwrapped is ignored when diffing single .cmi files\n" tool_name
+  | Some _, true ->
+      Printf.eprintf
+        "%s: --main-module and --unwrapped are ignored when diffing single \
+         .cmi files\n"
+        tool_name
+
+let mode ~reference ~current ~main_module ~unwrapped =
   let open CCResult.Infix in
-  let* reference_sig, current_sig, module_name =
-    match
-      (Sys.is_directory reference, Sys.is_directory current, main_module)
-    with
-    | true, true, Some main_module ->
+  let* both_dirs = both_directories reference current in
+  match (both_dirs, main_module, unwrapped) with
+  | true, Some main_module, false -> Ok (Wrapped main_module)
+  | true, None, true -> Ok Unwrapped
+  | false, main_module, unwrapped ->
+      print_warning main_module unwrapped;
+      Ok Cmi
+  | true, _, _ ->
+      Error
+        "Either --main-module or --unwrapped must be provided when diffing \
+         entire libraries."
+
+let run (`Main_module main_module) (`Unwrapped_library unwrapped)
+    (`Ref_cmi reference) (`Current_cmi current) =
+  let open CCResult.Infix in
+  let* reference_map, current_map =
+    let* curr_mode = mode ~reference ~current ~main_module ~unwrapped in
+    match curr_mode with
+    | Wrapped main_module ->
         let main_module = String.capitalize_ascii main_module in
-        let+ reference_sig = Api_watch.Library.load ~main_module reference
-        and+ current_sig = Api_watch.Library.load ~main_module current in
-        let module_name = String.capitalize_ascii main_module in
-        (reference_sig, current_sig, module_name)
-    | false, false, main_module ->
-        let () =
-          match main_module with
-          | None -> ()
-          | Some _ ->
-              Printf.eprintf
-                "%s: --main-module ignored when diffing single .cmi files\n"
-                tool_name
-        in
+        let+ reference_map = Api_watch.Library.load ~main_module reference
+        and+ current_map = Api_watch.Library.load ~main_module current in
+        (reference_map, current_map)
+    | Unwrapped ->
+        let+ reference_map = Api_watch.Library.load_unwrapped reference
+        and+ current_map = Api_watch.Library.load_unwrapped current in
+        (reference_map, current_map)
+    | Cmi ->
         let+ reference_cmi, _ = Api_watch.Library.load_cmi reference
         and+ current_cmi, module_name = Api_watch.Library.load_cmi current in
-        (reference_cmi, current_cmi, module_name)
-    | true, false, _ | false, true, _ ->
-        Error
-          "Arguments must either both be directories or both single .cmi files."
-    | true, true, None ->
-        Error "--main-module must be provided when diffing entire libraries."
+        let reference_map =
+          Api_watch.String_map.singleton module_name reference_cmi
+        in
+        let current_map =
+          Api_watch.String_map.singleton module_name current_cmi
+        in
+        (reference_map, current_map)
   in
-  let diff =
-    Api_watch.Diff.interface ~module_name ~reference:reference_sig
-      ~current:current_sig
+  let diff_map =
+    Api_watch.Diff.library ~reference:reference_map ~current:current_map
+    |> Api_watch.String_map.bindings
+    |> List.filter_map (fun (_, v) -> v)
   in
-  match diff with
-  | None -> Ok 0
-  | Some diff ->
+  let has_changes = not (List.is_empty diff_map) in
+  List.iter
+    (fun diff ->
       let text_diff = Api_watch.Text_diff.from_diff diff in
-      Api_watch.Text_diff.With_colors.pp Format.std_formatter text_diff;
-      Ok 1
+      Api_watch.Text_diff.With_colors.pp Format.std_formatter text_diff)
+    diff_map;
+  if has_changes then Ok 1 else Ok 0
 
 let named f = Cmdliner.Term.(app (const f))
 
@@ -54,6 +92,15 @@ let main_module =
     Cmdliner.Arg.(
       value & opt (some string) None & info ~doc ~docv [ "main-module" ])
 
+let unwrapped_library =
+  let doc =
+    "Loads a library without a main module. Ignored when diffing single \
+     $(b,.cmi) files."
+  in
+  named
+    (fun x -> `Unwrapped_library x)
+    Cmdliner.Arg.(value & flag & info ~doc [ "unwrapped" ])
+
 let ref_cmi =
   let docv = "REF_CMI_FILES" in
   let doc =
@@ -79,7 +126,9 @@ let info =
   Cmd.info tool_name ~version:"%%VERSION%%" ~exits:Cmd.Exit.defaults
     ~doc:"List API changes between two versions of a library"
 
-let term = Cmdliner.Term.(const run $ main_module $ ref_cmi $ current_cmi)
+let term =
+  Cmdliner.Term.(
+    const run $ main_module $ unwrapped_library $ ref_cmi $ current_cmi)
 
 let () =
   Fmt_tty.setup_std_outputs ();
diff --git a/dev-tools/print_api.ml b/dev-tools/print_api.ml
@@ -21,7 +21,8 @@ let run (`Main_module main_module) (`Input fn) =
       List.iter print_cmi cmi_files;
       Ok ()
   | true, Some main_module ->
-      let+ sig_ = Api_watch.Library.load ~main_module fn in
+      let+ sig_map = Api_watch.Library.load ~main_module fn in
+      let sig_ = Api_watch.String_map.find main_module sig_map in
       Printtyp.signature Format.std_formatter sig_;
       Format.printf "\n"
 
diff --git a/lib/diff.ml b/lib/diff.ml
@@ -4,8 +4,8 @@ type ('item, 'diff) t = Added of 'item | Removed of 'item | Modified of 'diff
 
 type 'a atomic_modification = { reference : 'a; current : 'a }
 (** The simplest diff representation for the modification of a value of type 'a.
-     [reference] is the value before and [current] is the value after the change occured.
-     Use this type when there is no better representation available. *)
+    [reference] is the value before and [current] is the value after the change
+    occured. Use this type when there is no better representation available. *)
 
 type value = {
   vname : string;
@@ -235,3 +235,55 @@ let interface ~module_name ~reference ~current =
   let typing_env = Env.empty in
   let sig_out = signatures ~typing_env ~reference ~current in
   Option.map (fun mdiff -> { mname = module_name; mdiff }) sig_out
+
+let library ~reference ~current =
+  let mod_dec_of_sig sign =
+    {
+      md_type = Mty_signature sign;
+      md_attributes = [];
+      md_loc = Location.none;
+      md_uid = Uid.internal_not_actually_unique;
+    }
+  in
+  String_map.merge
+    (fun module_name ref_sig_opt cur_sig_opt ->
+      match (ref_sig_opt, cur_sig_opt) with
+      | None, None -> None
+      | Some ref_sig, None ->
+          Some
+            (Some
+               {
+                 mname = module_name;
+                 mdiff =
+                   Modified
+                     (Supported
+                        [
+                          Module
+                            {
+                              mname = module_name;
+                              mdiff = Removed (mod_dec_of_sig ref_sig);
+                            };
+                        ]);
+               })
+      | None, Some cur_sig ->
+          Some
+            (Some
+               {
+                 mname = module_name;
+                 mdiff =
+                   Modified
+                     (Supported
+                        [
+                          Module
+                            {
+                              mname = module_name;
+                              mdiff = Added (mod_dec_of_sig cur_sig);
+                            };
+                        ]);
+               })
+      | Some ref_sig, Some cur_sig -> (
+          let module_diff =
+            interface ~module_name ~reference:ref_sig ~current:cur_sig
+          in
+          match module_diff with None -> None | Some _ -> Some module_diff))
+    reference current
diff --git a/lib/diff.mli b/lib/diff.mli
@@ -51,3 +51,6 @@ val interface :
   reference:Types.signature ->
   current:Types.signature ->
   module_ option
+
+val library :
+  reference:Library.t -> current:Library.t -> module_ option String_map.t
diff --git a/lib/library.ml b/lib/library.ml
@@ -178,7 +178,17 @@ let rec expand_sig ~library_modules sig_ =
       | _ -> Ok item)
     sig_
 
-let load ~main_module project_path =
+type t = Types.signature String_map.t
+
+let load_unwrapped project_path : (t, string) result =
+  let open CCResult.Infix in
+  let* library_modules = collect_modules project_path in
+  let module_map =
+    String_map.map (fun sig_ -> Lazy.force sig_) library_modules
+  in
+  Ok module_map
+
+let load ~main_module project_path : (t, string) result =
   let open CCResult.Infix in
   let* library_modules = collect_modules project_path in
   let* main_sig =
@@ -189,4 +199,9 @@ let load ~main_module project_path =
           (Printf.sprintf "Could not find main module %s in %s" main_module
              project_path)
   in
-  expand_sig ~library_modules main_sig
+  let expanded_main_sig =
+    match expand_sig ~library_modules main_sig with
+    | Ok expanded_sig -> expanded_sig
+    | Error e -> failwith e
+  in
+  Ok (String_map.singleton main_module expanded_main_sig)
diff --git a/lib/library.mli b/lib/library.mli
@@ -1,2 +1,16 @@
 val load_cmi : string -> (Types.signature * string, string) result
-val load : main_module:string -> string -> (Types.signature, string) result
+
+type t = Types.signature String_map.t
+(** Type representing a library's root modules.
+    For wrapped libraries, contains only the main module.
+    For unwrapped libraries, contains all root-level modules. *)
+
+val load_unwrapped : string -> (t, string) result
+(** Load an unwrapped library, returning all root-level modules.
+    Each module in the returned map represents a .cmi file at the root
+    of the project path. *)
+
+val load : main_module:string -> string -> (t, string) result
+(** Load a wrapped library, returning only its main module.
+    The returned map will contain a single entry for the main module,
+    with all its dependencies expanded. *)
diff --git a/tests/api-diff/errors.t b/tests/api-diff/errors.t
@@ -7,18 +7,30 @@ diff a .cmi file with another .cmi file or a directory with a directory
   api-diff: Arguments must either both be directories or both single .cmi files.
   [123]
 
-When diffing all libraries, the --main-module argument is mandatory
+When diffing all libraries, the Either --main-module or --unwrapped must be specified
 
   $ mkdir test2
   $ api-diff test test2
-  api-diff: --main-module must be provided when diffing entire libraries.
+  api-diff: Either --main-module or --unwrapped must be provided when diffing entire libraries.
   [123]
 
-When passing --main-module while diffing single .cmi files, the user will be warn
+When passing --main-module and/or --unwrapped while diffing single .cmi files, the user will be warn
 that it is ignored
 
   $ touch test2.cmi
   $ api-diff --main-module main test.cmi test2.cmi
-  api-diff: --main-module ignored when diffing single .cmi files
+  api-diff: --main-module is ignored when diffing single .cmi files
+  api-diff: Cmi_format.Error(_)
+  [123]
+
+  $ touch test2.cmi
+  $ api-diff --unwrapped test.cmi test2.cmi
+  api-diff: --unwrapped is ignored when diffing single .cmi files
+  api-diff: Cmi_format.Error(_)
+  [123]
+
+  $ touch test2.cmi
+  $ api-diff --main-module main --unwrapped test.cmi test2.cmi
+  api-diff: --main-module and --unwrapped are ignored when diffing single .cmi files
   api-diff: Cmi_format.Error(_)
   [123]
diff --git a/tests/api-diff/project_comparison.t b/tests/api-diff/project_comparison.t
