Merge pull request #64 from quantifyearth/mwd-small-fixes

Small fixes

src/bin/main.ml

@@ -159,12 +159,8 @@ let md ~fs ~net ~domain_mgr ~proc () no_run store conf file port fetcher jobs
           (* First we translate the import statement to a build block *)
           let uid = string_of_int !import_uid in
           incr import_uid;
-          let (cb, blk), src_dir_opt =
-            Shark.Md.translate_import_block ~uid block
-          in
-          let import_src_dir =
-            match src_dir_opt with Some x -> x | None -> src_dir
-          in
+          let cb, blk = Shark.Md.translate_import_block ~uid block in
+          let import_src_dir = "/" in
           (* Now we build the block *)
           (* Import block digests need to be mapped to this build hash *)
           let hb =

src/lib/block.ml

@@ -156,49 +156,45 @@ let digest : t -> string = function
 
 let import_spec b =
   let open Obuilder_spec in
-  (* TODO: Support multi-import statements *)
-  let url, target_path = imports b |> List.hd in
-  match Uri.scheme url with
-  | None | Some "file" ->
-      (* Choose better image, just need tools to import? *)
-      let fpath =
-        match Fpath.of_string (Uri.path url) with
-        | Ok p -> p
-        | Error (`Msg msg) ->
-            Fmt.failwith "Failed to parse path %s: %s" (Uri.path url) msg
-      in
-      let src_dir, path = Fpath.split_base fpath in
-      let src_dir = Fpath.rem_empty_seg src_dir in
-      ( stage ~from:(`Image "alpine")
-          [
-            (* shell [ "/bin/sh"; "-c" ]; *)
-            (* run "mkdir -p %s" (Fpath.to_string (Fpath.parent path)); *)
-            copy [ Fpath.to_string path ] ~dst:(Fpath.to_string target_path);
-          ],
-        Some (Fpath.to_string src_dir) )
-  | Some "http" | Some "https" -> (
-      let src_path = Uri.path url in
-      match String.cut ~rev:true ~sep:"." src_path with
-      | Some (_, "git") ->
-          (* Choose better image, just need tools to import? *)
-          ( stage ~from:(`Image "alpine")
-              [
-                shell [ "/bin/sh"; "-c" ];
-                run ~network:[ "host" ] "apk add --no-cache git";
-                run ~network:[ "host" ] "mkdir -p /data && git clone %s %s"
-                  (Uri.to_string url)
-                  (Fpath.to_string target_path);
-              ],
-            None )
-      | _ ->
-          (* Choose better image, just need tools to import? *)
-          ( stage ~from:(`Image "alpine")
-              [
-                shell [ "/bin/sh"; "-c" ];
-                run ~network:[ "host" ] "apk add --no-cache curl";
-                run ~network:[ "host" ] "mkdir -p /data && curl -O %s %s"
-                  (Fpath.to_string target_path)
-                  (Uri.to_string url);
-              ],
-            None ))
-  | Some scheme -> Fmt.failwith "Unsupported import scheme %s" scheme
+  let commands =
+    imports b
+    |> List.concat_map (fun (url, target_path) ->
+           match Uri.scheme url with
+           | None | Some "file" ->
+               let fpath =
+                 match Fpath.of_string (Uri.path url) with
+                 | Ok p -> p
+                 | Error (`Msg msg) ->
+                     Fmt.failwith "Failed to parse path %s: %s" (Uri.path url)
+                       msg
+               in
+               let relpath =
+                 Option.get (Fpath.relativize ~root:(Fpath.v "/") fpath)
+               in
+               [
+                 copy
+                   [ Fpath.to_string relpath ]
+                   ~dst:(Fpath.to_string target_path);
+               ]
+           | Some "http" | Some "https" -> (
+               let src_path = Uri.path url in
+               match String.cut ~rev:true ~sep:"." src_path with
+               | Some (_, "git") ->
+                   [
+                     shell [ "/bin/sh"; "-c" ];
+                     run ~network:[ "host" ] "apk add --no-cache git";
+                     run ~network:[ "host" ] "mkdir -p /data && git clone %s %s"
+                       (Uri.to_string url)
+                       (Fpath.to_string target_path);
+                   ]
+               | _ ->
+                   [
+                     shell [ "/bin/sh"; "-c" ];
+                     run ~network:[ "host" ] "apk add --no-cache curl";
+                     run ~network:[ "host" ] "mkdir -p /data && curl -O %s %s"
+                       (Fpath.to_string target_path)
+                       (Uri.to_string url);
+                   ])
+           | Some scheme -> Fmt.failwith "Unsupported import scheme %s" scheme)
+  in
+  stage ~from:(`Image "alpine") commands

src/lib/block.mli

@@ -73,5 +73,5 @@ val imports : t -> (Uri.t * Fpath.t) list
 
 val digest : t -> string
 
-val import_spec : t -> Obuilder_spec.t * string option
+val import_spec : t -> Obuilder_spec.t
 (** For a shark-import block generate the spec to execute to enact the import. *)

src/lib/md.ml

@@ -222,10 +222,17 @@ let process_run_block ?(environment_override = []) ~fs ~build_cache ~pool store
         | Error (`Failed (id, msg)) -> Error (Some id, msg)
       in
 
-      let process_single_command acc command_leaf =
-        let previous_results, previous_state = acc in
+      let process_single_command command_history command_leaf =
+        let previous_states = List.hd command_history in
+        let previous_state =
+          match previous_states with
+          | hd :: _ -> hd
+          | [] ->
+              Fmt.failwith "There were no processed blocks for %s"
+                (Command.name (Leaf.command command_leaf))
+        in
         match Run_block.ExecutionState.success previous_state with
-        | false -> acc
+        | false -> command_history
         | true ->
             let inputs = Leaf.inputs command_leaf in
             let input_and_hashes =
@@ -289,23 +296,16 @@ let process_run_block ?(environment_override = []) ~fs ~build_cache ~pool store
                    ~run_f:obuilder_command_runner)
                 inputs
             in
-            let es =
-              match processed_blocks with
-              | hd :: _ -> hd
-              | [] ->
-                  Fmt.failwith "There were no processed blocks for %s"
-                    (Command.name (Leaf.command command_leaf))
-            in
-            (processed_blocks :: previous_results, es)
+            processed_blocks :: command_history
       in
 
-      let ids_and_output_and_cmd, _es =
-        List.fold_left process_single_command
-          ( [],
-            Run_block.ExecutionState.init ~build_hash:build
-              ~workdir:(Fpath.to_string (Ast.default_container_path ast))
-              ~environment:[] )
-          commands
+      let initial_state =
+        Run_block.ExecutionState.init ~build_hash:build
+          ~workdir:(Fpath.to_string (Ast.default_container_path ast))
+          ~environment:[]
+      in
+      let ids_and_output_and_cmd =
+        List.fold_left process_single_command [ [ initial_state ] ] commands
       in
       let last = List.hd ids_and_output_and_cmd in
       let id = Run_block.ExecutionState.build_hash (List.hd last) in
@@ -408,7 +408,7 @@ let process_publish_block (Obuilder.Store_spec.Store ((module Store), store))
 let translate_import_block ~uid block =
   match Block.kind block with
   | `Import ->
-      let spec, src_dir_opt = Block.import_spec block in
+      let spec = Block.import_spec block in
       Logs.info (fun f -> f "import spec: %a" Obuilder_spec.pp spec);
       let body = Sexplib.Sexp.to_string_hum (Obuilder_spec.sexp_of_t spec) in
       let alias = Fmt.str "import-statement-%s" uid in
@@ -418,5 +418,5 @@ let translate_import_block ~uid block =
           ~info_string:(Fmt.str "shark-build:%s" alias, Cmarkit.Meta.none)
           (Cmarkit.Block_line.list_of_string body)
       in
-      ((code_block, block), src_dir_opt)
+      (code_block, block)
   | _ -> failwith "Expected Import Block"

src/lib/md.mli

@@ -48,9 +48,6 @@ val process_publish_block :
   Cmarkit.Block.Code_block.t * Block.t
 
 val translate_import_block :
-  uid:string ->
-  Block.t ->
-  (Cmarkit.Block.Code_block.t * Block.t) * string option
+  uid:string -> Block.t -> Cmarkit.Block.Code_block.t * Block.t
 (** [translate_import_block uid block] will generate an expanded code block that contains a shark-build spec that 
-    carries out the actual import when evaluated. If the import is from the file system then the optional second
-    return is the src_dir needed for the file system context when the spec is evaluated. *)
+    carries out the actual import when evaluated. *)

src/test/block.ml

@@ -55,12 +55,11 @@ let test_git_import_block () =
   in
   Alcotest.(check (list (pair string string))) "Single import" expected test;
 
-  let spec, src_dir = Shark.Block.import_spec block in
+  let spec = Shark.Block.import_spec block in
   let specbody = Sexplib.Sexp.to_string_hum (Obuilder_spec.sexp_of_t spec) in
   Alcotest.(check bool)
     "Found git command" true
-    (Astring.String.is_infix ~affix:"git clone" specbody);
-  Alcotest.(check (option string)) "No src_dir change" None src_dir
+    (Astring.String.is_infix ~affix:"git clone" specbody)
 
 let test_http_import_block () =
   let body = "https://example.com/data/something.csv /data/src.csv" in
@@ -75,12 +74,11 @@ let test_http_import_block () =
   in
   Alcotest.(check (list (pair string string))) "Single import" expected test;
 
-  let spec, src_dir = Shark.Block.import_spec block in
+  let spec = Shark.Block.import_spec block in
   let specbody = Sexplib.Sexp.to_string_hum (Obuilder_spec.sexp_of_t spec) in
   Alcotest.(check bool)
     "Found git command" true
-    (Astring.String.is_infix ~affix:"curl -O" specbody);
-  Alcotest.(check (option string)) "No src_dir change" None src_dir
+    (Astring.String.is_infix ~affix:"curl -O" specbody)
 
 let test_file_import_block_no_schema () =
   let body = "/home/michael/file.csv /data/file.csv" in
@@ -93,13 +91,11 @@ let test_file_import_block_no_schema () =
   in
   Alcotest.(check (list (pair string string))) "Single import" expected test;
 
-  let spec, src_dir = Shark.Block.import_spec block in
+  let spec = Shark.Block.import_spec block in
   let specbody = Sexplib.Sexp.to_string_hum (Obuilder_spec.sexp_of_t spec) in
   Alcotest.(check bool)
     "Found git command" true
-    (Astring.String.is_infix ~affix:"copy" specbody);
-  Alcotest.(check (option string))
-    "Src_dir change" (Some "/home/michael") src_dir
+    (Astring.String.is_infix ~affix:"copy" specbody)
 
 let test_file_import_block_with_schema () =
   let body = "file:///home/michael/file.csv /data/file.csv" in
@@ -112,13 +108,11 @@ let test_file_import_block_with_schema () =
   in
   Alcotest.(check (list (pair string string))) "Single import" expected test;
 
-  let spec, src_dir = Shark.Block.import_spec block in
+  let spec = Shark.Block.import_spec block in
   let specbody = Sexplib.Sexp.to_string_hum (Obuilder_spec.sexp_of_t spec) in
   Alcotest.(check bool)
     "Found git command" true
-    (Astring.String.is_infix ~affix:"copy" specbody);
-  Alcotest.(check (option string))
-    "Src_dir change" (Some "/home/michael") src_dir
+    (Astring.String.is_infix ~affix:"copy" specbody)
 
 let tests =
   [