From 9596dde0e4d7f89d715cc2eafdd689f72b1d2686 Mon Sep 17 00:00:00 2001
From: Swrup <swrup@protonmail.com>
Date: Thu, 26 Sep 2024 02:15:54 +0200
Subject: [PATCH] init

---
 .gitignore               |  1 +
 .ocamlformat             | 43 ++++++++++++++++++++++
 Makefile                 |  2 +
 README.md                |  4 ++
 config.scfg              |  2 +
 drame_template.opam      | 33 +++++++++++++++++
 dune-project             | 31 ++++++++++++++++
 src/app.ml               | 14 +++++++
 src/assets/css/style.css | 15 ++++++++
 src/dune                 | 22 +++++++++++
 src/home.ml              |  8 ++++
 src/main.ml              | 79 ++++++++++++++++++++++++++++++++++++++++
 src/sitemap.ml           |  9 +++++
 src/template.ml          | 18 +++++++++
 14 files changed, 281 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 .ocamlformat
 create mode 100644 Makefile
 create mode 100644 README.md
 create mode 100644 config.scfg
 create mode 100644 drame_template.opam
 create mode 100644 dune-project
 create mode 100644 src/app.ml
 create mode 100644 src/assets/css/style.css
 create mode 100644 src/dune
 create mode 100644 src/home.ml
 create mode 100644 src/main.ml
 create mode 100644 src/sitemap.ml
 create mode 100644 src/template.ml

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..e35d885
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+_build
diff --git a/.ocamlformat b/.ocamlformat
new file mode 100644
index 0000000..f146225
--- /dev/null
+++ b/.ocamlformat
@@ -0,0 +1,43 @@
+version=0.26.2
+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
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..8a44e5b
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,2 @@
+run:
+	dune exec src/main.exe
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..a70df3d
--- /dev/null
+++ b/README.md
@@ -0,0 +1,4 @@
+# template for drame website
+
+- use htmlit instead of tyxml
+- single lang
diff --git a/config.scfg b/config.scfg
new file mode 100644
index 0000000..c0a3499
--- /dev/null
+++ b/config.scfg
@@ -0,0 +1,2 @@
+port 3696
+path_to_images TODO/src/img/
diff --git a/drame_template.opam b/drame_template.opam
new file mode 100644
index 0000000..612b8c6
--- /dev/null
+++ b/drame_template.opam
@@ -0,0 +1,33 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "A short synopsis"
+description: "A longer description"
+maintainer: ["Maintainer Name"]
+authors: ["Author Name"]
+license: "LICENSE"
+tags: ["topics" "to describe" "your" "project"]
+homepage: "https://github.com/username/reponame"
+doc: "https://url/to/documentation"
+bug-reports: "https://github.com/username/reponame/issues"
+depends: [
+  "ocaml"
+  "dune" {>= "3.15"}
+  "drame"
+  "htmlit"
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/username/reponame.git"
diff --git a/dune-project b/dune-project
new file mode 100644
index 0000000..bed2991
--- /dev/null
+++ b/dune-project
@@ -0,0 +1,31 @@
+(lang dune 3.15)
+
+(name drame_template)
+
+(generate_opam_files true)
+
+(source
+ (github username/reponame))
+
+(authors "Author Name")
+
+(maintainers "Maintainer Name")
+
+(license LICENSE)
+
+(documentation https://url/to/documentation)
+
+(package
+ (name drame_template)
+ (synopsis "A short synopsis")
+ (description "A longer description")
+ (depends
+   ocaml
+   dune
+   drame
+   htmlit
+   )
+ (tags
+  (topics "to describe" your project)))
+
+; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project
diff --git a/src/app.ml b/src/app.ml
new file mode 100644
index 0000000..709a3b0
--- /dev/null
+++ b/src/app.ml
@@ -0,0 +1,14 @@
+module App_id = struct
+  let qualifier = "org"
+
+  let organization = "TODO"
+
+  let application = "drame_template"
+end
+
+include Drame.Server.Make (App_id)
+
+let path_to_images =
+  match Scfg.Query.get_dir "path_to_images" config with
+  | None -> failwith "missing path_to_images in configuration"
+  | Some dir -> Scfg.Query.get_param_exn 0 dir
diff --git a/src/assets/css/style.css b/src/assets/css/style.css
new file mode 100644
index 0000000..75e2d17
--- /dev/null
+++ b/src/assets/css/style.css
@@ -0,0 +1,15 @@
+:root {
+  --bg: #FFFFFF;
+  --fg: #000000;
+}
+
+html {
+  background-color: var(--bg);
+  color: var(--fg);
+}
+
+body {
+}
+
+nav {
+}
diff --git a/src/dune b/src/dune
new file mode 100644
index 0000000..ca16d88
--- /dev/null
+++ b/src/dune
@@ -0,0 +1,22 @@
+(executable
+ (public_name web_template)
+ (name main)
+ (libraries drame htmlit))
+
+(rule
+ (target assets.ml)
+ (deps
+  (source_tree assets))
+ (action
+  (with-stdout-to
+   %{null}
+   (run ocaml-crunch -m plain assets -o %{target}))))
+
+(rule
+ (target data.ml)
+ (deps
+  (source_tree data))
+ (action
+  (with-stdout-to
+   %{null}
+   (run ocaml-crunch -m plain data -o %{target}))))
diff --git a/src/home.ml b/src/home.ml
new file mode 100644
index 0000000..92910f3
--- /dev/null
+++ b/src/home.ml
@@ -0,0 +1,8 @@
+open Htmlit
+
+let get request =
+  let title = "Home" in
+  let h1 = El.h1 [ El.txt title ] in
+  let txt = El.txt "Welcome to my home page" in
+  let doc = Template.render request ~styles:[] ~title [ h1; txt ] in
+  Ok (Drame.Content.Html doc)
diff --git a/src/main.ml b/src/main.ml
new file mode 100644
index 0000000..2a1c355
--- /dev/null
+++ b/src/main.ml
@@ -0,0 +1,79 @@
+open Drame
+
+let get_img =
+  let forbidden_characters =
+    let tbl = Hashtbl.create 16 in
+    Array.iter (fun c -> Hashtbl.add tbl c ()) [| '.'; '/'; '\\' |];
+    tbl
+  in
+  let allowed_extensions =
+    let tbl = Hashtbl.create 16 in
+    Array.iter (fun e -> Hashtbl.add tbl e ()) [| ".jpeg"; ".png"; ".gif" |];
+    tbl
+  in
+  fun ~filename request ->
+    let extension = Filename.extension filename in
+    let without_extension = Filename.chop_extension filename in
+    if
+      String.exists (Hashtbl.mem forbidden_characters) without_extension
+      || (not @@ Hashtbl.mem allowed_extensions extension)
+    then
+      let title = Format.sprintf "Invalid filename: %s." filename in
+      let doc = Template.render request ~title [] in
+      Error (Status.Bad_request, doc)
+    else
+      let path = Filename.concat App.path_to_images filename in
+      let chan = open_in_bin path in
+      let len = in_channel_length chan in
+      let s = Bytes.create len in
+      Fun.protect
+        ~finally:(fun () -> close_in chan)
+        (fun () ->
+          assert (len <= Sys.max_string_length);
+          really_input chan s 0 len );
+      let content = Bytes.unsafe_to_string s in
+      let mimetype =
+        match extension with
+        | ".jpeg" -> Mimetype.Image_jpeg
+        | ".png" -> Mimetype.Image_png
+        | ".gif" -> Mimetype.Image_gif
+        | _ -> assert false
+      in
+      Ok (Content.Unsafe { content; mimetype })
+
+let get_asset ~filename request =
+  match Assets.read filename with
+  | None ->
+    let title = Format.sprintf "Invalid filename: %s." filename in
+    let doc = Template.render request ~title [] in
+    Error (Status.Bad_request, doc)
+  | Some content -> (
+    let extension = Filename.extension filename in
+    match extension with
+    | ".css" -> Ok (Content.Unsafe { mimetype = Mimetype.Text_css; content })
+    | ".ttf" -> Ok (Content.Unsafe { mimetype = Mimetype.Font_ttf; content })
+    | _ -> assert false )
+
+let get_favicon request =
+  let title = "The favicon is not where you think it is!" in
+  let h1 = Htmlit.El.h1 [ Htmlit.El.txt title ] in
+  let doc = Template.render request ~title [ h1 ] in
+  Error (Status.Moved_permanently Sitemap.favicon, doc)
+
+let not_found request =
+  let title = "Not found" in
+  let h1 = Htmlit.El.h1 [ Htmlit.El.txt title ] in
+  let doc = Template.render request ~title [ h1 ] in
+  Error (Status.Not_found, doc)
+
+let handler = function
+  | [| "assets"; "css"; filename |] ->
+    get_asset ~filename:(Format.sprintf "css/%s" filename)
+  | [| "assets"; "fonts"; filename |] ->
+    get_asset ~filename:(Format.sprintf "fonts/%s" filename)
+  | [| "assets"; "img"; filename |] -> get_img ~filename
+  | [| "favicon.ico" |] -> get_favicon
+  | [||] -> Home.get
+  | _ -> not_found
+
+let () = App.run ~handler
diff --git a/src/sitemap.ml b/src/sitemap.ml
new file mode 100644
index 0000000..f5448c3
--- /dev/null
+++ b/src/sitemap.ml
@@ -0,0 +1,9 @@
+let img name = Format.sprintf "/assets/img/%s" name
+
+let script name = Format.sprintf "/assets/js/%s" name
+
+let style name = Format.sprintf "/assets/css/%s" name
+
+let favicon = img "favicon.png"
+
+let home = "/"
diff --git a/src/template.ml b/src/template.ml
new file mode 100644
index 0000000..f7e455e
--- /dev/null
+++ b/src/template.ml
@@ -0,0 +1,18 @@
+open Htmlit
+
+let render _request ?(scripts = []) ?(styles = []) ~title content =
+  let favicon = El.link ~at:[ At.rel "icon"; At.href Sitemap.favicon ] () in
+  let meta_desc =
+    El.meta ~at:[ At.name "description"; At.content "TODO site desciption" ] ()
+  in
+  let meta_keys =
+    El.meta ~at:[ At.name "keywords"; At.content "TODO site desciption" ] ()
+  in
+  let more_head = El.splice [ favicon; meta_desc; meta_keys ] in
+  let header = El.header [ El.nav [] ] in
+  let main = El.main content in
+  let footer = El.footer [] in
+  let body = El.body [ header; main; footer ] in
+  let page = El.page ~lang:"en" ~styles ~scripts ~more_head ~title body in
+  let doc = El.to_string ~doctype:true page in
+  Drame.Content.Unsafe_doc doc