Merge pull request #114 from Linda-Njau/pp_validation_error

Include source and target paths in provider error pretty-printing

Author: xhtmlboi

lib/core/action.ml

@@ -107,14 +107,38 @@ let perform_update now target eff cache =
       in
       perform_writing now target cache fc hc dynamic_deps
 
+let propagate_target target program cache =
+  let handler =
+    Effect.Deep.
+      {
+        exnc = (fun exn -> raise exn)
+      ; retc = Eff.return
+      ; effc =
+          (fun (type a) (eff : a Effect.t) ->
+            match eff with
+            | Eff.Yocaml_failwith (Eff.Provider_error e) ->
+                Some
+                  (fun (k : (a, _) continuation) ->
+                    let open Eff in
+                    let new_exn =
+                      Eff.Provider_error { e with target = Some target }
+                    in
+                    let* x = raise new_exn in
+                    continue k x)
+            | _ -> None)
+      }
+  in
+  Eff.run handler (fun cache -> program cache) cache
+
 let write_dynamic_file target task =
-  perform target task
-    ~when_creation:(fun now target eff cache ->
-      let open Eff.Syntax in
-      let* fc, dynamic_deps = eff () in
-      let* hc = Eff.hash fc in
-      perform_writing now target cache fc hc dynamic_deps)
-    ~when_update:perform_update
+  propagate_target target
+    (perform target task
+       ~when_creation:(fun now target eff cache ->
+         let open Eff.Syntax in
+         let* fc, dynamic_deps = eff () in
+         let* hc = Eff.hash fc in
+         perform_writing now target cache fc hc dynamic_deps)
+       ~when_update:perform_update)
 
 let write_static_file target task cache =
   write_dynamic_file target Task.(task ||> no_dynamic_deps) cache

lib/core/diagnostic.ml

@@ -84,16 +84,31 @@ and pp_record_error custom_error ppf = function
         (pp_validation_error custom_error)
         error
 
-let pp_provider_error custom_error ppf = function
+let pp_source_label ppf label = function
+  | None -> Format.fprintf ppf "%s:@." label
+  | Some src -> Format.fprintf ppf "%s in: %a@." label Path.pp src
+
+let pp_entity ppf entity = Format.fprintf ppf "Entity: `%s`@,@." entity
+
+let pp_target ppf = function
+  | None -> ()
+  | Some tgt ->
+      Format.fprintf ppf "Unable to write to target %a:@,@," Path.pp tgt
+
+let pp_provider_error custom_error ~source ~target ppf = function
   | Required.Parsing_error { given; message } ->
-      Format.fprintf ppf "Parsing error:@,Given: `%s`@,Message: `%s`" given
-        message
+      pp_target ppf target;
+      pp_source_label ppf "Parsing error" source;
+      Format.fprintf ppf "@.Given:@.%s@.Message: `%s`" given message
   | Required.Required_metadata { entity } ->
-      Format.fprintf ppf "Required metadata: `%s`" entity
+      pp_target ppf target;
+      pp_source_label ppf "Required metadata" source;
+      pp_entity ppf entity
   | Required.Validation_error { entity; error } ->
-      Format.fprintf ppf "Validation error: `%s`@,@[%a@]" entity
-        (pp_validation_error custom_error)
-        error
+      pp_target ppf target;
+      pp_source_label ppf "Validation error" source;
+      pp_entity ppf entity;
+      Format.fprintf ppf "@,@[%a@]" (pp_validation_error custom_error) error
 
 let glob_pp p v backtrace ppf =
   Format.fprintf ppf "--- %a ---@,%a@,---@,%s" Lexicon.there_is_an_error () p v
@@ -118,7 +133,8 @@ let exception_to_diagnostic
       glob_pp (Lexicon.directory_not_exists source path) ()
   | Eff.Directory_is_a_file (source, path) ->
       glob_pp (Lexicon.directory_is_a_file source path) ()
-  | Eff.Provider_error error -> glob_pp (pp_provider_error custom_error) error
+  | Eff.Provider_error { source; target; error } ->
+      glob_pp (pp_provider_error custom_error ~source ~target) error
   | exn -> glob_pp Lexicon.unknown_error exn
 
 let runtime_error_to_diagnostic ppf message =

lib/core/eff.ml

@@ -128,7 +128,13 @@ exception Invalid_path of filesystem * Path.t
 exception File_is_a_directory of filesystem * Path.t
 exception Directory_is_a_file of filesystem * Path.t
 exception Directory_not_exists of filesystem * Path.t
-exception Provider_error of Required.provider_error
+
+exception
+  Provider_error of {
+      source : Path.t option
+    ; target : Path.t option
+    ; error : Required.provider_error
+  }
 
 let yocaml_log_src = Logs.Src.create ~doc:"Log emitted by YOCaml" "yocaml"
 
@@ -170,7 +176,9 @@ let read_file_as_metadata (type a) (module P : Required.DATA_PROVIDER)
   |> Option.some
   |> Metadata.validate (module P) (module R)
   |> Result.fold
-       ~error:(fun err -> raise @@ Provider_error err)
+       ~error:(fun err ->
+         raise
+         @@ Provider_error { source = Some path; target = None; error = err })
        ~ok:(fun metadata -> return metadata)
 
 let read_file_with_metadata (type a) (module P : Required.DATA_PROVIDER)
@@ -183,7 +191,9 @@ let read_file_with_metadata (type a) (module P : Required.DATA_PROVIDER)
   raw_metadata
   |> Metadata.validate (module P) (module R)
   |> Result.fold
-       ~error:(fun err -> raise @@ Provider_error err)
+       ~error:(fun err ->
+         raise
+         @@ Provider_error { source = Some path; target = None; error = err })
        ~ok:(fun metadata -> return (metadata, content))
 
 let get_mtime ~on path =

lib/core/eff.mli

@@ -303,8 +303,15 @@ exception Directory_is_a_file of filesystem * Path.t
 exception Directory_not_exists of filesystem * Path.t
 (** Exception raised when we try to use a directory as a regular file. *)
 
-exception Provider_error of Required.provider_error
-(** Exception raised when we try to validate an invalid source of metadata. *)
+exception
+  Provider_error of {
+      source : Path.t option
+    ; target : Path.t option
+    ; error : Required.provider_error
+  }
+(** Exception raised when reading, validating, or writing metadata fails.
+    [source] indicates the file from which the metadata was read, when known.
+    [target] indicates the destination path we tried to write to, when known. *)
 
 (** {2 Helpers for performing effects}
 

test/e2e/bin/dune

@@ -18,3 +18,14 @@
  (name gen_residuals)
  (modules gen_residuals runtime)
  (libraries yocaml yocaml_unix))
+
+(executable
+ (name gen_pp_errors)
+ (modules gen_pp_errors runtime test_article)
+ (libraries
+  yocaml
+  yocaml_unix
+  yocaml_yaml
+  yocaml_jingoo
+  yocaml_cmarkit
+  yocaml_markdown))

test/e2e/bin/gen_pp_errors.ml

@@ -0,0 +1,50 @@
+module Test_Article = Test_article
+
+class resolver ~source ~target =
+  object (self)
+    val get_source : Yocaml.Path.t = source
+    val get_target : Yocaml.Path.t = target
+    method source = get_source
+    method target = Yocaml.Path.(get_target / "_www")
+    method cache = Yocaml.Path.(self#target / ".cache")
+    method templates = Yocaml.Path.(self#source / "content" / "templates")
+    method articles = Yocaml.Path.(self#target / "articles")
+
+    method as_article path =
+      path
+      |> Yocaml.Path.move ~into:self#articles
+      |> Yocaml.Path.change_extension "html"
+
+    method as_template path = Yocaml.Path.(self#templates / path)
+  end
+
+let article (resolver : resolver) file =
+  Yocaml.Action.Static.write_file_with_metadata (resolver#as_article file)
+    Yocaml.Task.(
+      Yocaml_yaml.Pipeline.read_file_with_metadata (module Test_Article) file
+      >>> Yocaml_cmarkit.content_to_html ()
+      >>> Yocaml_jingoo.Pipeline.as_template
+            (module Test_Article)
+            (resolver#as_template "article.html")
+      >>> Yocaml_jingoo.Pipeline.as_template
+            (module Test_Article)
+            (resolver#as_template "layout.html"))
+
+let program (resolver : resolver) file () =
+  let open Yocaml.Eff in
+  let* () = logf ~level:`Debug "Trigger in %a" Yocaml.Path.pp resolver#source in
+  Yocaml.Action.with_cache ~on:`Target resolver#cache (article resolver file)
+
+module R = Yocaml.Runtime.Make (Runtime)
+
+let () =
+  let () = Array.iter print_endline Sys.argv in
+  let cwd = Yocaml.Path.rel [] in
+  let file =
+    match Array.to_list Sys.argv with
+    | _ :: file :: _ -> Yocaml.Path.rel [ file ]
+    | _ -> failwith "Usage: gen_pp_errors.exe <path-to-markdown-file>"
+  in
+  let resolver = new resolver ~source:cwd ~target:cwd in
+  let () = Yocaml_runtime.Log.setup ~level:`Debug () in
+  R.run (program resolver file)

test/e2e/bin/test_article.ml

@@ -0,0 +1,19 @@
+open Yocaml
+
+let entity_name = "Test_article"
+
+type t = { title : string; date : string }
+
+let neutral : (t, Required.provider_error) result =
+  Error (Required.Required_metadata { entity = entity_name })
+
+let validate =
+  let open Data.Validation in
+  record (fun fields ->
+      let+ title = required fields "title" string
+      and+ date = required fields "date" string in
+      { title; date })
+
+let normalize { title; date } =
+  let open Data in
+  [ ("title", string title); ("date", string date) ]

test/e2e/content_pp_errors/parsing_error.md

@@ -0,0 +1,6 @@
+---
+title: A broken article
+date 2025-06-08
+---
+
+text for parsing error

test/e2e/content_pp_errors/required_metadata.md

@@ -0,0 +1 @@
+text for required metadata error

test/e2e/content_pp_errors/validation_error.md

@@ -0,0 +1,6 @@
+---
+title: Valid title
+date: [1, 2, 3]
+---
+
+text for validation error