Merge pull request #116 from Linda-Njau/server-error

Show detailed diagnostics for 500 server errors

Author: xhtmlboi

CHANGES.md

@@ -84,10 +84,12 @@
 
 #### Yocaml_unix
 
+- Improve rendering of 500 error pages on server (by [Linda-Njau](https://github.com/Linda-Njau))
 - Adapt runtime to `is_file` (by [xvw](https://xvw.lol))
 
 #### Yocaml_eio
 
+- Improve rendering of 500 error pages on server (by [Linda-Njau](https://github.com/Linda-Njau))
 - Adapt runtime to `is_file` (by [xvw](https://xvw.lol))
 
 #### Yocaml_git

lib/core/runtime.ml

@@ -22,7 +22,7 @@ module Make (Runtime : Required.RUNTIME) = struct
            ~in_exception_handler:true)
         exn
     in
-    msg |> Runtime.log `Error |> Runtime.bind (fun () -> raise Exit)
+    msg |> Runtime.log `Error |> Runtime.bind (fun () -> raise exn)
 
   let runtimec error =
     let error = Runtime.runtime_error_to_string error in

lib/runtime/server.ml

@@ -107,6 +107,12 @@ module Pages = struct
       |> String.concat ""
     in
     Format.asprintf "<nav><h1>%s</h1></nav><ul>%s</ul>" top listing
+
+  let error500 msg =
+    Format.asprintf
+      "<h1>500 Internal server error</h1><hr /><p>The build failed while \
+       refreshing the site.</p><pre>%s</pre>"
+      msg
 end
 
 let prompt port =

lib/runtime/server.mli

@@ -54,6 +54,7 @@ module Pages : sig
 
   val error404 : string -> string
   val directory : string list -> Kind.t list -> string
+  val error500 : string -> string
 end
 
 (** {1 Helpers} *)

plugins/yocaml_eio/server.ml

@@ -60,11 +60,22 @@ let dir path lpath =
     render_html @@ Yocaml_runtime.Server.Pages.directory lpath children
 
 let handler htdoc refresh _socket request _body =
-  let () = refresh () in
-  match get_requested_uri htdoc request with
-  | Error404 -> error404 htdoc
-  | File (path, str) -> file path str
-  | Dir (path, lpath) -> dir path lpath
+  try
+    refresh ();
+    match get_requested_uri htdoc request with
+    | Error404 -> error404 htdoc
+    | File (path, str) -> file path str
+    | Dir (path, lpath) -> dir path lpath
+  with exn ->
+    let msg =
+      Format.asprintf "%a"
+        (fun ppf exn ->
+          Yocaml.Diagnostic.exception_to_diagnostic ~in_exception_handler:true
+            ppf exn)
+        exn
+    in
+    render_html ~status:`Internal_server_error
+      (Yocaml_runtime.Server.Pages.error500 msg)
 
 let run ?custom_error_handler directory port program env =
   Eio.Switch.run (fun sw ->

plugins/yocaml_unix/server.ml

@@ -82,11 +82,22 @@ let dir reqd path lpath =
 
 let[@warning "-8"] handler htdoc refresh _socket
     (`V1 reqd : Httpcats.Server.reqd) =
-  let () = refresh () in
-  match get_requested_uri htdoc reqd with
-  | Error404 -> error404 reqd htdoc
-  | File (path, _) -> file reqd path
-  | Dir (path, lpath) -> dir reqd path lpath
+  try
+    refresh ();
+    match get_requested_uri htdoc reqd with
+    | Error404 -> error404 reqd htdoc
+    | File (path, _) -> file reqd path
+    | Dir (path, lpath) -> dir reqd path lpath
+  with exn ->
+    let msg =
+      Format.asprintf "%a"
+        (fun ppf exn ->
+          Yocaml.Diagnostic.exception_to_diagnostic ~in_exception_handler:true
+            ppf exn)
+        exn
+    in
+    render_html ~status:`Internal_server_error reqd
+      (Yocaml_runtime.Server.Pages.error500 msg)
 
 let run ?custom_error_handler directory port program =
   let refresh () = Runner.run ?custom_error_handler program in

test/e2e/bin/dune

@@ -29,3 +29,25 @@
   yocaml_jingoo
   yocaml_cmarkit
   yocaml_markdown))
+
+(executable
+ (name unix_server_error)
+ (modules server_error unix_server_error test_article)
+ (libraries
+  yocaml
+  yocaml_unix
+  yocaml_yaml
+  yocaml_jingoo
+  yocaml_cmarkit
+  yocaml_markdown))
+
+(executable
+ (name eio_server_error)
+ (modules server_error eio_server_error test_article)
+ (libraries
+  yocaml
+  yocaml_eio
+  yocaml_yaml
+  yocaml_jingoo
+  yocaml_cmarkit
+  yocaml_markdown))

test/e2e/bin/eio_server_error.ml

@@ -0,0 +1,4 @@
+let () =
+  let port, resolver, file = Server_error.setup () in
+  Yocaml_eio.serve ~target:resolver#target ~port
+    (Server_error.program resolver file)

test/e2e/bin/server_error.ml

@@ -0,0 +1,45 @@
+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 () =
+  Yocaml.Action.with_cache ~on:`Target resolver#cache (article resolver file)
+
+let setup () =
+  let port, file =
+    match Array.to_list Sys.argv with
+    | _ :: port_str :: file :: _ -> (int_of_string port_str, file)
+    | _ -> failwith "Usage: server_error.exe <port> <file>"
+  in
+  let cwd = Yocaml.Path.rel [] in
+  let file = Yocaml.Path.rel [ file ] in
+  let resolver = new resolver ~source:cwd ~target:cwd in
+  (port, resolver, file)

test/e2e/bin/unix_server_error.ml

@@ -0,0 +1,4 @@
+let () =
+  let port, resolver, file = Server_error.setup () in
+  Yocaml_unix.serve ~target:resolver#target ~port
+    (Server_error.program resolver file)