Source file XInstallObject.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
(** The implementation of ["install-object"] is the same as ["get-object"].

    The real difference is how overlapping paths are treated, but that is the
    responsibility of {!BuildTask.verify_nonoverlapping_subpaths_for_getobject}
*)

module Make (Ctx : BuildContext.S) = struct
  module BuildTraceStore' = BuildTraceStore.Make (Ctx)
  module BuildTaskUnresolved' = BuildTaskUnresolved.Make (Ctx)
  module BuildEngine' = BuildEngine.Make (Ctx)

  let run ~context ~tasks ~slot ~command_output ~archive_member =
    let open Ctx.Syntax in
    let* apply_aliases =
      BuildTraceStore'.get_apply_aliases (Ctx.of_value_context context)
    in
    let key =
      BuildEngine'.create_key_for_object ~apply_aliases:(Some apply_aliases)
        ~debug_reference:(Ctx.vc_debug_reference context)
        ~module_id:(Ctx.vc_module_id context)
        ~module_semver:(Ctx.vc_module_semver context)
        ~slot ()
    in
    let* () =
      BuildTaskUnresolved'.run_single (Ctx.of_value_context context) ~tasks key
    in
    let* () =
      BuildEngine'.output_install_object
        (Ctx.of_value_context context)
        ~build_request:(Ctx.vc_build_request context)
        ~source:(Ctx.vc_source context) ~command_output ~archive_member key
    in
    return key
end