ocamlformatting

Signed-off-by: Paul-Elliot <[email protected]>

Author: panglesd

src/driver/compile.ml

@@ -2,7 +2,7 @@
 
 type ty = Module of Packages.modulety | Mld of Packages.mld
 
-type impl = { impl_odoc : Fpath.t; impl_odocl: Fpath.t; src : Fpath.t }
+type impl = { impl_odoc : Fpath.t; impl_odocl : Fpath.t; src : Fpath.t }
 
 type pkg_args = {
   docs : (string * Fpath.t) list;
@@ -69,7 +69,7 @@ let init_stats (pkgs : Packages.t Util.StringMap.t) =
 
 open Eio.Std
 
-type partial = 
+type partial =
   (string * compiled) list * (string * Packages.modulety) Util.StringMap.t
 
 let unmarshal filename =
@@ -87,26 +87,34 @@ let marshal (v : partial) filename =
 
 let find_partials odoc_dir =
   let tbl = Hashtbl.create 1000 in
-  let hashes_result = Bos.OS.Dir.fold_contents ~dotfiles:false
-  (fun p hashes ->
-    if Fpath.filename p = "index.m"
-    then
-      let (tbl', hashes') = unmarshal p in
-      List.iter (fun (k,v) -> Hashtbl.replace tbl k (Promise.create_resolved (Ok v))) tbl';
-      Util.StringMap.union (fun _x o1 _o2 -> Some o1) hashes hashes'
-    else hashes) Util.StringMap.empty odoc_dir in
+  let hashes_result =
+    Bos.OS.Dir.fold_contents ~dotfiles:false
+      (fun p hashes ->
+        if Fpath.filename p = "index.m" then (
+          let tbl', hashes' = unmarshal p in
+          List.iter
+            (fun (k, v) ->
+              Hashtbl.replace tbl k (Promise.create_resolved (Ok v)))
+            tbl';
+          Util.StringMap.union (fun _x o1 _o2 -> Some o1) hashes hashes')
+        else hashes)
+      Util.StringMap.empty odoc_dir
+  in
   match hashes_result with
-  | Ok h -> h, tbl
-  | Error _ -> (* odoc_dir doesn't exist...? *) Util.StringMap.empty, tbl
+  | Ok h -> (h, tbl)
+  | Error _ -> (* odoc_dir doesn't exist...? *) (Util.StringMap.empty, tbl)
 
 let compile partial ~output_dir ?linked_dir all =
   let linked_dir = Option.value linked_dir ~default:output_dir in
   let hashes = mk_byhash all in
   let other_hashes, tbl =
     match partial with
     | Some _ -> find_partials output_dir
-    | None -> Util.StringMap.empty, Hashtbl.create 10 in
-  let all_hashes = Util.StringMap.union (fun _x o1 _o2 -> Some o1) hashes other_hashes in
+    | None -> (Util.StringMap.empty, Hashtbl.create 10)
+  in
+  let all_hashes =
+    Util.StringMap.union (fun _x o1 _o2 -> Some o1) hashes other_hashes
+  in
   let pkg_args =
     let docs, libs =
       Util.StringMap.fold
@@ -115,7 +123,8 @@ let compile partial ~output_dir ?linked_dir all =
           let lib =
             List.map
               (fun lib ->
-                ( lib.Packages.lib_name, Fpath.(output_dir // lib.Packages.odoc_dir )))
+                ( lib.Packages.lib_name,
+                  Fpath.(output_dir // lib.Packages.odoc_dir) ))
               pkg.Packages.libraries
           in
           let docs = doc :: docs and libs = List.rev_append lib libs in
@@ -165,7 +174,12 @@ let compile partial ~output_dir ?linked_dir all =
                   Odoc.compile_impl ~output_dir ~input_file:impl.mip_path
                     ~includes ~parent_id:impl.mip_parent_id ~source_id:si.src_id;
                   Atomic.incr Stats.stats.compiled_impls;
-                  Some { impl_odoc = odoc_file; impl_odocl=odocl_file; src = si.src_path }
+                  Some
+                    {
+                      impl_odoc = odoc_file;
+                      impl_odocl = odocl_file;
+                      src = si.src_path;
+                    }
               | None -> None)
           | None -> None
         in
@@ -203,81 +217,77 @@ let compile partial ~output_dir ?linked_dir all =
   in
   let to_build = Util.StringMap.bindings hashes |> List.map fst in
   let mod_results = Fiber.List.map compile to_build in
-  let zipped_res = List.map2 (fun a b -> (a,b)) to_build mod_results in
-  let zipped = List.filter_map (function (a, Ok b) -> Some (a,b) | _ -> None) zipped_res in
+  let zipped_res = List.map2 (fun a b -> (a, b)) to_build mod_results in
+  let zipped =
+    List.filter_map (function a, Ok b -> Some (a, b) | _ -> None) zipped_res
+  in
   let mods =
     List.filter_map (function Ok x -> Some x | Error _ -> None) mod_results
   in
-  let result = Util.StringMap.fold
-    (fun package_name (pkg : Packages.t) acc ->
-      Logs.debug (fun m ->
-          m "Package %s mlds: [%a]" pkg.name
-            Fmt.(list ~sep:sp Packages.pp_mld)
-            pkg.mlds);
-      List.fold_left
-        (fun acc (mld : Packages.mld) ->
-          let odoc_file = Fpath.(output_dir // mld.Packages.mld_odoc_file) in
-          let odocl_file = Fpath.(linked_dir // mld.Packages.mld_odocl_file) in
-          let odoc_output_dir = Fpath.split_base odoc_file |> fst in
-          Odoc.compile ~output_dir ~input_file:mld.mld_path
-            ~includes:Fpath.Set.empty ~parent_id:mld.mld_parent_id;
-          Atomic.incr Stats.stats.compiled_mlds;
-          let include_dirs =
-            List.map (fun f -> Fpath.(output_dir // f)) mld.mld_deps
-            |> Fpath.Set.of_list
-          in
-          let include_dirs = Fpath.Set.add odoc_output_dir include_dirs in
-          let odoc_output_dir = Fpath.split_base odoc_file |> fst in
-          {
-            m = Mld mld;
-            odoc_output_dir;
-            odoc_file;
-            odocl_file;
-            include_dirs;
-            impl = None;
-            pkg_args;
-            pkg_dir = mld.mld_pkg_dir;
-            pkg_name = package_name;
-          }
-          :: acc)
-        acc pkg.mlds)
-    all mods in
+  let result =
+    Util.StringMap.fold
+      (fun package_name (pkg : Packages.t) acc ->
+        Logs.debug (fun m ->
+            m "Package %s mlds: [%a]" pkg.name
+              Fmt.(list ~sep:sp Packages.pp_mld)
+              pkg.mlds);
+        List.fold_left
+          (fun acc (mld : Packages.mld) ->
+            let odoc_file = Fpath.(output_dir // mld.Packages.mld_odoc_file) in
+            let odocl_file =
+              Fpath.(linked_dir // mld.Packages.mld_odocl_file)
+            in
+            let odoc_output_dir = Fpath.split_base odoc_file |> fst in
+            Odoc.compile ~output_dir ~input_file:mld.mld_path
+              ~includes:Fpath.Set.empty ~parent_id:mld.mld_parent_id;
+            Atomic.incr Stats.stats.compiled_mlds;
+            let include_dirs =
+              List.map (fun f -> Fpath.(output_dir // f)) mld.mld_deps
+              |> Fpath.Set.of_list
+            in
+            let include_dirs = Fpath.Set.add odoc_output_dir include_dirs in
+            let odoc_output_dir = Fpath.split_base odoc_file |> fst in
+            {
+              m = Mld mld;
+              odoc_output_dir;
+              odoc_file;
+              odocl_file;
+              include_dirs;
+              impl = None;
+              pkg_args;
+              pkg_dir = mld.mld_pkg_dir;
+              pkg_name = package_name;
+            }
+            :: acc)
+          acc pkg.mlds)
+      all mods
+  in
 
   (match partial with
   | Some l -> marshal (zipped, hashes) Fpath.(l / "index.m")
   | None -> ());
   result
 
-type linked = {
-  output_file : Fpath.t;
-  src : Fpath.t option;
-  pkg_dir : Fpath.t;
-}
+type linked = { output_file : Fpath.t; src : Fpath.t option; pkg_dir : Fpath.t }
 
 let link : compiled list -> _ =
  fun compiled ->
   let link : compiled -> linked list =
    fun c ->
     let includes = Fpath.Set.add c.odoc_output_dir c.include_dirs in
     let link input_file output_file =
-      let { pkg_args = { libs; docs }; pkg_name; _ } =
-        c
-      in
-      Odoc.link ~input_file ~output_file ~includes ~libs ~docs ~current_package:pkg_name ()
+      let { pkg_args = { libs; docs }; pkg_name; _ } = c in
+      Odoc.link ~input_file ~output_file ~includes ~libs ~docs
+        ~current_package:pkg_name ()
     in
     let impl =
       match c.impl with
       | Some { impl_odoc; impl_odocl; src } ->
-          Logs.debug (fun m -> m "Linking impl: %a -> %a" Fpath.pp impl_odoc Fpath.pp impl_odocl);
+          Logs.debug (fun m ->
+              m "Linking impl: %a -> %a" Fpath.pp impl_odoc Fpath.pp impl_odocl);
           link impl_odoc impl_odocl;
           Atomic.incr Stats.stats.linked_impls;
-          [
-            {
-              pkg_dir = c.pkg_dir;
-              output_file = impl_odocl;
-              src = Some src;
-            };
-          ]
+          [ { pkg_dir = c.pkg_dir; output_file = impl_odocl; src = Some src } ]
       | None -> []
     in
     match c.m with
@@ -290,12 +300,7 @@ let link : compiled list -> _ =
         (match c.m with
         | Module _ -> Atomic.incr Stats.stats.linked_units
         | Mld _ -> Atomic.incr Stats.stats.linked_mlds);
-        {
-          output_file = c.odocl_file;
-          src = None;
-          pkg_dir = c.pkg_dir;
-        }
-        :: impl
+        { output_file = c.odocl_file; src = None; pkg_dir = c.pkg_dir } :: impl
   in
   Fiber.List.map link compiled |> List.concat
 
@@ -304,8 +309,7 @@ let index_one ~odocl_dir pkgname pkg =
   let output_file = Fpath.(odocl_dir // dir / Odoc.index_filename) in
   let libs =
     List.map
-      (fun lib ->
-        (lib.Packages.lib_name, Fpath.(odocl_dir // lib.odoc_dir)))
+      (fun lib -> (lib.Packages.lib_name, Fpath.(odocl_dir // lib.odoc_dir)))
       pkg.Packages.libraries
   in
   Odoc.compile_index ~json:false ~output_file ~libs
@@ -315,7 +319,9 @@ let index_one ~odocl_dir pkgname pkg =
 let index ~odocl_dir pkgs = Util.StringMap.iter (index_one ~odocl_dir) pkgs
 
 let sherlodoc_index_one ~html_dir ~odocl_dir _ pkg_content =
-  let inputs = [ Fpath.(odocl_dir // pkg_content.Packages.pkg_dir / Odoc.index_filename) ] in
+  let inputs =
+    [ Fpath.(odocl_dir // pkg_content.Packages.pkg_dir / Odoc.index_filename) ]
+  in
   let dst = Fpath.(html_dir // Sherlodoc.db_js_file pkg_content.pkg_dir) in
   let dst_dir, _ = Fpath.split_base dst in
   Util.mkdir_p dst_dir;
@@ -331,20 +337,16 @@ let sherlodoc ~html_dir ~odocl_dir pkgs =
   Util.mkdir_p dst_dir;
   let inputs =
     pkgs |> Util.StringMap.bindings
-    |> List.map (fun (_pkgname, pkg) -> Fpath.(odocl_dir // pkg.Packages.pkg_dir / Odoc.index_filename))
+    |> List.map (fun (_pkgname, pkg) ->
+           Fpath.(odocl_dir // pkg.Packages.pkg_dir / Odoc.index_filename))
   in
   Sherlodoc.index ~format ~inputs ~dst ()
 
 let html_generate output_dir ~odocl_dir linked =
   let html_generate : linked -> unit =
    fun l ->
-    let search_uris =
-      [
-        Sherlodoc.db_js_file l.pkg_dir;
-        Sherlodoc.js_file;
-      ]
-    in
-    let index = Some (Fpath.(odocl_dir // l.pkg_dir / Odoc.index_filename)) in
+    let search_uris = [ Sherlodoc.db_js_file l.pkg_dir; Sherlodoc.js_file ] in
+    let index = Some Fpath.(odocl_dir // l.pkg_dir / Odoc.index_filename) in
     Odoc.html_generate ~search_uris ?index
       ~output_dir:(Fpath.to_string output_dir)
       ~input_file:l.output_file ?source:l.src ();

src/driver/compile.mli

@@ -2,7 +2,12 @@ type compiled
 
 val init_stats : Packages.set -> unit
 
-val compile : Fpath.t option -> output_dir:Fpath.t -> ?linked_dir:Fpath.t -> Packages.set -> compiled list
+val compile :
+  Fpath.t option ->
+  output_dir:Fpath.t ->
+  ?linked_dir:Fpath.t ->
+  Packages.set ->
+  compiled list
 
 type linked
 

src/driver/dune_style.ml

@@ -1,42 +1,68 @@
 (* Dune build tree *)
 
 let of_dune_build dir =
-  let contents = Bos.OS.Dir.fold_contents ~dotfiles:true
-    (fun p acc ->
-      p::acc
-    ) [] Fpath.(v dir) in
+  let contents =
+    Bos.OS.Dir.fold_contents ~dotfiles:true
+      (fun p acc -> p :: acc)
+      []
+      Fpath.(v dir)
+  in
   match contents with
   | Error _ -> Util.StringMap.empty
-  | Ok c -> 
-    let sorted = List.sort (fun p1 p2 -> Fpath.compare p1 p2) c in
-    let libs = List.filter_map (fun x ->
-      match Fpath.segs x |> List.rev with
-      | "byte" :: libname :: path ->
-        let sz = String.length ".objs" in
-        if Astring.String.is_suffix ~affix:".objs" libname && String.length libname > sz + 1 && libname.[0] = '.'
-        then
-          let libname = String.sub libname 1 (String.length libname - sz - 1) in
-          Some (libname, Fpath.(v (String.concat dir_sep (List.rev path))))
-        else None
-      | _ -> None) sorted in
-    let libs = List.map (fun (libname, path) ->
-      let cmtidir = Fpath.(path / Printf.sprintf ".%s.objs" libname / "byte") in
-      match Fpath.rem_prefix (Fpath.v dir) path with
-      | Some pkg_dir ->
-          (pkg_dir, Packages.Lib.v pkg_dir (Util.StringMap.singleton libname libname) libname path (Some cmtidir))
-      | None -> failwith "Error") libs
-    in
-    let packages = List.filter_map (fun (pkg_dir, lib) ->
-      match lib with
-      | [lib] ->
-        Some (lib.Packages.lib_name, {
-        Packages.name = lib.Packages.lib_name;
-        version="1.0";
-        libraries=[lib];
-        mlds = [];
-        mld_odoc_dir = Fpath.v lib.Packages.lib_name;
-        pkg_dir;
-        other_docs = Fpath.Set.empty;
-        })
-      | _ -> None) libs in
-    Util.StringMap.of_list packages
+  | Ok c ->
+      let sorted = List.sort (fun p1 p2 -> Fpath.compare p1 p2) c in
+      let libs =
+        List.filter_map
+          (fun x ->
+            match Fpath.segs x |> List.rev with
+            | "byte" :: libname :: path ->
+                let sz = String.length ".objs" in
+                if
+                  Astring.String.is_suffix ~affix:".objs" libname
+                  && String.length libname > sz + 1
+                  && libname.[0] = '.'
+                then
+                  let libname =
+                    String.sub libname 1 (String.length libname - sz - 1)
+                  in
+                  Some
+                    (libname, Fpath.(v (String.concat dir_sep (List.rev path))))
+                else None
+            | _ -> None)
+          sorted
+      in
+      let libs =
+        List.map
+          (fun (libname, path) ->
+            let cmtidir =
+              Fpath.(path / Printf.sprintf ".%s.objs" libname / "byte")
+            in
+            match Fpath.rem_prefix (Fpath.v dir) path with
+            | Some pkg_dir ->
+                ( pkg_dir,
+                  Packages.Lib.v pkg_dir
+                    (Util.StringMap.singleton libname libname)
+                    libname path (Some cmtidir) )
+            | None -> failwith "Error")
+          libs
+      in
+      let packages =
+        List.filter_map
+          (fun (pkg_dir, lib) ->
+            match lib with
+            | [ lib ] ->
+                Some
+                  ( lib.Packages.lib_name,
+                    {
+                      Packages.name = lib.Packages.lib_name;
+                      version = "1.0";
+                      libraries = [ lib ];
+                      mlds = [];
+                      mld_odoc_dir = Fpath.v lib.Packages.lib_name;
+                      pkg_dir;
+                      other_docs = Fpath.Set.empty;
+                    } )
+            | _ -> None)
+          libs
+      in
+      Util.StringMap.of_list packages