Rearrange xcb bindings

flake.nix

@@ -11,24 +11,19 @@
       mruby = pkgs.stdenv.mkDerivation {
         pname = "mruby";
         version = "0.0.1";
-
         src = pkgs.lib.cleanSourceWith {
           src = ./libs;
           name = "mruby-src";
         };
-
         patches = [ ./libs/changes.patch ];
-
         nativeBuildInputs = with pkgs; [
           ruby
           gnumake
           gcc
         ];
-
         buildPhase = ''
           (cd mruby && rake)
         '';
-
         installPhase = ''
           mkdir -p $out
           cp -r mruby/build/host/lib $out/
@@ -38,15 +33,12 @@
       kutu = pkgs.stdenv.mkDerivation {
         pname = "kutu";
         version = "0.1.0";
-
         src = ./.;
-
         nativeBuildInputs = with pkgs; [
           dune_3
           ocaml
           ocamlPackages.findlib
         ];
-
         buildInputs = with pkgs; [
           libxcb
           xcbutilwm
@@ -54,30 +46,18 @@
           ocamlPackages.ctypes-foreign
           mruby
         ];
-
         buildPhase = ''
           export MRUBY_LIB=${mruby}/lib
           dune build src/main.exe --release
         '';
-
         installPhase = ''
           mkdir -p $out/bin
           cp _build/default/src/main.exe $out/bin/kutu
         '';
       };
 
-    in
-    {
-      packages.${system} = {
-        default = kutu;
-        kutu = kutu;
-        mruby = mruby;
-      };
-
-      apps.${system}.default = {
-        type = "app";
-        program = "${pkgs.writeShellScript "kutu-run" ''
-          set -e
+      kutu-run = pkgs.writeShellScriptBin "kutu-run" ''
+        set -e
           if [ -z "$DISPLAY" ]; then
             exec ${pkgs.xinit}/bin/startx \
               ${kutu}/bin/kutu \
@@ -97,7 +77,18 @@
             DISPLAY=$DISPLAY_NUM ${kutu}/bin/kutu
             echo "Returned: $?"
           fi
-        ''}";
+      '';
+    in
+    {
+      packages.${system} = {
+        default = kutu;
+        kutu = kutu;
+        mruby = mruby;
+      };
+
+      apps.${system}.default = {
+        type = "app";
+        program = "${kutu-run}/bin/kutu-run";
       };
 
       devShells.${system}.default = pkgs.mkShell {

src/dune

@@ -1,3 +1,5 @@
+(include_subdirs qualified)
+
 (executable
  (name main)
  (libraries ctypes-foreign)

src/main.ml

@@ -1,22 +1,29 @@
 let spawn cmd =
-  match Unix.fork () with 0 -> Unix.execvp cmd.(0) cmd | _pid -> ()
+  match Unix.fork () with
+  | 0 ->
+      let devnull = Unix.openfile "/dev/null" [ Unix.O_WRONLY ] 0o666 in
+      Unix.dup2 devnull Unix.stdout;
+      Unix.dup2 devnull Unix.stderr;
+      Unix.close devnull;
+      Unix.execvp cmd.(0) cmd
+  | _pid -> ()
 
 let () =
-  let conn = Xcb.connect () in
+  let conn = Xcb.Functions.connect () in
 
   print_endline "connected";
 
-  let _ = Xcb.window_attribute_setup conn in
+  Xcb.Functions.window_attribute_setup conn;
 
-  Xcb.flush conn;
+  if Xcb.Functions.flush conn <= 0 then exit 1;
 
   spawn [| "kitty" |];
 
   while true do
-    Xcb.flush conn;
+    if Xcb.Functions.flush conn <= 0 then exit 1;
     Unix.sleepf 0.01
   done;
 
-  Xcb.disconnect conn;
+  Xcb.Functions.disconnect conn;
 
   print_endline "done"

src/xcb/functions.ml

@@ -0,0 +1,53 @@
+open Ctypes
+open Foreign
+
+let xcb_connect =
+  foreign "xcb_connect"
+    (string_opt @-> ptr int @-> returning (ptr Types.connection))
+
+let disconnect =
+  foreign "xcb_disconnect" (ptr Types.connection @-> returning void)
+
+let flush = foreign "xcb_flush" (ptr Types.connection @-> returning int)
+
+let connect () =
+  let screen = allocate int 0 in
+  xcb_connect None screen
+
+let get_setup =
+  foreign "xcb_get_setup" (ptr Types.connection @-> returning (ptr Types.setup))
+
+let setup_roots_iterator =
+  foreign "xcb_setup_roots_iterator"
+    (ptr Types.setup @-> returning Types.screen_iterator)
+
+let scr conn = getf (setup_roots_iterator (get_setup conn)) Types.data
+let root_window conn : Types.window = getf !@(scr conn) Types.root
+
+let values =
+  CArray.of_list uint32_t
+    [ Unsigned.UInt32.of_int (1048576 lor 524288 lor 131072 lor 4194304) ]
+
+let xcb_change_window_attributes_checked =
+  foreign "xcb_change_window_attributes_checked"
+    (ptr Types.connection @-> uint32_t @-> uint32_t @-> ptr uint32_t
+    @-> returning Types.void_cookie)
+
+let xcb_request_check =
+  foreign "xcb_request_check"
+    (ptr Types.connection @-> Types.void_cookie
+    @-> returning (ptr_opt Types.generic_error))
+
+let window_attribute_setup conn =
+  let cookie =
+    xcb_change_window_attributes_checked conn (root_window conn)
+      (Unsigned.UInt32.of_int 2048)
+      (CArray.start values)
+  in
+
+  match xcb_request_check conn cookie with
+  | None -> print_endline "WM ownership acquired"
+  | Some _ -> print_endline "another WM already owns the display"
+
+let connection_has_error =
+  foreign "xcb_connection_has_error" (ptr Types.connection @-> returning int)

src/xcb/types.ml

@@ -41,55 +41,5 @@ let data = field screen_iterator "data" (ptr screen)
 let rem = field screen_iterator "rem" int
 let index = field screen_iterator "index" int
 let () = seal screen_iterator
-
-(**)
 let setup : setup structure typ = structure "xcb_setup_t"
-
-(**)
 let connection : connection structure typ = structure "xcb_connection_t"
-
-let xcb_connect =
-  foreign "xcb_connect" (string_opt @-> ptr int @-> returning (ptr connection))
-
-let xcb_disconnect = foreign "xcb_disconnect" (ptr connection @-> returning void)
-let xcb_flush = foreign "xcb_flush" (ptr connection @-> returning int)
-
-let connect () =
-  let screen = allocate int 0 in
-  xcb_connect None screen
-
-let disconnect conn = xcb_disconnect conn
-let flush conn = ignore (xcb_flush conn)
-
-let get_setup =
-  foreign "xcb_get_setup" (ptr connection @-> returning (ptr setup))
-
-let setup_roots_iterator =
-  foreign "xcb_setup_roots_iterator" (ptr setup @-> returning screen_iterator)
-
-let scr conn = getf (setup_roots_iterator (get_setup conn)) data
-let root_window conn : window = getf !@(scr conn) root
-
-let values =
-  CArray.of_list uint32_t
-    [ Unsigned.UInt32.of_int (1048576 lor 524288 lor 131072 lor 4194304) ]
-
-let xcb_change_window_attributes_checked =
-  foreign "xcb_change_window_attributes_checked"
-    (ptr connection @-> uint32_t @-> uint32_t @-> ptr uint32_t
-   @-> returning void_cookie)
-
-let xcb_request_check =
-  foreign "xcb_request_check"
-    (ptr connection @-> void_cookie @-> returning (ptr_opt generic_error))
-
-let window_attribute_setup conn =
-  let cookie =
-    xcb_change_window_attributes_checked conn (root_window conn)
-      (Unsigned.UInt32.of_int 2048)
-      (CArray.start values)
-  in
-
-  match xcb_request_check conn cookie with
-  | None -> print_endline "WM ownership acquired"
-  | Some _ -> print_endline "another WM already owns the display"