Add location to a few errors

src/action.ml

@@ -210,6 +210,13 @@ module Unexpanded = struct
         "if you meant for this to be executed with bash, write (bash \"...\") instead"
     | List _ -> t sexp
 
+  let check_mkdir loc path =
+    if not (Path.is_local path) then
+      Loc.fail loc
+        "(mkdir ...) is not supported for paths outside of the workspace:\n\
+        \  %a\n"
+        Sexp.pp (List [Atom "mkdir"; Path.sexp_of_t path])
+
   module Partial = struct
     module type Past = Action_intf.Ast
       with type program = (Program.t, String_with_vars.t) either
@@ -292,7 +299,12 @@ module Unexpanded = struct
       | Remove_tree x ->
         Remove_tree (E.path ~dir ~f x)
       | Mkdir x ->
-        Mkdir (E.path ~dir ~f x)
+        match x with
+        | Inl path -> Mkdir path
+        | Inr tmpl ->
+          let path = E.path ~dir ~f x in
+          check_mkdir (SW.loc tmpl) path;
+          Mkdir path
   end
 
   module E = struct
@@ -435,7 +447,11 @@ module Unexpanded = struct
     | Remove_tree x ->
       Remove_tree (E.path ~dir ~f x)
     | Mkdir x ->
-      Mkdir (E.path ~dir ~f x)
+      let res = E.path ~dir ~f x in
+      (match res with
+       | Inl path -> check_mkdir (SW.loc x) path
+       | Inr _    -> ());
+      Mkdir res
 end
 
 let fold_one_step t ~init:acc ~f =
@@ -623,10 +639,10 @@ let rec exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to =
   | Mkdir path ->
     (match Path.kind path with
      | External _ ->
-       (* CR-someday jdimino: we need to keep locations here *)
+       (* Internally we make sure never to do that, and [Unexpanded.*expand] check that *)
-       die "(mkdir ...) is not supported for paths outside of the workspace:\n\
+       Sexp.code_error
-           \  %a\n"
+         "(mkdir ...) is not supported for paths outside of the workspace"
-         Sexp.pp (List [Atom "mkdir"; Path.sexp_of_t path])
+         [ "mkdir", Path.sexp_of_t path ]
      | Local path ->
        Path.Local.mkdir_p path);
     return ()
@@ -760,7 +776,7 @@ module Infer = struct
   let ( +@? ) acc fn =
     match fn with
     | Inl fn -> { acc with targets = S.add fn acc.targets }
-    | Inr _  -> die "cannot determine target"
+    | Inr sw -> Loc.fail (SW.loc sw) "Cannot determine this target statically."
 
   let rec partial_with_all_targets acc (t : Unexpanded.Partial.t) =
     match t with

src/loc.ml

@@ -13,7 +13,14 @@ let of_lexbuf lb =
 exception Error of t * string
 
 let fail t fmt =
-  ksprintf (fun msg -> raise (Error (t, msg))) fmt
+  Format.pp_print_as die_ppf 7 ""; (* "Error: " *)
+  Format.kfprintf
+    (fun ppf ->
+       Format.pp_print_flush ppf ();
+       let s = Buffer.contents die_buf in
+       Buffer.clear die_buf;
+       raise (Error (t, s)))
+    die_ppf fmt
 
 let fail_lex lb fmt =
   fail (of_lexbuf lb) fmt

src/loc.mli

@@ -7,8 +7,8 @@ val of_lexbuf : Lexing.lexbuf -> t
 
 exception Error of t * string
 
-val fail : t -> ('a, unit, string, _) format4 -> 'a
+val fail     : t             -> ('a, Format.formatter, unit, 'b) format4 -> 'a
-val fail_lex : Lexing.lexbuf -> ('a, unit, string, _) format4 -> 'a
+val fail_lex : Lexing.lexbuf -> ('a, Format.formatter, unit, 'b) format4 -> 'a
 
 val in_file : string -> t