update
This commit is contained in:
parent
b06a92c7de
commit
a39d735af4
25 changed files with 147 additions and 244 deletions
|
|
@ -3,4 +3,4 @@
|
|||
(modules main)
|
||||
(flags
|
||||
(:standard -open Prelude))
|
||||
(libraries drame fmt prelude scfg))
|
||||
(libraries drame fmt htmlit prelude scfg))
|
||||
|
|
|
|||
107
example/main.ml
107
example/main.ml
|
|
@ -1,7 +1,3 @@
|
|||
open Drame
|
||||
open Tyxml
|
||||
open Tyxml.Html
|
||||
|
||||
module App_id = struct
|
||||
let qualifier = "org"
|
||||
|
||||
|
|
@ -10,64 +6,65 @@ module App_id = struct
|
|||
let application = "drame"
|
||||
end
|
||||
|
||||
module Server = Server.Make (App_id)
|
||||
module Server = Drame.Server.Make (App_id)
|
||||
|
||||
let template_html (_request : Request.t) ~title ~body =
|
||||
let styles =
|
||||
List.map
|
||||
(fun s -> link ~rel:[ `Stylesheet ] ~href:(Fmt.str "/assets/css/%s" s) ())
|
||||
[ "style.css" ]
|
||||
in
|
||||
let head = head (Html.title title) styles in
|
||||
let body = Html.body [ main [ h1 [ title ]; body ] ] in
|
||||
let a = [ a_lang "en" ] in
|
||||
let tyxml_doc = html ~a head body in
|
||||
Html_doc.of_tyxml tyxml_doc
|
||||
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 =
|
||||
let body = txt "How are you doing?" in
|
||||
fun ~name ->
|
||||
let title = Fmt.kstr txt "Hello %s!" name in
|
||||
fun request ->
|
||||
let doc = template_html request ~title ~body in
|
||||
let content = Content.Html doc in
|
||||
Ok content
|
||||
|
||||
let hello_q request =
|
||||
let name = Request.query request "name" in
|
||||
let name = Option.value name ~default:"World" in
|
||||
let msg = Fmt.kstr txt "Hello %s!" name in
|
||||
let doc = template_html request ~title:msg ~body:msg in
|
||||
let content = Content.Html doc in
|
||||
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 config =
|
||||
let title = txt "Configuration" in
|
||||
let body = Fmt.kstr txt "%a" Scfg.Pp.config Server.config in
|
||||
fun request ->
|
||||
let doc = template_html request ~title ~body in
|
||||
let content = Content.Html doc in
|
||||
Ok content
|
||||
|
||||
let not_found =
|
||||
let title = txt "404 Not Found" in
|
||||
let body = txt "Ooops :S" in
|
||||
fun request ->
|
||||
let content = template_html request ~title ~body in
|
||||
Error (Status.Not_found, content)
|
||||
|
||||
let style =
|
||||
let sheet =
|
||||
{css|body {
|
||||
color: #ebb2bf;
|
||||
background-color: #0f1312;
|
||||
}|css}
|
||||
let hello_q request =
|
||||
let name =
|
||||
Drame.Request.query request "name" |> Option.value ~default:"World"
|
||||
in
|
||||
let content = Content.Unsafe { content = sheet; mimetype = Text_css } in
|
||||
fun _request -> Ok content
|
||||
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" Route.pp route;
|
||||
Fmt.pr "[request] %a@\n" Drame.Route.pp route;
|
||||
Fmt.flush Fmt.stdout ();
|
||||
match route with
|
||||
| [||] -> hello ~name:"World"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue