From 1003c8dbc72e12bee13d6ede4ca887f4a7974b98 Mon Sep 17 00:00:00 2001
From: Mava <maxime.jacquemin@pm.me>
Date: Fri, 8 Nov 2024 12:53:32 +0100
Subject: [PATCH] First steps for Wayland Protocol

---
 .gitignore                     |  2 ++
 protocol/dune-project          | 26 ++++++++++++++++++++++++
 protocol/lib/IO.ml             | 29 ++++++++++++++++++++++++++
 protocol/lib/IO.mli            | 13 ++++++++++++
 protocol/lib/dune              |  4 ++++
 protocol/lib/socket.ml         | 37 ++++++++++++++++++++++++++++++++++
 protocol/lib/socket.mli        | 11 ++++++++++
 protocol/protocol.opam         | 31 ++++++++++++++++++++++++++++
 protocol/test/dune             |  3 +++
 protocol/test/test_protocol.ml |  1 +
 10 files changed, 157 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 protocol/dune-project
 create mode 100644 protocol/lib/IO.ml
 create mode 100644 protocol/lib/IO.mli
 create mode 100644 protocol/lib/dune
 create mode 100644 protocol/lib/socket.ml
 create mode 100644 protocol/lib/socket.mli
 create mode 100644 protocol/protocol.opam
 create mode 100644 protocol/test/dune
 create mode 100644 protocol/test/test_protocol.ml

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..97f8009
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+_build/*
+protocol/_build/*
diff --git a/protocol/dune-project b/protocol/dune-project
new file mode 100644
index 0000000..6e21531
--- /dev/null
+++ b/protocol/dune-project
@@ -0,0 +1,26 @@
+(lang dune 3.16)
+
+(name protocol)
+
+(generate_opam_files true)
+
+(source
+ (github username/reponame))
+
+(authors "Author Name")
+
+(maintainers "Maintainer Name")
+
+(license LICENSE)
+
+(documentation https://url/to/documentation)
+
+(package
+ (name protocol)
+ (synopsis "A short synopsis")
+ (description "A longer description")
+ (depends ocaml dune)
+ (tags
+  (topics "to describe" your project)))
+
+; See the complete stanza docs at https://dune.readthedocs.io/en/stable/reference/dune-project/index.html
diff --git a/protocol/lib/IO.ml b/protocol/lib/IO.ml
new file mode 100644
index 0000000..e42a4e6
--- /dev/null
+++ b/protocol/lib/IO.ml
@@ -0,0 +1,29 @@
+type error = { code : Unix.error ; call : string ; parameter : string }
+type 'a t  = ('a, error) Stdlib.Result.t
+
+module Operators = struct
+  let ( let* ) (m : 'a t) (f : 'a -> 'b t) : 'b t = Stdlib.Result.bind m f
+  let ( let+ ) (m : 'a t) (f : 'a -> 'b  ) : 'b t = Stdlib.Result.map  f m
+  let ( ! ) (value : 'a) : 'a t = Stdlib.Result.Ok value
+end
+
+let return (value : 'a) : 'a t =
+  Stdlib.Result.Ok value
+
+let error code call parameter : 'a t =
+  Stdlib.Result.Error { code ; call ; parameter }
+
+let log { code ; call ; parameter } =
+  Format.fprintf Format.err_formatter
+    "@[<v>During the call %s(%s), the following error occured:@ - %s@ @]"
+    call parameter (Unix.error_message code)
+
+let recover (io : 'a t) ~using ~on : 'a t =
+  match io with
+  | Ok result -> Ok result
+  | Error e -> log e ; if e.code = on then using else Error e
+
+let environment_variable (variable : string) : string t =
+  try Ok (Unix.getenv variable) with
+  | Not_found -> error Unix.ENOENT "getenv" variable
+  | Unix.Unix_error (code, call, param) -> error code call param
diff --git a/protocol/lib/IO.mli b/protocol/lib/IO.mli
new file mode 100644
index 0000000..f5c3911
--- /dev/null
+++ b/protocol/lib/IO.mli
@@ -0,0 +1,13 @@
+type 'a t
+
+val return  : 'a -> 'a t
+val error   : Unix.error -> string -> string -> 'a t
+val recover : 'a t -> using:'a t -> on:Unix.error -> 'a t
+
+val environment_variable : string -> string t
+
+module Operators : sig
+  val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
+  val ( let+ ) : 'a t -> ('a -> 'b  ) -> 'b t
+  val ( ! )  : 'a -> 'a t
+end
diff --git a/protocol/lib/dune b/protocol/lib/dune
new file mode 100644
index 0000000..b1300e0
--- /dev/null
+++ b/protocol/lib/dune
@@ -0,0 +1,4 @@
+(library
+ (public_name protocol)
+ (libraries unix)
+ (name protocol))
diff --git a/protocol/lib/socket.ml b/protocol/lib/socket.ml
new file mode 100644
index 0000000..7c59a29
--- /dev/null
+++ b/protocol/lib/socket.ml
@@ -0,0 +1,37 @@
+type address = Unix.sockaddr
+type socket  = Unix.file_descr
+
+let create () : socket IO.t =
+  try IO.return Unix.(socket PF_UNIX SOCK_STREAM 0) with
+  | Unix.Unix_error (code, call, param) -> IO.error code call param
+
+let bind socket address : unit IO.t =
+  try IO.return (Unix.bind socket address) with
+  | Unix.Unix_error (code, call, param) -> IO.error code call param
+
+let connect socket address : unit IO.t =
+  try IO.return (Unix.connect socket address) with
+  | Unix.Unix_error (code, call, param) -> IO.error code call param
+
+let listen socket limit : unit IO.t =
+  try IO.return (Unix.listen socket limit) with
+  | Unix.Unix_error (code, call, param) -> IO.error code call param
+
+let accept socket : socket IO.t =
+  try IO.return (Unix.accept socket |> fst) with
+  | Unix.Unix_error (code, call, param) -> IO.error code call param
+
+let close socket : unit IO.t =
+  try IO.return (Unix.close socket) with
+  | Unix.Unix_error (code, call, param) -> IO.error code call param
+
+let address () : address IO.t =
+  let open IO.Operators in
+  let runtime = IO.environment_variable "XDG_RUNTIME_DIR" in
+  let display = IO.environment_variable "WAYLAND_DISPLAY" in
+  let socket  = IO.environment_variable "WAYLAND_SOCKET"  in
+  let display = IO.recover display ~using:!"wayland-0" ~on:Unix.ENOENT in
+  let concat runtime display = Format.asprintf "%s/%s" runtime display in
+  let fallback = let* runtime in let+ display in concat runtime display in
+  let+ filename = IO.recover socket ~using:fallback ~on:Unix.ENOENT in
+  Unix.ADDR_UNIX filename
diff --git a/protocol/lib/socket.mli b/protocol/lib/socket.mli
new file mode 100644
index 0000000..0005bc7
--- /dev/null
+++ b/protocol/lib/socket.mli
@@ -0,0 +1,11 @@
+type socket
+type address
+
+val create  : unit -> socket IO.t
+val address : unit -> address IO.t
+
+val bind    : socket -> address -> unit IO.t
+val connect : socket -> address -> unit IO.t
+val listen  : socket -> int -> unit IO.t
+val accept  : socket -> socket IO.t
+val close   : socket -> unit IO.t
diff --git a/protocol/protocol.opam b/protocol/protocol.opam
new file mode 100644
index 0000000..b296c11
--- /dev/null
+++ b/protocol/protocol.opam
@@ -0,0 +1,31 @@
+# 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.16"}
+  "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/protocol/test/dune b/protocol/test/dune
new file mode 100644
index 0000000..cf3546b
--- /dev/null
+++ b/protocol/test/dune
@@ -0,0 +1,3 @@
+(test
+ (libraries unix protocol)
+ (name test_protocol))
diff --git a/protocol/test/test_protocol.ml b/protocol/test/test_protocol.ml
new file mode 100644
index 0000000..8b13789
--- /dev/null
+++ b/protocol/test/test_protocol.ml
@@ -0,0 +1 @@
+