diff --git a/gitlab/pipeline.ml b/gitlab/pipeline.ml index e63488a1..04e2e281 100644 --- a/gitlab/pipeline.ml +++ b/gitlab/pipeline.ml @@ -187,9 +187,10 @@ let local_test ~solver repo () = Conf.fetch_platforms ~include_macos:false ~include_freebsd:false () in let src = Git.Local.head_commit repo in + let src_content = Repo_content.extract src in let repo = Current.return { Repo_id.owner = "local"; name = "test" } and analysis = - Analyse.examine ~solver ~platforms ~opam_repository_commit src + Analyse.examine ~solver ~platforms ~opam_repository_commit src src_content in Current.component "summarise" |> let> results = build_with_docker ~repo ~analysis ~platforms src in @@ -227,8 +228,10 @@ let v ?ocluster ~app ~solver ~migrations () = refs |> Current.list_iter (module Gitlab.Api.Commit) @@ fun head -> let src = Git.fetch (Current.map Gitlab.Api.Commit.id head) in + let src_content = Repo_content.extract src in let analysis = Analyse.examine ~solver ~platforms ~opam_repository_commit src + src_content in let* on_cancel = match ocluster with diff --git a/lib/analyse.ml b/lib/analyse.ml index 75799818..d73c651f 100644 --- a/lib/analyse.ml +++ b/lib/analyse.ml @@ -1,26 +1,11 @@ open Lwt.Infix open Current.Syntax module Worker = Ocaml_ci_api.Worker +module Content = Repo_content.Content -let pool = Current.Pool.create ~label:"analyse" 20 - -let is_empty_file x = - match Unix.lstat (Fpath.to_string x) with - | Unix.{ st_kind = S_REG; st_size = 0; _ } -> true - | _ -> false - +let pool = Current.Pool.create ~label:"analyse" 150 let ( >>!= ) = Lwt_result.bind -let read_file ~max_len path = - Lwt_io.with_file ~mode:Lwt_io.input path (fun ch -> - Lwt_io.length ch >>= fun len -> - let len = - if len <= Int64.of_int max_len then Int64.to_int len - else Fmt.failwith "File %S too big (%Ld bytes)" path len - in - let buf = Bytes.create len in - Lwt_io.read_into_exactly ch buf 0 len >|= fun () -> Bytes.to_string buf) - (* A logging service that logs to [job]. *) let job_log job = let module X = Ocaml_ci_api.Raw.Solve.Service.Log in @@ -58,81 +43,6 @@ module Analysis = struct let ocamlformat_selection t = t.ocamlformat_selection let ocamlformat_source t = t.ocamlformat_source let selections t = t.selections - let is_test_dir = Astring.String.is_prefix ~affix:"test" - - let check_opam_version = - let version_2 = OpamVersion.of_string "2" in - fun name opam -> - let opam_version = OpamFile.OPAM.opam_version opam in - if OpamVersion.compare opam_version version_2 < 0 then - Fmt.failwith "Package %S uses unsupported opam version %s (need >= 2)" - name - (OpamVersion.to_string opam_version) - - (* For each package in [root_pkgs], parse the opam file and check whether it uses pin-depends. - Fetch and return all pinned opam files. Also, ensure we're using opam format version 2. *) - let handle_opam_files ~job ~root_pkgs ~pinned_pkgs = - pinned_pkgs - |> List.iter (fun (name, contents) -> - check_opam_version name (OpamFile.OPAM.read_from_string contents)); - let pin_depends = - root_pkgs - |> List.map (fun (name, contents) -> - let opam = - try OpamFile.OPAM.read_from_string contents - with ex -> - Fmt.failwith "Invalid opam file %S: %a" name Fmt.exn ex - in - check_opam_version name opam; - let pin_depends = OpamFile.OPAM.pin_depends opam in - pin_depends - |> List.map (fun (pkg, url) -> - Current.Job.log job "%s: found pin-depends: %s -> %s" name - (OpamPackage.to_string pkg) - (OpamUrl.to_string url); - (name, pkg, url))) - |> List.concat - in - pin_depends - |> Lwt_list.map_s (fun (root_pkg, pkg, url) -> - Lwt.catch - (fun () -> - Pin_depends.get_opam ~job ~pkg url >|= fun contents -> - (OpamPackage.to_string pkg, contents)) - (function - | Failure msg -> - Fmt.failwith "%s (processing pin-depends in %s)" msg root_pkg - | ex -> Lwt.fail ex)) - - let opam_selections ~solve ~job ~platforms ~opam_files dir = - let src = Fpath.to_string dir in - let ( / ) = Filename.concat in - opam_files - |> Lwt_list.fold_left_s - (fun (root_pkgs, pinned_pkgs) path -> - let name = Filename.basename path |> Filename.chop_extension in - let name = - if String.contains name '.' then name else name ^ ".dev" - in - read_file ~max_len:102400 (src / path) >|= fun file -> - let item = (name, file) in - if Filename.dirname path = "." then (item :: root_pkgs, pinned_pkgs) - else (root_pkgs, item :: pinned_pkgs)) - ([], []) - >>= fun (root_pkgs, pinned_pkgs) -> - Lwt.try_bind - (fun () -> handle_opam_files ~job ~root_pkgs ~pinned_pkgs) - (fun pin_depends -> - let pinned_pkgs = pin_depends @ pinned_pkgs in - Lwt_result.map - (fun selections -> `Opam_build selections) - (solve ~root_pkgs ~pinned_pkgs ~platforms)) - (function Failure msg -> Lwt_result.fail (`Msg msg) | ex -> Lwt.fail ex) - - let type_of_dir dir = - match Opam_monorepo.detect ~dir with - | Some info -> `Opam_monorepo info - | None -> `Ocaml_repo (** Call the solver with a request containing these packages. When it returns a list, it is nonempty. *) @@ -153,6 +63,8 @@ module Analysis = struct root_pkgs; pinned_pkgs; platforms; + (* TODO ocamlformat in the request (option)*) + (* TODO opam_monorepo in the request (option)*) } in Current.Job.log job "Solving with opam-repository commit: %a" @@ -235,76 +147,32 @@ module Analysis = struct Ocaml_version.compare (Variant.ocaml_version v0) (Variant.ocaml_version v1)) - let of_dir ~solver ~job ~platforms ~opam_repository_commit root = - let cancelled = Atomic.make None in - let fold_on_opam_files () = - let module M = struct - exception Exit of string - end in - let module S = Astring.String.Set in - let opam_files full_path = - let path = Option.get (Fpath.rem_prefix root full_path) in - let consider_opam_file = - match Fpath.segs path with - | [] | [ _ ] -> true - | segs -> - if List.exists is_test_dir segs then ( - Current.Job.log job "Ignoring test directory %a" Fpath.pp path; - false) - else true - in - if is_empty_file full_path then ( - Current.Job.log job "WARNING: ignoring empty opam file %a" Fpath.pp - path; - None) - else if consider_opam_file then Some path - else None - in - let is_opam_ext path = Ok (Fpath.has_ext "opam" path) in - let traverse path = - match Fpath.rem_prefix root path with - (* maxdepth=3 *) - | Some suffix -> Ok (List.compare_length_with (Fpath.segs suffix) 3 <= 0) - | None when Fpath.equal root path -> Ok true - | None -> - Fmt.error_msg "%a is not a prefix of %a" Fpath.pp root Fpath.pp path - in - let add_opam_files path acc = - Option.iter (fun s -> raise_notrace (M.Exit s)) (Atomic.get cancelled); - match opam_files path with - | Some path -> S.add (Fpath.to_string path) acc - | None -> acc - in - (try - Bos.OS.Path.fold ~elements:(`Sat is_opam_ext) ~traverse:(`Sat traverse) - add_opam_files S.empty [ root ] - with M.Exit reason -> - Fmt.error_msg "Cancelling opam file lookup (%s)" reason) - |> Result.map S.elements - in - Current.Job.on_cancel job (fun reason -> - Atomic.set cancelled (Some reason); - Lwt.return_unit) - >>= fun () -> - Lwt_preemptive.detach fold_on_opam_files () >>!= fun opam_files -> + let of_content ~solver ~job ~platforms ~opam_repository_commit src = + let opam_files = Content.opam_files src in + let version = Content.ocamlformat_version src in let solve = solve ~opam_repository_commit ~job ~solver in let find_opam_repo_commit = find_opam_repo_commit_for_ocamlformat ~solve ~platforms:(filter_linux_x86_64_platforms platforms) in - Analyse_ocamlformat.get_ocamlformat_source job ~opam_files ~root + Analyse_ocamlformat.get_ocamlformat_source job ~opam_files ~version ~find_opam_repo_commit >>!= fun (ocamlformat_source, ocamlformat_selection) -> if opam_files = [] then Lwt_result.fail (`Msg "No opam files found!") else if List.filter Fpath.is_seg opam_files = [] then Lwt_result.fail (`Msg "No top-level opam files found!") else - (match type_of_dir root with + (match Content.dir_type src with | `Opam_monorepo builds -> lwt_result_list_mapm builds ~f:(fun info -> Opam_monorepo.selection ~info ~solve ~platforms) |> Lwt_result.map (fun l -> `Opam_monorepo l) - | `Ocaml_repo -> opam_selections ~solve ~job ~platforms ~opam_files root) + | `Ocaml_repo -> + let root_pkgs = Content.root_pkgs src in + let pinned_pkgs = Content.pinned_pkgs src in + Lwt_result.map + (fun selections -> `Opam_build selections) + (solve ~root_pkgs ~pinned_pkgs ~platforms)) >>!= fun selections -> let r = { opam_files; ocamlformat_selection; ocamlformat_source; selections } @@ -330,6 +198,7 @@ module Examine = struct type t = { opam_repository_commit : Current_git.Commit_id.t; platforms : (Variant.t * Worker.Vars.t) list; + src_content : Repo_content.Content.t; } let platform_to_yojson (variant, vars) = @@ -339,13 +208,14 @@ module Examine = struct ("vars", Worker.Vars.to_yojson vars); ] - let digest { opam_repository_commit; platforms } = + let digest { opam_repository_commit; platforms; src_content } = let json = `Assoc [ ( "opam-repository", `String (Current_git.Commit_id.hash opam_repository_commit) ); ("platforms", `List (List.map platform_to_yojson platforms)); + ("src_content", `String (Repo_content.Content.marshal src_content)); ] in Yojson.Safe.to_string json @@ -355,10 +225,11 @@ module Examine = struct let id = "ci-analyse" - let run solver job src { Value.opam_repository_commit; platforms } = - Current.Job.start job ~level:Current.Level.Harmless >>= fun () -> - Current_git.with_checkout ~job ~pool src @@ fun src -> - Analysis.of_dir ~solver ~platforms ~opam_repository_commit ~job src + let run solver job _ { Value.opam_repository_commit; platforms; src_content } + = + Current.Job.start job ~pool ~level:Current.Level.Harmless >>= fun () -> + Analysis.of_content ~solver ~platforms ~opam_repository_commit ~job + src_content let pp f _ = Fmt.string f "Analyse" let auto_cancel = true @@ -367,12 +238,12 @@ end module Examine_cache = Current_cache.Generic (Examine) -let examine ~solver ~platforms ~opam_repository_commit src = +let examine ~solver ~platforms ~opam_repository_commit src src_content = Current.component "Analyse" - |> let> src and> opam_repository_commit and> platforms in + |> let> src and> opam_repository_commit and> platforms and> src_content in let platforms = platforms |> List.map (fun { Platform.variant; vars; _ } -> (variant, vars)) in Examine_cache.run solver src - { Examine.Value.opam_repository_commit; platforms } + { Examine.Value.opam_repository_commit; platforms; src_content } diff --git a/lib/analyse.mli b/lib/analyse.mli index e718a478..738f16d0 100644 --- a/lib/analyse.mli +++ b/lib/analyse.mli @@ -12,12 +12,12 @@ module Analysis : sig [ `Opam_build of Selection.t list | `Opam_monorepo of Opam_monorepo.config list ] - val of_dir : + val of_content : solver:Backend_solver.t -> job:Current.Job.t -> platforms:(Variant.t * Ocaml_ci_api.Worker.Vars.t) list -> opam_repository_commit:Current_git.Commit_id.t -> - Fpath.t -> + Repo_content.Content.t -> (t, [ `Msg of string ]) result Lwt.t end @@ -26,6 +26,7 @@ val examine : platforms:Platform.t list Current.t -> opam_repository_commit:Current_git.Commit_id.t Current.t -> Current_git.Commit.t Current.t -> + Repo_content.Content.t Current.t -> Analysis.t Current.t (** [examine ~solver ~platforms ~opam_repository_commit src] analyses the source code [src] and selects package versions to test using diff --git a/lib/analyse_ocamlformat.ml b/lib/analyse_ocamlformat.ml index c7d5a5c4..edd2029d 100644 --- a/lib/analyse_ocamlformat.ml +++ b/lib/analyse_ocamlformat.ml @@ -73,9 +73,8 @@ let ocamlformat_version_from_file ~root job path = | _ :: _ :: _ -> Lwt.return (Error (`Msg "Multiple 'version=' lines in .ocamlformat")) -let get_ocamlformat_source job ~opam_files ~root ~find_opam_repo_commit = +let get_ocamlformat_source job ~opam_files ~version ~find_opam_repo_commit = let open Lwt.Infix in - let ( let* ) = Lwt_result.Infix.( >>= ) in let proj_is_ocamlformat p = String.equal (Filename.basename p) "ocamlformat.opam" in @@ -84,11 +83,7 @@ let get_ocamlformat_source job ~opam_files ~root ~find_opam_repo_commit = let path = Filename.dirname opam_file in Lwt_result.return (Some (Vendored { path }), None) | None -> ( - let* version_in_dot_ocamlformat = - ocamlformat_version_from_file ~root job - Fpath.(to_string (root / ".ocamlformat")) - in - match version_in_dot_ocamlformat with + match version with | None -> Lwt_result.return (None, None) | Some version -> ( find_opam_repo_commit version >>= function diff --git a/lib/analyse_ocamlformat.mli b/lib/analyse_ocamlformat.mli index f3b019db..6325a920 100644 --- a/lib/analyse_ocamlformat.mli +++ b/lib/analyse_ocamlformat.mli @@ -10,10 +10,17 @@ type source = val pp_source : source Fmt.t (** Pretty print [source]. *) +val ocamlformat_version_from_file : + root:Fpath.t -> + Current.Job.t -> + string -> + (string option, [ `Msg of string ]) Lwt_result.t +(** Extract the version in .ocamlformat file if the file exists in the project *) + val get_ocamlformat_source : Current.Job.t -> opam_files:string list -> - root:Fpath.t -> + version:string option -> find_opam_repo_commit: (string -> (string * Selection.t, [ `Msg of string ]) Lwt_result.t) -> (source option * Selection.t option, [ `Msg of string ]) Lwt_result.t diff --git a/lib/opam_monorepo.ml b/lib/opam_monorepo.ml index 8f9c3aca..1044c85a 100644 --- a/lib/opam_monorepo.ml +++ b/lib/opam_monorepo.ml @@ -1,4 +1,4 @@ -type info = string * OpamFile.OPAM.t +type info = string * string [@@deriving yojson] type lock_file_version = V0_2 | V0_3 [@@deriving yojson, ord] (** The kind of switch the package will be built in. *) @@ -58,7 +58,7 @@ let detect ~dir = OpamFile.OPAM.read (OpamFile.make (OpamFilename.of_string full_path)) in let* _ = x_opam_monorepo_version lock_file_contents in - Some (lock_file_path, lock_file_contents)) + Some (lock_file_path, OpamFile.OPAM.write_to_string lock_file_contents)) let packages_in_depends f = let get_atom = function OpamFormula.Atom a -> a | _ -> assert false in @@ -124,6 +124,7 @@ let adjust_ocaml_version platform ~version = let selection ~info:(lock_file_path, lock_file) ~platforms ~solve = let open Lwt_result.Infix in + let lock_file = OpamFile.OPAM.read_from_string lock_file in let ocaml_version = opam_monorepo_dep_version ~lock_file ~package:"ocaml" in let dune_version = opam_monorepo_dep_version ~lock_file ~package:"dune" in let lock_file_version = diff --git a/lib/opam_monorepo.mli b/lib/opam_monorepo.mli index bc423582..4ce28c7d 100644 --- a/lib/opam_monorepo.mli +++ b/lib/opam_monorepo.mli @@ -1,6 +1,6 @@ (** Generate obuilder specs for building opam packages with opam-monorepo. *) -type info +type info [@@deriving yojson] val detect : dir:Fpath.t -> info list option (** Detect whether a project uses opam-monorepo or something else. *) diff --git a/lib/repo_content.ml b/lib/repo_content.ml new file mode 100644 index 00000000..5bfb593b --- /dev/null +++ b/lib/repo_content.ml @@ -0,0 +1,217 @@ +open Lwt.Infix +open Current.Syntax +module Commit = Current_git.Commit +module Commit_id = Current_git.Commit_id + +let pool = Current.Pool.create ~label:"extract_commit" 20 + +let is_empty_file x = + match Unix.lstat (Fpath.to_string x) with + | Unix.{ st_kind = S_REG; st_size = 0; _ } -> true + | _ -> false + +let ( >>!= ) = Lwt_result.bind + +let read_file ~max_len path = + Lwt_io.with_file ~mode:Lwt_io.input path (fun ch -> + Lwt_io.length ch >>= fun len -> + let len = + if len <= Int64.of_int max_len then Int64.to_int len + else Fmt.failwith "File %S too big (%Ld bytes)" path len + in + let buf = Bytes.create len in + Lwt_io.read_into_exactly ch buf 0 len >|= fun () -> Bytes.to_string buf) + +module Content = struct + type t = { + opam_files : string list; + root_pkgs : (string * string) list; + pinned_pkgs : (string * string) list; + ocamlformat_version : string option; + dir_type : [ `Opam_monorepo of Opam_monorepo.info list | `Ocaml_repo ]; + } + [@@deriving yojson] + + let marshal t = to_yojson t |> Yojson.Safe.to_string + + let unmarshal s = + match Yojson.Safe.from_string s |> of_yojson with + | Ok x -> x + | Error e -> failwith e + + let root_pkgs t = t.root_pkgs + let pinned_pkgs t = t.pinned_pkgs + let ocamlformat_version t = t.ocamlformat_version + let opam_files t = t.opam_files + let dir_type t = t.dir_type + let is_test_dir = Astring.String.is_prefix ~affix:"test" + + let check_opam_version = + let version_2 = OpamVersion.of_string "2" in + fun name opam -> + let opam_version = OpamFile.OPAM.opam_version opam in + if OpamVersion.compare opam_version version_2 < 0 then + Fmt.failwith "Package %S uses unsupported opam version %s (need >= 2)" + name + (OpamVersion.to_string opam_version) + + (* For each package in [root_pkgs], parse the opam file and check whether it uses pin-depends. + Fetch and return all pinned opam files. Also, ensure we're using opam format version 2. *) + let handle_opam_files ~job ~root_pkgs ~pinned_pkgs = + pinned_pkgs + |> List.iter (fun (name, contents) -> + check_opam_version name (OpamFile.OPAM.read_from_string contents)); + let pin_depends = + root_pkgs + |> List.map (fun (name, contents) -> + let opam = + try OpamFile.OPAM.read_from_string contents + with ex -> + Fmt.failwith "Invalid opam file %S: %a" name Fmt.exn ex + in + check_opam_version name opam; + let pin_depends = OpamFile.OPAM.pin_depends opam in + pin_depends + |> List.map (fun (pkg, url) -> + Current.Job.log job "%s: found pin-depends: %s -> %s" name + (OpamPackage.to_string pkg) + (OpamUrl.to_string url); + (name, pkg, url))) + |> List.concat + in + pin_depends + |> Lwt_list.map_s (fun (root_pkg, pkg, url) -> + Lwt.catch + (fun () -> + Pin_depends.get_opam ~job ~pkg url >|= fun contents -> + (OpamPackage.to_string pkg, contents)) + (function + | Failure msg -> + Fmt.failwith "%s (processing pin-depends in %s)" msg root_pkg + | ex -> Lwt.fail ex)) + + let get_all_pinned_pkgs job opam_files dir = + let src = Fpath.to_string dir in + let ( / ) = Filename.concat in + opam_files + |> Lwt_list.fold_left_s + (fun (root_pkgs, pinned_pkgs) path -> + let name = Filename.basename path |> Filename.chop_extension in + let name = + if String.contains name '.' then name else name ^ ".dev" + in + read_file ~max_len:102400 (src / path) >|= fun file -> + let item = (name, file) in + if Filename.dirname path = "." then (item :: root_pkgs, pinned_pkgs) + else (root_pkgs, item :: pinned_pkgs)) + ([], []) + >>= fun (root_pkgs, pinned_pkgs) -> + Lwt.try_bind + (fun () -> handle_opam_files ~job ~root_pkgs ~pinned_pkgs) + (fun pin_depends -> + Lwt_result.return (root_pkgs, pin_depends @ pinned_pkgs)) + (function Failure msg -> Lwt_result.fail (`Msg msg) | ex -> Lwt.fail ex) + + let get_ocamlformat_version job ~root = + Analyse_ocamlformat.ocamlformat_version_from_file ~root job + Fpath.(to_string (root / ".ocamlformat")) + + let type_of_dir dir : + [ `Opam_monorepo of Opam_monorepo.info list | `Ocaml_repo ] = + match Opam_monorepo.detect ~dir with + | Some info -> `Opam_monorepo info + | None -> `Ocaml_repo + + let of_dir ~job root = + let dir_type = type_of_dir root in + let cancelled = Atomic.make None in + let fold_on_opam_files () = + let module M = struct + exception Exit of string + end in + let module S = Astring.String.Set in + let opam_files full_path = + let path = Option.get (Fpath.rem_prefix root full_path) in + let consider_opam_file = + match Fpath.segs path with + | [] | [ _ ] -> true + | segs -> + if List.exists is_test_dir segs then ( + Current.Job.log job "Ignoring test directory %a" Fpath.pp path; + false) + else true + in + if is_empty_file full_path then ( + Current.Job.log job "WARNING: ignoring empty opam file %a" Fpath.pp + path; + None) + else if consider_opam_file then Some path + else None + in + let is_opam_ext path = Ok (Fpath.has_ext "opam" path) in + let traverse path = + match Fpath.rem_prefix root path with + (* maxdepth=3 *) + | Some suffix -> Ok (List.compare_length_with (Fpath.segs suffix) 3 <= 0) + | None when Fpath.equal root path -> Ok true + | None -> + Fmt.error_msg "%a is not a prefix of %a" Fpath.pp root Fpath.pp path + in + let add_opam_files path acc = + Option.iter (fun s -> raise_notrace (M.Exit s)) (Atomic.get cancelled); + match opam_files path with + | Some path -> S.add (Fpath.to_string path) acc + | None -> acc + in + (try + Bos.OS.Path.fold ~elements:(`Sat is_opam_ext) ~traverse:(`Sat traverse) + add_opam_files S.empty [ root ] + with M.Exit reason -> + Fmt.error_msg "Cancelling opam file lookup (%s)" reason) + |> Result.map S.elements + in + Current.Job.on_cancel job (fun reason -> + Atomic.set cancelled (Some reason); + Lwt.return_unit) + >>= fun () -> + Lwt_preemptive.detach fold_on_opam_files () >>!= fun opam_files -> + get_ocamlformat_version job ~root >>!= fun ocamlformat_version -> + get_all_pinned_pkgs job opam_files root >>!= fun (root_pkgs, pinned_pkgs) -> + Lwt_result.return + { root_pkgs; pinned_pkgs; ocamlformat_version; opam_files; dir_type } +end + +module Extract = struct + let id = "ci-extract" + + type t = No_context + + module Key = struct + type t = Commit.t + + let digest t = Commit.hash t + end + + module Value = struct + type t = Commit.t + + let digest t = Commit.hash t + end + + module Outcome = Content + + let run _ job _ src = + Current.Job.start job ~pool ~level:Current.Level.Harmless >>= fun () -> + Current_git.with_checkout ~job src @@ fun src -> Content.of_dir ~job src + + let pp f _ = Fmt.pf f "Extract" + let auto_cancel = true + let latched = true +end + +module Extract_cache = Current_cache.Generic (Extract) + +let extract src = + Current.component "Extract" + |> let> src in + Extract_cache.run No_context src src diff --git a/lib/repo_content.mli b/lib/repo_content.mli new file mode 100644 index 00000000..9bc17b86 --- /dev/null +++ b/lib/repo_content.mli @@ -0,0 +1,20 @@ +(** Extract from a source repository the informations that needed to analyse the + opam packages. *) +module Content : sig + type t [@@deriving yojson] + + val opam_files : t -> string list + val root_pkgs : t -> (string * string) list + val pinned_pkgs : t -> (string * string) list + val ocamlformat_version : t -> string option + val dir_type : t -> [ `Opam_monorepo of Opam_monorepo.info list | `Ocaml_repo ] + val marshal : t -> string + val unmarshal : string -> t + + val of_dir : + job:Current.Job.t -> Fpath.t -> (t, [ `Msg of string ]) result Lwt.t +end + +val extract : Current_git.Commit.t Current.t -> Content.t Current.t +(** [extract src] extract the informations of the source code [src], usefull for + analysis *) diff --git a/service/pipeline.ml b/service/pipeline.ml index c3f6749c..6ff6a889 100644 --- a/service/pipeline.ml +++ b/service/pipeline.ml @@ -117,9 +117,10 @@ let local_test ~solver repo () = Conf.fetch_platforms ~include_macos:false ~include_freebsd:false () in let src = Git.Local.head_commit repo in + let src_content = Repo_content.extract src in let repo = Current.return { Repo_id.owner = "local"; name = "test" } and analysis = - Analyse.examine ~solver ~platforms ~opam_repository_commit src + Analyse.examine ~solver ~platforms ~opam_repository_commit src src_content in Current.component "summarise" |> let> results = build_with_docker ~repo ~analysis ~platforms src in @@ -157,8 +158,10 @@ let v ?ocluster ~app ~solver ~migrations () = |> Current.list_iter ~collapse_key:"ref" (module Github.Api.Commit) @@ fun head -> let src = Git.fetch (Current.map Github.Api.Commit.id head) in + let src_content = Repo_content.extract src in let analysis = Analyse.examine ~solver ~platforms ~opam_repository_commit src + src_content in let* on_cancel = match ocluster with diff --git a/test/service/test_analyse.ml b/test/service/test_analyse.ml index 07b6b51c..f6b76a8f 100644 --- a/test/service/test_analyse.ml +++ b/test/service/test_analyse.ml @@ -1,4 +1,5 @@ open Lwt.Infix +module Content = Ocaml_ci.Repo_content.Content let () = Logs.(set_level (Some Info)); @@ -54,9 +55,9 @@ module Analysis = struct } [@@deriving eq, yojson] - let of_dir ~job ~platforms ~opam_repository_commit d = + let of_content ~job ~platforms ~opam_repository_commit d = let solver = Ocaml_ci.Backend_solver.v None in - of_dir ~solver ~job ~platforms ~opam_repository_commit d + of_content ~solver ~job ~platforms ~opam_repository_commit d |> Lwt_result.map (fun t -> { opam_files = opam_files t; @@ -146,8 +147,10 @@ let expect_test name ~project ~expected = Current_git.Commit_id.v ~repo:"opam-repository" ~hash:(String.trim hash) ~gref:"master" in - Analysis.of_dir ~job ~platforms:Test_platforms.v ~opam_repository_commit - (Fpath.v root) + Content.of_dir ~job (Fpath.v root) >|= unwrap_result ~job + >>= fun content -> + Analysis.of_content ~job ~platforms:Test_platforms.v + ~opam_repository_commit content >|= fun result -> (match (result, expected) with | Error _, Ok _ ->