2022-12-04 22:42:55 +01:00
|
|
|
open Tyxml
|
|
|
|
|
|
2022-12-06 00:12:14 +01:00
|
|
|
let generic ~page_title ~scripts content =
|
2022-12-04 22:42:55 +01:00
|
|
|
let open Html in
|
|
|
|
|
let head =
|
|
|
|
|
head
|
|
|
|
|
(title (txt page_title))
|
|
|
|
|
( [ link ~rel:[ `Icon ] ~href:"/assets/img/favicon.png" ()
|
|
|
|
|
; link ~rel:[ `Stylesheet ] ~href:"/assets/css/style.css" ()
|
|
|
|
|
]
|
|
|
|
|
@ scripts )
|
|
|
|
|
in
|
2022-12-06 00:12:14 +01:00
|
|
|
let body = body [ main [ div [ content ] ] ] in
|
2022-12-04 22:42:55 +01:00
|
|
|
let page = html head body in
|
|
|
|
|
Format.asprintf "%a@." (pp ~indent:true ()) page
|
2022-12-06 00:12:14 +01:00
|
|
|
|
|
|
|
|
let render ~title ~scripts content =
|
|
|
|
|
Dream.html @@ generic ~page_title:title ~scripts content
|
|
|
|
|
|
|
|
|
|
let err (status, msg) =
|
|
|
|
|
let code = Dream.status_to_int status in
|
|
|
|
|
Dream.html ~code @@ generic ~page_title:"Error" ~scripts:[] (Html.txt msg)
|
|
|
|
|
|
|
|
|
|
let error _error _debug_info suggested_response =
|
|
|
|
|
let status = Dream.status suggested_response in
|
|
|
|
|
let code = Dream.status_to_int status in
|
|
|
|
|
let reason = Dream.status_to_string status in
|
|
|
|
|
|
|
|
|
|
Dream.set_header suggested_response "Content-Type" Dream.text_html;
|
|
|
|
|
|
|
|
|
|
let content = Html.txt @@ Format.sprintf "%d: %s" code reason in
|
|
|
|
|
let body = generic ~page_title:"Error" ~scripts:[] content in
|
|
|
|
|
|
|
|
|
|
Dream.set_body suggested_response body;
|
|
|
|
|
Lwt.return suggested_response
|
