1 (** Error pages. 2 3 These are deliberately self-contained rather than going through {!Layout}: 4 an error may be raised before a repository context exists, so the page can 5 depend on nothing but the status and message. *) 6 7 let hint_of_status status = 8 match Dream.status_to_int status with 9 | 400 -> 10 "The request could not be understood. Check the URL for typos or invalid \ 11 characters." 12 | 404 -> 13 "The page or resource you are looking for does not exist. It may have \ 14 been moved or deleted." 15 | 500 -> 16 "Something went wrong on the server. This is not your fault — try again \ 17 later." 18 | code when code >= 400 && code < 500 -> 19 "The request could not be completed. Check the URL and try again." 20 | code when code >= 500 -> 21 "The server encountered an unexpected condition. Try again later." 22 | _ -> "" 23 24 let render ?(title = "Request failed") ?(status = `Internal_Server_Error) 25 message = 26 let status_code = Dream.status_to_int status |> string_of_int in 27 Ui.respond ~status 28 @@ Ui.document 29 ~head: 30 (Ui.document_head ~title 31 [ Ui.meta_viewport; Ui.stylesheet "/static/styles.css" ]) 32 ~body: 33 (Ui.document_body 34 [ 35 Ui.page_banner ~id:"error-header" 36 [ 37 Ui.inline_text ~class_:"error-code" status_code; 38 Ui.heading [ Ui.text title ]; 39 ]; 40 Ui.page_content ~id:"main" 41 [ 42 Ui.paragraph_text ~class_:"error-hint" (hint_of_status status); 43 Ui.paragraph_text ~class_:"error-detail" message; 44 Ui.paragraph ~class_:"error-nav" 45 [ Ui.text_link ~href:"/" "Return to the repository list" ]; 46 ]; 47 ]) 48 () 49