Expose metadata extraction from intermediate Buck API layer

Reviewed By: kinto0

Differential Revision: D47579492

fbshipit-source-id: e538e3ce7739da239848c9fe531ad1efeedacc5b

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.

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 }

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