diff --git a/source/buck/buck.mli b/source/buck/buck.mli index b20c5a463c6..9844fb9f4a5 100644 --- a/source/buck/buck.mli +++ b/source/buck/buck.mli @@ -382,6 +382,17 @@ module Interface : sig } end + (** This module provides a utility type that attach a piece of metadata to an optional piece of + data. The metadata part is mostly useful for telemetry purpose. *) + module WithMetadata : sig + type ('data, 'metadata) t = { + data: 'data; + metadata: 'metadata option; + } + + val create : ?metadata:'metadata -> 'data -> ('data, 'metadata) t + end + (** This module contains APIs specific to Buck1 *) module V1 : sig type t @@ -457,7 +468,10 @@ module Interface : sig (** Create an instance of [t] from custom [construct_build_map] behavior. Useful for unit testing. *) - val create_for_testing : construct_build_map:(string list -> BuildMap.t Lwt.t) -> unit -> t + val create_for_testing + : construct_build_map:(string list -> (BuildMap.t, string) WithMetadata.t Lwt.t) -> + unit -> + t (** Given a list of Buck targets or target expressions, invoke [buck] to construct the link tree as well as source databases. It then loads all generated source databases, and merge all of @@ -470,7 +484,7 @@ module Interface : sig May raise {!Raw.BuckError} when `buck` invocation fails, or {!JsonError} when `buck` itself succeeds but its output cannot be parsed. *) - val construct_build_map : t -> string list -> BuildMap.t Lwt.t + val construct_build_map : t -> string list -> (BuildMap.t, string) WithMetadata.t Lwt.t end (** This module contains APIs specific to lazy Buck building. diff --git a/source/buck/builder.ml b/source/buck/builder.ml index 9f928cd399b..1c921655cfa 100644 --- a/source/buck/builder.ml +++ b/source/buck/builder.ml @@ -271,7 +271,7 @@ module Classic = struct let build ~interface ~source_root ~artifact_root targets = let open Lwt.Infix in Interface.V2.construct_build_map interface targets - >>= fun build_map -> + >>= fun { Interface.WithMetadata.data = build_map; metadata = _ } -> Log.info "Constructing Python link-tree for type checking..."; Artifacts.populate ~source_root ~artifact_root build_map >>= function @@ -282,7 +282,7 @@ module Classic = struct let full_incremental_build ~interface ~source_root ~artifact_root ~old_build_map targets = let open Lwt.Infix in Interface.V2.construct_build_map interface targets - >>= fun build_map -> + >>= fun { Interface.WithMetadata.data = build_map; metadata = _ } -> do_incremental_build ~source_root ~artifact_root ~old_build_map ~new_build_map:build_map () >>= fun changed_artifacts -> Lwt.return { IncrementalBuildResult.targets; build_map; changed_artifacts } diff --git a/source/buck/interface.ml b/source/buck/interface.ml index 6e9fc7352e9..3fdf9888152 100644 --- a/source/buck/interface.ml +++ b/source/buck/interface.ml @@ -29,6 +29,15 @@ module BuildResult = struct } end +module WithMetadata = struct + type ('data, 'metadata) t = { + data: 'data; + metadata: 'metadata option; + } + + let create ?metadata data = { data; metadata } +end + module V1 = struct module IncompatibleMergeItem = struct type t = { @@ -431,7 +440,7 @@ module V1 = struct end module V2 = struct - type t = { construct_build_map: string list -> BuildMap.t Lwt.t } + type t = { construct_build_map: string list -> (BuildMap.t, string) WithMetadata.t Lwt.t } let create_for_testing ~construct_build_map () = { construct_build_map } @@ -567,11 +576,11 @@ module V2 = struct let open Lwt.Infix in Log.info "Building Buck source databases..."; run_bxl_for_targets ~bxl_builder ~buck_options target_patterns - >>= fun { Raw.Command.Output.stdout; _ } -> + >>= fun { Raw.Command.Output.stdout; build_id } -> let { BuckBxlBuilderOutput.build_map; target_count; conflicts } = parse_bxl_output stdout in warn_on_conflicts conflicts; Log.info "Loaded source databases for %d targets" target_count; - Lwt.return build_map + Lwt.return (WithMetadata.create ?metadata:build_id build_map) let create ?mode ?isolation_prefix ?bxl_builder raw = @@ -582,7 +591,7 @@ module V2 = struct { construct_build_map = construct_build_map_with_options ~bxl_builder ~buck_options } - let construct_build_map { construct_build_map; _ } target_patterns = + let construct_build_map { construct_build_map } target_patterns = construct_build_map target_patterns end