Various tweaks before removing the Lwt layer

5 files changed, 85 insertions, 52 deletions

diff --git a/bin/spatial/main.ml b/bin/spatial/main.ml
index daee93f..af62117 100644
--- a/bin/spatial/main.ml
+++ b/bin/spatial/main.ml
@@ -15,8 +15,13 @@ let workspace_handle (ev : Event.workspace_event) state =
       Lwt.return (state, false, None)
 
 let window_handle (ev : Event.window_event) state =
+  let open Lwt.Syntax in
   match ev.change with
   | Event.New ->
+      let* () =
+        Lwt_io.printf "created window %Ld (%s)\n" ev.container.id
+          (Option.value ~default:"<meh>" ev.container.app_id)
+      in
       let state =
         State.register_window false 2 state.State.current_workspace state
           ev.container
@@ -37,6 +42,10 @@ let window_handle (ev : Event.window_event) state =
           in
           Lwt.return (state, true, None)
       | Floating_con ->
+          let* () =
+            Lwt_io.printf "window %Ld (%s) turned floating\n" ev.container.id
+              (Option.value ~default:"<meh>" ev.container.app_id)
+          in
           let state = State.unregister_window state ev.container.id in
           Lwt.return (state, true, Some ev.container.id)
       | _ -> Lwt.return (state, false, None))
@@ -50,33 +59,41 @@ let event_handle ev state =
         | From_sway (Event.Workspace ev) -> workspace_handle ev state
         | From_sway (Window ev) -> window_handle ev state
         | From_sway _ -> assert false
-        | From_client socket -> (
-            let+ handle_res =
-              Spatial_ipc.(
-                handle_next_command ~socket state
-                  { handler = State.client_command_handle })
-            in
-            match handle_res with Some x -> x | _ -> (state, false, None))
+        | From_client socket ->
+            Lwt.try_bind
+              (fun () ->
+                let+ handle_res =
+                  Spatial_ipc.(
+                    handle_next_command ~socket state
+                      { handler = State.client_command_handle })
+                in
+                match handle_res with Some x -> x | _ -> (state, false, None))
+              Lwt.return
+              (fun exn ->
+                let* () = Spatial_ipc.close socket in
+                raise exn)
       in
       let+ () =
-        if arrange then State.arrange_current_workspace ?force_focus state
+        if arrange then
+          let* () = State.arrange_current_workspace ?force_focus state in
+          (* TODO: Make this more general *)
+          let* _ =
+            Lwt_process.(exec @@ shell "/usr/bin/pkill -SIGRTMIN+8 waybar")
+          in
+          Lwt.return ()
         else Lwt.return ()
       in
       state)
     Lwt.return
-    (fun _exn ->
-      let+ _ = Lwt_io.printf "something went wrong with an event\n" in
+    (fun exn ->
+      let+ _ =
+        Lwt_io.printf "something went wrong with an event:\n%s\n"
+          (Printexc.to_string exn)
+      in
       state)
 
 let merge_streams l =
-  let open Lwt.Syntax in
-  Lwt_stream.from (fun () ->
-      Lwt.choose
-        (List.map
-           (fun x ->
-             let+ x = Lwt_stream.next x in
-             Some x)
-           l))
+  Lwt_stream.from (fun () -> Lwt.pick (List.map Lwt_stream.get l))
 
 let main () =
   let open Lwt.Syntax in
@@ -94,6 +111,6 @@ let main () =
   let string = Format.asprintf "%a" State.pp state in
   let* () = Lwt_io.printf "%s\n" string in
   let* _ = Lwt_stream.fold_s event_handle stream state in
-  Lwt.return ()
+  Lwt_io.printf "one of the stream has ended\n"
 
 let () = Lwt_main.run @@ main ()
diff --git a/bin/spatial/state.ml b/bin/spatial/state.ml
index 8b67191..495436b 100644
--- a/bin/spatial/state.ml
+++ b/bin/spatial/state.ml
@@ -103,16 +103,18 @@ let register_window default_full_view default_maximum_visible workspace state
   | _ -> state
 
 let unregister_window state window =
-  let info = Windows_registry.find window state.windows in
-  let windows = Windows_registry.unregister window state.windows in
-  let workspaces =
-    Workspaces_registry.update info.workspace
-      (function
-        | Some ribbon -> Some (Ribbon.remove_window window ribbon)
-        | None -> None)
-      state.workspaces
-  in
-  { state with windows; workspaces }
+  match Windows_registry.find_opt window state.windows with
+  | Some info ->
+      let windows = Windows_registry.unregister window state.windows in
+      let workspaces =
+        Workspaces_registry.update info.workspace
+          (function
+            | Some ribbon -> Some (Ribbon.remove_window window ribbon)
+            | None -> None)
+          state.workspaces
+      in
+      { state with windows; workspaces }
+  | None -> state
 
 let init default_full_view default_maximum_visible =
   let open Lwt.Syntax in
@@ -186,20 +188,24 @@ let client_command_handle :
           (Some res, { success = true })
       | Get_windows -> (
           let ribbon =
-            Workspaces_registry.find state.current_workspace state.workspaces
+            Workspaces_registry.find_opt state.current_workspace
+              state.workspaces
           in
           ( None,
-            match ribbon.visible with
-            | Some (f, l) ->
-                {
-                  focus = Some f;
-                  windows =
-                    List.map
-                      (fun id ->
-                        (Windows_registry.find id state.windows).app_id)
-                      (l @ ribbon.hidden);
-                }
-            | None -> { focus = None; windows = [] } ))
+            match ribbon with
+            | None -> { focus = None; windows = [] }
+            | Some ribbon -> (
+                match ribbon.visible with
+                | Some (f, l) ->
+                    {
+                      focus = Some f;
+                      windows =
+                        List.map
+                          (fun id ->
+                            (Windows_registry.find id state.windows).app_id)
+                          (l @ ribbon.hidden);
+                    }
+                | None -> { focus = None; windows = [] }) ))
        : _ * a)
 
 let pp fmt state =
diff --git a/bin/spatial/windows_registry.ml b/bin/spatial/windows_registry.ml
index 55dddb3..9c36083 100644
--- a/bin/spatial/windows_registry.ml
+++ b/bin/spatial/windows_registry.ml
@@ -7,6 +7,7 @@ let empty : t = Map.empty
 let register : int64 -> info -> t -> t = Map.add
 let unregister = Map.remove
 let find = Map.find
+let find_opt = Map.find_opt
 
 let pp_window fmt (id, { app_id; workspace }) =
   Format.fprintf fmt "{ id = %Ld; app_id = %s; workspace = %s }" id app_id
diff --git a/bin/spatialmsg/main.ml b/bin/spatialmsg/main.ml
index 3c3062a..50b40c4 100644
--- a/bin/spatialmsg/main.ml
+++ b/bin/spatialmsg/main.ml
@@ -13,15 +13,22 @@ let () =
       let cmd = command_of_string_exn cmd in
       let { success } = Lwt_main.run (send_command (Run_command cmd)) in
       if not success then exit 1
-  | "get_windows" ->
+  | "get_windows" -> (
+      let cmd = Clap.optional_int ~placeholder:"INDEX" () in
       Clap.close ();
 
       let reply = Lwt_main.run (send_command Get_windows) in
-      List.iteri
-        (fun idx name ->
-          Format.printf "- %s%s%s\n"
-            (if reply.focus = Some idx then "*" else "")
-            name
-            (if reply.focus = Some idx then "*" else ""))
-        reply.windows
+
+      match (cmd, reply.focus) with
+      | Some idx, Some focus when idx < List.length reply.windows ->
+          let name = List.nth reply.windows idx in
+          let cls = if idx = focus then "focus" else "unfocus" in
+          Format.(printf "%s\n%s\n%s" name name cls)
+      | Some _, _ -> ()
+      | None, _ ->
+          List.iteri
+            (fun idx name ->
+              let marker = if reply.focus = Some idx then "*" else "" in
+              Format.printf "| %s%s%s | " marker name marker)
+            reply.windows)
   | _ -> exit 2
diff --git a/lib/spatial_ipc/spatial_ipc.ml b/lib/spatial_ipc/spatial_ipc.ml
index 3c471ba..8d00d70 100644
--- a/lib/spatial_ipc/spatial_ipc.ml
+++ b/lib/spatial_ipc/spatial_ipc.ml
@@ -141,15 +141,17 @@ let socket_from_option = function
 
 let send_command ?socket cmd =
   let open Lwt.Syntax in
-  let* socket = socket_from_option socket in
+  let* s = socket_from_option socket in
   let ((op, _) as raw) = to_raw_message cmd in
   let* () =
-    trust_spatial @@ fun () -> Socket.write_raw_message ~magic_string socket raw
+    trust_spatial @@ fun () -> Socket.write_raw_message ~magic_string s raw
   in
   let* op', payload =
-    trust_spatial @@ fun () -> Socket.read_raw_message ~magic_string socket
+    trust_spatial @@ fun () -> Socket.read_raw_message ~magic_string s
   in
   assert (op = op');
+  let* () = if Option.is_none socket then close s else Lwt.return () in
+
   Lwt.return @@ reply_of_string_exn cmd payload
 
 type ('a, 'b) handler = { handler : 'r. 'a -> 'r t -> ('b option * 'r) Lwt.t }