77 lines
2 KiB
OCaml
77 lines
2 KiB
OCaml
module App_id = struct
|
|
let qualifier = "org"
|
|
|
|
let organization = "drame"
|
|
|
|
let application = "drame"
|
|
end
|
|
|
|
module Server = Drame.Server.Make (App_id)
|
|
|
|
let template_html (_request : Drame.Request.t) ~title ~body =
|
|
let open Htmlit in
|
|
El.html
|
|
~at:[ At.lang "en" ]
|
|
[ El.head
|
|
[ El.title [ El.txt title ]
|
|
; El.link
|
|
~at:[ At.rel "stylesheet"; At.href "/assets/css/style.css" ]
|
|
()
|
|
]
|
|
; El.body [ El.main [ El.h1 [ El.txt title ]; body ] ]
|
|
]
|
|
|
|
let hello ~name request =
|
|
let title = Fmt.str "Hello %s!" name in
|
|
let body = Htmlit.El.txt "How are you doing?" in
|
|
let doc = template_html request ~title ~body in
|
|
let content = Drame.Content.Html doc in
|
|
Ok content
|
|
|
|
let hello_q request =
|
|
let name =
|
|
Drame.Request.query request "name" |> Option.value ~default:"World"
|
|
in
|
|
let title = Fmt.str "Hello %s!" name in
|
|
let body = Htmlit.El.txt title in
|
|
let doc = template_html request ~title ~body in
|
|
let content = Drame.Content.Html doc in
|
|
Ok content
|
|
|
|
let config request =
|
|
let title = "Configuration" in
|
|
let body = Fmt.kstr Htmlit.El.txt "%a" Scfg.Pp.config Server.config in
|
|
let doc = template_html request ~title ~body in
|
|
let content = Drame.Content.Html doc in
|
|
Ok content
|
|
|
|
let not_found request =
|
|
let title = "404 Not Found" in
|
|
let body = Htmlit.El.txt "Ooops :S" in
|
|
let content = template_html request ~title ~body in
|
|
Error (Drame.Status.Not_found, content)
|
|
|
|
let style _request =
|
|
let sheet =
|
|
{css|
|
|
body {
|
|
color: #ebb2bf;
|
|
background-color: #0f1312;
|
|
}
|
|
|css}
|
|
in
|
|
let content = Drame.Content.Unsafe { content = sheet; mimetype = Text_css } in
|
|
Ok content
|
|
|
|
let handler route =
|
|
Fmt.pr "[request] %a@\n" Drame.Route.pp route;
|
|
Fmt.flush Fmt.stdout ();
|
|
match route with
|
|
| [||] -> hello ~name:"World"
|
|
| [| "assets"; "css"; "style.css" |] -> style
|
|
| [| "config" |] -> config
|
|
| [| "hello"; name |] -> hello ~name
|
|
| [| "helloq" |] -> hello_q
|
|
| _ -> not_found
|
|
|
|
let () = Server.run ~handler
|