Part 2 : pinned packages support

docs/docson/build-schema.json

@@ -404,6 +404,10 @@
             "$ref": "#/definitions/dependencies",
             "description": "OCaml/Reason dev dependencies of the library, like in package.json. Currently searches in `node_modules`"
         },
+        "pinned-dependencies" : {
+            "$ref": "#/definitions/dependencies",
+            "description": "Those dependencies are pinned (since version 8.4)"
+        },
         "generators": {
             "type": "array",
             "items": {

jscomp/bsb/bsb_build_schemas.ml

@@ -36,6 +36,7 @@ let refmt = "refmt"
 let bs_external_includes = "bs-external-includes"
 let bs_lib_dir = "bs-lib-dir"
 let bs_dependencies = "bs-dependencies"
+let pinned_dependencies = "pinned-dependencies"
 let bs_dev_dependencies = "bs-dev-dependencies"
 
 

jscomp/bsb/bsb_config_parse.ml

@@ -40,17 +40,10 @@ let (|?)  m (key, cb) =
 
 
 
+let (.?()) = Map_string.find_opt
 
 
 
-let package_specs_from_bsconfig () = 
-  let json = Ext_json_parse.parse_json_from_file Literals.bsconfig_json in
-  begin match json with
-    | Obj {map} ->
-      Bsb_package_specs.from_map map
-    | _ -> assert false
-  end
-
 
 
 
@@ -61,7 +54,7 @@ let package_specs_from_bsconfig () =
 let extract_package_name_and_namespace
     (map : json_map) : string * string option =   
   let package_name = 
-    match Map_string.find_opt map Bsb_build_schemas.name with 
+    match  map.?(Bsb_build_schemas.name) with 
 
     | Some (Str { str = "_" } as config)
       -> 
@@ -76,7 +69,7 @@ let extract_package_name_and_namespace
         "field name is required"
   in 
   let namespace = 
-    match Map_string.find_opt map Bsb_build_schemas.namespace with 
+    match map.?(Bsb_build_schemas.namespace) with 
     | None 
     | Some (False _) 
       -> None 
@@ -115,7 +108,7 @@ let check_version_exit (map : json_map) stdlib_path =
   | _ -> assert false
 
 let check_stdlib (map : json_map) cwd (*built_in_package*) =  
-  match Map_string.find_opt map Bsb_build_schemas.use_stdlib with      
+  match map.?( Bsb_build_schemas.use_stdlib) with      
   | Some (False _) -> None    
   | None 
   | Some _ ->
@@ -143,11 +136,11 @@ let check_stdlib (map : json_map) cwd (*built_in_package*) =
 
 let extract_gentype_config (map : json_map) cwd 
   : Bsb_config_types.gentype_config option = 
-  match Map_string.find_opt map Bsb_build_schemas.gentypeconfig with 
+  match map.?(Bsb_build_schemas.gentypeconfig) with 
   | None -> None
   | Some (Obj {map = obj}) -> 
     Some { path = 
-             match Map_string.find_opt obj Bsb_build_schemas.path with
+             match obj.?(Bsb_build_schemas.path) with
              | None -> 
                (Bsb_build_util.resolve_bsb_magic_file
                  ~cwd ~desc:"gentype.exe"
@@ -165,7 +158,7 @@ let extract_gentype_config (map : json_map) cwd
       config "gentypeconfig expect an object"  
 
 let extract_refmt (map : json_map) cwd : Bsb_config_types.refmt =      
-  match Map_string.find_opt map Bsb_build_schemas.refmt with 
+  match map.?(Bsb_build_schemas.refmt) with 
   | Some (Flo {flo} as config) -> 
     begin match flo with 
       | "3" -> None
@@ -182,14 +175,14 @@ let extract_refmt (map : json_map) cwd : Bsb_config_types.refmt =
     None
 
 let extract_string (map : json_map) (field : string) cb = 
-  match Map_string.find_opt map field with 
+  match  map.?( field) with 
   | None -> None 
   | Some (Str{str}) -> cb str 
   | Some config -> 
     Bsb_exception.config_error config (field ^ " expect a string" )
 
 let extract_boolean (map : json_map) (field : string) (default : bool) : bool = 
-  match Map_string.find_opt map field with 
+  match map.?(field) with 
   | None -> default 
   | Some (True _ ) -> true
   | Some (False _) -> false 
@@ -200,7 +193,7 @@ let extract_reason_react_jsx (map : json_map) =
   let default : Bsb_config_types.reason_react_jsx option ref = ref None in 
   map
   |? (Bsb_build_schemas.reason, `Obj begin fun m -> 
-      match Map_string.find_opt m Bsb_build_schemas.react_jsx with 
+      match m.?(Bsb_build_schemas.react_jsx) with 
       | Some (Flo{loc; flo}) -> 
         begin match flo with 
           | "3" -> 
@@ -215,30 +208,37 @@ let extract_reason_react_jsx (map : json_map) =
   !default
 
 let extract_warning (map : json_map) = 
-  match Map_string.find_opt map Bsb_build_schemas.warnings with 
+  match map.?(Bsb_build_schemas.warnings) with 
   | None -> Bsb_warning.use_default 
   | Some (Obj {map }) -> Bsb_warning.from_map map 
   | Some config -> Bsb_exception.config_error config "expect an object"
 
-let extract_ignored_dirs (map : json_map) =   
-  match Map_string.find_opt map Bsb_build_schemas.ignored_dirs with 
+let extract_ignored_dirs (map : json_map) : Set_string .t =   
+  match map.?(Bsb_build_schemas.ignored_dirs) with 
   | None -> Set_string.empty
   | Some (Arr {content}) -> 
     Set_string.of_list (Bsb_build_util.get_list_string content)
   | Some config -> 
     Bsb_exception.config_error config "expect an array of string"  
+let extract_pinned_dependencies (map : json_map) : Set_string.t = 
+  match map.?(Bsb_build_schemas.pinned_dependencies) with 
+  | None -> Set_string.empty
+  | Some (Arr {content}) -> 
+    Set_string.of_list (Bsb_build_util.get_list_string content)
+  | Some config -> 
+    Bsb_exception.config_error config "expect an array of string"    
 
 let extract_generators (map : json_map) = 
   let generators = ref Map_string.empty in 
-  (match Map_string.find_opt map Bsb_build_schemas.generators with 
+  (match map.?(Bsb_build_schemas.generators) with 
    | None -> ()
    | Some (Arr {content = s}) -> 
      generators :=
        Ext_array.fold_left s Map_string.empty (fun acc json -> 
            match json with 
            | Obj {map = m ; loc}  -> 
-             begin match Map_string.find_opt  m Bsb_build_schemas.name,
-                         Map_string.find_opt  m Bsb_build_schemas.command with 
+             begin match m.?(Bsb_build_schemas.name),
+                         m.?(Bsb_build_schemas.command) with 
              | Some (Str {str = name}), Some ( Str {str = command}) -> 
                Map_string.add acc name command 
              | _, _ -> 
@@ -253,7 +253,7 @@ let extract_generators (map : json_map) =
 
 let extract_dependencies (map : json_map) cwd (field : string )
   : Bsb_config_types.dependencies =   
-  match Map_string.find_opt map field with 
+  match map.?(field) with 
   | None -> []
   | Some (Arr ({content = s})) -> 
     Ext_list.map (Bsb_build_util.get_list_string s) (fun s -> resolve_package cwd (Bsb_pkg_types.string_as_package s))
@@ -263,7 +263,7 @@ let extract_dependencies (map : json_map) cwd (field : string )
 
 (* return an empty array if not found *)     
 let extract_string_list (map : json_map) (field : string) : string list = 
-  match Map_string.find_opt map field with 
+  match map.?(field) with 
   | None -> []
   | Some (Arr {content = s}) -> 
     Bsb_build_util.get_list_string s 
@@ -274,7 +274,7 @@ let extract_ppx
   (map : json_map) 
   (field : string) 
   ~(cwd : string) : Bsb_config_types.ppx list =     
-  match Map_string.find_opt map field with 
+  match map.?(field) with 
   | None -> []
   | Some (Arr {content }) -> 
     let resolve s = 
@@ -367,10 +367,13 @@ let interpret_json
     let bs_dependencies = extract_dependencies map per_proj_dir Bsb_build_schemas.bs_dependencies in    
     let bs_dev_dependencies = 
       match package_kind with 
-      | Toplevel ->
+      | Toplevel 
+      | Pinned_dependency _ ->
         extract_dependencies map per_proj_dir Bsb_build_schemas.bs_dev_dependencies
       | Dependency _ -> [] in 
-    begin match Map_string.find_opt map Bsb_build_schemas.sources with 
+    let pinned_dependencies = 
+      extract_pinned_dependencies map in   
+    begin match map.?(Bsb_build_schemas.sources) with 
       | Some sources -> 
         let cut_generators = 
           extract_boolean map Bsb_build_schemas.cut_generators false in 
@@ -382,6 +385,7 @@ let interpret_json
             ~namespace
             sources in         
         {
+          pinned_dependencies;  
           gentype_config;
           package_name ;
           namespace ;    
@@ -406,6 +410,7 @@ let interpret_json
           package_specs = 
             (match package_kind with 
              | Toplevel ->  Bsb_package_specs.from_map map                
+             | Pinned_dependency x
              | Dependency x -> x);          
           file_groups = groups; 
           files_to_install = Queue.create ();
@@ -422,3 +427,13 @@ let interpret_json
     end
   | _ -> 
     Bsb_exception.invalid_spec "bsconfig.json expect a json object {}"
+
+
+let package_specs_from_bsconfig () = 
+  let json = Ext_json_parse.parse_json_from_file Literals.bsconfig_json in
+  begin match json with
+    | Obj {map} ->
+      Bsb_package_specs.from_map map,
+      extract_pinned_dependencies map
+    | _ -> assert false
+  end

jscomp/bsb/bsb_config_parse.mli

@@ -23,7 +23,8 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 val package_specs_from_bsconfig : 
-    unit -> Bsb_package_specs.t
+    unit -> 
+    Bsb_package_specs.t * Set_string.t
 
 
 

jscomp/bsb/bsb_config_types.ml

@@ -60,6 +60,7 @@ type t =
     pp_file : string option;
     bs_dependencies : dependencies;
     bs_dev_dependencies : dependencies;
+    pinned_dependencies : Set_string.t;
     built_in_dependency : dependency option; 
     warning : Bsb_warning.t;
     (*TODO: maybe we should always resolve bs-platform 

jscomp/bsb/bsb_ninja_check.ml

@@ -44,6 +44,7 @@ type check_result =
   | Bsb_source_directory_changed
   | Bsb_bsc_version_mismatch
   | Bsb_forced
+  | Bsb_package_kind_inconsistent
   | Other of string
 
 let pp_check_result fmt (check_resoult : check_result) =
@@ -57,6 +58,8 @@ let pp_check_result fmt (check_resoult : check_result) =
         "Bsc or bsb version mismatch"
       | Bsb_forced ->
         "Bsb forced rebuild"
+      | Bsb_package_kind_inconsistent -> 
+        "The package was built in different mode"  
       | Other s -> s)
 
 let rec check_aux cwd (xs : string list)  =
@@ -94,12 +97,18 @@ and check_global rest =
 
 
 let record 
+  ~(package_kind : Bsb_package_kind.t)
   ~per_proj_dir ~file  
   ~(config:Bsb_config_types.t) (file_or_dirs : string list) : unit =
   let _ = config in 
   let buf = Ext_buffer.create 1_000 in   
   Ext_buffer.add_string_char buf Bs_version.version '\n';  
   Ext_buffer.add_string_char buf per_proj_dir '\n';
+  (match package_kind with 
+  | Toplevel -> Ext_buffer.add_string buf "0\n"
+  | Dependency _ -> Ext_buffer.add_string buf "1\n"
+  | Pinned_dependency _ -> Ext_buffer.add_string buf "2\n"
+  );
   Ext_list.iter file_or_dirs (fun f -> 
     Ext_buffer.add_string_char buf f '\t'; 
     Ext_buffer.add_string_char buf 
@@ -126,18 +135,29 @@ let record
     Even forced, we still need walk through a little
     bit in case we found a different version of compiler
 *)
-let check ~(per_proj_dir:string) ~forced ~file : check_result =
+let check 
+  ~(package_kind : Bsb_package_kind.t)
+  ~(per_proj_dir:string) ~forced ~file : check_result =
   match  open_in_bin file with   (* Windows binary mode*)    
   | exception _ -> Bsb_file_not_exist
   | ic ->
     match List.rev (Ext_io.rev_lines_of_chann ic) with
     | exception _ -> Bsb_file_corrupted 
-    | version :: source_directory :: dir_or_files ->
+    | version :: source_directory ::package_kind_str:: dir_or_files ->
       if version <> Bs_version.version then Bsb_bsc_version_mismatch
       else 
         if per_proj_dir <> source_directory then Bsb_source_directory_changed else
         if forced then Bsb_forced (* No need walk through *)
-        else begin 
+        else if 
+
+          not (match package_kind, package_kind_str with 
+          | Toplevel, "0" 
+          | Dependency _, "1"
+          | Pinned_dependency _, "2" -> true 
+          | _ -> false ) then 
+          Bsb_package_kind_inconsistent
+        else
+        begin 
           try
             check_aux per_proj_dir dir_or_files 
           with e ->

jscomp/bsb/bsb_ninja_check.mli

@@ -41,6 +41,7 @@ type check_result =
   | Bsb_source_directory_changed
   | Bsb_bsc_version_mismatch  
   | Bsb_forced
+  | Bsb_package_kind_inconsistent
   | Other of string
 
 val pp_check_result : 
@@ -60,6 +61,7 @@ val pp_check_result :
     [build.ninja] should be regenerated
 *)
 val record : 
+  package_kind:Bsb_package_kind.t ->
   per_proj_dir:string -> 
   file:string -> 
   config:Bsb_config_types.t ->
@@ -69,6 +71,7 @@ val record :
 
 (** check if [build.ninja] should be regenerated *)
 val check :
+  package_kind:Bsb_package_kind.t ->
   per_proj_dir:string ->  
   forced:bool -> 
   file:string -> 

jscomp/bsb/bsb_ninja_regen.ml

@@ -39,7 +39,8 @@ let regenerate_ninja
   let output_deps = lib_bs_dir // bsdeps in
   let check_result  =
     Bsb_ninja_check.check 
-      ~per_proj_dir:per_proj_dir  
+      ~package_kind
+      ~per_proj_dir
       ~forced ~file:output_deps in
   Bsb_log.info
     "@{<info>BSB check@} build spec : %a @." Bsb_ninja_check.pp_check_result check_result ;
@@ -48,6 +49,7 @@ let regenerate_ninja
     None  (* Fast path, no need regenerate ninja *)
   | Bsb_forced 
   | Bsb_bsc_version_mismatch
+  | Bsb_package_kind_inconsistent
   | Bsb_file_corrupted
   | Bsb_file_not_exist 
   | Bsb_source_directory_changed  
@@ -72,6 +74,7 @@ let regenerate_ninja
       Bsb_watcher_gen.generate_sourcedirs_meta
         ~name:(lib_bs_dir // Literals.sourcedirs_meta)
         config.file_groups
+    | Pinned_dependency _ (* FIXME: seems need to be watched *)
     | Dependency _ -> ())    
     ;
 
@@ -81,7 +84,7 @@ let regenerate_ninja
       ~per_proj_dir  ~package_kind config ;                 
     (* PR2184: we still need record empty dir 
         since it may add files in the future *)  
-    Bsb_ninja_check.record ~per_proj_dir ~config ~file:output_deps 
+    Bsb_ninja_check.record ~package_kind ~per_proj_dir ~config ~file:output_deps 
       (Literals.bsconfig_json::config.file_groups.globbed_dirs) ;
     Some config 
 

jscomp/bsb/bsb_package_kind.ml

@@ -25,6 +25,7 @@
 type t = 
     | Toplevel
     | Dependency of Bsb_package_specs.t 
+    | Pinned_dependency of Bsb_package_specs.t 
         (*  This package specs comes from the toplevel to 
             override the current settings
         *)