drame/example/main.ml

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