Merge pull request #55 from quantifyearth/mwd-make-default-path-in-co…

…ntainers-overridable

Allow default path for containers to be set in frontmatter

src/lib/ast/ast.ml

@@ -49,6 +49,7 @@ type block_id = int [@@deriving sexp]
 type t = {
   nodes : (block_id * Hyperblock.t) list;
   edges : (block_id * block_id) list;
+  metadata : Frontmatter.t;
 }
 [@@deriving sexp]
 
@@ -330,7 +331,7 @@ let of_sharkdown ?concrete_paths template_markdown =
          id_all_hyperblocks)
   in
 
-  ({ nodes = id_all_hyperblocks; edges }, expanded_markdown)
+  ({ nodes = id_all_hyperblocks; edges; metadata }, expanded_markdown)
 
 let find_id_of_block ast ib =
   let d = Block.digest ib in
@@ -357,3 +358,5 @@ let find_dependencies ast id =
       if too = id then Some from else None)
     ast.edges
   |> List.map (fun id -> List.assoc id ast.nodes)
+
+let default_container_path ast = Frontmatter.default_container_path ast.metadata

src/lib/ast/ast.mli

@@ -43,5 +43,7 @@ val block_by_id : t -> block_id -> Hyperblock.t option
 val find_hyperblock_from_block : t -> Block.t -> Hyperblock.t option
 val find_dependencies : t -> block_id -> Hyperblock.t list
 
+val default_container_path : t -> Fpath.t
+
 val to_list : t -> Hyperblock.t list
 (** Convert the AST to a list of command blocks. *)

src/lib/frontmatter.ml

@@ -66,3 +66,16 @@ let of_string s = String.trim s |> Yaml.of_string |> Result.map of_toplevel_yaml
 let variables t = t.variables
 let inputs t = List.map (fun (_, v) -> v) t.inputs
 let input_map t = t.inputs
+
+let default_container_path t =
+  let default = "/root" in
+  let path = match (List.assoc_opt "path" t.variables) with
+  | None -> default
+  | Some pl -> (
+    match (List.nth_opt pl 0) with
+    | None -> default
+    | Some p -> p
+  ) in
+  match Fpath.of_string path with
+  | Error (`Msg m) -> failwith m
+  | Ok p -> p

src/lib/frontmatter.mli

@@ -5,5 +5,8 @@ val v : (string * string list) list -> (string * Fpath.t) list -> t
 val empty : t
 val of_string : string -> (t, [ `Msg of string ]) result
 val variables : t -> (string * string list) list
+
+(* These are specific to shark rather than general frontmatter *)
 val inputs : t -> Fpath.t list
 val input_map : t -> (string * Fpath.t) list
+val default_container_path : t -> Fpath.t

src/lib/md.ml

@@ -370,7 +370,7 @@ let process_run_block ?(env_override = []) ~fs ~build_cache ~pool store ast
       in
 
       let ids_and_output_and_cmd, _hash, _pwd, _env =
-        List.fold_left outer_process ([], build, "/root", []) commands
+        List.fold_left outer_process ([], build, (Fpath.to_string (Ast.default_container_path ast)), []) commands
       in
       let last = List.hd ids_and_output_and_cmd in
       let { build_hash = id; _ } = List.hd last in