b

.gitignore

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

.ocamlformat

@@ -0,0 +1,42 @@
+version=0.23.0
+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=68
+module-item-spacing=sparse
+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

README.md

@@ -0,0 +1,40 @@
+# pellest
+
+[pellest] is an [OCaml] executable/library to TODO.
+
+## Installation
+
+`pellest` can be installed with [opam]:
+
+```sh
+opam install pellest
+```
+
+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]: ./pellest.opam
+[test suite]: ./test
+
+[documentation]: TODO/pellest
+[how to install opam]: https://opam.ocaml.org/doc/Install.html
+[OCaml]: https://ocaml.org
+[opam]: https://opam.ocaml.org/
+[pellest]: TODO/pellest

doc/dune

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

doc/index.mld

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

dune-project

@@ -0,0 +1,31 @@
+(lang dune 2.9)
+
+(implicit_transitive_deps false)
+
+(name pellest)
+
+(authors "swrup")
+
+(maintainers "swrup@protonmail.com")
+
+(source
+ (uri TODO/pellest))
+
+(homepage TODO/pellest)
+
+(bug_reports TODO/pellest)
+
+(documentation TODO/pellest)
+
+(generate_opam_files true)
+
+(package
+ (name pellest)
+ (synopsis "OCaml library/executable to TODO")
+ (description
+  "pellest is an OCaml library/executable to TODO.")
+ (tags
+  (pellest TODO TODO TODO TODO))
+ (depends
+  (ocaml
+   (>= 4.08))))

example/dune

@@ -0,0 +1,3 @@
+(executable
+ (name main)
+ (modules main))

example/main.ml

@@ -0,0 +1 @@
+let () = Format.printf "TODO@."

pellest.opam

@@ -0,0 +1,32 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "OCaml library/executable to TODO"
+description: "pellest is an OCaml library/executable to TODO."
+maintainer: ["swrup@protonmail.com"]
+authors: ["swrup"]
+tags: ["pellest" "TODO" "TODO" "TODO" "TODO"]
+homepage: "TODO/pellest"
+doc: "TODO/pellest"
+bug-reports: "TODO/pellest"
+depends: [
+  "dune" {>= "2.9"}
+  "ocaml" {>= "4.08"}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "--promote-install-files=false"
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+  ["dune" "install" "-p" name "--create-install-files" name]
+]
+dev-repo: "TODO/pellest"

src/app.ml

@@ -0,0 +1,94 @@
+module App_id = struct
+  let qualifier = "org"
+
+  let organization = "pellest"
+
+  let application = "pellest"
+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
+    failwith
+    @@ Format.sprintf "configuration file `%s` does not exist, please create it"
+         filename;
+  Dream.log "config file: %s" filename;
+  match Scfg.Parse.from_file filename with
+  | Error e -> failwith e
+  | Ok config -> config
+
+let open_registration =
+  match Scfg.Query.get_dir "open_registration" config with
+  | None -> true
+  | Some open_registration -> (
+    match Scfg.Query.get_param 0 open_registration with
+    | Error e -> failwith e
+    | Ok "true" -> true
+    | Ok "false" -> false
+    | Ok _unknown ->
+      failwith "invalid `open_registration` value in configuration file" )
+
+let () = Dream.log "open_registration: %b" open_registration
+
+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 =
+  match Scfg.Query.get_dir "hostname" config with
+  | None -> Format.sprintf "localhost:%d" port
+  | 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 get_dirs name =
+  let dirs = Scfg.Query.get_dirs name config in
+  List.map
+    (fun dir ->
+      Result.fold ~error:failwith ~ok:Fun.id (Scfg.Query.get_param 0 dir) )
+    dirs
+
+let random_state = Random.State.make_self_init ()
+
+let () = Random.set_state random_state
+
+let about =
+  (* TODO read from about.txt *)
+  "This is pellest"

src/content/assets/css/leaflet.css

@@ -0,0 +1,640 @@
+/* required styles */
+
+.leaflet-pane,
+.leaflet-tile,
+.leaflet-marker-icon,
+.leaflet-marker-shadow,
+.leaflet-tile-container,
+.leaflet-pane > svg,
+.leaflet-pane > canvas,
+.leaflet-zoom-box,
+.leaflet-image-layer,
+.leaflet-layer {
+	position: absolute;
+	left: 0;
+	top: 0;
+	}
+.leaflet-container {
+	overflow: hidden;
+	}
+.leaflet-tile,
+.leaflet-marker-icon,
+.leaflet-marker-shadow {
+	-webkit-user-select: none;
+	   -moz-user-select: none;
+	        user-select: none;
+	  -webkit-user-drag: none;
+	}
+/* Prevents IE11 from highlighting tiles in blue */
+.leaflet-tile::selection {
+	background: transparent;
+}
+/* Safari renders non-retina tile on retina better with this, but Chrome is worse */
+.leaflet-safari .leaflet-tile {
+	image-rendering: -webkit-optimize-contrast;
+	}
+/* hack that prevents hw layers "stretching" when loading new tiles */
+.leaflet-safari .leaflet-tile-container {
+	width: 1600px;
+	height: 1600px;
+	-webkit-transform-origin: 0 0;
+	}
+.leaflet-marker-icon,
+.leaflet-marker-shadow {
+	display: block;
+	}
+/* .leaflet-container svg: reset svg max-width decleration shipped in Joomla! (joomla.org) 3.x */
+/* .leaflet-container img: map is broken in FF if you have max-width: 100% on tiles */
+.leaflet-container .leaflet-overlay-pane svg,
+.leaflet-container .leaflet-marker-pane img,
+.leaflet-container .leaflet-shadow-pane img,
+.leaflet-container .leaflet-tile-pane img,
+.leaflet-container img.leaflet-image-layer,
+.leaflet-container .leaflet-tile {
+	max-width: none !important;
+	max-height: none !important;
+	}
+
+.leaflet-container.leaflet-touch-zoom {
+	-ms-touch-action: pan-x pan-y;
+	touch-action: pan-x pan-y;
+	}
+.leaflet-container.leaflet-touch-drag {
+	-ms-touch-action: pinch-zoom;
+	/* Fallback for FF which doesn't support pinch-zoom */
+	touch-action: none;
+	touch-action: pinch-zoom;
+}
+.leaflet-container.leaflet-touch-drag.leaflet-touch-zoom {
+	-ms-touch-action: none;
+	touch-action: none;
+}
+.leaflet-container {
+	-webkit-tap-highlight-color: transparent;
+}
+.leaflet-container a {
+	-webkit-tap-highlight-color: rgba(51, 181, 229, 0.4);
+}
+.leaflet-tile {
+	filter: inherit;
+	visibility: hidden;
+	}
+.leaflet-tile-loaded {
+	visibility: inherit;
+	}
+.leaflet-zoom-box {
+	width: 0;
+	height: 0;
+	-moz-box-sizing: border-box;
+	     box-sizing: border-box;
+	z-index: 800;
+	}
+/* workaround for https://bugzilla.mozilla.org/show_bug.cgi?id=888319 */
+.leaflet-overlay-pane svg {
+	-moz-user-select: none;
+	}
+
+.leaflet-pane         { z-index: 400; }
+
+.leaflet-tile-pane    { z-index: 200; }
+.leaflet-overlay-pane { z-index: 400; }
+.leaflet-shadow-pane  { z-index: 500; }
+.leaflet-marker-pane  { z-index: 600; }
+.leaflet-tooltip-pane   { z-index: 650; }
+.leaflet-popup-pane   { z-index: 700; }
+
+.leaflet-map-pane canvas { z-index: 100; }
+.leaflet-map-pane svg    { z-index: 200; }
+
+.leaflet-vml-shape {
+	width: 1px;
+	height: 1px;
+	}
+.lvml {
+	behavior: url(#default#VML);
+	display: inline-block;
+	position: absolute;
+	}
+
+
+/* control positioning */
+
+.leaflet-control {
+	position: relative;
+	z-index: 800;
+	pointer-events: visiblePainted; /* IE 9-10 doesn't have auto */
+	pointer-events: auto;
+	}
+.leaflet-top,
+.leaflet-bottom {
+	position: absolute;
+	z-index: 1000;
+	pointer-events: none;
+	}
+.leaflet-top {
+	top: 0;
+	}
+.leaflet-right {
+	right: 0;
+	}
+.leaflet-bottom {
+	bottom: 0;
+	}
+.leaflet-left {
+	left: 0;
+	}
+.leaflet-control {
+	float: left;
+	clear: both;
+	}
+.leaflet-right .leaflet-control {
+	float: right;
+	}
+.leaflet-top .leaflet-control {
+	margin-top: 10px;
+	}
+.leaflet-bottom .leaflet-control {
+	margin-bottom: 10px;
+	}
+.leaflet-left .leaflet-control {
+	margin-left: 10px;
+	}
+.leaflet-right .leaflet-control {
+	margin-right: 10px;
+	}
+
+
+/* zoom and fade animations */
+
+.leaflet-fade-anim .leaflet-tile {
+	will-change: opacity;
+	}
+.leaflet-fade-anim .leaflet-popup {
+	opacity: 0;
+	-webkit-transition: opacity 0.2s linear;
+	   -moz-transition: opacity 0.2s linear;
+	        transition: opacity 0.2s linear;
+	}
+.leaflet-fade-anim .leaflet-map-pane .leaflet-popup {
+	opacity: 1;
+	}
+.leaflet-zoom-animated {
+	-webkit-transform-origin: 0 0;
+	    -ms-transform-origin: 0 0;
+	        transform-origin: 0 0;
+	}
+.leaflet-zoom-anim .leaflet-zoom-animated {
+	will-change: transform;
+	}
+.leaflet-zoom-anim .leaflet-zoom-animated {
+	-webkit-transition: -webkit-transform 0.25s cubic-bezier(0,0,0.25,1);
+	   -moz-transition:    -moz-transform 0.25s cubic-bezier(0,0,0.25,1);
+	        transition:         transform 0.25s cubic-bezier(0,0,0.25,1);
+	}
+.leaflet-zoom-anim .leaflet-tile,
+.leaflet-pan-anim .leaflet-tile {
+	-webkit-transition: none;
+	   -moz-transition: none;
+	        transition: none;
+	}
+
+.leaflet-zoom-anim .leaflet-zoom-hide {
+	visibility: hidden;
+	}
+
+
+/* cursors */
+
+.leaflet-interactive {
+	cursor: pointer;
+	}
+.leaflet-grab {
+	cursor: -webkit-grab;
+	cursor:    -moz-grab;
+	cursor:         grab;
+	}
+.leaflet-crosshair,
+.leaflet-crosshair .leaflet-interactive {
+	cursor: crosshair;
+	}
+.leaflet-popup-pane,
+.leaflet-control {
+	cursor: auto;
+	}
+.leaflet-dragging .leaflet-grab,
+.leaflet-dragging .leaflet-grab .leaflet-interactive,
+.leaflet-dragging .leaflet-marker-draggable {
+	cursor: move;
+	cursor: -webkit-grabbing;
+	cursor:    -moz-grabbing;
+	cursor:         grabbing;
+	}
+
+/* marker & overlays interactivity */
+.leaflet-marker-icon,
+.leaflet-marker-shadow,
+.leaflet-image-layer,
+.leaflet-pane > svg path,
+.leaflet-tile-container {
+	pointer-events: none;
+	}
+
+.leaflet-marker-icon.leaflet-interactive,
+.leaflet-image-layer.leaflet-interactive,
+.leaflet-pane > svg path.leaflet-interactive,
+svg.leaflet-image-layer.leaflet-interactive path {
+	pointer-events: visiblePainted; /* IE 9-10 doesn't have auto */
+	pointer-events: auto;
+	}
+
+/* visual tweaks */
+
+.leaflet-container {
+	background: #ddd;
+	outline: 0;
+	}
+.leaflet-container a {
+	color: #0078A8;
+	}
+.leaflet-container a.leaflet-active {
+	outline: 2px solid orange;
+	}
+.leaflet-zoom-box {
+	border: 2px dotted #38f;
+	background: rgba(255,255,255,0.5);
+	}
+
+
+/* general typography */
+.leaflet-container {
+	font: 12px/1.5 "Helvetica Neue", Arial, Helvetica, sans-serif;
+	}
+
+
+/* general toolbar styles */
+
+.leaflet-bar {
+	box-shadow: 0 1px 5px rgba(0,0,0,0.65);
+	border-radius: 4px;
+	}
+.leaflet-bar a,
+.leaflet-bar a:hover {
+	background-color: #fff;
+	border-bottom: 1px solid #ccc;
+	width: 26px;
+	height: 26px;
+	line-height: 26px;
+	display: block;
+	text-align: center;
+	text-decoration: none;
+	color: black;
+	}
+.leaflet-bar a,
+.leaflet-control-layers-toggle {
+	background-position: 50% 50%;
+	background-repeat: no-repeat;
+	display: block;
+	}
+.leaflet-bar a:hover {
+	background-color: #f4f4f4;
+	}
+.leaflet-bar a:first-child {
+	border-top-left-radius: 4px;
+	border-top-right-radius: 4px;
+	}
+.leaflet-bar a:last-child {
+	border-bottom-left-radius: 4px;
+	border-bottom-right-radius: 4px;
+	border-bottom: none;
+	}
+.leaflet-bar a.leaflet-disabled {
+	cursor: default;
+	background-color: #f4f4f4;
+	color: #bbb;
+	}
+
+.leaflet-touch .leaflet-bar a {
+	width: 30px;
+	height: 30px;
+	line-height: 30px;
+	}
+.leaflet-touch .leaflet-bar a:first-child {
+	border-top-left-radius: 2px;
+	border-top-right-radius: 2px;
+	}
+.leaflet-touch .leaflet-bar a:last-child {
+	border-bottom-left-radius: 2px;
+	border-bottom-right-radius: 2px;
+	}
+
+/* zoom control */
+
+.leaflet-control-zoom-in,
+.leaflet-control-zoom-out {
+	font: bold 18px 'Lucida Console', Monaco, monospace;
+	text-indent: 1px;
+	}
+
+.leaflet-touch .leaflet-control-zoom-in, .leaflet-touch .leaflet-control-zoom-out  {
+	font-size: 22px;
+	}
+
+
+/* layers control */
+
+.leaflet-control-layers {
+	box-shadow: 0 1px 5px rgba(0,0,0,0.4);
+	background: #fff;
+	border-radius: 5px;
+	}
+.leaflet-control-layers-toggle {
+	background-image: url(/assets/img/layers.png);
+	width: 36px;
+	height: 36px;
+	}
+.leaflet-retina .leaflet-control-layers-toggle {
+	background-image: url(/assets/img/layers-2x.png);
+	background-size: 26px 26px;
+	}
+.leaflet-touch .leaflet-control-layers-toggle {
+	width: 44px;
+	height: 44px;
+	}
+.leaflet-control-layers .leaflet-control-layers-list,
+.leaflet-control-layers-expanded .leaflet-control-layers-toggle {
+	display: none;
+	}
+.leaflet-control-layers-expanded .leaflet-control-layers-list {
+	display: block;
+	position: relative;
+	}
+.leaflet-control-layers-expanded {
+	padding: 6px 10px 6px 6px;
+	color: #333;
+	background: #fff;
+	}
+.leaflet-control-layers-scrollbar {
+	overflow-y: scroll;
+	overflow-x: hidden;
+	padding-right: 5px;
+	}
+.leaflet-control-layers-selector {
+	margin-top: 2px;
+	position: relative;
+	top: 1px;
+	}
+.leaflet-control-layers label {
+	display: block;
+	}
+.leaflet-control-layers-separator {
+	height: 0;
+	border-top: 1px solid #ddd;
+	margin: 5px -10px 5px -6px;
+	}
+
+/* Default icon URLs */
+.leaflet-default-icon-path {
+	background-image: url(/assets/img/marker-icon.png);
+	}
+
+
+/* attribution and scale controls */
+
+.leaflet-container .leaflet-control-attribution {
+	background: #fff;
+	background: rgba(255, 255, 255, 0.7);
+	margin: 0;
+	}
+.leaflet-control-attribution,
+.leaflet-control-scale-line {
+	padding: 0 5px;
+	color: #333;
+	}
+.leaflet-control-attribution a {
+	text-decoration: none;
+	}
+.leaflet-control-attribution a:hover {
+	text-decoration: underline;
+	}
+.leaflet-container .leaflet-control-attribution,
+.leaflet-container .leaflet-control-scale {
+	font-size: 11px;
+	}
+.leaflet-left .leaflet-control-scale {
+	margin-left: 5px;
+	}
+.leaflet-bottom .leaflet-control-scale {
+	margin-bottom: 5px;
+	}
+.leaflet-control-scale-line {
+	border: 2px solid #777;
+	border-top: none;
+	line-height: 1.1;
+	padding: 2px 5px 1px;
+	font-size: 11px;
+	white-space: nowrap;
+	overflow: hidden;
+	-moz-box-sizing: border-box;
+	     box-sizing: border-box;
+
+	background: #fff;
+	background: rgba(255, 255, 255, 0.5);
+	}
+.leaflet-control-scale-line:not(:first-child) {
+	border-top: 2px solid #777;
+	border-bottom: none;
+	margin-top: -2px;
+	}
+.leaflet-control-scale-line:not(:first-child):not(:last-child) {
+	border-bottom: 2px solid #777;
+	}
+
+.leaflet-touch .leaflet-control-attribution,
+.leaflet-touch .leaflet-control-layers,
+.leaflet-touch .leaflet-bar {
+	box-shadow: none;
+	}
+.leaflet-touch .leaflet-control-layers,
+.leaflet-touch .leaflet-bar {
+	border: 2px solid rgba(0,0,0,0.2);
+	background-clip: padding-box;
+	}
+
+
+/* popup */
+
+.leaflet-popup {
+	position: absolute;
+	text-align: center;
+	margin-bottom: 20px;
+	}
+.leaflet-popup-content-wrapper {
+	padding: 1px;
+	text-align: left;
+	border-radius: 12px;
+	}
+.leaflet-popup-content {
+	margin: 13px 19px;
+	line-height: 1.4;
+	}
+.leaflet-popup-content p {
+	margin: 18px 0;
+	}
+.leaflet-popup-tip-container {
+	width: 40px;
+	height: 20px;
+	position: absolute;
+	left: 50%;
+	margin-left: -20px;
+	overflow: hidden;
+	pointer-events: none;
+	}
+.leaflet-popup-tip {
+	width: 17px;
+	height: 17px;
+	padding: 1px;
+
+	margin: -10px auto 0;
+
+	-webkit-transform: rotate(45deg);
+	   -moz-transform: rotate(45deg);
+	    -ms-transform: rotate(45deg);
+	        transform: rotate(45deg);
+	}
+.leaflet-popup-content-wrapper,
+.leaflet-popup-tip {
+	background: white;
+	color: #333;
+	box-shadow: 0 3px 14px rgba(0,0,0,0.4);
+	}
+.leaflet-container a.leaflet-popup-close-button {
+	position: absolute;
+	top: 0;
+	right: 0;
+	padding: 4px 4px 0 0;
+	border: none;
+	text-align: center;
+	width: 18px;
+	height: 14px;
+	font: 16px/14px Tahoma, Verdana, sans-serif;
+	color: #c3c3c3;
+	text-decoration: none;
+	font-weight: bold;
+	background: transparent;
+	}
+.leaflet-container a.leaflet-popup-close-button:hover {
+	color: #999;
+	}
+.leaflet-popup-scrolled {
+	overflow: auto;
+	border-bottom: 1px solid #ddd;
+	border-top: 1px solid #ddd;
+	}
+
+.leaflet-oldie .leaflet-popup-content-wrapper {
+	-ms-zoom: 1;
+	}
+.leaflet-oldie .leaflet-popup-tip {
+	width: 24px;
+	margin: 0 auto;
+
+	-ms-filter: "progid:DXImageTransform.Microsoft.Matrix(M11=0.70710678, M12=0.70710678, M21=-0.70710678, M22=0.70710678)";
+	filter: progid:DXImageTransform.Microsoft.Matrix(M11=0.70710678, M12=0.70710678, M21=-0.70710678, M22=0.70710678);
+	}
+.leaflet-oldie .leaflet-popup-tip-container {
+	margin-top: -1px;
+	}
+
+.leaflet-oldie .leaflet-control-zoom,
+.leaflet-oldie .leaflet-control-layers,
+.leaflet-oldie .leaflet-popup-content-wrapper,
+.leaflet-oldie .leaflet-popup-tip {
+	border: 1px solid #999;
+	}
+
+
+/* div icon */
+
+.leaflet-div-icon {
+	background: #fff;
+	border: 1px solid #666;
+	}
+
+
+/* Tooltip */
+/* Base styles for the element that has a tooltip */
+.leaflet-tooltip {
+	position: absolute;
+	padding: 6px;
+	background-color: #fff;
+	border: 1px solid #fff;
+	border-radius: 3px;
+	color: #222;
+	white-space: nowrap;
+	-webkit-user-select: none;
+	-moz-user-select: none;
+	-ms-user-select: none;
+	user-select: none;
+	pointer-events: none;
+	box-shadow: 0 1px 3px rgba(0,0,0,0.4);
+	}
+.leaflet-tooltip.leaflet-clickable {
+	cursor: pointer;
+	pointer-events: auto;
+	}
+.leaflet-tooltip-top:before,
+.leaflet-tooltip-bottom:before,
+.leaflet-tooltip-left:before,
+.leaflet-tooltip-right:before {
+	position: absolute;
+	pointer-events: none;
+	border: 6px solid transparent;
+	background: transparent;
+	content: "";
+	}
+
+/* Directions */
+
+.leaflet-tooltip-bottom {
+	margin-top: 6px;
+}
+.leaflet-tooltip-top {
+	margin-top: -6px;
+}
+.leaflet-tooltip-bottom:before,
+.leaflet-tooltip-top:before {
+	left: 50%;
+	margin-left: -6px;
+	}
+.leaflet-tooltip-top:before {
+	bottom: 0;
+	margin-bottom: -12px;
+	border-top-color: #fff;
+	}
+.leaflet-tooltip-bottom:before {
+	top: 0;
+	margin-top: -12px;
+	margin-left: -6px;
+	border-bottom-color: #fff;
+	}
+.leaflet-tooltip-left {
+	margin-left: -6px;
+}
+.leaflet-tooltip-right {
+	margin-left: 6px;
+}
+.leaflet-tooltip-left:before,
+.leaflet-tooltip-right:before {
+	top: 50%;
+	margin-top: -6px;
+	}
+.leaflet-tooltip-left:before {
+	right: 0;
+	margin-right: -12px;
+	border-left-color: #fff;
+	}
+.leaflet-tooltip-right:before {
+	left: 0;
+	margin-left: -12px;
+	border-right-color: #fff;
+	}

src/content/assets/css/style.css

@@ -0,0 +1,21 @@
+html {
+  height: 100%;
+}
+
+body {
+  height: 100%;
+  padding-top: 0rem;
+  color: #5a5a5a;
+  background-color: #e8eaf6;
+  line-height: 1.6;
+  font-size: 18px;
+}
+
+#page-title {
+  text-align: center;
+}
+
+main {
+  height: 100%;
+  width: 100%;
+}

src/content/assets/js/dune

@@ -0,0 +1,8 @@
+(rule
+ (target client.js)
+ (deps
+  (file ../../../js/client.bc.js))
+ (action
+  (with-stdout-to
+   %{target}
+   (cat ../../../js/client.bc.js))))

src/db.ml

@@ -0,0 +1,48 @@
+open Caqti_request.Infix
+
+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.warning (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 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 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 ->
+    Format.eprintf "db error@\n";
+    exit 1
+
+let unwrap_err = function
+  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
+  | Ok _ as ok -> ok
+
+let exec q v = Db.exec q v |> unwrap_err
+
+let find q v = Db.find q v |> unwrap_err
+
+let find_opt q v = Db.find_opt q v |> unwrap_err
+
+let collect_list q v = Db.collect_list q v |> unwrap_err

src/dune

@@ -0,0 +1,45 @@
+(executable
+ (name pellest)
+ (modules
+  app
+  content
+  pellest
+  util
+  template
+  home
+  register
+  login
+  user
+  syntax
+  db
+  tyx_util)
+ (libraries
+  uuidm
+  bos
+  caqti
+  caqti.blocking
+  caqti-driver-sqlite3
+  directories
+  dream
+  emile
+  fpath
+  lambdasoup
+  lwt
+  safepass
+  scfg
+  uri
+  tyxml
+  tyxml.functor
+  yojson)
+ (preprocess
+  (pps lwt_ppx)))
+
+(rule
+ (target content.ml)
+ (deps
+  (source_tree content)
+  (file content/assets/js/client.js))
+ (action
+  (with-stdout-to
+   %{null}
+   (run ocaml-crunch -m plain content -o %{target}))))

src/home.ml

@@ -0,0 +1,11 @@
+open Tyxml.Html
+
+let f _request =
+  let page_title = "Pellest is the best game ever!" in
+  let about = div [ txt App.about ] in
+  let link_to_register =
+    div [ a ~a:[ a_href "/register" ] [ txt "Register" ] ]
+  in
+  let link_to_login = div [ a ~a:[ a_href "/login" ] [ txt "Login" ] ] in
+  let page = div [ about; link_to_login; link_to_register ] in
+  Template.render ~page_title ~scripts:[] page

src/js/dune

@@ -0,0 +1,10 @@
+(executable
+ (name client)
+ (modules client)
+ (libraries brr utils)
+ (modes js))
+
+(library
+ (name utils)
+ (modules utils)
+ (libraries brr))

src/js/geo.ml

@@ -0,0 +1,97 @@
+open Utils
+open Leaflet
+
+let map =
+  let options = Jv.obj [| ("zoomControl", Jv.of_bool false) |] in
+  Map.create_on ~options "map"
+
+let () =
+  let osm_layer = Layer.create_tile_osm None in
+  Layer.add_to map osm_layer
+
+let storage = Brr_io.Storage.local Brr.G.window
+
+let save_view () =
+  let latlng = Map.get_center map in
+  let zoom = Map.get_zoom map |> Jstr.of_int in
+  let lat = Latlng.lat latlng |> Jstr.of_float in
+  let lng = Latlng.lng latlng |> Jstr.of_float in
+  match Brr_io.Storage.set_item storage (Jstr.v "lat") lat with
+  | (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage"
+  | Ok () -> (
+    match Brr_io.Storage.set_item storage (Jstr.v "lng") lng with
+    | (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage"
+    | Ok () -> (
+      match Brr_io.Storage.set_item storage (Jstr.v "zoom") zoom with
+      | (exception Jv.Error _) | Error _ -> failwith "can't set zoom storage"
+      | Ok () -> () ) )
+
+(* wrap Leaflet.Map.set_view to save last position to storage *)
+let set_view latlng ~zoom =
+  log "set view wrapper@\n";
+  (*we need to wrap coordinates so we don't drift into a parralel universe and lose track of markers :^) *)
+  (* todo: use `worldCopyJump` option on map creation *)
+  let wrapped_latlng = Map.wrap_latlng latlng map in
+  Map.set_view wrapped_latlng ~zoom map;
+  save_view ()
+
+(* set map's view *)
+(* try to set map's view to last position viewed by using web storage *)
+let () =
+  log "setting view@\n";
+  let lat = Brr_io.Storage.get_item storage (Jstr.v "lat") in
+  let lng = Brr_io.Storage.get_item storage (Jstr.v "lng") in
+  let zoom = Brr_io.Storage.get_item storage (Jstr.v "zoom") in
+  match (lat, lng, zoom) with
+  | Some lat, Some lng, Some zoom ->
+    let lat = Jstr.to_float lat in
+    let lng = Jstr.to_float lng in
+    let zoom =
+      match Jstr.to_int zoom with
+      | None -> failwith "view storage bug"
+      | Some zoom -> Some zoom
+    in
+    let latlng = Latlng.create lat lng in
+    set_view latlng ~zoom
+  | _ ->
+    let latlng = Latlng.create 51.505 (-0.09) in
+    set_view latlng ~zoom:(Some 13)
+
+let () =
+  log "add on (move/zoom)end event@\n";
+  let on_moveend _event =
+    log "on moveend event@\n";
+    save_view ()
+  in
+  let on_zoomend _event =
+    log "on zoomend event@\n";
+    save_view ()
+  in
+  Map.on Event.Move_end on_moveend map;
+  Map.on Event.Zoom_end on_zoomend map
+
+let watch_geolocation f =
+  let open Brr_io.Geolocation in
+  log "geolocalize@\n";
+
+  let update_location geo =
+    log "update_location@\n";
+    match geo with
+    | Error e ->
+      (* todo: popup error message for user *)
+      log "geolocation failure: %s@\n" @@ Jstr.to_string @@ Error.message e
+    | Ok geo ->
+      (* monitors geolocation update with f *)
+      f geo;
+      (* set view *)
+      let lat = Pos.latitude geo in
+      let lng = Pos.longitude geo in
+      let latlng = Latlng.create lat lng in
+      set_view latlng ~zoom:None
+    (* TODO update/make camel marker on the map *)
+  in
+
+  (* watch l ~opts f monitors the position of l determined with opts by periodically calling f. Stop watching by calling unwatch with the returned identifier. *)
+  let l = of_navigator Brr.G.navigator in
+  let opts = opts ~high_accuracy:true () in
+  watch l ~opts update_location

src/js/utils.ml

@@ -0,0 +1,14 @@
+open Brr
+
+let log = Format.printf
+
+let find_by_id_opt id = Document.find_el_by_id G.document (Jstr.of_string id)
+
+let find_by_id id =
+  match find_by_id_opt id with
+  | None -> failwith (Format.sprintf "element `%s` not found" id)
+  | Some el -> el
+
+let add_event_to_class event name handler =
+  let el_list = El.find_by_class (Jstr.of_string name) in
+  List.iter (fun el -> Ev.listen event (handler el) (El.as_target el)) el_list

src/login.ml

@@ -0,0 +1,16 @@
+open Tyxml.Html
+open Tyx_util
+
+let f request =
+  (* todo page titles? *)
+  let page_title = "Pellest|Login" in
+  let login =
+    let submit = button ~a:[ a_id "submit_login" ] [ txt "submit" ] in
+    let login = make_input_text "login" in
+    let password = make_input_text "password" in
+    div
+      [ make_form request ~action:"/login" ~items:[ login; password; submit ] ]
+  in
+  let text = div [ txt "login ~!" ] in
+  let page = div [ text; login ] in
+  Template.render ~page_title ~scripts:[] page

src/pellest.ml

@@ -0,0 +1,52 @@
+open Util
+
+let home_get request = Home.f request |> Dream.html
+
+let register_get request = Register.f request |> Dream.html
+
+let login_get request = Login.f request |> Dream.html
+
+let login_post request =
+  match%lwt Dream.form request with
+  | `Ok [ ("login", login); ("password", password) ] -> (
+    match User.login ~login ~password request with
+    | Error e -> render e
+    | Ok () ->
+      let url =
+        match Dream.query request "redirect" with
+        | None -> "/"
+        | Some redirect -> Dream.from_percent_encoded redirect
+      in
+      Dream.respond ~status:`See_Other
+        ~headers:[ ("Location", url) ]
+        "Logged in: Happy geo-posting!" )
+  | form -> handle_invalid_form form
+
+let register_post request =
+  match%lwt Dream.form request with
+  | `Ok [ ("email", email); ("nick", nick); ("password", password) ] -> (
+    match User.register ~email ~nick ~password with
+    | Error e -> render e
+    | Ok () ->
+      let res =
+        Result.fold ~error:Fun.id
+          ~ok:(fun _ -> "User created ! Welcome !")
+          (User.login ~login:nick ~password request)
+      in
+      render res )
+  | form -> Util.handle_invalid_form form
+
+let () =
+  let logger = if App.log then Dream.logger else Fun.id in
+  Dream.run ~port:App.port
+    ~error_handler:(Dream.error_template Util.error_template)
+  @@ logger @@ Dream.memory_sessions
+  @@ Dream.router
+       Dream.
+         [ get "/assets/**" (Dream.static ~loader:Util.asset_loader "")
+         ; get "/" home_get
+         ; get "/login" login_get
+         ; post "/login" login_post
+         ; get "/register" register_get
+         ; post "/register" register_post
+         ]

src/register.ml

@@ -0,0 +1,19 @@
+open Tyxml.Html
+open Tyx_util
+
+let f request =
+  (* todo page titles? *)
+  let page_title = "Pellest|Register" in
+  let register =
+    let submit = button ~a:[ a_id "submet_reginster" ] [ txt "submit" ] in
+    let nick = make_input_text "nick" in
+    let password = make_input_text "password" in
+    let email = make_input_text "email" in
+    div
+      [ make_form request ~action:"/register"
+          ~items:[ nick; password; email; submit ]
+      ]
+  in
+  let text = div [ txt "register a new pellestian ~!" ] in
+  let page = div [ text; register ] in
+  Template.render ~page_title ~scripts:[] page

src/syntax.ml

@@ -0,0 +1,12 @@
+(* let bindings for early return when encountering an error *)
+(* see https://ocaml.org/releases/4.13/htmlman/bindingops.html *)
+
+let ( let* ) o f = Result.fold ~ok:f ~error:Result.error o
+
+let unwrap_list f ids =
+  let l = List.map f ids in
+  let res = List.find_opt Result.is_error l in
+  match res with
+  | None -> Ok (List.map Result.get_ok l)
+  | Some (Ok _) -> assert false
+  | Some (Error _e as error) -> error

src/template.ml

@@ -0,0 +1,15 @@
+open Tyxml
+
+let render ~page_title ~scripts content =
+  let open Html in
+  let head =
+    head
+      (title (txt page_title))
+      ( [ link ~rel:[ `Icon ] ~href:"/assets/img/favicon.png" ()
+        ; link ~rel:[ `Stylesheet ] ~href:"/assets/css/style.css" ()
+        ]
+      @ scripts )
+  in
+  let body = body [ main [ content ] ] in
+  let page = html head body in
+  Format.asprintf "%a@." (pp ~indent:true ()) page

src/tyx_util.ml

@@ -0,0 +1,7 @@
+open Tyxml.Html
+
+let make_input_text id = input ~a:[ a_id id; a_name id; a_input_type `Text ] ()
+
+let make_form request ~action ~items =
+  (* TODO labels ...? *)
+  form ~a:[ a_action action; a_method `Post ] (Util.csrf_tag request :: items)

src/user.ml

@@ -0,0 +1,213 @@
+open Syntax
+open Caqti_request.Infix
+open Caqti_type
+
+type t =
+  { user_id : string
+  ; nick : string
+  ; password : string
+  ; email : string
+  }
+
+let () =
+  let tables =
+    [| (unit ->. unit)
+         "CREATE TABLE IF NOT EXISTS user (user_id TEXT, nick TEXT, password \
+          TEXT, email TEXT, PRIMARY KEY(user_id))"
+     ; (unit ->. unit)
+         "CREATE TABLE IF NOT EXISTS banished (nick TEXT, email TEXT)"
+    |]
+  in
+  if
+    Array.exists Result.is_error
+      (Array.map (fun query -> Db.exec query ()) tables)
+  then Dream.error (fun log -> log "can't create user tables")
+
+module Q = struct
+  let get_user_id_from_email =
+    Db.find @@ (string ->! string) "SELECT user_id FROM user WHERE email=?"
+
+  let get_password =
+    Db.find @@ (string ->! string) "SELECT password FROM user WHERE user_id=?"
+
+  let is_already_user =
+    Db.find
+    @@ (tup2 string string ->! int)
+         "SELECT EXISTS(SELECT 1 FROM user WHERE nick=? OR email=?)"
+
+  let upload_user =
+    Db.exec
+    @@ (tup4 string string string string ->. unit)
+         "INSERT INTO user VALUES (?, ?, ?, ?)"
+
+  let list_nicks = Db.collect_list @@ (unit ->* string) "SELECT nick FROM user"
+
+  let get_user =
+    Db.find
+    @@ (string ->! tup4 string string string string)
+         "SELECT * FROM user WHERE user_id=?"
+
+  let update_bio =
+    Db.exec
+    @@ (tup2 string string ->. unit) "UPDATE user SET bio=? WHERE user_id=?"
+
+  let update_nick =
+    Db.exec
+    @@ (tup2 string string ->. unit) "UPDATE user SET nick=? WHERE user_id=?"
+
+  let update_email =
+    Db.exec
+    @@ (tup2 string string ->. unit) "UPDATE user SET email=? WHERE user_id=?"
+
+  let update_password =
+    Db.exec
+    @@ (tup2 string string ->. unit)
+         "UPDATE user SET password=? WHERE user_id=?"
+
+  let get_email =
+    Db.find @@ (string ->! string) "SELECT email FROM user WHERE user_id=?"
+
+  let delete_user =
+    Db.exec @@ (string ->. unit) "DELETE FROM user WHERE user_id=?"
+
+  let upload_banished =
+    Db.exec @@ (tup2 string string ->. unit) "INSERT INTO banished VALUES (?,?)"
+
+  let get_banished =
+    Db.find
+    @@ (tup2 string string ->! tup2 string string)
+         "SELECT * FROM banished WHERE nick=? OR email=?"
+end
+
+let get_nick =
+  Db.find @@ (string ->! string) "SELECT nick FROM user WHERE user_id=?"
+
+let get_id_from_nick =
+  Db.find @@ (string ->! string) "SELECT user_id FROM user WHERE nick=?"
+
+let exist id = Result.is_ok (Q.get_user id)
+
+let exist_nick nick = Result.is_ok (get_id_from_nick nick)
+
+let exist_email email = Result.is_ok (Q.get_user_id_from_email email)
+
+let get_user user_id =
+  let* user_id, nick, password, email = Q.get_user user_id in
+  Ok { user_id; nick; password; email }
+
+let is_banished login = Result.is_ok (Q.get_banished (login, login))
+
+let login ~login ~password request =
+  let login = String.trim login in
+  let try_password user_id =
+    let* good_password = Q.get_password user_id in
+    if Bcrypt.verify password (Bcrypt.hash_of_string good_password) then
+      let _unit_lwt = Dream.invalidate_session request in
+      let _unit_lwt = Dream.put_session "user_id" user_id request in
+      let* nick = get_nick user_id in
+      let _unit_lwt = Dream.put_session "nick" nick request in
+      Ok ()
+    else if is_banished login then Error "YOU ARE BANISHED"
+    else Error "wrong password"
+  in
+
+  let id_from_nick = get_id_from_nick login in
+  let id_from_email = Q.get_user_id_from_email login in
+  let user_id_list =
+    List.filter_map Result.to_option [ id_from_nick; id_from_email ]
+  in
+  try
+    List.iter
+      (fun id -> if Result.is_ok @@ try_password id then raise Exit)
+      user_id_list;
+    Error "invalid login"
+  with Exit -> Ok ()
+
+let valid_nick nick =
+  String.length nick < 64
+  && String.length nick > 0
+  && Dream.html_escape nick = nick
+
+let valid_password password =
+  String.length password < 128 && String.length password > 0
+
+let valid_email email = Result.is_ok @@ Emile.of_string email
+
+let register ~email ~nick ~password =
+  let email = String.trim email in
+  let nick = String.trim nick in
+  let valid = valid_nick nick && valid_email email && valid_password password in
+
+  let password = Bcrypt.hash password in
+  let password = Bcrypt.string_of_hash password in
+
+  if not valid then Error "Something is wrong"
+  else
+    let* nb = Q.is_already_user (nick, email) in
+    if nb = 0 then
+      let user_id = Uuidm.to_string (Uuidm.v4_gen App.random_state ()) in
+      Q.upload_user (user_id, nick, password, email)
+    else Error "nick or email already exists"
+
+let list () =
+  let* users = Q.list_nicks () in
+  Ok
+    (Format.asprintf "<ul>%a</ul>"
+       (Format.pp_print_list (fun fmt -> function
+          | s -> Format.fprintf fmt {|<li><a href="/user/%s">%s</a></li>|} s s )
+       )
+       users )
+
+let profile request =
+  match Dream.session "nick" request with
+  | None -> "not logged in"
+  | Some nick -> Format.sprintf "Hello %s !" nick
+
+let banish user_id =
+  let* nick = get_nick user_id in
+  let* email = Q.get_email user_id in
+  let* () = Q.delete_user user_id in
+  Q.upload_banished (nick, email)
+
+let delete_user user_id = Q.delete_user user_id
+
+let update_nick nick user_id =
+  if valid_nick nick then
+    if not (exist_nick nick) then Q.update_nick (nick, user_id)
+    else Error "nick already taken"
+  else Error "invalid nick"
+
+let update_email email user_id =
+  if valid_email email then
+    if not (exist_email email) then Q.update_email (email, user_id)
+    else Error "email already taken"
+  else Error "invalid email"
+
+let update_password password user_id =
+  if valid_password password then
+    let password = Bcrypt.hash password |> Bcrypt.string_of_hash in
+    Q.update_password (password, user_id)
+  else Error "invalid password"
+
+let public_profile user_id =
+  let* user = get_user user_id in
+  let user_info =
+    Format.asprintf
+      {|
+    <h1>%s</h1>
+    <br />
+    <div class="row">
+      <div class="col-md-6">
+        <blockquote>%s</blockquote>
+      </div>
+      <div class="col-md-6">
+        <img src="/user/%s/avatar" class="img-thumbnail" alt="Your avatar picture">
+      </div>
+      <div class="col-md-6">
+        %a
+      </div>
+    </div>
+|}
+      user.nick user.nick
+  in
+  Ok user_info

src/util.ml

@@ -0,0 +1,34 @@
+let handle_invalid_form = function
+  | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form"
+  | `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Wrong_session _
+  | `Expired _ | `Wrong_content_type ->
+    Dream.empty `Bad_Request
+
+let asset_loader _root path _request =
+  match Content.read ("assets/" ^ path) with
+  | None -> Dream.empty `Not_Found
+  | Some asset ->
+    (* TODO cache-control: ~headers:[ ("Cache-Control", "max-age=151200") ] *)
+    Dream.respond asset
+
+let error_template _error _debug_info response =
+  let open Lwt.Syntax in
+  let status = Dream.status response in
+  let code = Dream.status_to_int status in
+  (*TODO improve: can't use template.elm.html because it needs "request" *)
+  let* body = Dream.body response in
+  let reason =
+    if String.equal "" body then Dream.status_to_string status else body
+  in
+  Dream.set_body response (Format.sprintf "%d: %s" code reason);
+  Lwt.return response
+
+let csrf_tag request =
+  let open Tyxml.Html in
+  let token = Dream.csrf_token request in
+  input ~a:[ a_name "dream.csrf"; a_input_type `Hidden; a_value token ] ()
+
+let render s =
+  let open Tyxml.Html in
+  let page = div [ txt s ] in
+  Dream.html @@ Template.render ~page_title:"blblbl" ~scripts:[] page

test/dune

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

test/test.ml

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