The unpac monorepo manager self-hosting as a monorepo using unpac

Update minimum OCaml version to 4.08

Remove our custom `Option` module and use the new stdlib one instead.
Use the new `List.filter_map` from the stdlib instead of our one. Also,
rename our `first_match` to `find_map`, to match the name in 4.10.

+53 -84
+1 -1
0install-gtk.opam
··· 9 9 ["dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test}] 10 10 ] 11 11 depends: [ 12 - "ocaml" {>= "4.05.0"} 12 + "ocaml" {>= "4.08.0"} 13 13 "0install" {= version} 14 14 "ounit2" {with-test} 15 15 "dune" {>= "2.1"}
+1 -1
0install-solver.opam
··· 9 9 ["dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test}] 10 10 ] 11 11 depends: [ 12 - "ocaml" {>= "4.05.0"} 12 + "ocaml" {>= "4.08.0"} 13 13 "dune" {>= "2.1"} 14 14 "ounit2" {with-test} 15 15 ]
+1 -1
0install.opam
··· 9 9 ["dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test}] 10 10 ] 11 11 depends: [ 12 - "ocaml" {>= "4.05.0"} 12 + "ocaml" {>= "4.08.0"} 13 13 "0install-solver" 14 14 "yojson" 15 15 "xmlm"
+1
appveyor.yml
··· 4 4 environment: 5 5 FORK_USER: ocaml 6 6 FORK_BRANCH: master 7 + OPAM_SWITCH: 4.08.1+mingw64c 7 8 CYG_ROOT: C:\cygwin64 8 9 PINS: 0install.dev:. 0install-gtk.dev:. 0install-solver.dev:. 9 10 PACKAGE: 0install
+1 -1
src/cli/completion.ml
··· 291 291 if starts_with vexpr pre then Some vexpr else None in 292 292 let all_versions = Feed.zi_implementations feed 293 293 |> XString.Map.map_bindings (fun _k impl -> impl.Impl.parsed_version) in 294 - let matching_versions = Support.Utils.filter_map check (List.sort compare all_versions) in 294 + let matching_versions = List.filter_map check (List.sort compare all_versions) in 295 295 List.iter (completer#add Add) matching_versions 296 296 297 297 (* 0install --option=<Tab> *)
+1 -1
src/cli/generic_select.ml
··· 243 243 } in 244 244 245 245 let flags = 246 - flags |> Support.Utils.filter_map (function 246 + flags |> List.filter_map (function 247 247 | `ShowHuman -> select_opts.output <- Output_human; None 248 248 | `ShowXML -> select_opts.output <- Output_XML; None 249 249 | `Refresh -> select_opts.refresh <- true; select_opts.must_select <- true; None
+1 -1
src/cli/req_options.ml
··· 19 19 let not_before = ref None in 20 20 21 21 (* Handle --before, --not-before and --version by converting to --version-for options *) 22 - let options = options |> Support.Utils.filter_map (function 22 + let options = options |> List.filter_map (function 23 23 | `Before v -> before := Some v; None 24 24 | `NotBefore v -> not_before := Some v; None 25 25 | `RequireVersion v -> Some (`RequireVersionFor (default_iface, v))
+1 -1
src/cli/store.ml
··· 76 76 | [] -> config.stores 77 77 | dirs -> dirs in 78 78 79 - let audit_ls = dirs |> U.filter_map (fun dir -> 79 + let audit_ls = dirs |> List.filter_map (fun dir -> 80 80 if U.is_dir system dir then Some ( 81 81 let items = 82 82 match system#readdir dir with
+1 -1
src/gui_gtk/trust_box.ml
··· 258 258 259 259 dialog#connect#response ==> (function 260 260 | `OK -> 261 - let to_trust = !trust_checkboxes |> U.filter_map (fun (fpr, box) -> 261 + let to_trust = !trust_checkboxes |> List.filter_map (fun (fpr, box) -> 262 262 if box#active then Some fpr else None 263 263 ) in 264 264 assert (to_trust <> []);
+3 -4
src/solver/diagnostics.ml
··· 5 5 (** Explaining why a solve failed or gave an unexpected answer. *) 6 6 7 7 module List = Solver_core.List 8 - module Option = Solver_core.Option 9 8 10 9 let pf = Format.fprintf 11 10 ··· 223 222 let check_restriction r = 224 223 if Model.meets_restriction dep_impl r then None 225 224 else Some (`DepFailsRestriction (dep, r)) in 226 - List.first_match check_restriction (Model.restrictions dep) in 225 + List.find_map check_restriction (Model.restrictions dep) in 227 226 let deps, commands_needed = Model.requires role impl in 228 - commands_needed |> List.first_match (fun command -> 227 + commands_needed |> List.find_map (fun command -> 229 228 if Model.get_command impl command <> None then None 230 229 else Some (`MissingCommand command : Note.rejection_reason) 231 230 ) 232 231 |> function 233 232 | Some _ as r -> r 234 - | None -> List.first_match check_dep deps 233 + | None -> List.find_map check_dep deps 235 234 236 235 (** A selected component has [dep] as a dependency. Use this to explain why some implementations 237 236 of the required interface were rejected. *)
+5 -27
src/solver/solver_core.ml
··· 4 4 5 5 (** Select a compatible set of components to run a program. *) 6 6 7 - module Option = struct 8 - let iter f = function 9 - | None -> () 10 - | Some x -> f x 11 - 12 - let bind x f = 13 - match x with 14 - | None -> None 15 - | Some x -> f x 16 - 17 - let map f = function 18 - | None -> None 19 - | Some x -> Some (f x) 20 - end 21 - 22 7 module List = struct 23 8 include List 24 9 25 - let rec filter_map fn = function 26 - | [] -> [] 27 - | (x::xs) -> 28 - match fn x with 29 - | None -> filter_map fn xs 30 - | Some y -> y :: filter_map fn xs 31 - 32 - let rec first_match f = function 10 + let rec find_map f = function 33 11 | [] -> None 34 12 | (x::xs) -> match f x with 35 13 | Some _ as result -> result 36 - | None -> first_match f xs 14 + | None -> find_map f xs 37 15 end 38 16 39 17 type ('a, 'b) partition_result = ··· 580 558 | Selected (deps, self_commands) -> 581 559 (* We've already selected a candidate for this component. Now check its dependencies. *) 582 560 let check_self_command name = find_undecided {req with Model.command = Some name} in 583 - match List.first_match check_self_command self_commands with 561 + match List.find_map check_self_command self_commands with 584 562 | Some _ as r -> r 585 563 | None -> 586 564 (* Self-commands already done; now try the dependencies *) ··· 598 576 | None -> 599 577 (* Command dependencies next *) 600 578 let check_command_dep name = find_undecided {Model.command = Some name; role = dep_role} in 601 - List.first_match check_command_dep dep_required_commands 579 + List.find_map check_command_dep dep_required_commands 602 580 ) 603 581 in 604 - match List.first_match check_dep deps with 582 + match List.find_map check_dep deps with 605 583 | Some _ as r -> r 606 584 | None -> 607 585 (* All dependencies checked; now to the impl (if we're a <command>) *)
+1 -1
src/support/argparse.ml
··· 261 261 262 262 let pp_options format_type fmt opts = 263 263 let display_options = 264 - opts |> Utils.filter_map (fun (names, (nargs:int), help, p) -> 264 + opts |> List.filter_map (fun (names, (nargs:int), help, p) -> 265 265 match help with 266 266 | "" -> None 267 267 | help ->
+1 -1
src/support/gpg.ml
··· 199 199 200 200 (** Parse the status output from gpg as a list of signatures. *) 201 201 let sigs_from_gpg_status_output status = 202 - status |> Str.split re_newline |> U.filter_map (fun line -> 202 + status |> Str.split re_newline |> List.filter_map (fun line -> 203 203 if XString.starts_with line "[GNUPG:] " then ( 204 204 match XString.tail line 9 |> Str.split_delim XString.re_space with 205 205 | [] -> None
+1 -1
src/support/locale.ml
··· 55 55 | Some langs -> Str.split XString.re_colon langs 56 56 | None -> [lang] 57 57 ) in 58 - let specs = Utils.filter_map parse_lang langs in 58 + let specs = List.filter_map parse_lang langs in 59 59 if List.mem default specs then specs else specs @ [default] 60 60 61 61 (* Converts a list of languages (most preferred first) to a map from languages to scores.
+1 -7
src/support/utils.ml
··· 40 40 Logging.dump_crash_log ~ex (); 41 41 exit 1 42 42 43 + (* Replace with [List.find_map] once we require OCaml >= 4.10 *) 43 44 let rec first_match f = function 44 45 | [] -> None 45 46 | (x::xs) -> match f x with 46 47 | Some _ as result -> result 47 48 | None -> first_match f xs 48 - 49 - let rec filter_map fn = function 50 - | [] -> [] 51 - | (x::xs) -> 52 - match fn x with 53 - | None -> filter_map fn xs 54 - | Some y -> y :: filter_map fn xs 55 49 56 50 let filter_map_array fn arr = 57 51 let result = ref [] in
-3
src/support/utils.mli
··· 19 19 val first_match : ('a -> 'b option) -> 'a list -> 'b option 20 20 21 21 (** List the non-None results of [fn item] *) 22 - val filter_map : ('a -> 'b option) -> 'a list -> 'b list 23 - 24 - (** List the non-None results of [fn item] *) 25 22 val filter_map_array : ('a -> 'b option) -> 'a array -> 'b list 26 23 27 24 (** Extract a sub-list. *)
+1 -1
src/tests/fake_system.ml
··· 475 475 record 476 476 477 477 method pop_warnings = 478 - let warnings = record |> U.filter_map (function 478 + let warnings = record |> List.filter_map (function 479 479 | (_ex, Support.Logging.Warning, msg) -> Some msg 480 480 | _ -> None) in 481 481 record <- [];
+2 -2
src/tests/test_feed.ml
··· 30 30 let feed = F.parse system root (Some local_path) in 31 31 32 32 let () = 33 - let langs = Support.Locale.score_langs @@ U.filter_map Support.Locale.parse_lang ["en_US"; "en_GB"; "fr"] in 33 + let langs = Support.Locale.score_langs @@ List.filter_map Support.Locale.parse_lang ["en_US"; "en_GB"; "fr"] in 34 34 assert_equal 6 (Support.Locale.score_lang langs @@ Some "en_US"); 35 35 assert_equal 4 (Support.Locale.score_lang langs @@ Some "en_GB"); 36 36 assert_equal 3 (Support.Locale.score_lang langs @@ Some "en"); ··· 39 39 assert_equal 3 (Support.Locale.score_lang langs @@ None) in 40 40 41 41 let test ?description expected langs = 42 - let langs = Support.Locale.score_langs @@ U.filter_map Support.Locale.parse_lang langs in 42 + let langs = Support.Locale.score_langs @@ List.filter_map Support.Locale.parse_lang langs in 43 43 Fake_system.assert_str_equal expected @@ Fake_system.expect @@ F.get_summary langs feed; 44 44 description |> if_some (fun d -> 45 45 Fake_system.assert_str_equal d @@ Fake_system.expect @@ F.get_description langs feed
+1 -1
src/tests/test_selections.ml
··· 182 182 let s3 = `String (0, output) |> Xmlm.make_input |> Q.parse_input None |> Selections.create in 183 183 184 184 let runnable_impl = Selections.get_selected_ex (binary runnable) s3 in 185 - Element.deps_and_bindings runnable_impl |> U.filter_map (function 185 + Element.deps_and_bindings runnable_impl |> List.filter_map (function 186 186 | `Command child -> Some (Element.command_name child) 187 187 | _ -> None 188 188 ) |> Fake_system.equal_str_lists ["foo"; "run"]
+1 -1
src/tests/test_solver.ml
··· 352 352 config.network_use <- Minimal_network; 353 353 354 354 let scope_filter = { linux_multi_scope_filter with Scope_filter. 355 - languages = Support.Locale.score_langs @@ U.filter_map Support.Locale.parse_lang ["es_ES"; "fr_FR"]; 355 + languages = Support.Locale.score_langs @@ List.filter_map Support.Locale.parse_lang ["es_ES"; "fr_FR"]; 356 356 } in 357 357 358 358 let test_solve scope_filter =
+1 -1
src/zeroinstall/compiled.ml
··· 70 70 71 71 (* Source dependencies tagged with binary-include. *) 72 72 let extra_binary_reqs = 73 - Impl.(src_impl.props.requires) |> U.filter_map (fun req -> 73 + Impl.(src_impl.props.requires) |> List.filter_map (fun req -> 74 74 let elem = req.Impl.dep_qdom in 75 75 if Element.compile_include_binary elem = Some true then ( 76 76 let elem = Element.as_xml elem in
+5 -5
src/zeroinstall/element.ml
··· 89 89 match node.Q.attrs |> AttrMap.get_no_ns FeedAttr.if_0install_version with 90 90 | Some expr when not (Version.parse_expr expr About.parsed_version) -> None 91 91 | Some _expr -> Some { 92 - node with Q.child_nodes = Support.Utils.filter_map filter_if_0install_version node.Q.child_nodes; 92 + node with Q.child_nodes = List.filter_map filter_if_0install_version node.Q.child_nodes; 93 93 attrs = node.Q.attrs |> AttrMap.remove ("", FeedAttr.if_0install_version) 94 94 } 95 95 | None -> Some { 96 - node with Q.child_nodes = Support.Utils.filter_map filter_if_0install_version node.Q.child_nodes; 96 + node with Q.child_nodes = List.filter_map filter_if_0install_version node.Q.child_nodes; 97 97 } 98 98 99 99 let parse_feed root = ··· 194 194 let default = ZI.get_attribute_opt "default" 195 195 196 196 let feed_metadata root = 197 - root.Q.child_nodes |> Support.Utils.filter_map (fun node -> 197 + root.Q.child_nodes |> List.filter_map (fun node -> 198 198 match ZI.tag node with 199 199 | Some "name" -> Some (`Name node) 200 200 | Some "feed" -> Some (`Feed_import node) ··· 208 208 ) 209 209 210 210 let group_children group = 211 - group.Q.child_nodes |> Support.Utils.filter_map (fun node -> 211 + group.Q.child_nodes |> List.filter_map (fun node -> 212 212 match ZI.tag node with 213 213 | Some "group" -> Some (`Group node) 214 214 | Some "implementation" -> Some (`Implementation node) ··· 270 270 | Some "remove" -> Some (`Remove child) 271 271 | Some _ -> raise Unknown_step 272 272 | None -> None in 273 - try Some (Support.Utils.filter_map parse_step elem.Q.child_nodes) 273 + try Some (List.filter_map parse_step elem.Q.child_nodes) 274 274 with Unknown_step -> None 275 275 276 276 let importance dep =
+1 -1
src/zeroinstall/exec.ml
··· 114 114 115 115 (* Do <environment> bindings; collect executable bindings *) 116 116 let exec_bindings = 117 - bindings |> Support.Utils.filter_map (fun (role, binding) -> match Binding.parse_binding binding with 117 + bindings |> List.filter_map (fun (role, binding) -> match Binding.parse_binding binding with 118 118 | Binding.EnvironmentBinding b -> 119 119 let sel = lazy ( 120 120 Selections.RoleMap.find_opt role impls
+2 -2
src/zeroinstall/feed.ml
··· 256 256 } 257 257 258 258 let get_feed_targets feed = 259 - Element.feed_metadata feed.root |> U.filter_map (function 259 + Element.feed_metadata feed.root |> List.filter_map (function 260 260 | `Feed_for f -> Some (Element.interface f) 261 261 | _ -> None 262 262 ) ··· 274 274 ) 275 275 276 276 let icons feed = 277 - Element.feed_metadata feed.root |> U.filter_map (function 277 + Element.feed_metadata feed.root |> List.filter_map (function 278 278 | `Icon icon -> Some icon 279 279 | _ -> None 280 280 )
+1 -1
src/zeroinstall/feed_cache.ml
··· 158 158 attrs := !attrs |> Q.AttrMap.add_no_ns IfaceConfigAttr.stability_policy (Stability.to_string policy) 159 159 ); 160 160 161 - let child_nodes = iface_config.extra_feeds |> U.filter_map add_import_elem in 161 + let child_nodes = iface_config.extra_feeds |> List.filter_map add_import_elem in 162 162 let root = ZI.make ~attrs:!attrs ~child_nodes "interface-preferences" in 163 163 164 164 config_file |> config.system#atomic_write [Open_wronly; Open_binary] ~mode:0o644 (fun ch ->
+2 -2
src/zeroinstall/fetch.ml
··· 151 151 152 152 (* Start a download for each missing key *) 153 153 let missing_keys = 154 - sigs |> U.filter_map (function 154 + sigs |> List.filter_map (function 155 155 | G.ErrSig (G.UnknownKey key) -> Some (fetch key) 156 156 | _ -> None 157 157 ) in ··· 243 243 trust_db, possibly after confirming with the user. *) 244 244 let confirm_keys feed sigs messages = 245 245 let `Remote_feed feed_url = feed in 246 - let valid_sigs = sigs |> U.filter_map (function 246 + let valid_sigs = sigs |> List.filter_map (function 247 247 | G.ValidSig info -> Some info 248 248 | G.BadSig _ | G.ErrSig _ -> None 249 249 ) in
+1 -1
src/zeroinstall/gui.ml
··· 431 431 | Some description -> Str.split (Str.regexp_string "\n\n") description |> List.map format_para 432 432 | None -> ["-"] in 433 433 434 - let homepages = Feed.root feed |> Element.feed_metadata |> U.filter_map (function 434 + let homepages = Feed.root feed |> Element.feed_metadata |> List.filter_map (function 435 435 | `Homepage homepage -> Some (Element.simple_content homepage) 436 436 | _ -> None 437 437 ) in
+3 -3
src/zeroinstall/host_python.ml
··· 75 75 let make system = 76 76 let (_host_os, host_machine) = Arch.platform system in 77 77 let python_installations = lazy ( 78 - ["python"; "python2"; "python3"] |> Utils.filter_map (fun name -> 78 + ["python"; "python2"; "python3"] |> List.filter_map (fun name -> 79 79 Utils.find_in_path system name |> pipe_some (fun path -> 80 80 try 81 81 let json = [path; "-c"; python_test_code] |> Utils.check_output system Yojson.Basic.from_channel in ··· 134 134 (id, make_host_impl t ~package:"host-python" path version ~commands url id) 135 135 ) 136 136 | `Remote_feed "http://repo.roscidus.com/python/python-gobject" as url -> 137 - Lazy.force t.python_installations |> Utils.filter_map (fun installation -> 137 + Lazy.force t.python_installations |> List.filter_map (fun installation -> 138 138 match installation.python_gobject with 139 139 | Some info -> 140 140 let id = "package:host:python-gobject:" ^ info.version in ··· 143 143 | None -> None 144 144 ) 145 145 | `Remote_feed "https://apps.0install.net/python/pygobject.xml" as url -> 146 - Lazy.force t.python_installations |> Utils.filter_map (fun installation -> 146 + Lazy.force t.python_installations |> List.filter_map (fun installation -> 147 147 match installation.python_gobject with 148 148 | Some info -> 149 149 let id = "package:host:python-gobject:" ^ info.version in
+1 -1
src/zeroinstall/impl.ml
··· 270 270 match AttrMap.get_no_ns "langs" impl.props.attrs with 271 271 | Some langs -> Str.split XString.re_space langs 272 272 | None -> ["en"] in 273 - Support.Utils.filter_map Support.Locale.parse_lang langs 273 + List.filter_map Support.Locale.parse_lang langs 274 274 275 275 let is_retrievable_without_network cache_impl = 276 276 let ok_without_network elem =
+3 -3
src/zeroinstall/impl_provider.ml
··· 272 272 in 273 273 274 274 let get_extra_feeds ~problem want_source iface_config = 275 - Support.Utils.filter_map (get_feed_if_useful ~problem want_source) iface_config.Feed_cache.extra_feeds in 275 + List.filter_map (get_feed_if_useful ~problem want_source) iface_config.Feed_cache.extra_feeds in 276 276 277 277 let impls_for_iface = U.memoize ~initial_size:10 (fun (iface, want_source) -> 278 278 let master_feed = feed_provider#get_feed (Feed_url.master_feed_of_iface iface) in ··· 288 288 problem (Printf.sprintf "Main feed '%s' not available" iface); 289 289 ([], None) 290 290 | Some ((feed, _overrides) as pair) -> 291 - let sub_feeds = U.filter_map (get_feed_if_useful ~problem want_source) (Feed.imported_feeds feed) in 291 + let sub_feeds = List.filter_map (get_feed_if_useful ~problem want_source) (Feed.imported_feeds feed) in 292 292 let impls = List.concat (List.map (get_impls ~problem) (pair :: sub_feeds)) in 293 293 (impls, iface_config.Feed_cache.stability_policy) in 294 294 ··· 321 321 if scope_filter.Scope_filter.may_compile && not want_source then ( 322 322 let (host_os, host_machine) = Arch.platform config.system in 323 323 let host_arch = (Some host_os, Some host_machine) in 324 - U.filter_map (src_to_bin ~host_arch ~rejects) existing_impls 324 + List.filter_map (src_to_bin ~host_arch ~rejects) existing_impls 325 325 ) else ( 326 326 (existing_impls :> Impl.generic_implementation list) 327 327 ) in
+1 -1
src/zeroinstall/packagekit.ml
··· 189 189 | None -> 190 190 log_info "No size returned for '%s'" packagekit_id; 191 191 Some impl in 192 - let results = U.filter_map add_size impls in 192 + let results = List.filter_map add_size impls in 193 193 Lwt.wakeup resolver { 194 194 results; 195 195 problems = !problems;
+3 -3
src/zeroinstall/selections.ml
··· 184 184 (** Collect all the commands needed by this dependency. *) 185 185 let get_required_commands dep = 186 186 let commands = 187 - Element.bindings dep |> U.filter_map (fun node -> 187 + Element.bindings dep |> List.filter_map (fun node -> 188 188 Binding.parse_binding node |> Binding.get_command 189 189 ) in 190 190 match Element.classify_dep dep with ··· 193 193 194 194 let make_deps children = 195 195 let self_commands = ref [] in 196 - let deps = children |> U.filter_map (function 196 + let deps = children |> List.filter_map (function 197 197 | `Requires r -> Some (r :> dependency) 198 198 | `Runner r -> Some (r :> dependency) 199 199 | #Element.binding as b -> ··· 216 216 let get_command sel name = Element.get_command name sel 217 217 218 218 let selected_commands sel = 219 - Element.deps_and_bindings sel |> U.filter_map (function 219 + Element.deps_and_bindings sel |> List.filter_map (function 220 220 | `Command c -> Some (Element.command_name c) 221 221 | _ -> None 222 222 )
+2 -2
src/zeroinstall/solver.ml
··· 93 93 let make_deps role zi_deps self_bindings = 94 94 let impl_provider = role.scope in 95 95 let deps = zi_deps 96 - |> U.filter_map (fun zi_dep -> 96 + |> List.filter_map (fun zi_dep -> 97 97 if impl_provider#is_dep_needed zi_dep then Some (role, zi_dep) 98 98 else None 99 99 ) in 100 100 let self_commands = self_bindings 101 - |> U.filter_map (fun binding -> 101 + |> List.filter_map (fun binding -> 102 102 Element.classify_binding binding |> Binding.parse_binding |> Binding.get_command 103 103 ) in 104 104 (deps, self_commands)
+1 -1
src/zeroinstall/tree.ml
··· 47 47 ); 48 48 49 49 let children = 50 - !deps |> U.filter_map (fun dep -> 50 + !deps |> List.filter_map (fun dep -> 51 51 let {Model.dep_role; dep_importance; dep_required_commands = _} = Model.dep_info dep in 52 52 if dep_importance <> `Restricts then 53 53 build_node dep_role ~essential:(dep_importance = `Essential)