first commit

.gitignore

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

.ocamlformat

@@ -0,0 +1,43 @@
+version=0.25.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

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,34 @@
+# jb
+
+[jb] is an [OCaml] executable/library to TODO.
+
+## Installation
+
+`jb` can be installed with [opam]:
+
+```sh
+opam install jb
+```
+
+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@."
+```
+
+## About
+
+- [LICENSE]
+
+[example]: ./example
+[LICENSE]: ./LICENSE.md
+[opam file]: ./jb.opam
+
+[how to install opam]: https://opam.ocaml.org/doc/Install.html
+[OCaml]: https://ocaml.org
+[opam]: https://opam.ocaml.org
+[jb]: https://git.zapashcanon.fr/zapashcanon/jb

dune-project

@@ -0,0 +1,33 @@
+(lang dune 3.0)
+
+(implicit_transitive_deps false)
+
+(name jb)
+
+(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/jb.git))
+
+(homepage https://git.zapashcanon.fr/zapashcanon/jb)
+
+(bug_reports https://git.zapashcanon.fr/zapashcanon/jb/issues)
+
+(documentation https://doc.zapashcanon.fr/jb)
+
+(generate_opam_files true)
+
+(package
+ (name jb)
+ (synopsis "OCaml library/executable to TODO")
+ (description
+  "jb is an OCaml library/executable to TODO.")
+ (tags
+  (jb TODO TODO TODO TODO))
+ (depends
+  (ocaml
+   (>= 4.08))))

jb.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: "jb 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: ["jb" "TODO" "TODO" "TODO" "TODO"]
+homepage: "https://git.zapashcanon.fr/zapashcanon/jb"
+doc: "https://doc.zapashcanon.fr/jb"
+bug-reports: "https://git.zapashcanon.fr/zapashcanon/jb/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/jb.git"

src/about.ml

@@ -0,0 +1,56 @@
+open Tyxml.Html
+
+let get _request =
+  let content =
+    div
+      [ img ~src:Sitemap.me ~alt:"Picture of myself." ()
+      ; h2 [ txt "Joanna Barreiro" ]
+      ; p
+          [ txt "Architecte Libérale (MOE)"
+          ; br ()
+          ; txt
+              "Assistante à Maîtrise d'Ouvrage spécialisée en réhabilitation \
+               et réemploi (AMO)"
+          ]
+      ; p
+          [ txt "Année préparatoire -- LISAA Paris, 2013"
+          ; br ()
+          ; txt
+              "Diplôme master \"Structure et Architecture\" -- EAVT Paris-Est \
+               & ENPC, 2020"
+          ; br ()
+          ; txt
+              "Diplôme Habilitation à la maîtrise d'ouvrage en son nom propre \
+               -- EAVT Paris-Est, 2021"
+          ]
+      ; h2 [ txt "Présentation" ]
+      ; p [ txt @@ Lorem.lorem () ]
+      ; h2 [ txt "Ma pratique" ]
+      ; p [ txt @@ Lorem.lorem () ]
+      ; h2 [ txt "MOE - Maîtrise d'oeuvre" ]
+      ; ul
+          [ li [ txt "Conseil & Faisabilité" ]
+          ; li [ txt "ESQ / APS / APD / PC / PRO / DCE" ]
+          ; li [ txt "Études et permis de construire" ]
+          ; li [ txt "Plan de ventes" ]
+          ; li [ txt "Suivi de chantier" ]
+          ; li [ txt "Analyse urbaine et plan de développement" ]
+          ; li [ txt "Expertise" ]
+          ]
+      ; h2 [ txt "Mission de design d'intérieur" ]
+      ; ul
+          [ li [ txt "Optimisation et requalification des espaces" ]
+          ; li [ txt "Ambiances et fonctionnalité" ]
+          ; li [ txt "Accompagnement et diagnostique" ]
+          ]
+      ; h2 [ txt "AMO réhabilitation et réemploi" ]
+      ; ul
+          [ li [ txt "Missions réhabilitation" ]
+          ; li [ txt "Missions rénovation énergétique" ]
+          ; li [ txt "Missions réemploi" ]
+          ]
+      ; p [ txt @@ Lorem.lorem () ]
+      ]
+  in
+
+  Reply.page ~title:None ~scripts:[] ~styles:[] ~h1:"À propos" content

src/app.ml

@@ -0,0 +1,75 @@
+module App_id = struct
+  let qualifier = "org"
+
+  let organization = "jb"
+
+  let application = "jb"
+end
+
+module Project_dirs = Directories.Project_dirs (App_id)
+
+let data_dir =
+  match Project_dirs.data_dir with
+  | None -> failwith "can't compute data directory"
+  | Some data_dir -> data_dir
+
+let config_dir =
+  match Project_dirs.config_dir with
+  | None -> failwith "can't compute configuration directory"
+  | Some config_dir -> config_dir
+
+let config =
+  let filename = Filename.concat config_dir "config.scfg" in
+  if not @@ Sys.file_exists filename then []
+  else begin
+    Dream.log "config file: %s" filename;
+    match Scfg.Parse.from_file filename with
+    | Error e -> failwith e
+    | Ok config -> config
+  end
+
+let port =
+  match Scfg.Query.get_dir "port" config with
+  | None -> 8080
+  | Some port -> (
+    match Scfg.Query.get_param 0 port with
+    | Error e -> failwith e
+    | Ok n -> (
+      try
+        let n = int_of_string n in
+        if n < 0 then raise (Invalid_argument "negative port number");
+        n
+      with Invalid_argument _msg ->
+        failwith "invalid `port` value in configuration file" ) )
+
+let () = Dream.log "port: %d" port
+
+let hostname =
+  let default_hostname = Format.sprintf "localhost:%d" port in
+  match Scfg.Query.get_dir "hostname" config with
+  | None -> default_hostname
+  | Some hostname ->
+    Result.fold ~error:failwith ~ok:Fun.id (Scfg.Query.get_param 0 hostname)
+
+let () = Dream.log "hostname: %s" hostname
+
+let log =
+  match Scfg.Query.get_dir "log" config with
+  | None -> true
+  | Some log -> (
+    match Scfg.Query.get_param 0 log with
+    | Error e -> failwith e
+    | Ok "true" -> true
+    | Ok "false" -> false
+    | Ok _unknown -> failwith "invalid `log` value in configuration file" )
+
+let () = Dream.log "log: %b" log
+
+let about =
+  let default_about = "JB" in
+  match Scfg.Query.get_dir "about" config with
+  | None -> default_about
+  | Some about -> (
+    match Scfg.Query.get_param 0 about with
+    | Error e -> failwith e
+    | Ok about -> about )

src/assets/css/csslider.css

@@ -0,0 +1,231 @@
+.csslider {
+  -moz-perspective: 1300px;
+  -ms-perspective: 1300px;
+  -webkit-perspective: 1300px;
+  perspective: 1300px;
+  display: inline-block;
+  text-align: left;
+  position: relative;
+  margin-bottom: 22px;
+}
+.csslider > input {
+  display: none;
+}
+.csslider > input:nth-of-type(10):checked ~ ul li:first-of-type {
+  margin-left: -900%;
+}
+.csslider > input:nth-of-type(9):checked ~ ul li:first-of-type {
+  margin-left: -800%;
+}
+.csslider > input:nth-of-type(8):checked ~ ul li:first-of-type {
+  margin-left: -700%;
+}
+.csslider > input:nth-of-type(7):checked ~ ul li:first-of-type {
+  margin-left: -600%;
+}
+.csslider > input:nth-of-type(6):checked ~ ul li:first-of-type {
+  margin-left: -500%;
+}
+.csslider > input:nth-of-type(5):checked ~ ul li:first-of-type {
+  margin-left: -400%;
+}
+.csslider > input:nth-of-type(4):checked ~ ul li:first-of-type {
+  margin-left: -300%;
+}
+.csslider > input:nth-of-type(3):checked ~ ul li:first-of-type {
+  margin-left: -200%;
+}
+.csslider > input:nth-of-type(2):checked ~ ul li:first-of-type {
+  margin-left: -100%;
+}
+.csslider > input:nth-of-type(1):checked ~ ul li:first-of-type {
+  margin-left: 0%;
+}
+.csslider > ul {
+  position: relative;
+  width: 916px;
+  height: 483px;
+  z-index: 1;
+  font-size: 0;
+  line-height: 0;
+  background-color: #3a3a3a;
+  border: 10px solid #3a3a3a;
+  margin: 0 auto;
+  padding: 0;
+  overflow: hidden;
+  white-space: nowrap;
+  -moz-box-sizing: border-box;
+  -webkit-box-sizing: border-box;
+  box-sizing: border-box;
+}
+.csslider > ul > li {
+  position: relative;
+  display: inline-block;
+  width: 100%;
+  height: 100%;
+  overflow: hidden;
+  font-size: 15px;
+  font-size: initial;
+  line-height: normal;
+  -moz-transition: all 0.5s cubic-bezier(0.4, 1.3, 0.65, 1);
+  -o-transition: all 0.5s ease-out;
+  -webkit-transition: all 0.5s cubic-bezier(0.4, 1.3, 0.65, 1);
+  transition: all 0.5s cubic-bezier(0.4, 1.3, 0.65, 1);
+  vertical-align: top;
+  -moz-box-sizing: border-box;
+  -webkit-box-sizing: border-box;
+  box-sizing: border-box;
+  white-space: normal;
+}
+.csslider > ul > li.scrollable {
+  overflow-y: scroll;
+}
+.csslider > .navigation {
+  position: absolute;
+  bottom: -8px;
+  left: 50%;
+  z-index: 10;
+  margin-bottom: -10px;
+  font-size: 0;
+  line-height: 0;
+  text-align: center;
+  -webkit-touch-callout: none;
+  -webkit-user-select: none;
+  -khtml-user-select: none;
+  -moz-user-select: none;
+  -ms-user-select: none;
+  user-select: none;
+}
+.csslider > .navigation > div {
+  margin-left: -100%;
+}
+.csslider > .navigation label {
+  position: relative;
+  display: inline-block;
+  cursor: pointer;
+  border-radius: 50%;
+  margin: 0 4px;
+  padding: 4px;
+  background: #3a3a3a;
+}
+.csslider > .navigation label:hover:after {
+  opacity: 1;
+}
+.csslider > .navigation label:after {
+  content: '';
+  position: absolute;
+  left: 50%;
+  top: 50%;
+  margin-left: -6px;
+  margin-top: -6px;
+  background: #71ad37;
+  border-radius: 50%;
+  padding: 6px;
+  opacity: 0;
+}
+.csslider > .arrows {
+  -webkit-touch-callout: none;
+  -webkit-user-select: none;
+  -khtml-user-select: none;
+  -moz-user-select: none;
+  -ms-user-select: none;
+  user-select: none;
+}
+.csslider.inside .navigation {
+  bottom: 10px;
+  margin-bottom: 10px;
+}
+.csslider.inside .navigation label {
+  border: 1px solid #7e7e7e;
+}
+.csslider > input:nth-of-type(1):checked ~ .navigation label:nth-of-type(1):after,
+.csslider > input:nth-of-type(2):checked ~ .navigation label:nth-of-type(2):after,
+.csslider > input:nth-of-type(3):checked ~ .navigation label:nth-of-type(3):after,
+.csslider > input:nth-of-type(4):checked ~ .navigation label:nth-of-type(4):after,
+.csslider > input:nth-of-type(5):checked ~ .navigation label:nth-of-type(5):after,
+.csslider > input:nth-of-type(6):checked ~ .navigation label:nth-of-type(6):after,
+.csslider > input:nth-of-type(7):checked ~ .navigation label:nth-of-type(7):after,
+.csslider > input:nth-of-type(8):checked ~ .navigation label:nth-of-type(8):after,
+.csslider > input:nth-of-type(9):checked ~ .navigation label:nth-of-type(9):after,
+.csslider > input:nth-of-type(10):checked ~ .navigation label:nth-of-type(10):after,
+.csslider > input:nth-of-type(11):checked ~ .navigation label:nth-of-type(11):after {
+  opacity: 1;
+}
+.csslider > .arrows {
+  position: absolute;
+  left: -31px;
+  top: 50%;
+  width: 100%;
+  height: 26px;
+  padding: 0 31px;
+  z-index: 0;
+  -moz-box-sizing: content-box;
+  -webkit-box-sizing: content-box;
+  box-sizing: content-box;
+}
+.csslider > .arrows label {
+  display: none;
+  position: absolute;
+  top: -50%;
+  padding: 13px;
+  box-shadow: inset 2px -2px 0 1px #3a3a3a;
+  cursor: pointer;
+  -moz-transition: box-shadow 0.15s, margin 0.15s;
+  -o-transition: box-shadow 0.15s, margin 0.15s;
+  -webkit-transition: box-shadow 0.15s, margin 0.15s;
+  transition: box-shadow 0.15s, margin 0.15s;
+}
+.csslider > .arrows label:hover {
+  box-shadow: inset 3px -3px 0 2px #71ad37;
+  margin: 0 0px;
+}
+.csslider > .arrows label:before {
+  content: '';
+  position: absolute;
+  top: -100%;
+  left: -100%;
+  height: 300%;
+  width: 300%;
+}
+.csslider.infinity > input:first-of-type:checked ~ .arrows label.goto-last,
+.csslider > input:nth-of-type(1):checked ~ .arrows > label:nth-of-type(0),
+.csslider > input:nth-of-type(2):checked ~ .arrows > label:nth-of-type(1),
+.csslider > input:nth-of-type(3):checked ~ .arrows > label:nth-of-type(2),
+.csslider > input:nth-of-type(4):checked ~ .arrows > label:nth-of-type(3),
+.csslider > input:nth-of-type(5):checked ~ .arrows > label:nth-of-type(4),
+.csslider > input:nth-of-type(6):checked ~ .arrows > label:nth-of-type(5),
+.csslider > input:nth-of-type(7):checked ~ .arrows > label:nth-of-type(6),
+.csslider > input:nth-of-type(8):checked ~ .arrows > label:nth-of-type(7),
+.csslider > input:nth-of-type(9):checked ~ .arrows > label:nth-of-type(8),
+.csslider > input:nth-of-type(10):checked ~ .arrows > label:nth-of-type(9),
+.csslider > input:nth-of-type(11):checked ~ .arrows > label:nth-of-type(10) {
+  display: block;
+  left: 0;
+  right: auto;
+  -moz-transform: rotate(45deg);
+  -ms-transform: rotate(45deg);
+  -o-transform: rotate(45deg);
+  -webkit-transform: rotate(45deg);
+  transform: rotate(45deg);
+}
+.csslider.infinity > input:last-of-type:checked ~ .arrows label.goto-first,
+.csslider > input:nth-of-type(1):checked ~ .arrows > label:nth-of-type(2),
+.csslider > input:nth-of-type(2):checked ~ .arrows > label:nth-of-type(3),
+.csslider > input:nth-of-type(3):checked ~ .arrows > label:nth-of-type(4),
+.csslider > input:nth-of-type(4):checked ~ .arrows > label:nth-of-type(5),
+.csslider > input:nth-of-type(5):checked ~ .arrows > label:nth-of-type(6),
+.csslider > input:nth-of-type(6):checked ~ .arrows > label:nth-of-type(7),
+.csslider > input:nth-of-type(7):checked ~ .arrows > label:nth-of-type(8),
+.csslider > input:nth-of-type(8):checked ~ .arrows > label:nth-of-type(9),
+.csslider > input:nth-of-type(9):checked ~ .arrows > label:nth-of-type(10),
+.csslider > input:nth-of-type(10):checked ~ .arrows > label:nth-of-type(11),
+.csslider > input:nth-of-type(11):checked ~ .arrows > label:nth-of-type(12) {
+  display: block;
+  right: 0;
+  left: auto;
+  -moz-transform: rotate(225deg);
+  -ms-transform: rotate(225deg);
+  -o-transform: rotate(225deg);
+  -webkit-transform: rotate(225deg);
+  transform: rotate(225deg);
+}

src/assets/css/style.css

@@ -0,0 +1,54 @@
+:root {
+  --color-01: #797D62;
+  --color-02: #9B9B7A;
+  --color-03: #BAA587;
+  --color-04: #D9AE94;
+  --color-05: #F1DCA7;
+  --color-06: #FFCB69;
+  --color-07: #E8AC65;
+  --color-08: #D08C60;
+  --color-09: #B58463;
+  --color-10: #997B66;
+}
+
+html {
+  text-align: center;
+  background:-color: #FFFFFF;
+  color: #000000;
+  font-family: "Helvetica", "Times", "Avenir Next", "Helvetica", "Calibri", "EB Garamod", "Arial";
+  font-size: 22px;
+}
+
+main {
+  margin-left: 30%;
+  margin-right: 30%;
+}
+
+a {
+  text-decoration: none;
+  color: var(--color-08);
+}
+
+a:visited {
+  color: var(--color-08);
+}
+
+a:hover {
+  text-decoration: underline;
+}
+
+img {
+  max-height: 60%;
+  max-width: 60%;
+  margin: 2%;
+}
+
+.logo {
+  display: inline;
+  max-width: 50px;
+  margin: 0%;
+}
+
+.hidden {
+  display: none;
+}

src/contact.ml

@@ -0,0 +1,25 @@
+open Tyxml.Html
+
+let get _request =
+  let content =
+    div
+      [ p
+          [ txt "Joanna Barreiro Architecte"
+          ; br ()
+          ; txt "Architecte libérale & AMO"
+          ]
+      ; p
+          [ txt "Email :"
+          ; a
+              ~a:[ a_href "mailto:contact@jb-architecte.com" ]
+              [ txt "contact@jb-architecte.com" ]
+          ; br ()
+          ; txt "Tel : +33 6 71 16 36 15"
+          ; br ()
+          ; txt "Instagram : TODOlienTODO"
+          ; br ()
+          ; txt "Paris"
+          ]
+      ]
+  in
+  Reply.page ~title:None ~scripts:[] ~styles:[] ~h1:"Contact" content

src/db.ml

@@ -0,0 +1,66 @@
+let db_root = App.data_dir
+
+let () =
+  match Bos.OS.Dir.create (Fpath.v db_root) with
+  | Ok true -> Dream.log "created %s" db_root
+  | Ok false -> Dream.log "%s already exists" db_root
+  | Error (`Msg _) ->
+    Dream.error (fun log -> log "error when creating %s" db_root)
+
+let db = Filename.concat db_root (App.App_id.application ^ ".db")
+
+let db_uri = Format.sprintf "sqlite3://%s" db
+
+module Db =
+  (val Caqti_blocking.connect (Uri.of_string db_uri) |> Caqti_blocking.or_fail)
+
+let () =
+  let open Caqti_request.Infix in
+  let set_foreign_keys_on =
+    Caqti_type.(unit ->. unit) "PRAGMA foreign_keys = ON"
+  in
+  if Result.is_error (Db.exec set_foreign_keys_on ()) then
+    Dream.error (fun log -> log "can't set foreign keys on")
+
+let () =
+  let open Caqti_request.Infix in
+  let query =
+    Caqti_type.(unit ->. unit)
+      "CREATE TABLE IF NOT EXISTS dream_session (id TEXT PRIMARY KEY, label \
+       TEXT NOT NULL, expires_at REAL NOT NULL, payload TEXT NOT NULL)"
+  in
+  match Db.exec query () with
+  | Ok () -> ()
+  | Error e ->
+    Dream.error (fun log ->
+      log "error while creating database dream_session: %s" (Caqti_error.show e) )
+
+let handle_err = function
+  | Ok _ as ok -> ok
+  | Error e ->
+    Dream.error (fun log -> log "database error: %s" (Caqti_error.show e));
+    Error "database error"
+
+let find t q v =
+  match Db.find_opt (t q) v |> handle_err with
+  | Ok None -> Reply.not_found ()
+  | Ok (Some v) -> Reply.continue v
+  | Error _ -> Reply.database_error ()
+
+let exists t q v =
+  match Db.find_opt (t q) v |> handle_err with
+  | Ok None -> Reply.continue false
+  | Ok (Some n) -> Reply.continue (n <> 0)
+  | Error _ -> Reply.database_error ()
+
+let exec t q v =
+  match Db.exec (t q) v |> handle_err with
+  | Ok () -> Reply.continue ()
+  | Error _ -> Reply.database_error ()
+
+let exec_nolwt t q v = Db.exec (t q) v |> handle_err
+
+let collect_list t q v =
+  match Db.collect_list (t q) v |> handle_err with
+  | Ok l -> Reply.continue l
+  | Error _ -> Reply.database_error ()

src/dune

@@ -0,0 +1,40 @@
+(executable
+ (public_name jb)
+ (modules
+  about
+  app
+  assets
+  contact
+  db
+  home
+  jb
+  lorem
+  projects
+  reply
+  sitemap
+  syntax
+  template)
+ (libraries
+  bos
+  caqti
+  caqti.blocking
+  caqti-driver-sqlite3
+  directories
+  dream
+  fpath
+  lwt
+  scfg
+  tyxml
+  tyxml.functor
+  uri)
+ (preprocess
+  (pps lwt_ppx)))
+
+(rule
+ (target assets.ml)
+ (deps
+  (source_tree assets))
+ (action
+  (with-stdout-to
+   %{null}
+   (run ocaml-crunch -m plain assets -o %{target}))))

src/home.ml

@@ -0,0 +1,66 @@
+open Tyxml.Html
+open Syntax
+
+let get _request =
+  let* projects = Projects.load () in
+  let slides_radio =
+    List.mapi
+      (fun i _p ->
+        let a =
+          [ a_input_type `Radio
+          ; a_name "slides"
+          ; a_id (Format.sprintf "slides_%d" i)
+          ]
+        in
+        let a = if i = 0 then a_checked () :: a else a in
+        input ~a () )
+      projects
+  in
+  let slides_ul =
+    List.mapi
+      (fun _i { Projects.img_alt; id; _ } ->
+        li
+          [ a
+              ~a:[ a_href (Sitemap.projects_one id) ]
+              [ img ~src:(Sitemap.project_img id) ~alt:img_alt () ]
+          ] )
+      projects
+  in
+  let slides_labels =
+    List.mapi
+      (fun i _p -> label ~a:[ a_label_for (Format.sprintf "slides_%d" i) ] [])
+      projects
+  in
+  let slides_arrows =
+    slides_labels
+    @ [ label ~a:[ a_label_for "slides_0"; a_class [ "goto-first" ] ] []
+      ; label
+          ~a:
+            [ a_label_for
+                (Format.sprintf "slides_%d" (List.length projects - 1))
+            ; a_class [ "goto-last" ]
+            ]
+          []
+      ]
+  in
+  let slider =
+    div ~a:[ a_class [ "csslider" ] ]
+    @@ slides_radio
+    @ [ ul slides_ul
+      ; div ~a:[ a_class [ "arrows" ] ] slides_arrows
+      ; div ~a:[ a_class [ "navigation" ] ] [ div slides_labels ]
+      ]
+  in
+
+  let content =
+    div
+      [ slider
+      ; p
+          [ txt "Joanna Barreiro Architecte"
+          ; br ()
+          ; txt "Architecte libérale & AMO"
+          ]
+      ]
+  in
+  Reply.page ~title:None ~scripts:[] ~styles:[ "csslider.css" ] ~h1:"Welcome !"
+    content

src/jb.ml

@@ -0,0 +1,41 @@
+let logger = if App.log then Dream.logger else Fun.id
+
+let with_reply f request =
+  let reply = f request in
+  Template.reply request reply
+
+let get route f = Dream.get route (with_reply f)
+
+let post route f = Dream.post route (with_reply f)
+
+let get_asset =
+  Dream.static
+    ~loader:(fun _root path request ->
+      Template.reply request
+      @@
+      match Assets.read path with
+      | None -> Reply.not_found ()
+      | Some asset -> Reply.cache asset )
+    ""
+
+let get_favicon _request =
+  Dream.respond ~status:`See_Other
+    ~headers:[ ("Location", Sitemap.favicon) ]
+    "favicon is not where you think it is !"
+
+let routes =
+  [ Dream.get "/assets/**" get_asset
+  ; Dream.get "/favicon.ico" get_favicon
+  ; get Sitemap.about About.get
+  ; get Sitemap.contact Contact.get
+  ; get Sitemap.home Home.get
+  ; get Sitemap.projects Projects.get
+  ; get Sitemap.projects_add Projects.get_add
+  ; post Sitemap.projects_add Projects.post_add
+  ; get (Sitemap.projects_one ":id") Projects.get_one
+  ; get (Sitemap.project_img ":id") Projects.get_img
+  ]
+
+let () =
+  Dream.run ~port:App.port @@ logger @@ Dream.memory_sessions
+  @@ Dream.router routes

src/lorem.ml

@@ -0,0 +1,48 @@
+let lorem =
+  [| "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Maecenas varius \
+      posuere tortor, iaculis faucibus diam molestie non. Pellentesque nec \
+      convallis mi. Duis euismod nec ipsum quis feugiat. Curabitur nisl ex, \
+      feugiat nec mi nec, facilisis iaculis lorem. Ut id lectus eget dolor \
+      feugiat tempor vitae nec leo. Nam ultrices felis vitae tempus tincidunt. \
+      Duis orci libero, imperdiet sollicitudin velit a, pharetra ornare augue. \
+      Donec eu sollicitudin nisl."
+   ; "Maecenas porta tellus ut sollicitudin sagittis. Mauris placerat, nisi \
+      aliquet tempus pellentesque, tellus nibh hendrerit sapien, non tempus \
+      dui sapien id leo. Fusce ac convallis nibh, in mollis justo. Sed vel \
+      orci lorem. In ut pretium nulla, et efficitur odio. Vestibulum ut dolor \
+      velit. Mauris erat augue, dapibus quis dignissim sed, condimentum at \
+      erat. Etiam at neque et massa pharetra molestie non eget est. Integer \
+      vestibulum mauris ligula. Morbi pharetra, elit eget aliquam accumsan, \
+      sem ex porttitor sem, vitae gravida nibh ex eget dolor. Curabitur \
+      lobortis maximus nulla et consectetur. Sed sodales libero id lorem \
+      pulvinar commodo. Donec sed aliquam felis. Donec eu risus ut eros \
+      ullamcorper dignissim."
+   ; "Pellentesque ligula diam, imperdiet in commodo at, molestie ac risus. \
+      Vestibulum cursus, sem at accumsan luctus, metus ipsum consequat massa, \
+      ac elementum urna mi eu eros. Aenean convallis augue ut volutpat \
+      tristique. Aenean rutrum lobortis lectus eu imperdiet. Phasellus \
+      pulvinar posuere mattis. Mauris pretium, dolor vel rutrum tincidunt, \
+      urna ipsum tempor magna, ac luctus justo velit commodo libero. Sed et \
+      blandit quam. Donec aliquam vel nulla quis tincidunt. Mauris vel posuere \
+      velit. Mauris pulvinar sed neque nec faucibus. Ut sed dolor eu ipsum \
+      tincidunt porttitor ac quis enim. Aliquam laoreet tortor eu felis \
+      pharetra, sed tincidunt metus ornare. Nam id purus sed lacus commodo \
+      sollicitudin."
+   ; "Vivamus fermentum ante sit amet ipsum hendrerit tempus. Nunc a mi non \
+      leo lacinia tincidunt. Sed malesuada justo ac enim eleifend tincidunt. \
+      Morbi posuere in dui a tempus. Maecenas placerat lectus lectus, eu \
+      posuere enim feugiat ac. Curabitur aliquet dolor ut vulputate dictum. \
+      Mauris dignissim purus at ipsum fermentum molestie. Proin volutpat \
+      feugiat eleifend. Nam in elit porta, egestas mauris at, imperdiet enim. \
+      Fusce at justo viverra, consequat massa nec, lacinia ligula."
+   ; "Sed at leo in justo imperdiet efficitur a ac nulla. In iaculis sapien in \
+      feugiat imperdiet. Aliquam laoreet, elit eget placerat rutrum, metus \
+      arcu pharetra lacus, nec accumsan massa est quis tortor. Donec molestie \
+      massa a lorem mattis ultrices. Nunc rutrum ac dolor a porta. Donec \
+      luctus lectus tortor, et blandit tortor cursus non. Mauris a nibh nec \
+      augue porta suscipit eget et sem."
+  |]
+
+let () = Random.self_init ()
+
+let lorem () = lorem.(Random.int (Array.length lorem))

src/projects.ml

@@ -0,0 +1,204 @@
+open Tyxml.Html
+open Syntax
+
+type project =
+  { id : string
+  ; title : string
+  ; img_content : string
+  ; img_alt : string
+  ; description : string
+  }
+
+let () =
+  let open Caqti_request.Infix in
+  let open Caqti_type in
+  Result.value_or_fail
+  @@ Db.exec_nolwt (unit ->. unit)
+       "CREATE TABLE IF NOT EXISTS projects (id TEXT, title TEXT, img_content \
+        TEXT, img_alt TEXT, description TEXT)"
+       ()
+
+let load () =
+  let open Caqti_request.Infix in
+  let open Caqti_type in
+  let* projects =
+    Db.collect_list
+      (unit ->* tup4 string string string (tup2 string string))
+      "SELECT id, title, img_content, img_alt, description FROM projects" ()
+  in
+  List.fold_left
+    (fun files (id, title, img_content, (img_alt, description)) ->
+      let* files in
+      Reply.continue
+      @@ ({ id; title; img_content; img_alt; description } :: files) )
+    (Reply.continue []) projects
+
+let get _request =
+  let* projects = load () in
+  let projects =
+    List.map
+      (fun { img_content = _; img_alt; id; title; description } ->
+        let href = Sitemap.projects_one id in
+        (* see https://github.com/ciar4n/imagehover.css *)
+        figure
+          ~a:[ a_class [ "imghvr-fade" ] ]
+          ~figcaption:
+            (`Bottom
+              (figcaption
+                 [ a ~a:[ a_href href ] [ txt title; br (); txt description ] ] )
+              )
+          [ img ~src:(Sitemap.project_img id) ~alt:img_alt () ] )
+      projects
+  in
+  let content = div projects in
+  Reply.page ~title:None ~scripts:[] ~styles:[ "imagehover.css" ] ~h1:"Projets"
+    content
+
+let get_one request =
+  let id = Dream.param request "id" in
+  let* projects = load () in
+  let project = List.find_opt (fun p -> p.id = id) projects in
+  match project with
+  | None -> Reply.not_found ()
+  | Some { title; img_alt; img_content = _; description; _ } ->
+    let content =
+      div
+        [ img ~src:(Sitemap.project_img id) ~alt:img_alt ()
+        ; p [ txt description ]
+        ]
+    in
+    Reply.page ~title:None ~scripts:[] ~styles:[] ~h1:title content
+
+let get_add request =
+  let is_logged_in = (* TODO *) true in
+  if not is_logged_in then Reply.redirect Sitemap.home
+  else
+    let title = Some "Ajout d'un nouveau projet" in
+    let upload_form =
+      let token = Dream.csrf_token request in
+      let token_input =
+        input ~a:[ a_name "dream.csrf"; a_input_type `Hidden; a_value token ] ()
+      in
+      let id_input =
+        input
+          ~a:[ a_id "id"; a_name "id"; a_input_type `Text; a_required () ]
+          ()
+      in
+      let title_input =
+        input
+          ~a:[ a_id "title"; a_name "title"; a_input_type `Text; a_required () ]
+          ()
+      in
+      let img_content_input =
+        input
+          ~a:
+            [ a_id "img_content"
+            ; a_name "img_content"
+            ; a_input_type `File
+            ; a_required ()
+            ]
+          ()
+      in
+      let img_alt_input =
+        input
+          ~a:
+            [ a_id "img_alt"
+            ; a_name "img_alt"
+            ; a_input_type `Text
+            ; a_required ()
+            ]
+          ()
+      in
+      let description_input =
+        textarea
+          ~a:[ a_id "description"; a_name "description"; a_required () ]
+          (txt "")
+      in
+
+      let submit = button ~a:[ a_id "submit" ] [ txt "Go!" ] in
+      let form =
+        form
+          ~a:
+            [ a_action Sitemap.projects_add
+            ; a_method `Post
+            ; a_enctype "multipart/form-data"
+            ]
+          [ token_input
+          ; label
+              ~a:[ a_label_for "id" ]
+              [ (let id_exemple = "super-cafetaria" in
+                 let url_exemple =
+                   Format.sprintf "%s%s" App.hostname
+                     (Sitemap.projects_one id_exemple)
+                 in
+                 txt
+                 @@ Format.sprintf
+                      "L'identifiant du projet. C'est ce qui sera utilisé dans \
+                       l'URL. Par exemple, si tu choisis l'identifiant %s, le \
+                       projet sera accessible à l'adresse %s ; il ne faut \
+                       utiliser que des lettres en minuscules et des tirets \
+                       comme dans l'exemple  :"
+                      id_exemple url_exemple )
+              ]
+          ; id_input
+          ; txt ""
+          ; br ()
+          ; br ()
+          ; label ~a:[ a_label_for "title" ] [ txt "Titre" ]
+          ; title_input
+          ; txt ""
+          ; br ()
+          ; label ~a:[ a_label_for "img_content" ] [ txt "Image source" ]
+          ; img_content_input
+          ; br ()
+          ; label ~a:[ a_label_for "img_alt" ] [ txt "Description de l'image" ]
+          ; img_alt_input
+          ; br ()
+          ; label
+              ~a:[ a_label_for "description" ]
+              [ txt "Description du projet" ]
+          ; description_input
+          ; br ()
+          ; submit
+          ]
+      in
+      div [ form ]
+    in
+    Reply.page ~title ~scripts:[] ~styles:[] ~h1:"Nouveau projet" upload_form
+
+let save_to_db ~id ~title ~img_content ~img_alt ~description =
+  let open Caqti_request.Infix in
+  let open Caqti_type in
+  let q =
+    Db.exec
+      (tup4 string string string (tup2 string string) ->. unit)
+      "INSERT INTO projects VALUES (?, ?, ?, ?, ?)"
+  in
+  q (id, title, img_content, (img_alt, description))
+
+let post_add request =
+  let is_logged_in = (* TODO *) true in
+  if not is_logged_in then Reply.redirect Sitemap.home
+  else
+    match%lwt Dream.multipart request with
+    | `Ok
+        [ ("description", [ (None, description) ])
+        ; ("id", [ (None, id) ])
+        ; ("img_alt", [ (None, img_alt) ])
+        ; ("img_content", [ (_name, img_content) ])
+        ; ("title", [ (None, title) ])
+        ] ->
+      let* () = save_to_db ~id ~title ~img_content ~img_alt ~description in
+      Reply.page ~title:(Some title) ~scripts:[] ~styles:[] ~h1:"AAA"
+        (div [ p [ txt "yeah" ] ])
+    | _form -> Reply.bad_request "invalid form"
+
+let get_img request =
+  let open Caqti_request.Infix in
+  let open Caqti_type in
+  let id = Dream.param request "id" in
+  let* img_content =
+    (Db.find (string ->! string) "SELECT img_content FROM projects WHERE id =?")
+      id
+  in
+  Reply.cache img_content

src/reply.ml

@@ -0,0 +1,39 @@
+type page =
+  { title : string option
+  ; scripts : string list
+  ; styles : string list
+  ; h1 : string
+  ; content : [ `Div ] Tyxml_html.elt
+  }
+
+type t =
+  | Bad_Request of string
+  | Cache of string
+  | Database_error
+  | Not_found
+  | Page of page
+  | Redirect of string
+  | Unauthorized
+
+type 'a control =
+  | Continue of 'a
+  | Stop of t
+
+let continue v = Lwt.return @@ Continue v
+
+let stop v = Lwt.return @@ Stop v
+
+let cache v = stop (Cache v)
+
+let database_error () = stop Database_error
+
+let bad_request msg = stop (Bad_Request msg)
+
+let not_found () = stop Not_found
+
+let redirect url = stop (Redirect url)
+
+let unauthorized () = stop Unauthorized
+
+let page ~title ~scripts ~styles ~h1 content =
+  stop (Page { title; scripts; h1; content; styles })

src/sitemap.ml

@@ -0,0 +1,29 @@
+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
+
+(* TODO: begin tmp *)
+let parvis = img "parvis.png"
+
+let cafetaria = img "cafetaria.png"
+
+let me = img "me.jpeg"
+(* TODO: end tmp *)
+
+let about = "/about"
+
+let contact = "/contact"
+
+let favicon = "/assets/img/favicon.png"
+
+let home = "/"
+
+let projects = "/projects"
+
+let projects_add = "/projects/add"
+
+let projects_one name = Format.sprintf "/projects/%s" name
+
+let project_img id = Format.sprintf "/img/%s" id

src/syntax.ml

@@ -0,0 +1,23 @@
+let ( let* ) o f =
+  match%lwt o with Reply.Continue v -> f v | Stop _ as s -> Lwt.return s
+
+module Result = struct
+  include Result
+
+  let ( let* ) = Result.bind
+
+  let list_map f l =
+    let exception E of string in
+    try
+      Ok
+        (List.map
+           (fun v -> match f v with Error s -> raise (E s) | Ok v -> v)
+           l )
+    with E s -> Error s
+
+  let value_or_fail = function
+    | Error msg ->
+      Dream.error (fun log -> log "error: %s" msg);
+      assert false
+    | Ok v -> v
+end

src/template.ml

@@ -0,0 +1,83 @@
+open Tyxml
+
+let generic _request ~title:title_txt ~scripts ~styles ~h1:h1_txt content =
+  let open Html in
+  let title_txt =
+    Option.fold ~none:"Joanna Barreiro - Architecte"
+      ~some:(Format.sprintf "%s - Joanna Barreiro - Architecte")
+      title_txt
+  in
+  let scripts =
+    List.map
+      (fun s ->
+        script
+          ~a:
+            [ a_mime_type "text/javascript"
+            ; a_src @@ Sitemap.script s
+            ; a_defer ()
+            ]
+          (txt "") )
+      scripts
+  in
+  let styles =
+    List.map
+      (fun s -> link ~rel:[ `Stylesheet ] ~href:(Sitemap.style s) ())
+      ("style.css" :: styles)
+  in
+  let head =
+    head
+      (title (txt title_txt))
+      ([ link ~rel:[ `Icon ] ~href:Sitemap.favicon () ] @ styles @ scripts)
+  in
+  let topbar =
+    nav
+    @@ [ a
+           ~a:[ a_href Sitemap.home ]
+           [ img ~a:[ a_class [ "logo" ] ] ~src:Sitemap.favicon ~alt:"JB" () ]
+       ; a ~a:[ a_href Sitemap.home ] [ txt "Accueil" ]
+       ; txt " | "
+       ; a ~a:[ a_href Sitemap.projects ] [ txt "Projets" ]
+       ; txt " | "
+       ; a ~a:[ a_href Sitemap.about ] [ txt "À propos" ]
+       ; txt " | "
+       ; a ~a:[ a_href Sitemap.contact ] [ txt "Contact" ]
+       ]
+  in
+
+  let page =
+    html head
+      (body
+         [ topbar
+         ; main
+             [ h1 ~a:[ a_class [ "hidden" ] ] [ txt h1_txt ]; div [ content ] ]
+         ] )
+  in
+  Format.asprintf "%a@." (pp ~indent:true ()) page
+
+let render request { Reply.title; scripts; h1; content; styles } =
+  Dream.html @@ generic request ~title ~scripts ~styles ~h1 content
+
+let err request status msg =
+  let code = Dream.status_to_int status in
+  let title = Some "Error" in
+  Dream.html ~code
+  @@ generic request ~title ~scripts:[] ~styles:[] ~h1:"Error" (Html.txt msg)
+
+type empty = |
+
+open Reply
+
+let reply request (v : empty control Lwt.t) =
+  match%lwt v with
+  | Stop v -> (
+    match v with
+    | Cache content ->
+      let headers = [ ("Cache-Control", "max-age=151200") ] in
+      Dream.respond ~status:`OK ~headers content
+    | Redirect url ->
+      Dream.respond ~status:`See_Other ~headers:[ ("Location", url) ] ""
+    | Page p -> render request p
+    | Database_error -> err request `Internal_Server_Error "database error"
+    | Not_found -> err request `Not_Found "not found"
+    | Unauthorized -> err request `Unauthorized "unauthorized"
+    | Bad_Request msg -> err request `Bad_Request msg )