first commit

.gitignore

@@ -0,0 +1 @@
+_build

.ocamlformat

@@ -0,0 +1,43 @@
+version=0.26.1
+assignment-operator=end-line
+break-cases=fit
+break-fun-decl=wrap
+break-fun-sig=wrap
+break-infix=wrap
+break-infix-before-func=false
+break-separators=before
+break-sequences=true
+cases-exp-indent=2
+cases-matching-exp-indent=normal
+doc-comments=before
+doc-comments-padding=2
+doc-comments-tag-only=default
+dock-collection-brackets=false
+exp-grouping=preserve
+field-space=loose
+if-then-else=compact
+indicate-multiline-delimiters=space
+indicate-nested-or-patterns=unsafe-no
+infix-precedence=indent
+leading-nested-match-parens=false
+let-and=sparse
+let-binding-spacing=compact
+let-module=compact
+margin=80
+max-indent=2
+module-item-spacing=sparse
+ocaml-version=4.14.0
+ocp-indent-compat=false
+parens-ite=false
+parens-tuple=always
+parse-docstrings=true
+sequence-blank-line=preserve-one
+sequence-style=terminator
+single-case=compact
+space-around-arrays=true
+space-around-lists=true
+space-around-records=true
+space-around-variants=true
+type-decl=sparse
+wrap-comments=false
+wrap-fun-args=true

CHANGES.md

@@ -0,0 +1 @@
+## unreleased

LICENSE.md

@@ -0,0 +1,8 @@
+The ISC License (ISC)
+=====================
+
+Copyright © 2023, Léo Andrès <contact@ndrs.fr>
+
+Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

README.md

@@ -0,0 +1,40 @@
+# drame
+
+[drame] is an [OCaml] executable/library to TODO.
+
+## Installation
+
+`drame` can be installed with [opam]:
+
+```sh
+opam install drame
+```
+
+If you don't have `opam`, you can install it following the [how to install opam] guide.
+
+If you can't or don't want to use `opam`, consult the [opam file] for build instructions.
+
+## Quickstart
+
+```ocaml
+let () = Format.printf "TODO@."
+```
+
+For more, have a look at the [example] folder, at the [documentation] or at the [test suite].
+
+## About
+
+- [LICENSE]
+- [CHANGELOG]
+
+[CHANGELOG]: ./CHANGES.md
+[example]: ./example
+[LICENSE]: ./LICENSE.md
+[opam file]: ./drame.opam
+[test suite]: ./test
+
+[documentation]: https://doc.zapashcanon.fr/drame
+[how to install opam]: https://opam.ocaml.org/doc/Install.html
+[OCaml]: https://ocaml.org
+[opam]: https://opam.ocaml.org/
+[drame]: https://git.zapashcanon.fr/zapashcanon/drame

doc/dune

@@ -0,0 +1,3 @@
+(documentation
+ (package drame)
+ (mld_files index))

doc/index.mld

@@ -0,0 +1,17 @@
+{0 drame}
+
+{{:https://git.zapashcanon.fr/zapashcanon/drame} drame} is an {{:https://ocaml.org} OCaml} library/executable to TODO.
+
+{1:api API}
+
+{!modules:
+Drame
+}
+
+{1:private_api Private API}
+
+You shouldn't have to use any of these modules, they're used internally only.
+
+{!modules:
+TODO
+}

drame.opam

@@ -0,0 +1,31 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "OCaml library/executable to TODO"
+description: "drame is an OCaml library/executable to TODO."
+maintainer: ["Léo Andrès <contact@ndrs.fr>"]
+authors: ["Léo Andrès <contact@ndrs.fr>"]
+license: "ISC"
+tags: ["drame" "TODO" "TODO" "TODO" "TODO"]
+homepage: "https://git.zapashcanon.fr/zapashcanon/drame"
+doc: "https://doc.zapashcanon.fr/drame"
+bug-reports: "https://git.zapashcanon.fr/zapashcanon/drame/issues"
+depends: [
+  "dune" {>= "3.0"}
+  "ocaml" {>= "4.08"}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://git.zapashcanon.fr/zapashcanon/drame.git"

dune-project

@@ -0,0 +1,33 @@
+(lang dune 3.0)
+
+(implicit_transitive_deps false)
+
+(name drame)
+
+(license ISC)
+
+(authors "Léo Andrès <contact@ndrs.fr>")
+
+(maintainers "Léo Andrès <contact@ndrs.fr>")
+
+(source
+ (uri git+https://git.zapashcanon.fr/zapashcanon/drame.git))
+
+(homepage https://git.zapashcanon.fr/zapashcanon/drame)
+
+(bug_reports https://git.zapashcanon.fr/zapashcanon/drame/issues)
+
+(documentation https://doc.zapashcanon.fr/drame)
+
+(generate_opam_files true)
+
+(package
+ (name drame)
+ (synopsis "OCaml library/executable to TODO")
+ (description
+  "drame is an OCaml library/executable to TODO.")
+ (tags
+  (drame TODO TODO TODO TODO))
+ (depends
+  (ocaml
+   (>= 4.08))))

example/dune

@@ -0,0 +1,4 @@
+(executable
+ (name main)
+ (modules main)
+ (libraries css drame httpcats h2 scfg tyxml tyxml.functor))

example/main.ml

@@ -0,0 +1,75 @@
+open Drame
+
+module App_id = struct
+  let qualifier = "org"
+
+  let organization = "drame"
+
+  let application = "drame"
+end
+
+include Make (App_id)
+
+let template_html =
+  let open Html in
+  fun (_request : Request.t) ~title ~body ->
+    let styles =
+      List.map
+        (fun s ->
+          link ~rel:[ `Stylesheet ] ~href:(Format.sprintf "/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 page = html ~a head body in
+    Content.Html page
+
+let hello =
+  let open Html in
+  let body = txt "How are you doing?" in
+  fun ~name ->
+    let title = Format.ksprintf txt "Hello %s!" name in
+    fun request ->
+      let content = template_html request ~title ~body in
+      Ok content
+
+let config =
+  let open Html in
+  let title = txt "Configuration" in
+  let body = Format.kasprintf txt "%a" Scfg.Pp.config config in
+  fun request ->
+    let content = template_html request ~title ~body in
+    Ok content
+
+let not_found =
+  let open Html in
+  let title = txt "404 Not Found" in
+  let body = txt "Ooops :S" in
+  fun request ->
+    let content = template_html request ~title ~body in
+    Error (`Not_found, content)
+
+let style =
+  let s =
+    {css|body {
+  color: #ebb2bfff;
+  background-color: #0f1312ff;
+}|css}
+  in
+  let sheet = Css.parse_string s in
+  let content = Content.Css sheet in
+  fun _request -> Ok content
+
+let handler route =
+  Format.printf "[request] %a@\n" Route.pp route;
+  Format.pp_print_flush Format.std_formatter ();
+  match route with
+  | [||] -> hello ~name:"World"
+  | [| "assets"; "css"; "style.css" |] -> style
+  | [| "config" |] -> config
+  | [| "hello"; name |] -> hello ~name
+  | _ -> not_found
+
+let () = run ~handler

src/drame.ml

@@ -0,0 +1,156 @@
+module Syntax = struct
+  let ( let* ) = Result.bind
+
+  let ( let+ ) r f = Result.map f r
+end
+
+module Route = struct
+  type t = string array
+
+  let pp fmt route =
+    Format.fprintf fmt "/%a"
+      (Format.pp_print_array
+         ~pp_sep:(fun fmt () -> Format.pp_print_char fmt '/')
+         Format.pp_print_string )
+      route
+end
+
+module Request = struct
+  type t = Httpcats.Server.request
+end
+
+module Status = struct
+  type t = Httpcats.Status.t
+end
+
+module Content = struct
+  type t =
+    | Css of string Css.css
+    | Html of Tyxml.Html.doc
+    | JavaScript of Js_of_ocaml_compiler.Javascript.program
+    | Txt of string
+    | Unsafe of
+        { content : string
+        ; mimetype : string
+        }
+end
+
+module Response = struct
+  type t = (Content.t, Status.t * Content.t) Result.t
+end
+
+module Handler = struct
+  type t = Route.t -> Request.t -> Response.t
+end
+
+module Html = Tyxml.Html
+
+module Make (App_id : sig
+  val qualifier : string
+
+  val organization : string
+
+  val application : string
+end) : sig
+  val config : Scfg.Types.config
+
+  val run : handler:Handler.t -> unit
+end = struct
+  module Project_dirs = Directories.Project_dirs (App_id)
+
+  let config_dir =
+    match Project_dirs.config_dir with
+    | None -> failwith "can not compute configuration directory path"
+    | Some config_dir -> config_dir
+
+  let config =
+    let filename = Filename.concat config_dir "config.scfg" in
+    match Scfg.Parse.from_file filename with
+    | (exception Sys_error msg) | Error msg -> failwith msg
+    | Ok config -> config
+
+  open Scfg.Query
+
+  let port =
+    let directive = get_dir "port" config in
+    match directive with
+    | None -> failwith "configuration file is missing a port directive"
+    | Some directive -> (
+      let param = get_param_int 0 directive in
+      match param with Error msg -> failwith msg | Ok port -> port )
+
+  let listen () =
+    let inet_addr = Unix.inet_addr_loopback in
+    let sockaddr = Unix.ADDR_INET (inet_addr, port) in
+    let file_descr =
+      if Unix.is_inet6_addr inet_addr then Miou_unix.tcpv6 ()
+      else Miou_unix.tcpv4 ()
+    in
+    Miou_unix.bind_and_listen file_descr sockaddr;
+    file_descr
+
+  let stop = Miou_unix.Cond.make ()
+
+  let prepare_content content =
+    let content, content_type =
+      match content with
+      | Content.Css sheet ->
+        ( Format.asprintf "%a@\n" Css.pp_string_css sheet
+        , "text/css;charset=utf-8" )
+      | Html doc ->
+        let indent = false in
+        ( Format.asprintf "%a@\n" (Tyxml.Html.pp ~indent ()) doc
+        , "text/html;charset=utf-8" )
+      | JavaScript program ->
+        let open Js_of_ocaml_compiler in
+        let accept_unnamed_var = true in
+        let buffer = Buffer.create 4096 in
+        let pp = Pretty_print.to_buffer buffer in
+        let _source_map : Source_map.t option =
+          Js_output.program ~accept_unnamed_var pp program
+        in
+        (* setting a charset is invalid for JavaScript ! *)
+        (Buffer.contents buffer, "text/javascript")
+      | Txt txt -> (txt, "text/plain;charset=utf-8")
+      | Unsafe { content; mimetype } -> (content, mimetype)
+    in
+    let content_length = String.length content in
+    let headers =
+      Httpcats.Headers.of_list
+        [ ("content-type", content_type)
+        ; ("content-length", string_of_int content_length)
+        ]
+    in
+    (headers, content)
+
+  let mk_server ~(handler : Handler.t) =
+    let handler request =
+      let target = String.split_on_char '/' request.Httpcats.Server.target in
+      let target = List.filter (fun s -> s <> "") target in
+      let target = Array.of_list target in
+      let response = handler target request in
+      let status, content =
+        match response with
+        | Ok content -> (`OK, content)
+        | Error (status, content) -> (status, content)
+      in
+      let headers, content = prepare_content content in
+      Httpcats.Server.string ~headers ~status content
+    in
+    let file_descr = listen () in
+    Httpcats.Server.clear ~stop ~handler file_descr;
+    Miou_unix.disown file_descr
+
+  let stop (_n : int) = Miou_unix.Cond.broadcast stop
+
+  let run ~(handler : Handler.t) =
+    Sys.set_signal Sys.sigint (Signal_handle stop);
+    let server () = mk_server ~handler in
+    let main () =
+      let prm = Miou.call_cc server in
+      Miou.parallel server (List.init (Miou.Domain.count ()) (Fun.const ()))
+      |> List.iter (function Ok () -> () | Error exn -> raise exn);
+      Miou.await_exn prm
+    in
+    Miou_unix.run main
+end

src/dune

@@ -0,0 +1,14 @@
+(library
+ (public_name drame)
+ (libraries
+  css
+  directories
+  h2
+  httpcats
+  js_of_ocaml-compiler
+  miou
+  miou.unix
+  scfg
+  tyxml
+  tyxml.functor
+  unix))

test/dune

@@ -0,0 +1,3 @@
+(test
+ (name test)
+ (modules test))

test/test.ml

@@ -0,0 +1 @@
+let () = assert true (* TODO *)