diff --git a/docs/docson/build-schema.json b/docs/docson/build-schema.json index 8af76b8d7f..e16071d685 100644 --- a/docs/docson/build-schema.json +++ b/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": { diff --git a/jscomp/bsb/bsb_build_schemas.ml b/jscomp/bsb/bsb_build_schemas.ml index 6806072ad8..90cdeb56bf 100644 --- a/jscomp/bsb/bsb_build_schemas.ml +++ b/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" diff --git a/jscomp/bsb/bsb_config_parse.ml b/jscomp/bsb/bsb_config_parse.ml index e8a17661fa..91e10d7a56 100644 --- a/jscomp/bsb/bsb_config_parse.ml +++ b/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 diff --git a/jscomp/bsb/bsb_config_parse.mli b/jscomp/bsb/bsb_config_parse.mli index 4231772411..bb8ae8f7f7 100644 --- a/jscomp/bsb/bsb_config_parse.mli +++ b/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 diff --git a/jscomp/bsb/bsb_config_types.ml b/jscomp/bsb/bsb_config_types.ml index a8d15574a9..ee508f615b 100644 --- a/jscomp/bsb/bsb_config_types.ml +++ b/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 diff --git a/jscomp/bsb/bsb_ninja_check.ml b/jscomp/bsb/bsb_ninja_check.ml index 67d57ab29a..a47dae81ad 100644 --- a/jscomp/bsb/bsb_ninja_check.ml +++ b/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 -> diff --git a/jscomp/bsb/bsb_ninja_check.mli b/jscomp/bsb/bsb_ninja_check.mli index 21fa0679a4..475b285ed2 100644 --- a/jscomp/bsb/bsb_ninja_check.mli +++ b/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 -> diff --git a/jscomp/bsb/bsb_ninja_regen.ml b/jscomp/bsb/bsb_ninja_regen.ml index 4393361422..d15919515d 100644 --- a/jscomp/bsb/bsb_ninja_regen.ml +++ b/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 "@{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 diff --git a/jscomp/bsb/bsb_package_kind.ml b/jscomp/bsb/bsb_package_kind.ml index adbd63ae16..1b2f693c49 100644 --- a/jscomp/bsb/bsb_package_kind.ml +++ b/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 *) diff --git a/jscomp/bsb/bsb_package_specs.ml b/jscomp/bsb/bsb_package_specs.ml index fe5b961ce4..598f7e9428 100644 --- a/jscomp/bsb/bsb_package_specs.ml +++ b/jscomp/bsb/bsb_package_specs.ml @@ -43,6 +43,7 @@ module Spec_set = Set.Make( struct type t = spec type t = Spec_set.t +let (.?()) = Map_string.find_opt let bad_module_format_message_exn ~loc format = Bsb_exception.errorf ~loc "package-specs: `%s` isn't a valid output module format. It has to be one of: %s, %s or %s" @@ -91,13 +92,13 @@ and from_json_single suffix (x : Ext_json_types.t) : spec = begin match Map_string.find_exn map "module" with | Str {str = format} -> let in_source = - match Map_string.find_opt map Bsb_build_schemas.in_source with + match map.?(Bsb_build_schemas.in_source) with | Some (True _) -> true | Some _ | None -> false in let suffix = - match Map_string.find_opt map "suffix" with + match map.?("suffix") with | Some (Str {str = suffix; loc}) -> let s = Ext_js_suffix.of_string suffix in if s = Unknown_extension then @@ -188,7 +189,7 @@ let list_dirs_by type json_map = Ext_json_types.t Map_string.t let extract_bs_suffix_exn (map : json_map) : Ext_js_suffix.t = - match Map_string.find_opt map Bsb_build_schemas.suffix with + match map.?(Bsb_build_schemas.suffix) with | None -> Js | Some (Str {str; loc}) -> let s = Ext_js_suffix.of_string str in @@ -202,7 +203,7 @@ let extract_bs_suffix_exn (map : json_map) : Ext_js_suffix.t = let from_map map = let suffix = extract_bs_suffix_exn map in - match Map_string.find_opt map Bsb_build_schemas.package_specs with + match map.?(Bsb_build_schemas.package_specs) with | Some x -> from_json suffix x | None -> default_package_specs suffix diff --git a/jscomp/bsb/bsb_parse_sources.ml b/jscomp/bsb/bsb_parse_sources.ml index 13adb240ff..46bd6aa47c 100644 --- a/jscomp/bsb/bsb_parse_sources.ml +++ b/jscomp/bsb/bsb_parse_sources.ml @@ -27,6 +27,7 @@ type build_generator = Bsb_file_groups.build_generator +let (.?()) = Map_string.find_opt (* type file_group = Bsb_file_groups.file_group *) @@ -79,7 +80,7 @@ let collect_pub_modules !set let extract_pub (input : Ext_json_types.t Map_string.t) (cur_sources : Bsb_db.map) : Bsb_file_groups.public = - match Map_string.find_opt input Bsb_build_schemas.public with + match input.?(Bsb_build_schemas.public) with | Some ((Str({str = s}) as x)) -> if s = Bsb_build_schemas.export_all then Export_all else if s = Bsb_build_schemas.export_none then Export_none else @@ -92,7 +93,7 @@ let extract_pub (input : Ext_json_types.t Map_string.t) (cur_sources : Bsb_db.ma Export_all let extract_resources (input : Ext_json_types.t Map_string.t) : string list = - match Map_string.find_opt input Bsb_build_schemas.resources with + match input.?(Bsb_build_schemas.resources) with | Some (Arr x) -> Bsb_build_util.get_list_string x.content | Some config -> @@ -131,14 +132,14 @@ let extract_input_output (edge : Ext_json_types.t) : string list * string list = type json_map = Ext_json_types.t Map_string.t let extract_generators (input : json_map) : build_generator list = - match Map_string.find_opt input Bsb_build_schemas.generators with + match input.?(Bsb_build_schemas.generators) with | Some (Arr { content ; loc_start= _}) -> (* Need check is dev build or not *) Ext_array.fold_left content [] (fun acc x -> match x with | Obj { map } -> - (match Map_string.find_opt map Bsb_build_schemas.name , - Map_string.find_opt map Bsb_build_schemas.edge + (match map.?(Bsb_build_schemas.name) , + map.?(Bsb_build_schemas.edge) with | Some (Str command), Some edge -> let output, input = extract_input_output edge in @@ -152,11 +153,11 @@ let extract_generators (input : json_map) : build_generator list = let extract_predicate (m : json_map) : string -> bool = let excludes = - match Map_string.find_opt m Bsb_build_schemas.excludes with + match m.?(Bsb_build_schemas.excludes) with | None -> [] | Some (Arr {content = arr}) -> Bsb_build_util.get_list_string arr | Some x -> Bsb_exception.config_error x "excludes expect array "in - let slow_re = Map_string.find_opt m Bsb_build_schemas.slow_re in + let slow_re = m.?(Bsb_build_schemas.slow_re) in match slow_re, excludes with | Some (Str {str = s}), [] -> let re = Str.regexp s in @@ -264,12 +265,12 @@ let rec let cur_globbed_dirs = ref false in let has_generators = match cxt with - | {cut_generators = false; package_kind = Toplevel } -> true + | {cut_generators = false; package_kind = Toplevel | Pinned_dependency _ } -> true | {cut_generators = false; package_kind = Dependency _} | {cut_generators = true ; _ } -> false in let scanned_generators = extract_generators input in - let sub_dirs_field = Map_string.find_opt input Bsb_build_schemas.subdirs in + let sub_dirs_field = input.?(Bsb_build_schemas.subdirs) in let base_name_array = lazy (cur_globbed_dirs := true ; Sys.readdir (Filename.concat cxt.root dir)) in let output_sources = @@ -277,7 +278,7 @@ let rec Map_string.empty (fun acc o -> Bsb_db_util.add_basename ~dir acc o) in let sources = - match Map_string.find_opt input Bsb_build_schemas.files with + match input.?(Bsb_build_schemas.files) with | None -> (** We should avoid temporary files *) Ext_array.fold_left (Lazy.force base_name_array) output_sources (fun acc basename -> @@ -351,7 +352,7 @@ and parsing_single_source ({package_kind; dev_index ; cwd} as cxt ) (x : Ext_jso | Dependency _ , true -> Bsb_file_groups.empty | Dependency _, false - | Toplevel, _ -> + | (Toplevel | Pinned_dependency _), _ -> parsing_source_dir_map {cxt with cwd = Ext_path.concat cwd (Ext_path.simple_convert_node_path_to_os_path dir)} @@ -359,7 +360,7 @@ and parsing_single_source ({package_kind; dev_index ; cwd} as cxt ) (x : Ext_jso end | Obj {map} -> let current_dir_index = - match Map_string.find_opt map Bsb_build_schemas.type_ with + match map.?(Bsb_build_schemas.type_) with | Some (Str {str="dev"}) -> true | Some _ -> Bsb_exception.config_error x {|type field expect "dev" literal |} @@ -368,9 +369,9 @@ and parsing_single_source ({package_kind; dev_index ; cwd} as cxt ) (x : Ext_jso | Dependency _ , true -> Bsb_file_groups.empty | Dependency _, false - | Toplevel, _ -> + | (Toplevel | Pinned_dependency _), _ -> let dir = - match Map_string.find_opt map Bsb_build_schemas.dir with + match map.?(Bsb_build_schemas.dir) with | Some (Str{str}) -> Ext_path.simple_convert_node_path_to_os_path str | Some x -> Bsb_exception.config_error x "dir expected to be a string" @@ -439,11 +440,11 @@ and walk_single_source cxt (x : Ext_json_types.t) = walk_source_dir_map {cxt with cwd = Ext_path.concat cxt.cwd dir } None | Obj {map} -> - begin match Map_string.find_opt map Bsb_build_schemas.dir with + begin match map.?(Bsb_build_schemas.dir) with | Some (Str{str}) -> let dir = Ext_path.simple_convert_node_path_to_os_path str in walk_source_dir_map - {cxt with cwd = Ext_path.concat cxt.cwd dir} (Map_string.find_opt map Bsb_build_schemas.subdirs) + {cxt with cwd = Ext_path.concat cxt.cwd dir} map.?(Bsb_build_schemas.subdirs) | _ -> () end | _ -> () @@ -486,22 +487,22 @@ let clean_re_js root = (Filename.concat root Literals.bsconfig_json) with | Obj { map } -> let ignored_dirs = - match Map_string.find_opt map Bsb_build_schemas.ignored_dirs with + match map .?(Bsb_build_schemas.ignored_dirs) with | Some (Arr {content = x}) -> Set_string.of_list (Bsb_build_util.get_list_string x ) | Some _ | None -> Set_string.empty in let gentype_language = - match Map_string.find_opt map Bsb_build_schemas.gentypeconfig with + match map.?(Bsb_build_schemas.gentypeconfig) with | None -> "" | Some (Obj { map }) -> - (match Map_string.find_opt map Bsb_build_schemas.language with + (match map.?(Bsb_build_schemas.language) with | None -> "" | Some (Str {str}) -> str | Some _ -> "") | Some _ -> "" in - Ext_option.iter (Map_string.find_opt map Bsb_build_schemas.sources) begin fun config -> + Ext_option.iter map.?(Bsb_build_schemas.sources) begin fun config -> try ( walk_sources { root ; traverse = true; diff --git a/jscomp/bsb/bsb_warning.ml b/jscomp/bsb/bsb_warning.ml index e1dff40116..8acf3dcbaf 100644 --- a/jscomp/bsb/bsb_warning.ml +++ b/jscomp/bsb/bsb_warning.ml @@ -95,7 +95,8 @@ let from_map (m : Ext_json_types.t Map_string.t) = let to_bsb_string ~(package_kind: Bsb_package_kind.t) warning = match package_kind with - | Toplevel -> + | Toplevel + | Pinned_dependency _ -> (match warning with | None -> Ext_string.empty | Some warning -> diff --git a/jscomp/bsb/bsb_world.ml b/jscomp/bsb/bsb_world.ml index af595fc51d..3d916e3f73 100644 --- a/jscomp/bsb/bsb_world.ml +++ b/jscomp/bsb/bsb_world.ml @@ -29,7 +29,7 @@ let (//) = Ext_path.combine let vendor_ninja = Bsb_global_paths.vendor_ninja let make_world_deps cwd (config : Bsb_config_types.t option) (ninja_args : string array) = - let deps = + let deps, pinned_dependencies = match config with | None -> (* When this running bsb does not read bsconfig.json, @@ -37,7 +37,7 @@ let make_world_deps cwd (config : Bsb_config_types.t option) (ninja_args : strin it wants *) Bsb_config_parse.package_specs_from_bsconfig () - | Some config -> config.package_specs in + | Some config -> config.package_specs, config.pinned_dependencies in let args = if Ext_array.is_empty ninja_args then [|vendor_ninja|] else Array.append [|vendor_ninja|] ninja_args @@ -61,12 +61,15 @@ let make_world_deps cwd (config : Bsb_config_types.t option) (ninja_args : strin | Expect_none -> () | Expect_name s -> begin - print_endline ("Dependency on " ^ s ); + let is_pinned = Set_string.mem pinned_dependencies s in + (if is_pinned then + print_endline ("Dependency pinned on " ^ s ) + else print_endline ("Dependency on " ^ s )); let lib_bs_dir = proj_dir // lib_artifacts_dir in Bsb_build_util.mkp lib_bs_dir; let _config : _ option = Bsb_ninja_regen.regenerate_ninja - ~package_kind:(Dependency deps) + ~package_kind:(if is_pinned then Pinned_dependency deps else Dependency deps) ~per_proj_dir:proj_dir ~forced:false in let command = {Bsb_unix.cmd = vendor_ninja; diff --git a/jscomp/build_tests/pinned/.gitignore b/jscomp/build_tests/pinned/.gitignore new file mode 100644 index 0000000000..1dd11f93b0 --- /dev/null +++ b/jscomp/build_tests/pinned/.gitignore @@ -0,0 +1,27 @@ +*.exe +*.obj +*.out +*.compile +*.native +*.byte +*.cmo +*.annot +*.cmi +*.cmx +*.cmt +*.cmti +*.cma +*.a +*.cmxa +*.obj +*~ +*.annot +*.cmj +*.bak +lib/bs +*.mlast +*.mliast +.vscode +.merlin +.bsb.lock +/node_modules/ diff --git a/jscomp/build_tests/pinned/README.md b/jscomp/build_tests/pinned/README.md new file mode 100644 index 0000000000..b20ab1bade --- /dev/null +++ b/jscomp/build_tests/pinned/README.md @@ -0,0 +1,13 @@ + + +# Build +``` +npm run build +``` + +# Watch + +``` +npm run watch +``` + diff --git a/jscomp/build_tests/pinned/bsconfig.json b/jscomp/build_tests/pinned/bsconfig.json new file mode 100644 index 0000000000..7cf5ef7bbc --- /dev/null +++ b/jscomp/build_tests/pinned/bsconfig.json @@ -0,0 +1,10 @@ +{ + "name": "warnerror", + "version": "0.1.0", + "sources": { + "dir" : "src", + "subdirs" : true + }, + "bs-dependencies": [ "test"], + "pinned-dependencies": ["test"] +} diff --git a/jscomp/build_tests/pinned/input.js b/jscomp/build_tests/pinned/input.js new file mode 100644 index 0000000000..ac97f6a6a2 --- /dev/null +++ b/jscomp/build_tests/pinned/input.js @@ -0,0 +1,28 @@ +var cp = require("child_process"); +var assert = require("assert"); +var fs = require("fs"); +function checkSpawnOut(out) { + if (out.error) { + throw out.error; + } + if (out.status !== 0) { + assert.fail(out.stderr + "\n" + out.stdout); + } +} +var out = cp.spawnSync(`npx bsb -make-world`, { + encoding: "utf-8", + shell: true, +}); +checkSpawnOut(out); + +// In pinned mode, its dependency has warnings +assert.ok(out.stdout.split('\n').some(x=>x.includes('Warning 32: unused value'))) + +var out2 = cp.spawnSync(`npx bsb -- -C node_modules/test/lib/bs/ -t targets`, { + encoding: "utf-8", + shell: true, +}); +checkSpawnOut(out2); + +// In pinned mode, generators are running +assert.ok(out2.stdout.split('\n').some(x=>x.endsWith('test.ml'))) diff --git a/jscomp/build_tests/pinned/node_modules/test/.gitignore b/jscomp/build_tests/pinned/node_modules/test/.gitignore new file mode 100644 index 0000000000..1dd11f93b0 --- /dev/null +++ b/jscomp/build_tests/pinned/node_modules/test/.gitignore @@ -0,0 +1,27 @@ +*.exe +*.obj +*.out +*.compile +*.native +*.byte +*.cmo +*.annot +*.cmi +*.cmx +*.cmt +*.cmti +*.cma +*.a +*.cmxa +*.obj +*~ +*.annot +*.cmj +*.bak +lib/bs +*.mlast +*.mliast +.vscode +.merlin +.bsb.lock +/node_modules/ diff --git a/jscomp/build_tests/pinned/node_modules/test/.merlin b/jscomp/build_tests/pinned/node_modules/test/.merlin new file mode 100644 index 0000000000..a9cd803dfa --- /dev/null +++ b/jscomp/build_tests/pinned/node_modules/test/.merlin @@ -0,0 +1,8 @@ +####{BSB GENERATED: NO EDIT +FLG -ppx '/Users/hongbozhang/git/bucklescript/darwin/bsc.exe -as-ppx ' +S /Users/hongbozhang/git/bucklescript/lib/ocaml +B /Users/hongbozhang/git/bucklescript/lib/ocaml +FLG -w +a-4-9-20-40-41-42-50-61-102 +S src +B lib/bs/src +####BSB GENERATED: NO EDIT} diff --git a/jscomp/build_tests/pinned/node_modules/test/README.md b/jscomp/build_tests/pinned/node_modules/test/README.md new file mode 100644 index 0000000000..b20ab1bade --- /dev/null +++ b/jscomp/build_tests/pinned/node_modules/test/README.md @@ -0,0 +1,13 @@ + + +# Build +``` +npm run build +``` + +# Watch + +``` +npm run watch +``` + diff --git a/jscomp/build_tests/pinned/node_modules/test/bsconfig.json b/jscomp/build_tests/pinned/node_modules/test/bsconfig.json new file mode 100644 index 0000000000..943c0a8269 --- /dev/null +++ b/jscomp/build_tests/pinned/node_modules/test/bsconfig.json @@ -0,0 +1,24 @@ +{ + "name": "test", + "version": "0.1.0", + "sources": [ + { + "dir": "src", + "generators": [ + { + "name": "ml_cmj_cmi", + "edge": [ + "test.ml", ":", "test.cpp.ml" + ] + } + ] + } + + ], + "generators": [ + { + "name" : "ml_cmj_cmi", + "command": "sed 's/OCAML/3/' $in > $out" + } + ], +} diff --git a/jscomp/build_tests/pinned/node_modules/test/package.json b/jscomp/build_tests/pinned/node_modules/test/package.json new file mode 100644 index 0000000000..d1beeac7ad --- /dev/null +++ b/jscomp/build_tests/pinned/node_modules/test/package.json @@ -0,0 +1,17 @@ +{ + "name": "test", + "version": "0.1.0", + "scripts": { + "clean": "bsb -clean-world", + "build": "bsb -make-world", + "watch": "bsb -make-world -w" + }, + "keywords": [ + "BuckleScript" + ], + "author": "", + "license": "MIT", + "devDependencies": { + "bs-platform": "^8.4.0-dev.1" + } +} \ No newline at end of file diff --git a/jscomp/build_tests/pinned/node_modules/test/src/demo.ml b/jscomp/build_tests/pinned/node_modules/test/src/demo.ml new file mode 100644 index 0000000000..6636da36a5 --- /dev/null +++ b/jscomp/build_tests/pinned/node_modules/test/src/demo.ml @@ -0,0 +1,5 @@ + + + +let a = 1 +let a = 2 \ No newline at end of file diff --git a/jscomp/build_tests/pinned/node_modules/test/src/test.cpp.ml b/jscomp/build_tests/pinned/node_modules/test/src/test.cpp.ml new file mode 100644 index 0000000000..9cce515143 --- /dev/null +++ b/jscomp/build_tests/pinned/node_modules/test/src/test.cpp.ml @@ -0,0 +1,10 @@ + +(* +#define FS_VAL(name,ty) external name : ty = "" [@@bs.module "fs"] + + +FS_VAL(readdirSync, string -> string array) + *) + + + let ocaml = OCAML \ No newline at end of file diff --git a/jscomp/build_tests/pinned/package.json b/jscomp/build_tests/pinned/package.json new file mode 100644 index 0000000000..a161ec3762 --- /dev/null +++ b/jscomp/build_tests/pinned/package.json @@ -0,0 +1,17 @@ +{ + "name": "warnerror", + "version": "0.1.0", + "scripts": { + "clean": "bsb -clean-world", + "build": "bsb -make-world", + "watch": "bsb -make-world -w" + }, + "keywords": [ + "BuckleScript" + ], + "author": "", + "license": "MIT", + "devDependencies": { + "bs-platform": "^8.4.0-dev.1" + } +} \ No newline at end of file diff --git a/jscomp/build_tests/pinned/src/hey.ml b/jscomp/build_tests/pinned/src/hey.ml new file mode 100644 index 0000000000..923b77316d --- /dev/null +++ b/jscomp/build_tests/pinned/src/hey.ml @@ -0,0 +1,3 @@ + + +let () = Js.log "Hello, BuckleScript" \ No newline at end of file diff --git a/lib/4.06.1/bsb.ml b/lib/4.06.1/bsb.ml index f7cf6ba91d..7b7f0cb4e8 100644 --- a/lib/4.06.1/bsb.ml +++ b/lib/4.06.1/bsb.ml @@ -1899,6 +1899,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" @@ -7215,6 +7216,7 @@ module Spec_set = Set.Make( struct type t = spec type t = Spec_set.t +let (.?()) = Map_string.find_opt let bad_module_format_message_exn ~loc format = Bsb_exception.errorf ~loc "package-specs: `%s` isn't a valid output module format. It has to be one of: %s, %s or %s" @@ -7263,13 +7265,13 @@ and from_json_single suffix (x : Ext_json_types.t) : spec = begin match Map_string.find_exn map "module" with | Str {str = format} -> let in_source = - match Map_string.find_opt map Bsb_build_schemas.in_source with + match map.?(Bsb_build_schemas.in_source) with | Some (True _) -> true | Some _ | None -> false in let suffix = - match Map_string.find_opt map "suffix" with + match map.?("suffix") with | Some (Str {str = suffix; loc}) -> let s = Ext_js_suffix.of_string suffix in if s = Unknown_extension then @@ -7360,7 +7362,7 @@ let list_dirs_by type json_map = Ext_json_types.t Map_string.t let extract_bs_suffix_exn (map : json_map) : Ext_js_suffix.t = - match Map_string.find_opt map Bsb_build_schemas.suffix with + match map.?(Bsb_build_schemas.suffix) with | None -> Js | Some (Str {str; loc}) -> let s = Ext_js_suffix.of_string str in @@ -7374,7 +7376,7 @@ let extract_bs_suffix_exn (map : json_map) : Ext_js_suffix.t = let from_map map = let suffix = extract_bs_suffix_exn map in - match Map_string.find_opt map Bsb_build_schemas.package_specs with + match map.?(Bsb_build_schemas.package_specs) with | Some x -> from_json suffix x | None -> default_package_specs suffix @@ -7411,6 +7413,7 @@ module Bsb_package_kind 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 *) @@ -7643,7 +7646,8 @@ let from_map (m : Ext_json_types.t Map_string.t) = let to_bsb_string ~(package_kind: Bsb_package_kind.t) warning = match package_kind with - | Toplevel -> + | Toplevel + | Pinned_dependency _ -> (match warning with | None -> Ext_string.empty | Some warning -> @@ -7731,6 +7735,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 @@ -10593,6 +10598,7 @@ end = struct type build_generator = Bsb_file_groups.build_generator +let (.?()) = Map_string.find_opt (* type file_group = Bsb_file_groups.file_group *) @@ -10645,7 +10651,7 @@ let collect_pub_modules !set let extract_pub (input : Ext_json_types.t Map_string.t) (cur_sources : Bsb_db.map) : Bsb_file_groups.public = - match Map_string.find_opt input Bsb_build_schemas.public with + match input.?(Bsb_build_schemas.public) with | Some ((Str({str = s}) as x)) -> if s = Bsb_build_schemas.export_all then Export_all else if s = Bsb_build_schemas.export_none then Export_none else @@ -10658,7 +10664,7 @@ let extract_pub (input : Ext_json_types.t Map_string.t) (cur_sources : Bsb_db.ma Export_all let extract_resources (input : Ext_json_types.t Map_string.t) : string list = - match Map_string.find_opt input Bsb_build_schemas.resources with + match input.?(Bsb_build_schemas.resources) with | Some (Arr x) -> Bsb_build_util.get_list_string x.content | Some config -> @@ -10697,14 +10703,14 @@ let extract_input_output (edge : Ext_json_types.t) : string list * string list = type json_map = Ext_json_types.t Map_string.t let extract_generators (input : json_map) : build_generator list = - match Map_string.find_opt input Bsb_build_schemas.generators with + match input.?(Bsb_build_schemas.generators) with | Some (Arr { content ; loc_start= _}) -> (* Need check is dev build or not *) Ext_array.fold_left content [] (fun acc x -> match x with | Obj { map } -> - (match Map_string.find_opt map Bsb_build_schemas.name , - Map_string.find_opt map Bsb_build_schemas.edge + (match map.?(Bsb_build_schemas.name) , + map.?(Bsb_build_schemas.edge) with | Some (Str command), Some edge -> let output, input = extract_input_output edge in @@ -10718,11 +10724,11 @@ let extract_generators (input : json_map) : build_generator list = let extract_predicate (m : json_map) : string -> bool = let excludes = - match Map_string.find_opt m Bsb_build_schemas.excludes with + match m.?(Bsb_build_schemas.excludes) with | None -> [] | Some (Arr {content = arr}) -> Bsb_build_util.get_list_string arr | Some x -> Bsb_exception.config_error x "excludes expect array "in - let slow_re = Map_string.find_opt m Bsb_build_schemas.slow_re in + let slow_re = m.?(Bsb_build_schemas.slow_re) in match slow_re, excludes with | Some (Str {str = s}), [] -> let re = Str.regexp s in @@ -10830,12 +10836,12 @@ let rec let cur_globbed_dirs = ref false in let has_generators = match cxt with - | {cut_generators = false; package_kind = Toplevel } -> true + | {cut_generators = false; package_kind = Toplevel | Pinned_dependency _ } -> true | {cut_generators = false; package_kind = Dependency _} | {cut_generators = true ; _ } -> false in let scanned_generators = extract_generators input in - let sub_dirs_field = Map_string.find_opt input Bsb_build_schemas.subdirs in + let sub_dirs_field = input.?(Bsb_build_schemas.subdirs) in let base_name_array = lazy (cur_globbed_dirs := true ; Sys.readdir (Filename.concat cxt.root dir)) in let output_sources = @@ -10843,7 +10849,7 @@ let rec Map_string.empty (fun acc o -> Bsb_db_util.add_basename ~dir acc o) in let sources = - match Map_string.find_opt input Bsb_build_schemas.files with + match input.?(Bsb_build_schemas.files) with | None -> (** We should avoid temporary files *) Ext_array.fold_left (Lazy.force base_name_array) output_sources (fun acc basename -> @@ -10917,7 +10923,7 @@ and parsing_single_source ({package_kind; dev_index ; cwd} as cxt ) (x : Ext_jso | Dependency _ , true -> Bsb_file_groups.empty | Dependency _, false - | Toplevel, _ -> + | (Toplevel | Pinned_dependency _), _ -> parsing_source_dir_map {cxt with cwd = Ext_path.concat cwd (Ext_path.simple_convert_node_path_to_os_path dir)} @@ -10925,7 +10931,7 @@ and parsing_single_source ({package_kind; dev_index ; cwd} as cxt ) (x : Ext_jso end | Obj {map} -> let current_dir_index = - match Map_string.find_opt map Bsb_build_schemas.type_ with + match map.?(Bsb_build_schemas.type_) with | Some (Str {str="dev"}) -> true | Some _ -> Bsb_exception.config_error x {|type field expect "dev" literal |} @@ -10934,9 +10940,9 @@ and parsing_single_source ({package_kind; dev_index ; cwd} as cxt ) (x : Ext_jso | Dependency _ , true -> Bsb_file_groups.empty | Dependency _, false - | Toplevel, _ -> + | (Toplevel | Pinned_dependency _), _ -> let dir = - match Map_string.find_opt map Bsb_build_schemas.dir with + match map.?(Bsb_build_schemas.dir) with | Some (Str{str}) -> Ext_path.simple_convert_node_path_to_os_path str | Some x -> Bsb_exception.config_error x "dir expected to be a string" @@ -11005,11 +11011,11 @@ and walk_single_source cxt (x : Ext_json_types.t) = walk_source_dir_map {cxt with cwd = Ext_path.concat cxt.cwd dir } None | Obj {map} -> - begin match Map_string.find_opt map Bsb_build_schemas.dir with + begin match map.?(Bsb_build_schemas.dir) with | Some (Str{str}) -> let dir = Ext_path.simple_convert_node_path_to_os_path str in walk_source_dir_map - {cxt with cwd = Ext_path.concat cxt.cwd dir} (Map_string.find_opt map Bsb_build_schemas.subdirs) + {cxt with cwd = Ext_path.concat cxt.cwd dir} map.?(Bsb_build_schemas.subdirs) | _ -> () end | _ -> () @@ -11052,22 +11058,22 @@ let clean_re_js root = (Filename.concat root Literals.bsconfig_json) with | Obj { map } -> let ignored_dirs = - match Map_string.find_opt map Bsb_build_schemas.ignored_dirs with + match map .?(Bsb_build_schemas.ignored_dirs) with | Some (Arr {content = x}) -> Set_string.of_list (Bsb_build_util.get_list_string x ) | Some _ | None -> Set_string.empty in let gentype_language = - match Map_string.find_opt map Bsb_build_schemas.gentypeconfig with + match map.?(Bsb_build_schemas.gentypeconfig) with | None -> "" | Some (Obj { map }) -> - (match Map_string.find_opt map Bsb_build_schemas.language with + (match map.?(Bsb_build_schemas.language) with | None -> "" | Some (Str {str}) -> str | Some _ -> "") | Some _ -> "" in - Ext_option.iter (Map_string.find_opt map Bsb_build_schemas.sources) begin fun config -> + Ext_option.iter map.?(Bsb_build_schemas.sources) begin fun config -> try ( walk_sources { root ; traverse = true; @@ -11359,7 +11365,8 @@ module Bsb_config_parse : sig * 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 @@ -11418,17 +11425,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 - @@ -11439,7 +11439,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) -> @@ -11454,7 +11454,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 @@ -11493,7 +11493,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 _ -> @@ -11521,11 +11521,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" @@ -11543,7 +11543,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 @@ -11560,14 +11560,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 @@ -11578,7 +11578,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" -> @@ -11593,30 +11593,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 | _, _ -> @@ -11631,7 +11638,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)) @@ -11641,7 +11648,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 @@ -11652,7 +11659,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 = @@ -11745,10 +11752,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 @@ -11760,6 +11770,7 @@ let interpret_json ~namespace sources in { + pinned_dependencies; gentype_config; package_name ; namespace ; @@ -11784,6 +11795,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 (); @@ -11801,6 +11813,16 @@ let interpret_json | _ -> 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 + end module Ext_io : sig #1 "ext_io.mli" @@ -12181,6 +12203,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 : @@ -12200,6 +12223,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 -> @@ -12209,6 +12233,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 -> @@ -12262,6 +12287,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) = @@ -12275,6 +12301,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) = @@ -12312,12 +12340,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 @@ -12344,18 +12378,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 -> @@ -14167,7 +14212,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 "@{BSB check@} build spec : %a @." Bsb_ninja_check.pp_check_result check_result ; @@ -14176,6 +14222,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 @@ -14200,6 +14247,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 _ -> ()) ; @@ -14209,7 +14257,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 @@ -16407,7 +16455,7 @@ let (//) = Ext_path.combine let vendor_ninja = Bsb_global_paths.vendor_ninja let make_world_deps cwd (config : Bsb_config_types.t option) (ninja_args : string array) = - let deps = + let deps, pinned_dependencies = match config with | None -> (* When this running bsb does not read bsconfig.json, @@ -16415,7 +16463,7 @@ let make_world_deps cwd (config : Bsb_config_types.t option) (ninja_args : strin it wants *) Bsb_config_parse.package_specs_from_bsconfig () - | Some config -> config.package_specs in + | Some config -> config.package_specs, config.pinned_dependencies in let args = if Ext_array.is_empty ninja_args then [|vendor_ninja|] else Array.append [|vendor_ninja|] ninja_args @@ -16439,12 +16487,15 @@ let make_world_deps cwd (config : Bsb_config_types.t option) (ninja_args : strin | Expect_none -> () | Expect_name s -> begin - print_endline ("Dependency on " ^ s ); + let is_pinned = Set_string.mem pinned_dependencies s in + (if is_pinned then + print_endline ("Dependency pinned on " ^ s ) + else print_endline ("Dependency on " ^ s )); let lib_bs_dir = proj_dir // lib_artifacts_dir in Bsb_build_util.mkp lib_bs_dir; let _config : _ option = Bsb_ninja_regen.regenerate_ninja - ~package_kind:(Dependency deps) + ~package_kind:(if is_pinned then Pinned_dependency deps else Dependency deps) ~per_proj_dir:proj_dir ~forced:false in let command = {Bsb_unix.cmd = vendor_ninja;