First steps for Wayland Protocol

.gitignore

@@ -0,0 +1,2 @@
+_build/*
+protocol/_build/*

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

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

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

protocol/lib/dune

@@ -0,0 +1,4 @@
+(library
+ (public_name protocol)
+ (libraries unix)
+ (name protocol))

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

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

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"

protocol/test/dune

@@ -0,0 +1,3 @@
+(test
+ (libraries unix protocol)
+ (name test_protocol))

protocol/test/test_protocol.ml

@@ -0,0 +1 @@
+