Skip to content

Improve formatting of OBuilder specs #45

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
talex5 merged 1 commit into from
Dec 2, 2020
Merged

Improve formatting of OBuilder specs #45

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 2 additions & 3 deletions lib/build.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -142,8 +142,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) = struct
)

let pp_op ~(context:Context.t) f op =
let sexp = Obuilder_spec.sexp_of_op op in
Fmt.pf f "@[<v2>%s: %a@]" context.workdir Sexplib.Sexp.pp_hum sexp
Fmt.pf f "@[<v2>%s: %a@]" context.workdir Obuilder_spec.pp_op op

let update_workdir ~(context:Context.t) path =
let workdir =
Expand Down Expand Up @@ -198,7 +197,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) = struct
(fun () -> Os.exec ["docker"; "rm"; "--"; cid])

let get_base t ~log base =
log `Heading (Fmt.strf "FROM %s" base);
log `Heading (Fmt.strf "(from %a)" Sexplib.Sexp.pp_hum (Atom base));
let id = Sha256.to_hex (Sha256.string base) in
Store.build t.store ~id ~log (fun ~cancelled:_ ~log:_ tmp ->
Log.info (fun f -> f "Base image not present; importing %S...@." base);
Expand Down
25 changes: 25 additions & 0 deletions lib_spec/spec.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -117,3 +117,28 @@ let user ~uid ~gid = `User { uid; gid }
let root = { uid = 0; gid = 0 }

let stage ~from ops = { from; ops }

let rec pp_no_boxes f : Sexplib.Sexp.t -> unit = function
| List xs -> Fmt.pf f "(%a)" (Fmt.list ~sep:Fmt.sp pp_no_boxes) xs
| Atom _ as a -> Sexplib.Sexp.pp_hum f a

let pp_one_line = Fmt.hbox pp_no_boxes

let pp_op_sexp f : Sexplib.Sexp.t -> unit = function
| List (Atom ("copy") as op :: args) ->
Fmt.pf f "(%a @[<hv>%a@])"
Sexplib.Sexp.pp_hum op
(Fmt.list ~sep:Fmt.sp pp_one_line) args
| List (Atom ("run") as op :: args) ->
Fmt.pf f "(%a @[<v>%a@])"
Sexplib.Sexp.pp_hum op
(Fmt.list ~sep:Fmt.sp pp_one_line) args
| x -> Sexplib.Sexp.pp_hum f x

let pp_stage f t =
match sexp_of_stage t with
| List lines ->
Fmt.pf f "(@[<v>%a@]@,)" (Fmt.list ~sep:Fmt.cut pp_op_sexp) lines
| x -> Sexplib.Sexp.pp_hum f x

let pp_op = Fmt.using sexp_of_op pp_op_sexp
8 changes: 8 additions & 0 deletions lib_spec/spec.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -41,3 +41,11 @@ val env : string -> string -> op
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
attempts to improve the layout slightly by putting each operation on its
own line. *)

val pp_op : op Fmt.t
(** [pp_op] formats [op] as an S-expression. *)
104 changes: 53 additions & 51 deletions test/test.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -64,7 +64,7 @@ let test_simple _switch () =
B.build builder context spec >>!= get store "output" >>= fun result ->
Alcotest.(check build_result) "Final result" (Ok "base-distro\nrunner") result;
Log.check "Check log"
{|FROM base
{|(from base)
;---> saved as .*
/: (run (shell Append))
Append
Expand All @@ -75,7 +75,7 @@ let test_simple _switch () =
B.build builder context spec >>!= get store "output" >>= fun result ->
Alcotest.(check build_result) "Final result cached" (Ok "base-distro\nrunner") result;
Log.check "Check cached log"
{|FROM base
{|(from base)
;---> using .* from cache
/: (run (shell Append))
Append
Expand All @@ -93,7 +93,7 @@ let test_prune _switch () =
B.build builder context spec >>!= get store "output" >>= fun result ->
Alcotest.(check build_result) "Final result" (Ok "base-distro\nrunner") result;
Log.check "Check log"
{|FROM base
{|(from base)
;---> saved as .*
/: (run (shell Append))
Append
Expand Down Expand Up @@ -122,16 +122,16 @@ let test_concurrent _switch () =
Mock_sandbox.expect sandbox (mock_op ~output:`Append_cmd ());
Mock_sandbox.expect sandbox (mock_op ~output:`Append_cmd ());
let b1 = B.build builder context1 spec1 in
Log.await log1 "FROM base\n/: (run (shell A))\nA\n" >>= fun () ->
Log.await log1 "(from base)\n/: (run (shell A))\nA\n" >>= fun () ->
let b2 = B.build builder context2 spec2 in
Log.await log2 "FROM base\n/: (run (shell A))\nA\n" >>= fun () ->
Log.await log2 "(from base)\n/: (run (shell A))\nA\n" >>= fun () ->
Lwt.wakeup a_done (Ok ());
b1 >>!= get store "output" >>= fun b1 ->
b2 >>!= get store "output" >>= fun b2 ->
Alcotest.(check build_result) "Final result" (Ok "AB") b1;
Alcotest.(check build_result) "Final result" (Ok "AC") b2;
Log.check "Check AB log"
{| FROM base
{| (from base)
;---> saved as .*
/: (run (shell A))
A
Expand All @@ -142,7 +142,7 @@ let test_concurrent _switch () =
|}
log1;
Log.check "Check AC log"
{| FROM base
{| (from base)
;---> using .* from cache
/: (run (shell A))
A
Expand All @@ -166,23 +166,23 @@ let test_concurrent_failure _switch () =
let a, a_done = Lwt.wait () in
Mock_sandbox.expect sandbox (mock_op ~result:a ());
let b1 = B.build builder context1 spec1 in
Log.await log1 "FROM base\n/: (run (shell A))\nA\n" >>= fun () ->
Log.await log1 "(from base)\n/: (run (shell A))\nA\n" >>= fun () ->
let b2 = B.build builder context2 spec2 in
Log.await log2 "FROM base\n/: (run (shell A))\nA\n" >>= fun () ->
Log.await log2 "(from base)\n/: (run (shell A))\nA\n" >>= fun () ->
Lwt.wakeup a_done (Error (`Msg "Mock build failure"));
b1 >>!= get store "output" >>= fun b1 ->
b2 >>!= get store "output" >>= fun b2 ->
Alcotest.(check build_result) "B1 result" (Error (`Msg "Mock build failure")) b1;
Alcotest.(check build_result) "B2 result" (Error (`Msg "Mock build failure")) b2;
Log.check "Check AB log"
{| FROM base
{| (from base)
;---> saved as .*
/: (run (shell A))
A
|}
log1;
Log.check "Check AC log"
{| FROM base
{| (from base)
;---> using .* from cache
/: (run (shell A))
A
Expand All @@ -203,23 +203,23 @@ let test_concurrent_failure_2 _switch () =
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
Log.await log1 "FROM base\n/: (run (shell A))\nA\n" >>= fun () ->
Log.await log1 "(from base)\n/: (run (shell A))\nA\n" >>= fun () ->
let b2 = B.build builder context2 spec2 in
Log.await log2 "FROM base\n/: (run (shell A))\nA\n" >>= fun () ->
Log.await log2 "(from base)\n/: (run (shell A))\nA\n" >>= fun () ->
Lwt.wakeup a_done ();
b1 >>!= get store "output" >>= fun b1 ->
b2 >>!= get store "output" >>= fun b2 ->
Alcotest.(check build_result) "B1 result" (Error (`Msg "Mock build failure")) b1;
Alcotest.(check build_result) "B2 result" (Error (`Msg "Mock build failure")) b2;
Log.check "Check AB log"
{| FROM base
{| (from base)
;---> saved as .*
/: (run (shell A))
A
|}
log1;
Log.check "Check AC log"
{| FROM base
{| (from base)
;---> using .* from cache
/: (run (shell A))
A
Expand All @@ -236,12 +236,12 @@ let test_cancel _switch () =
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
Log.await log "FROM base\n/: (run (shell Wait))\nWait\n" >>= fun () ->
Log.await log "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () ->
Lwt_switch.turn_off switch >>= fun () ->
b >>= fun result ->
Alcotest.(check build_result) "Final result" (Error `Cancelled) result;
Log.check "Check log"
{|FROM base
{|(from base)
;---> saved as .*
/: (run (shell Wait))
Wait
Expand All @@ -261,14 +261,14 @@ let test_cancel_2 _switch () =
let context1 = Context.v ~switch:switch1 ~src_dir ~log:(Log.add log1) () in
let context2 = Context.v ~switch:switch2 ~src_dir ~log:(Log.add log2) () in
let b1 = B.build builder context1 spec in
Log.await log1 "FROM base\n/: (run (shell Wait))\nWait\n" >>= fun () ->
Log.await log1 "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () ->
let b2 = B.build builder context2 spec in
Log.await log2 "FROM base\n/: (run (shell Wait))\nWait\n" >>= fun () ->
Log.await log2 "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () ->
Lwt_switch.turn_off switch1 >>= fun () ->
b1 >>= fun result1 ->
Alcotest.(check build_result) "User 1 result" (Error `Cancelled) result1;
Log.check "Check log"
{|FROM base
{|(from base)
;---> saved as .*
/: (run (shell Wait))
Wait
Expand All @@ -277,7 +277,7 @@ let test_cancel_2 _switch () =
b2 >>!= get store "output" >>= fun result2 ->
Alcotest.(check build_result) "Final result" (Ok "ok") result2;
Log.check "Check log"
{|FROM base
{|(from base)
;---> using .* from cache
/: (run (shell Wait))
Wait
Expand All @@ -298,14 +298,14 @@ let test_cancel_3 _switch () =
let context1 = Context.v ~switch:switch1 ~src_dir ~log:(Log.add log1) () in
let context2 = Context.v ~switch:switch2 ~src_dir ~log:(Log.add log2) () in
let b1 = B.build builder context1 spec in
Log.await log1 "FROM base\n/: (run (shell Wait))\nWait\n" >>= fun () ->
Log.await log1 "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () ->
let b2 = B.build builder context2 spec in
Log.await log2 "FROM base\n/: (run (shell Wait))\nWait\n" >>= fun () ->
Log.await log2 "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () ->
Lwt_switch.turn_off switch1 >>= fun () ->
b1 >>= fun result1 ->
Alcotest.(check build_result) "User 1 result" (Error `Cancelled) result1;
Log.check "Check log"
{|FROM base
{|(from base)
;---> saved as .*
/: (run (shell Wait))
Wait
Expand All @@ -314,7 +314,7 @@ let test_cancel_3 _switch () =
b2 >>!= get store "output" >>= fun result2 ->
Alcotest.(check build_result) "User 2 result" (Error `Cancelled) result2;
Log.check "Check log"
{|FROM base
{|(from base)
;---> using .* from cache
/: (run (shell Wait))
Wait
Expand All @@ -337,13 +337,13 @@ let test_cancel_4 _switch () =
let context1 = Context.v ~switch:switch1 ~src_dir ~log:(Log.add log1) () in
let context2 = Context.v ~switch:switch2 ~src_dir ~log:(Log.add log2) () in
let b1 = B.build builder context1 spec in
Log.await log1 "FROM base\n/: (run (shell Wait))\nWait\n" >>= fun () ->
Log.await log1 "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () ->
Lwt.wakeup set_r (Error (`Msg "Build failed"));
(* Begin a new build. *)
let r2, set_r2 = Lwt.wait () in
Mock_sandbox.expect sandbox (mock_op ~result:r2 ~cancel:set_r2 ~output:(`Constant "ok") ());
let b2 = B.build builder context2 spec in
Log.await log2 "FROM base\n/: (run (shell Wait))\nWait\n" >>= fun () ->
Log.await log2 "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () ->
(* Cancel the original build. *)
Lwt_switch.turn_off switch1 >>= fun () ->
b1 >>= fun result1 ->
Expand All @@ -353,7 +353,7 @@ let test_cancel_4 _switch () =
let switch3 = Lwt_switch.create () in
let context3 = Context.v ~switch:switch3 ~src_dir ~log:(Log.add log3) () in
let b3 = B.build builder context3 spec in
Log.await log3 "FROM base\n/: (run (shell Wait))\nWait\n" >>= fun () ->
Log.await log3 "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () ->
Lwt.wakeup set_r2 (Ok ());
b2 >>!= get store "output" >>= fun result2 ->
Alcotest.(check build_result) "User 2 result" (Ok "ok") result2;
Expand All @@ -372,7 +372,7 @@ let test_cancel_5 _switch () =
let switch1 = Lwt_switch.create () in
let context1 = Context.v ~switch:switch1 ~src_dir ~log:(Log.add log1) () in
let b1 = B.build builder context1 spec in
Log.await log1 "FROM base\n/: (run (shell Wait))\nWait\n" >>= fun () ->
Log.await log1 "(from base)\n/: (run (shell Wait))\nWait\n" >>= fun () ->
Lwt_switch.turn_off switch1 >>= fun () ->
b1 >>= fun result1 ->
Alcotest.(check build_result) "User 1 result" (Error `Cancelled) result1;
Expand All @@ -382,7 +382,7 @@ let test_cancel_5 _switch () =
let switch2 = Lwt_switch.create () in
let context2 = Context.v ~switch:switch2 ~src_dir ~log:(Log.add log2) () in
let b2 = B.build builder context2 spec in
Log.await log2 "FROM base\n/: (run (shell Wait))\n" >>= fun () ->
Log.await log2 "(from base)\n/: (run (shell Wait))\n" >>= fun () ->
Lwt.wakeup set_delay ();
b2 >>!= get store "output" >>= fun result1 ->
Alcotest.(check build_result) "User 2 result" (Ok "ok") result1;
Expand Down Expand Up @@ -418,47 +418,49 @@ let test_delete _switch () =

let sexp = Alcotest.of_pp Sexplib.Sexp.pp_hum

let remove_line_indents = function
| (_ :: x :: _) as lines ->
let indent = Astring.String.find ((<>) ' ') x |> Option.value ~default:0 in
lines |> List.map (fun line ->
Astring.String.drop line ~sat:((=) ' ') ~max:indent
)
| x -> List.map String.trim x

let remove_indent s =
String.split_on_char '\n' s
|> remove_line_indents
|> List.filter ((<>) "")
|> String.concat "\n"


(* Check that parsing an S-expression and then serialising it again gets the same result. *)
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
Alcotest.(check sexp) name s1 s2
Alcotest.(check sexp) name s1 s2;
Alcotest.(check string) name s (Fmt.strf "%a" Spec.pp_stage stage)
in
test "copy" {|
((from base)
(comment "A test comment")
(workdir /src)
(run (shell "command"))
(run
(cache (a (target /data))
(b (target /srv)))
(shell "command"))
(run (shell "a command"))
(run (cache (a (target /data)) (b (target /srv)))
(shell "a very very very very very very very very very very very very very very very long command"))
(copy (src a b) (dst c))
(copy (src a b) (dst c) (exclude .git _build))
(env DEBUG 1)
(user (uid 1) (gid 2))
) |}

let remove_indent = function
| (_ :: x :: _) as lines ->
let indent = Astring.String.find ((<>) ' ') x |> Option.value ~default:0 in
lines |> List.map (fun line ->
Astring.String.drop line ~sat:((=) ' ') ~max:indent
)
| x -> List.map String.trim x
)|}

let test_docker () =
let test ~buildkit name expect sexp =
let spec = Spec.stage_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 =
String.split_on_char '\n' expect
|> remove_indent
|> List.filter ((<>) "")
|> String.concat "\n"
in
let expect = remove_indent expect in
Alcotest.(check string) name expect got
in
test ~buildkit:false "Dockerfile"
Expand Down