diff --git a/lib/s.ml b/lib/s.ml index a7095fe3..de8c353f 100644 --- a/lib/s.ml +++ b/lib/s.ml @@ -87,7 +87,7 @@ module type BUILDER = sig val build : t -> context -> - Obuilder_spec.stage -> + Obuilder_spec.t -> (id, [`Cancelled | `Msg of string]) Lwt_result.t val delete : ?log:(id -> unit) -> t -> id -> unit Lwt.t diff --git a/lib_spec/docker.mli b/lib_spec/docker.mli index eec67fb6..572e8468 100644 --- a/lib_spec/docker.mli +++ b/lib_spec/docker.mli @@ -1,4 +1,4 @@ -val dockerfile_of_spec : buildkit:bool -> Spec.stage -> Dockerfile.t +val dockerfile_of_spec : buildkit:bool -> Spec.t -> Dockerfile.t (** [dockerfile_of_spec x] produces a Dockerfile that aims to be equivalent to [x]. However, note that: diff --git a/lib_spec/spec.ml b/lib_spec/spec.ml index 1ed1c803..fd32c571 100644 --- a/lib_spec/spec.ml +++ b/lib_spec/spec.ml @@ -92,19 +92,19 @@ let op_of_sexp x = op_of_sexp (List (Atom name :: args)) | x -> Fmt.failwith "Invalid op: %a" Sexplib.Sexp.pp_hum x -type stage = { +type t = { from : string; ops : op list; } -let sexp_of_stage { from; ops } = +let sexp_of_t { from; ops } = let open Sexplib.Sexp in List (List [ Atom "from"; Atom from ] :: List.map sexp_of_op ops) -let stage_of_sexp = function +let t_of_sexp = function | Sexplib.Sexp.List (List [ Atom "from"; Atom from ] :: ops) -> { from; ops = List.map op_of_sexp ops } - | x -> Fmt.failwith "Invalid stage: %a" Sexplib.Sexp.pp_hum x + | x -> Fmt.failwith "Invalid spec: %a" Sexplib.Sexp.pp_hum x let comment fmt = fmt |> Printf.ksprintf (fun c -> `Comment c) let workdir x = `Workdir x @@ -135,8 +135,8 @@ let pp_op_sexp f : Sexplib.Sexp.t -> unit = function (Fmt.list ~sep:Fmt.sp pp_one_line) args | x -> pp_one_line f x -let pp_stage f t = - match sexp_of_stage t with +let pp f t = + match sexp_of_t t with | List lines -> Fmt.pf f "(@[%a@]@,)" (Fmt.list ~sep:Fmt.cut pp_op_sexp) lines | x -> Sexplib.Sexp.pp_hum f x diff --git a/lib_spec/spec.mli b/lib_spec/spec.mli index 2f3f736a..323a5c8d 100644 --- a/lib_spec/spec.mli +++ b/lib_spec/spec.mli @@ -25,12 +25,12 @@ type op = [ | `Env of (string * string) ] [@@deriving sexp] -type stage = { +type t = { from : string; ops : op list; } [@@deriving sexp] -val stage : from:string -> op list -> stage +val stage : from:string -> op list -> t val comment : ('a, unit, string, op) format4 -> 'a val workdir : string -> op @@ -42,8 +42,8 @@ val user : uid:int -> gid:int -> op val root : user -val pp_stage : stage Fmt.t -(** [pp_stage f s] is similar to [Sexplib.Sexp.pp_hum f (sexp_of_stage s)], but +val pp : t Fmt.t +(** [pp f s] is similar to [Sexplib.Sexp.pp_hum f (sexp_of_t s)], but attempts to improve the layout slightly by putting each operation on its own line. *) diff --git a/main.ml b/main.ml index a9dcd114..75e9c210 100644 --- a/main.ml +++ b/main.ml @@ -30,7 +30,7 @@ let create_builder ?fast_sync spec = let build fast_sync store spec src_dir = Lwt_main.run begin create_builder ~fast_sync store >>= fun (Builder ((module Builder), builder)) -> - let spec = Obuilder.Spec.stage_of_sexp (Sexplib.Sexp.load_sexp spec) in + let spec = Obuilder.Spec.t_of_sexp (Sexplib.Sexp.load_sexp spec) in let context = Obuilder.Context.v ~log ~src_dir () in Builder.build builder context spec >>= function | Ok x -> @@ -52,7 +52,7 @@ let delete store id = let dockerfile buildkit spec = Sexplib.Sexp.load_sexp spec - |> Obuilder_spec.stage_of_sexp + |> Obuilder_spec.t_of_sexp |> Obuilder_spec.Docker.dockerfile_of_spec ~buildkit |> Dockerfile.string_of_t |> print_endline diff --git a/stress/stress.ml b/stress/stress.ml index 8dcc49da..dfbae97e 100644 --- a/stress/stress.ml +++ b/stress/stress.ml @@ -133,7 +133,7 @@ module Test(Store : S.STORE) = struct |> fun got -> assert_str expected got in - check_log, { Spec.from = "busybox"; ops } + check_log, Spec.stage ~from:"busybox" ops let do_build builder = let src_dir = "/root" in diff --git a/test/test.ml b/test/test.ml index b76fd108..65301d61 100644 --- a/test/test.ml +++ b/test/test.ml @@ -59,7 +59,7 @@ let test_simple _switch () = with_config @@ fun ~src_dir ~store ~sandbox ~builder -> let log = Log.create "b" in let context = Context.v ~src_dir ~log:(Log.add log) () in - let spec = Spec.{ from = "base"; ops = [ run "Append" ] } in + let spec = Spec.(stage ~from:"base" [ run "Append" ]) in Mock_sandbox.expect sandbox (mock_op ~output:(`Append ("runner", "base-id")) ()); B.build builder context spec >>!= get store "output" >>= fun result -> Alcotest.(check build_result) "Final result" (Ok "base-distro\nrunner") result; @@ -88,7 +88,7 @@ let test_prune _switch () = let start = Unix.(gettimeofday () |> gmtime) in let log = Log.create "b" in let context = Context.v ~src_dir ~log:(Log.add log) () in - let spec = Spec.{ from = "base"; ops = [ run "Append" ] } in + let spec = Spec.(stage ~from:"base" [ run "Append" ]) in Mock_sandbox.expect sandbox (mock_op ~output:(`Append ("runner", "base-id")) ()); B.build builder context spec >>!= get store "output" >>= fun result -> Alcotest.(check build_result) "Final result" (Ok "base-distro\nrunner") result; @@ -115,8 +115,8 @@ let test_concurrent _switch () = let log2 = Log.create "b2" in let context1 = Obuilder.Context.v ~log:(Log.add log1) ~src_dir () in let context2 = Obuilder.Context.v ~log:(Log.add log2) ~src_dir () in - let spec1 = Obuilder.Spec.{ from = "base"; ops = [ run "A"; run "B" ] } in - let spec2 = Obuilder.Spec.{ from = "base"; ops = [ run "A"; run "C" ] } in + let spec1 = Obuilder.Spec.(stage ~from:"base"[ run "A"; run "B" ]) in + let spec2 = Obuilder.Spec.(stage ~from:"base"[ run "A"; run "C" ]) in let a, a_done = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:a ~output:(`Constant "A") ()); Mock_sandbox.expect sandbox (mock_op ~output:`Append_cmd ()); @@ -161,8 +161,8 @@ let test_concurrent_failure _switch () = let log2 = Log.create "b2" in let context1 = Obuilder.Context.v ~log:(Log.add log1) ~src_dir () in let context2 = Obuilder.Context.v ~log:(Log.add log2) ~src_dir () in - let spec1 = Obuilder.Spec.{ from = "base"; ops = [ run "A"; run "B" ] } in - let spec2 = Obuilder.Spec.{ from = "base"; ops = [ run "A"; run "C" ] } in + let spec1 = Obuilder.Spec.(stage ~from:"base" [ run "A"; run "B" ]) in + let spec2 = Obuilder.Spec.(stage ~from:"base" [ run "A"; run "C" ]) in let a, a_done = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:a ()); let b1 = B.build builder context1 spec1 in @@ -198,8 +198,8 @@ let test_concurrent_failure_2 _switch () = let log2 = Log.create "b2" in let context1 = Obuilder.Context.v ~log:(Log.add log1) ~src_dir () in let context2 = Obuilder.Context.v ~log:(Log.add log2) ~src_dir () in - let spec1 = Obuilder.Spec.{ from = "base"; ops = [ run "A"; run "B" ] } in - let spec2 = Obuilder.Spec.{ from = "base"; ops = [ run "A"; run "C" ] } in + let spec1 = Obuilder.Spec.(stage ~from:"base" [ run "A"; run "B" ]) in + let spec2 = Obuilder.Spec.(stage ~from:"base" [ run "A"; run "C" ]) in let a, a_done = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:(Lwt_result.fail (`Msg "Mock build failure")) ~delay_store:a ()); let b1 = B.build builder context1 spec1 in @@ -232,7 +232,7 @@ let test_cancel _switch () = let log = Log.create "b" in let switch = Lwt_switch.create () in let context = Context.v ~switch ~src_dir ~log:(Log.add log) () in - let spec = Spec.{ from = "base"; ops = [ run "Wait" ] } in + let spec = Spec.(stage ~from:"base" [ run "Wait" ]) in let r, set_r = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:r ~cancel:set_r ()); let b = B.build builder context spec in @@ -251,7 +251,7 @@ let test_cancel _switch () = (* Two users are sharing a build. One cancels. *) let test_cancel_2 _switch () = with_config @@ fun ~src_dir ~store ~sandbox ~builder -> - let spec = Spec.{ from = "base"; ops = [ run "Wait" ] } in + let spec = Spec.(stage ~from:"base" [ run "Wait" ]) in let r, set_r = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:r ~cancel:set_r ~output:(`Constant "ok") ()); let log1 = Log.create "b1" in @@ -288,7 +288,7 @@ let test_cancel_2 _switch () = (* Two users are sharing a build. Both cancel. *) let test_cancel_3 _switch () = with_config @@ fun ~src_dir ~store ~sandbox ~builder -> - let spec = Spec.{ from = "base"; ops = [ run "Wait" ] } in + let spec = Spec.(stage ~from:"base" [ run "Wait" ]) in let r, set_r = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:r ~cancel:set_r ()); let log1 = Log.create "b1" in @@ -327,7 +327,7 @@ let test_cancel_3 _switch () = (* One user cancels a failed build after its replacement has started. *) let test_cancel_4 _switch () = with_config @@ fun ~src_dir ~store ~sandbox ~builder -> - let spec = Spec.{ from = "base"; ops = [ run "Wait" ] } in + let spec = Spec.(stage ~from:"base" [ run "Wait" ]) in let r, set_r = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:r ~cancel:set_r ()); let log1 = Log.create "b1" in @@ -364,7 +364,7 @@ let test_cancel_4 _switch () = (* Start a new build while the previous one is cancelling. *) let test_cancel_5 _switch () = with_config @@ fun ~src_dir ~store ~sandbox ~builder -> - let spec = Spec.{ from = "base"; ops = [ run "Wait" ] } in + let spec = Spec.(stage ~from:"base" [ run "Wait" ]) in let r, set_r = Lwt.wait () in let delay_store, set_delay = Lwt.wait () in Mock_sandbox.expect sandbox (mock_op ~result:r ~cancel:set_r ~delay_store ()); @@ -390,7 +390,7 @@ let test_cancel_5 _switch () = let test_delete _switch () = with_config @@ fun ~src_dir ~store ~sandbox ~builder -> - let spec = Spec.{ from = "base"; ops = [ run "A"; run "B" ] } in + let spec = Spec.(stage ~from:"base" [ run "A"; run "B" ]) in Mock_sandbox.expect sandbox (mock_op ~output:(`Constant "A") ()); Mock_sandbox.expect sandbox (mock_op ~output:(`Constant "B") ()); let log1 = Log.create "b1" in @@ -438,10 +438,10 @@ let test_sexp () = let test name s = let s = remove_indent s in let s1 = Sexplib.Sexp.of_string s in - let stage = Spec.stage_of_sexp s1 in - let s2 = Spec.sexp_of_stage stage in + let spec = Spec.t_of_sexp s1 in + let s2 = Spec.sexp_of_t spec in Alcotest.(check sexp) name s1 s2; - Alcotest.(check string) name s (Fmt.strf "%a" Spec.pp_stage stage) + Alcotest.(check string) name s (Fmt.strf "%a" Spec.pp spec) in test "copy" {| ((from base) @@ -458,7 +458,7 @@ let test_sexp () = let test_docker () = let test ~buildkit name expect sexp = - let spec = Spec.stage_of_sexp (Sexplib.Sexp.of_string sexp) in + let spec = Spec.t_of_sexp (Sexplib.Sexp.of_string sexp) in let got = Obuilder_spec.Docker.dockerfile_of_spec ~buildkit spec |> Dockerfile.string_of_t in let expect = remove_indent expect in Alcotest.(check string) name expect got