# HG changeset patch # User Malcolm Matalka # Date 1621839010 -7200 # Mon May 24 08:50:10 2021 +0200 # Node ID ddb802e9c7b383bdbc58d778f004eb2d33c8001a # Parent b375d731d89a48086029a858039d36572b130652 FIX Support latest TOML diff --git a/hll.pins b/hll.pins --- a/hll.pins +++ b/hll.pins @@ -1,1 +1,2 @@ -toml >= "4" +ocaml > "4.02" +toml >= "6" diff --git a/src/hll/hll.ml b/src/hll/hll.ml --- a/src/hll/hll.ml +++ b/src/hll/hll.ml @@ -96,7 +96,7 @@ ; external_deps : String_set.t ; test_deps : String_set.t ; deps_blacklist : String_set.t - ; deps_map : TomlTypes.table + ; deps_map : Toml.Types.table ; pins : string String_map.t ; homepage : string ; authors : String_set.t @@ -177,8 +177,8 @@ let map_pins_to_dep_map deps_map pins = ListLabels.fold_left ~f:(fun pins (k, v) -> - let k = TomlTypes.Table.Key.to_string k in - let xs = TomlLenses.(get v (array |-- strings)) in + let k = Toml.Types.Table.Key.to_string k in + let xs = Toml.Lenses.(get v (array |-- strings)) in match (String_map.get k pins, xs) with | (Some _, _) | (_, Some []) @@ -189,7 +189,7 @@ | (None, _) -> pins) ~init:pins - (TomlTypes.Table.bindings deps_map) + (Toml.Types.Table.bindings deps_map) let generate_pkg_content t = let pins = @@ -210,15 +210,15 @@ (fun (_, v) -> value_exn ~msg:"Invalid deps_map value" - TomlLenses.(get v (array |-- strings))) - (TomlTypes.Table.bindings t.deps_map)) + Toml.Lenses.(get v (array |-- strings))) + (Toml.Types.Table.bindings t.deps_map)) in (* The set of packages that the compile-time deps map to *) let deps_map_dst = String_set.of_list (List.map - ~f:(fun (k, _) -> TomlTypes.Table.Key.to_string k) - (TomlTypes.Table.bindings t.deps_map)) + ~f:(fun (k, _) -> Toml.Types.Table.Key.to_string k) + (Toml.Types.Table.bindings t.deps_map)) in let blacklist = String_set.union t.deps_blacklist deps_map_src in let build_deps = @@ -280,7 +280,7 @@ ; url_pattern : string ; desc : string ; deps_blacklist : String_set.t - ; deps_map : TomlTypes.table + ; deps_map : Toml.Types.table ; homepage : string ; authors : String_set.t ; bug_reports : string @@ -298,20 +298,20 @@ | s -> failwith (Printf.sprintf "Invalid url_protocol (%s) in hll configuration" s) let selector_map table = - TomlTypes.Table.( + Toml.Types.Table.( fold (fun key v selectors -> let filter = value_exn ~msg:"Selector map must be string to string" - TomlLenses.(get v string) + Toml.Lenses.(get v string) in String_map.add (Key.to_string key) filter selectors) table String_map.empty) let get_selector_map hll_conf = - let sm = TomlLenses.(get hll_conf (key "selector_map" |-- table)) in + let sm = Toml.Lenses.(get hll_conf (key "selector_map" |-- table)) in match sm with | Some table -> selector_map table @@ -323,78 +323,78 @@ let maintainer = value_exn ~msg:"A maintainer is required" - TomlLenses.(get hll_conf (key "maintainer" |-- string)) + Toml.Lenses.(get hll_conf (key "maintainer" |-- string)) in let url_template = value_exn ~msg:"A url_template is required" - TomlLenses.(get hll_conf (key "url_template" |-- string)) + Toml.Lenses.(get hll_conf (key "url_template" |-- string)) in let url_protocol = value_exn ~msg:"A url_protocol is required" - TomlLenses.(get hll_conf (key "url_protocol" |-- string)) + Toml.Lenses.(get hll_conf (key "url_protocol" |-- string)) in let url_pattern = value_exn ~msg:"A url_pattern is required" - TomlLenses.(get hll_conf (key "url_pattern" |-- string)) + Toml.Lenses.(get hll_conf (key "url_pattern" |-- string)) in let desc = value_exn ~msg:"A desc is required" - TomlLenses.(get hll_conf (key "desc" |-- string)) + Toml.Lenses.(get hll_conf (key "desc" |-- string)) in let authors = value_exn ~msg:"A list of authors is required" - TomlLenses.(get hll_conf (key "authors" |-- array |-- strings)) + Toml.Lenses.(get hll_conf (key "authors" |-- array |-- strings)) in let homepage = value_exn ~msg:"A homepage is required" - TomlLenses.(get hll_conf (key "homepage" |-- string)) + Toml.Lenses.(get hll_conf (key "homepage" |-- string)) in let bug_reports = value_opt ~default:"" - TomlLenses.(get hll_conf (key "bug_reports" |-- string)) + Toml.Lenses.(get hll_conf (key "bug_reports" |-- string)) in let dev_repo = value_opt ~default:"" - TomlLenses.(get hll_conf (key "dev_repo" |-- string)) + Toml.Lenses.(get hll_conf (key "dev_repo" |-- string)) in let deps_blacklist = value_opt ~default:[] - TomlLenses.(get hll_conf (key "deps_blacklist" |-- array |-- strings)) + Toml.Lenses.(get hll_conf (key "deps_blacklist" |-- array |-- strings)) in let deps_map = value_opt - ~default:TomlTypes.Table.empty - TomlLenses.(get hll_conf (key "deps_map" |-- table)) + ~default:Toml.Types.Table.empty + Toml.Lenses.(get hll_conf (key "deps_map" |-- table)) in let build_deps = value_opt ~default:[] - TomlLenses.(get hll_conf (key "build_deps" |-- array |-- strings)) + Toml.Lenses.(get hll_conf (key "build_deps" |-- array |-- strings)) in let available = value_opt ~default:"" - TomlLenses.(get hll_conf (key "available" |-- string)) + Toml.Lenses.(get hll_conf (key "available" |-- string)) in let opam_extra_lines = value_opt ~default:[] - TomlLenses.(get hll_conf (key "opam_extra_lines" |-- array |-- strings)) + Toml.Lenses.(get hll_conf (key "opam_extra_lines" |-- array |-- strings)) in let pds_major_version = - TomlLenses.(get hll_conf (key "pds" |-- table |-- key "major_version" |-- int)) + Toml.Lenses.(get hll_conf (key "pds" |-- table |-- key "major_version" |-- int)) in let pds_version_str = - TomlLenses.(get hll_conf (key "pds" |-- table |-- key "version" |-- string)) + Toml.Lenses.(get hll_conf (key "pds" |-- table |-- key "version" |-- string)) in let pds_version = match (pds_major_version, pds_version_str) with @@ -438,19 +438,19 @@ let default_selector = "" let list_keys table = - TomlTypes.Table.( + Toml.Types.Table.( fold (fun key _ keys -> Key.to_string key::keys) table []) let list_deps table = - TomlTypes.Table.( + Toml.Types.Table.( fold (fun key v deps -> deps @ value_opt ~default:[] - TomlLenses.(get v (table |-- key "deps" |-- array |-- strings))) + Toml.Lenses.(get v (table |-- key "deps" |-- array |-- strings))) table []) @@ -468,12 +468,12 @@ (* Fold but specifically pick out the selectors of the entries in the table. *) let fold_selectors tbl f init = - TomlTypes.Table.fold + Toml.Types.Table.fold (fun build v acc -> let selector = value_opt - ~default:TomlTypes.Table.empty - TomlLenses.(get v (table |-- key "selector" |-- table)) + ~default:Toml.Types.Table.empty + Toml.Lenses.(get v (table |-- key "selector" |-- table)) in f selector acc) tbl @@ -482,13 +482,13 @@ (* Look over all of the selectors in a table and merge their deps -> selector map with the passed in map. *) let merge_deps selector acc = - TomlTypes.Table.fold + Toml.Types.Table.fold (fun slct v acc -> - let slct = TomlTypes.Table.Key.to_string slct in + let slct = Toml.Types.Table.Key.to_string slct in let deps = value_opt ~default:[] - TomlLenses.(get v (table |-- key "deps" |-- array |-- strings)) + Toml.Lenses.(get v (table |-- key "deps" |-- array |-- strings)) in deps |> ListLabels.map ~f:(fun d -> (d, [slct])) @@ -499,13 +499,13 @@ in let src = value_opt - ~default:TomlTypes.Table.empty - TomlLenses.(get pds_conf (key "src" |-- table)) + ~default:Toml.Types.Table.empty + Toml.Lenses.(get pds_conf (key "src" |-- table)) in let tests = value_opt - ~default:TomlTypes.Table.empty - TomlLenses.(get pds_conf (key "tests" |-- table)) + ~default:Toml.Types.Table.empty + Toml.Lenses.(get pds_conf (key "tests" |-- table)) in let src_deps = fold_selectors @@ -525,13 +525,13 @@ let pds_conf = Toml.Parser.(from_filename fname |> unsafe) in let srcs = value_opt - ~default:TomlTypes.Table.empty - TomlLenses.(get pds_conf (key "src" |-- table)) + ~default:Toml.Types.Table.empty + Toml.Lenses.(get pds_conf (key "src" |-- table)) in let tests = value_opt - ~default:TomlTypes.Table.empty - TomlLenses.(get pds_conf (key "tests" |-- table)) + ~default:Toml.Types.Table.empty + Toml.Lenses.(get pds_conf (key "tests" |-- table)) in let src_default_deps = String_map.of_list