first commit

example/dune

@@ -0,0 +1,6 @@
+(executable
+ (name main)
+ (modules main)
+ (flags
+  (:standard -open Prelude))
+ (libraries drame fmt prelude scfg))

example/main.ml

@@ -0,0 +1,80 @@
+open Drame
+open Tyxml
+open Tyxml.Html
+
+module App_id = struct
+  let qualifier = "org"
+
+  let organization = "drame"
+
+  let application = "drame"
+end
+
+module Server = 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 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
+  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}
+  in
+  let content = Content.Unsafe { content = sheet; mimetype = Text_css } in
+  fun _request -> Ok content
+
+let handler route =
+  Fmt.pr "[request] %a@\n" 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