Implement the commands to move windows to adjacent workspaces

7 files changed, 116 insertions, 47 deletions

diff --git a/README.md b/README.md
index 25c1a91..044172a 100644
--- a/README.md
+++ b/README.md
@@ -28,11 +28,17 @@ bindsym $mod+t exec $spatialmsg "focus prev"
 # Same thing, for the right.
 bindsym $mod+n exec $spatialmsg "focus next"
 
-# Move the focused window on the left, shift the loop if necessary.
-bindsym $mod+Shift+t exec $spatialmsg "move prev"
+# Move the focused window on the left.
+bindsym $mod+Shift+t exec $spatialmsg "move left"
 
-# Move the focused window on the right, shift the loop if necessary.
-bindsym $mod+Shift+n exec $spatialmsg "move next"
+# Move the focused window on the right.
+bindsym $mod+Shift+n exec $spatialmsg "move right"
+
+# Move the focused window on the upper workspace.
+bindsym $mod+Shift+r exec $spatialmsg "move up"
+
+# Move the focused window on the lower workspace.
+bindsym $mod+Shift+s exec $spatialmsg "move down"
 
 # Jump to the previous workspace (that is, N-1 for workspace N, but
 # iff N > 0).
diff --git a/bin/spatial/main.ml b/bin/spatial/main.ml
index 183e4ae..d3de864 100644
--- a/bin/spatial/main.ml
+++ b/bin/spatial/main.ml
@@ -61,6 +61,7 @@ let rec go poll state sway_socket server_socket =
     match Poll.wait poll (Poll.Timeout.after 10_000_000_000_000L) with
     | `Timeout -> go poll state sway_socket server_socket
     | `Ok ->
+        let previous_state = state in
         let state, arrange, force_focus =
           poll_fold_ready poll (state, false, None)
             (fun (state, arrange, force_focus) fd _event ->
@@ -99,7 +100,7 @@ let rec go poll state sway_socket server_socket =
         if arrange then (
           (* TODO: Be more configurable about that *)
           ignore (Jobs.shell "/usr/bin/pkill -SIGRTMIN+8 waybar");
-          State.arrange_current_workspace ?force_focus state);
+          State.arrange_current_workspace ~previous_state ?force_focus state);
         Poll.clear poll;
         go poll state sway_socket server_socket
   with Unix.Unix_error (EINTR, _, _) ->
diff --git a/bin/spatial/state.ml b/bin/spatial/state.ml
index e6fd29d..eb46373 100644
--- a/bin/spatial/state.ml
+++ b/bin/spatial/state.ml
@@ -46,6 +46,50 @@ let move_window_right workspace state =
         state.workspaces;
   }
 
+let move_window_in_workspace default_full_view default_maximum_visible
+    target_workspace state =
+  let current_workspace = state.current_workspace in
+  match target_workspace current_workspace with
+  | Some target_workspace -> (
+      let current_ribbon =
+        Workspaces_registry.find_opt current_workspace state.workspaces
+      in
+      match current_ribbon with
+      | Some ribbon -> (
+          match ribbon.visible with
+          | Some (f, l) ->
+              let window = List.nth l f in
+              let ribbon = Ribbon.remove_window window ribbon in
+              {
+                windows =
+                  Windows_registry.change_workspace window target_workspace
+                    state.windows;
+                current_workspace = target_workspace;
+                workspaces =
+                  Workspaces_registry.add current_workspace ribbon
+                    state.workspaces
+                  |> Workspaces_registry.register_window default_full_view
+                       default_maximum_visible target_workspace window;
+              }
+          | None -> state)
+      | None -> state)
+  | None -> state
+
+let move_window_up default_full_view default_maximum_visible =
+  move_window_in_workspace default_full_view default_maximum_visible
+    (fun current ->
+      match int_of_string_opt current with
+      | Some x when 0 < x -> Some (string_of_int (x - 1))
+      | _ -> None)
+
+let move_window_down default_full_view default_maximum_visible =
+  move_window_in_workspace default_full_view default_maximum_visible
+    (fun current ->
+      match int_of_string_opt current with
+      (* TODO: 6 should be configurable *)
+      | Some x when x < 6 -> Some (string_of_int (x + 1))
+      | _ -> None)
+
 let move_window_left workspace state =
   {
     state with
@@ -78,19 +122,33 @@ let decr_maximum_visible_size workspace state =
         state.workspaces;
   }
 
-let arrange_workspace_commands ?force_focus workspace state =
-  match Workspaces_registry.find_opt workspace state.workspaces with
-  | Some ribbon -> Ribbon.arrange_commands ?force_focus workspace ribbon
-  | None -> []
+let arrange_workspace_commands ?previous_state ?force_focus workspace state =
+  let change_workspace =
+    match previous_state with
+    | Some previous_state ->
+        if previous_state.current_workspace <> state.current_workspace then
+          [ Sway_ipc_types.Command.Workspace state.current_workspace ]
+        else []
+    | None -> []
+  in
+  let update_workspace =
+    match Workspaces_registry.find_opt workspace state.workspaces with
+    | Some ribbon -> Ribbon.arrange_commands ?force_focus workspace ribbon
+    | None -> []
+  in
+  change_workspace @ update_workspace
 
-let arrange_workspace ?force_focus ~socket workspace state =
-  let cmds = arrange_workspace_commands ?force_focus workspace state in
+let arrange_workspace ?previous_state ?force_focus ~socket workspace state =
+  let cmds =
+    arrange_workspace_commands ?previous_state ?force_focus workspace state
+  in
   let _replies = Sway_ipc.send_command ~socket (Run_command cmds) in
   ()
 
-let arrange_current_workspace ?force_focus state =
+let arrange_current_workspace ?previous_state ?force_focus state =
   Sway_ipc.with_socket (fun socket ->
-      arrange_workspace ?force_focus ~socket state.current_workspace state)
+      arrange_workspace ?previous_state ?force_focus ~socket
+        state.current_workspace state)
 
 let register_window default_full_view default_maximum_visible workspace state
     (tree : Node.t) =
@@ -157,7 +215,7 @@ let init default_full_view default_maximum_visible =
 (* TODO: Make it configurable *)
 let max_workspace = 6
 
-let send_command_workspace : 'kind Spatial_ipc.target -> state -> unit =
+let send_command_workspace : Spatial_ipc.target -> state -> unit =
  fun dir state ->
   (match (dir, int_of_string_opt state.current_workspace) with
   | Next, Some x when x < max_workspace -> Some (x + 1)
@@ -212,10 +270,12 @@ let client_command_handle :
                 that we will eventually received. *)
              send_command_workspace dir state;
              (state, false, None)
-         | Move Prev ->
+         | Move Left ->
              (move_window_left state.current_workspace state, true, None)
-         | Move Next ->
+         | Move Right ->
              (move_window_right state.current_workspace state, true, None)
+         | Move Up -> (move_window_up false 2 state, true, None)
+         | Move Down -> (move_window_down false 2 state, true, None)
          | Maximize Toggle ->
              (toggle_full_view state.current_workspace state, true, None)
          | Maximize _ ->
diff --git a/bin/spatial/windows_registry.ml b/bin/spatial/windows_registry.ml
index 7c9ecf2..63b286a 100644
--- a/bin/spatial/windows_registry.ml
+++ b/bin/spatial/windows_registry.ml
@@ -10,6 +10,11 @@ let find = Map.find
 let find_opt = Map.find_opt
 let update = Map.update
 
+let change_workspace window workspace map =
+  update window
+    (function Some info -> Some { info with workspace } | None -> None)
+    map
+
 let pp_window fmt (id, { app_id; name; workspace }) =
   Format.fprintf fmt "{ id = %Ld; app_id = %s; name = %s; workspace = %s }" id
     name app_id workspace
diff --git a/bin/spatial/workspaces_registry.ml b/bin/spatial/workspaces_registry.ml
index fc71b1e..986dfad 100644
--- a/bin/spatial/workspaces_registry.ml
+++ b/bin/spatial/workspaces_registry.ml
@@ -32,6 +32,7 @@ let unregister = Map.remove
 let find = Map.find
 let find_opt = Map.find_opt
 let update = Map.update
+let add = Map.add
 let get_list reg = reg |> Map.to_seq |> Seq.map fst |> List.of_seq
 
 let pp fmt workspaces =
diff --git a/lib/spatial_ipc/spatial_ipc.ml b/lib/spatial_ipc/spatial_ipc.ml
index fa33170..27ca81d 100644
--- a/lib/spatial_ipc/spatial_ipc.ml
+++ b/lib/spatial_ipc/spatial_ipc.ml
@@ -7,18 +7,7 @@ open Mltp_ipc
 let socket_path = "/tmp/spatial-sway.socket"
 let magic_string = "spatial-ipc"
 
-type focus = Focus_kind
-type move = Move_kind
-
-type 'kind target =
-  | Prev : 'kind target
-  | Next : 'kind target
-  | Index : int -> focus target
-
-let restrict_move_target : 'k target -> move target option = function
-  | Index _ -> None
-  | Next -> Some Next
-  | Prev -> Some Prev
+type target = Prev | Next | Index of int
 
 let target_of_string_opt = function
   | "prev" -> Some Prev
@@ -27,11 +16,26 @@ let target_of_string_opt = function
       Option.bind (int_of_string_opt x) @@ fun x ->
       if 0 <= x then Some (Index x) else None
 
-let target_to_string : type kind. kind target -> string = function
+let target_to_string = function
   | Prev -> "prev"
   | Next -> "next"
   | Index x -> string_of_int x
 
+type move_target = Left | Right | Up | Down
+
+let move_target_of_string_opt = function
+  | "left" -> Some Left
+  | "right" -> Some Right
+  | "up" -> Some Up
+  | "down" -> Some Down
+  | _ -> None
+
+let move_target_to_string = function
+  | Left -> "left"
+  | Right -> "right"
+  | Up -> "up"
+  | Down -> "down"
+
 type switch = On | Off | Toggle
 
 let switch_of_string_opt = function
@@ -52,9 +56,9 @@ let operation_of_string_opt = function
 let operation_to_string = function Incr -> "increment" | Decr -> "decrement"
 
 type command =
-  | Focus of focus target
-  | Workspace of focus target
-  | Move of move target
+  | Focus of target
+  | Workspace of target
+  | Move of move_target
   | Maximize of switch
   | Split of operation
 
@@ -67,9 +71,7 @@ let command_of_string str =
   | [ "focus"; target ] -> (fun x -> Focus x) <$> target_of_string_opt target
   | [ "workspace"; target ] ->
       (fun x -> Workspace x) <$> target_of_string_opt target
-  | [ "move"; target ] ->
-      Option.bind (target_of_string_opt target) @@ fun target ->
-      (fun x -> Move x) <$> restrict_move_target target
+  | [ "move"; target ] -> (fun x -> Move x) <$> move_target_of_string_opt target
   | [ "maximize"; switch ] ->
       (fun x -> Maximize x) <$> switch_of_string_opt switch
   | [ "split"; op ] -> (fun x -> Split x) <$> operation_of_string_opt op
@@ -83,7 +85,7 @@ let command_of_string_exn str =
 let command_to_string = function
   | Focus dir -> Format.sprintf "focus %s" (target_to_string dir)
   | Workspace dir -> Format.sprintf "workspace %s" (target_to_string dir)
-  | Move dir -> Format.sprintf "move %s" (target_to_string dir)
+  | Move dir -> Format.sprintf "move %s" (move_target_to_string dir)
   | Maximize switch -> Format.sprintf "maximize %s" (switch_to_string switch)
   | Split op -> Format.sprintf "split %s" (operation_to_string op)
 
diff --git a/lib/spatial_ipc/spatial_ipc.mli b/lib/spatial_ipc/spatial_ipc.mli
index 6313179..504332b 100644
--- a/lib/spatial_ipc/spatial_ipc.mli
+++ b/lib/spatial_ipc/spatial_ipc.mli
@@ -4,21 +4,15 @@
 
 val socket_path : string
 
-type focus = Focus_kind
-type move = Move_kind
-
-type 'kind target =
-  | Prev : 'kind target
-  | Next : 'kind target
-  | Index : int -> focus target
-
+type target = Prev | Next | Index of int
+type move_target = Left | Right | Up | Down
 type switch = On | Off | Toggle
 type operation = Incr | Decr
 
 type command =
-  | Focus of focus target
-  | Workspace of focus target
-  | Move of move target
+  | Focus of target
+  | Workspace of target
+  | Move of move_target
   | Maximize of switch
   | Split of operation