Make spatialmsg send commands to spatial instead of just code

This paves the road towards (1) configuration, and (2) commands with
operands.

We basically copy how Sway and i3 do it.

11 files changed, 278 insertions, 202 deletions

diff --git a/README.md b/README.md
index 837f844..c9c3a00 100644
--- a/README.md
+++ b/README.md
@@ -23,25 +23,25 @@ exec $spatialmsg
 # focus is on the last window on the left of the visible area, windows
 # will shift right to make room for the next candidate on the loop,
 # and the window on the far right will disappear.
-bindsym $mod+t exec $spatialmsg focus prev
+bindsym $mod+t exec $spatialmsg "focus left"
 
 # Same thing, for the right.
-bindsym $mod+n exec $spatialmsg focus next
+bindsym $mod+n exec $spatialmsg "focus right"
 
 # Move the focused window on the left, shift the loop if necessary.
-bindsym $mod+Shift+t exec $spatialmsg move prev
+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
+bindsym $mod+Shift+n exec $spatialmsg "move right"
 
 # Toggle between a mode where only one window is visible (maximized
 # mode), or a fixed numbers (split mode). spatial-sway will remember
 # how may windows you want visible when not in full view mode.
-bindsym $mod+space exec $spatialmsg maximized toggle
+bindsym $mod+space exec $spatialmsg "maximize toggle"
 
 # Decrease the number of windows to display when in split mode.
-bindsym $mod+g exec $spatialmsg split decrement
+bindsym $mod+g exec $spatialmsg "split decrement"
 
 # Increase the number of windows to display when in split mode.
-bindsym $mod+h exec $spatialmsg split increment
+bindsym $mod+h exec $spatialmsg "split increment"
 ```
diff --git a/bin/spatial/ipc.ml b/bin/spatial/ipc.ml
deleted file mode 100644
index ec00322..0000000
--- a/bin/spatial/ipc.ml
+++ /dev/null
@@ -1,27 +0,0 @@
-open Spatial_sway_ipc
-
-let rec socket_handler server () =
-  let open Lwt.Syntax in
-  let* socket, _ = Lwt_unix.accept server in
-  let buffer = Bytes.create 4 in
-  try
-    let* read_bytes = Lwt_unix.read socket buffer 0 4 in
-    assert (read_bytes = 4);
-    let code = Bytes.get_int32_ne buffer 0 in
-    let* () = Lwt_unix.close socket in
-    Lwt.return @@ Some (of_int32_exn code)
-  with _ ->
-    let* () = Lwt_unix.close socket in
-    socket_handler server ()
-
-let create_server () =
-  let open Lwt.Syntax in
-  let socket = Lwt_unix.socket PF_UNIX SOCK_STREAM 0 in
-  let* socket_exists = Lwt_unix.file_exists socket_path in
-  let* () =
-    if socket_exists then Lwt_unix.unlink socket_path else Lwt.return ()
-  in
-  let sockaddr = Lwt_unix.ADDR_UNIX socket_path in
-  let+ () = Lwt_unix.bind socket sockaddr in
-  let () = Lwt_unix.listen socket 100 in
-  Lwt_stream.from (socket_handler socket)
diff --git a/bin/spatial/main.ml b/bin/spatial/main.ml
index 9f2ff56..f0ed017 100644
--- a/bin/spatial/main.ml
+++ b/bin/spatial/main.ml
@@ -1,6 +1,6 @@
 open Sway_ipc_types
 
-type input = From_sway of Event.t | From_client of Spatial_sway_ipc.t
+type input = From_sway of Event.t | From_client of Spatial_sway_ipc.socket
 
 let workspace_handle (ev : Event.workspace_event) state =
   match ev.change with
@@ -49,8 +49,14 @@ let event_handle ev state =
         match ev with
         | From_sway (Event.Workspace ev) -> workspace_handle ev state
         | From_sway (Window ev) -> window_handle ev state
-        | From_client ev -> State.client_handle ev state
-        | _ -> assert false
+        | From_sway _ -> assert false
+        | From_client socket -> (
+            let+ handle_res =
+              Spatial_sway_ipc.(
+                handle_next_command ~socket state
+                  { handler = State.client_command_handle })
+            in
+            match handle_res with Some x -> x | _ -> (state, false, None))
       in
       let+ () =
         if arrange then State.arrange_current_workspace ?force_focus state
@@ -75,7 +81,7 @@ let merge_streams l =
 let main () =
   let open Lwt.Syntax in
   let* stream_sway = Sway_ipc.subscribe [ Window; Workspace ] in
-  let* stream_client = Ipc.create_server () in
+  let* stream_client = Spatial_sway_ipc.create_server () in
   let stream =
     merge_streams
       [
diff --git a/bin/spatial/state.ml b/bin/spatial/state.ml
index 82f20ac..234efa1 100644
--- a/bin/spatial/state.ml
+++ b/bin/spatial/state.ml
@@ -130,44 +130,62 @@ let init default_full_view default_maximum_visible =
       | None -> state)
     (empty cw.name) workspaces
 
-let client_handle ev state =
+let client_command_handle :
+    type a.
+    state ->
+    a Spatial_sway_ipc.t ->
+    ((state * bool * int64 option) option * a) Lwt.t =
+ fun state cmd ->
+  let open Spatial_sway_ipc in
   Lwt.return
-  @@
-  match ev with
-  | Spatial_sway_ipc.Move_left ->
-      ( {
-          state with
-          workspaces =
-            Workspaces_registry.update state.current_workspace
-              (function
-                | Some ribbon -> Some (Ribbon.move_focus_left ribbon)
-                | None -> None)
-              state.workspaces;
-        },
-        true,
-        None )
-  | Move_right ->
-      ( {
-          state with
-          workspaces =
-            Workspaces_registry.update state.current_workspace
-              (function
-                | Some ribbon -> Some (Ribbon.move_focus_right ribbon)
-                | None -> None)
-              state.workspaces;
-        },
-        true,
-        None )
-  | Move_window_left ->
-      (move_window_left state.current_workspace state, true, None)
-  | Move_window_right ->
-      (move_window_right state.current_workspace state, true, None)
-  | Toggle_full_view ->
-      (toggle_full_view state.current_workspace state, true, None)
-  | Incr_maximum_visible_space ->
-      (incr_maximum_visible_size state.current_workspace state, true, None)
-  | Decr_maximum_visible_space ->
-      (decr_maximum_visible_size state.current_workspace state, true, None)
+  @@ (match cmd with
+      | Run_command cmd ->
+          let res =
+            match cmd with
+            | Focus Left ->
+                ( {
+                    state with
+                    workspaces =
+                      Workspaces_registry.update state.current_workspace
+                        (function
+                          | Some ribbon -> Some (Ribbon.move_focus_left ribbon)
+                          | None -> None)
+                        state.workspaces;
+                  },
+                  true,
+                  None )
+            | Focus Right ->
+                ( {
+                    state with
+                    workspaces =
+                      Workspaces_registry.update state.current_workspace
+                        (function
+                          | Some ribbon -> Some (Ribbon.move_focus_right ribbon)
+                          | None -> None)
+                        state.workspaces;
+                  },
+                  true,
+                  None )
+            | Move Left ->
+                (move_window_left state.current_workspace state, true, None)
+            | Move Right ->
+                (move_window_right state.current_workspace state, true, None)
+            | Maximize Toggle ->
+                (toggle_full_view state.current_workspace state, true, None)
+            | Maximize _ ->
+                (* TODO: implement [On] and [Off] cases *)
+                (state, false, None)
+            | Split Incr ->
+                ( incr_maximum_visible_size state.current_workspace state,
+                  true,
+                  None )
+            | Split Decr ->
+                ( decr_maximum_visible_size state.current_workspace state,
+                  true,
+                  None )
+          in
+          (Some res, ())
+       : _ * a)
 
 let pp fmt state =
   Format.(
diff --git a/bin/spatialmsg/dune b/bin/spatialmsg/dune
index 3ebeb98..23ecccc 100644
--- a/bin/spatialmsg/dune
+++ b/bin/spatialmsg/dune
@@ -1,3 +1,3 @@
 (executable
  (name main)
- (libraries spatial-sway.ipc lwt lwt.unix clap))
+ (libraries mltp-ipc spatial-sway.ipc lwt lwt.unix clap))
diff --git a/bin/spatialmsg/main.ml b/bin/spatialmsg/main.ml
index a721677..63d5d8c 100644
--- a/bin/spatialmsg/main.ml
+++ b/bin/spatialmsg/main.ml
@@ -1,95 +1,5 @@
-let select_message = function
-  | `Focus `Prev -> Spatial_sway_ipc.Move_left
-  | `Focus `Next -> Move_right
-  | `Move `Prev -> Move_window_left
-  | `Move `Next -> Move_window_right
-  | `Maximize `Toggle -> Toggle_full_view
-  | `Split `Incr -> Incr_maximum_visible_space
-  | `Split `Decr -> Decr_maximum_visible_space
-
-let connect () =
-  let open Lwt.Syntax in
-  let socket = Lwt_unix.socket PF_UNIX SOCK_STREAM 0 in
-  let+ () = Lwt_unix.connect socket (ADDR_UNIX Spatial_sway_ipc.socket_path) in
-  socket
-
-let send_command socket cmd =
-  let open Lwt.Syntax in
-  let buffer = Bytes.create 4 in
-  Bytes.set_int32_ne buffer 0 (Spatial_sway_ipc.to_int32 cmd);
-  let* _ = Lwt_unix.write socket buffer 0 4 in
-  Lwt.return ()
-
-let main cmd =
-  let open Lwt.Syntax in
-  let* socket = connect () in
-  let* () = send_command socket cmd in
-  Lwt_unix.close socket
+open Spatial_sway_ipc
 
 let () =
-  Clap.description
-    "Send messages to a running instance of spatial-sway over the IPC socket";
-
-  let command =
-    Clap.subcommand
-      [
-        ( Clap.case "focus" ~description:"Change the focused window."
-        @@ fun () ->
-          let direction =
-            Clap.subcommand ~placeholder:"DIRECTION"
-              [
-                Clap.case "prev"
-                  ~description:"Focus the previous window in the ribbon."
-                  (fun () -> `Prev);
-                Clap.case "next"
-                  ~description:"Focus the next window in the ribbon." (fun () ->
-                    `Next);
-              ]
-          in
-          `Focus direction );
-        ( Clap.case "move" ~description:"Move the focused window." @@ fun () ->
-          let direction =
-            Clap.subcommand ~placeholder:"DIRECTION"
-              [
-                Clap.case "prev"
-                  ~description:
-                    "Move the focused container before the previous window in \
-                     the ribbon." (fun () -> `Prev);
-                Clap.case "next"
-                  ~description:
-                    "Move the focused container after the previous window in \
-                     the ribbon." (fun () -> `Next);
-              ]
-          in
-          `Move direction );
-        ( Clap.case "maximize" ~description:"Enable or disable maximized mode."
-        @@ fun () ->
-          let switch =
-            Clap.subcommand ~placeholder:"SWITCH"
-              [
-                Clap.case "toggle" ~description:"Toggle the maximized mode"
-                  (fun () -> `Toggle);
-              ]
-          in
-          `Maximize switch );
-        ( Clap.case "split" ~description:"Configure the split mode." @@ fun () ->
-          let cmd =
-            Clap.subcommand ~placeholder:"COMMAND"
-              [
-                Clap.case "increment"
-                  ~description:"Push one more window onto the output."
-                  (fun () -> `Incr);
-                Clap.case "decrement"
-                  ~description:"Remove one window from the output." (fun () ->
-                    `Decr);
-              ]
-          in
-          `Split cmd );
-      ]
-  in
-
-  Clap.close ();
-
-  let cmd = select_message command in
-
-  Lwt_main.run (main cmd)
+  let cmd = Sys.argv.(1) |> command_of_string_exn in
+  Lwt_main.run (send_command (Run_command cmd))
diff --git a/lib/mltp_ipc/socket.ml b/lib/mltp_ipc/socket.ml
index 0d5333d..e90ff65 100644
--- a/lib/mltp_ipc/socket.ml
+++ b/lib/mltp_ipc/socket.ml
@@ -62,11 +62,30 @@ let read_raw_message ~magic_string socket =
   let size = Raw_message.string_to_int32 msg in
   let* msg = read_all ~count:4 socket in
   let msg_type = Raw_message.string_to_int32 msg in
-  let* payload = read_all ~count:(Int32.to_int size) socket in
-  Lwt_result.return (msg_type, payload)
+  if size <> 0l then
+    let* payload = read_all ~count:(Int32.to_int size) socket in
+    Lwt_result.return (msg_type, payload)
+  else Lwt_result.return (msg_type, "")
 
 let rec read_next_raw_message ~magic_string socket f =
   let open Lwt_result.Syntax in
   let* raw = read_raw_message ~magic_string socket in
   if f raw then Lwt_result.return raw
   else read_next_raw_message ~magic_string socket f
+
+let socket_handler server () =
+  let open Lwt.Syntax in
+  let+ socket, _ = Lwt_unix.accept server in
+  let socket_in = Lwt_io.of_fd ~mode:Input socket in
+  let socket_out = Lwt_io.of_fd ~mode:Output socket in
+  Some (socket_in, socket_out, socket)
+
+let create_server path =
+  let open Lwt.Syntax in
+  let socket = Lwt_unix.socket PF_UNIX SOCK_STREAM 0 in
+  let* socket_exists = Lwt_unix.file_exists path in
+  let* () = if socket_exists then Lwt_unix.unlink path else Lwt.return () in
+  let sockaddr = Lwt_unix.ADDR_UNIX path in
+  let+ () = Lwt_unix.bind socket sockaddr in
+  let () = Lwt_unix.listen socket 100 in
+  Lwt_stream.from (socket_handler socket)
diff --git a/lib/mltp_ipc/socket.mli b/lib/mltp_ipc/socket.mli
index 9e8cf9f..f351676 100644
--- a/lib/mltp_ipc/socket.mli
+++ b/lib/mltp_ipc/socket.mli
@@ -61,3 +61,5 @@ val read_next_raw_message :
 val write_raw_message :
   magic_string:string -> socket -> Raw_message.t -> (unit, error) result Lwt.t
 (** This function may fail with [Connection_closed]. *)
+
+val create_server : string -> socket Lwt_stream.t Lwt.t
diff --git a/lib/spatial_sway_ipc/dune b/lib/spatial_sway_ipc/dune
index 4a95cc7..0203c64 100644
--- a/lib/spatial_sway_ipc/dune
+++ b/lib/spatial_sway_ipc/dune
@@ -1,3 +1,4 @@
 (library
  (name spatial_sway_ipc)
- (public_name spatial-sway.ipc))
+ (public_name spatial-sway.ipc)
+ (libraries mltp-ipc))
diff --git a/lib/spatial_sway_ipc/spatial_sway_ipc.ml b/lib/spatial_sway_ipc/spatial_sway_ipc.ml
index 07303f3..1efb8a9 100644
--- a/lib/spatial_sway_ipc/spatial_sway_ipc.ml
+++ b/lib/spatial_sway_ipc/spatial_sway_ipc.ml
@@ -1,34 +1,146 @@
+(* This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at https://mozilla.org/MPL/2.0/. *)
+
+open Mltp_ipc
+
 let socket_path = "/tmp/spatial-sway.socket"
+let magic_string = "spatial-ipc"
+
+type direction = Left | Right
+
+let direction_of_string_opt = function
+  | "left" -> Some Left
+  | "right" -> Some Right
+  | _ -> None
+
+let direction_to_string = function Left -> "left" | Right -> "right"
+
+type switch = On | Off | Toggle
+
+let switch_of_string_opt = function
+  | "on" -> Some On
+  | "off" -> Some Off
+  | "toggle" -> Some Toggle
+  | _ -> None
 
-type t =
-  | Move_left
-  | Move_right
-  | Move_window_left
-  | Move_window_right
-  | Toggle_full_view
-  | Incr_maximum_visible_space
-  | Decr_maximum_visible_space
-
-let to_int32 = function
-  | Move_left -> 0l
-  | Move_right -> 1l
-  | Move_window_left -> 2l
-  | Move_window_right -> 3l
-  | Toggle_full_view -> 4l
-  | Incr_maximum_visible_space -> 5l
-  | Decr_maximum_visible_space -> 6l
-
-let of_int32 = function
-  | 0l -> Some Move_left
-  | 1l -> Some Move_right
-  | 2l -> Some Move_window_left
-  | 3l -> Some Move_window_right
-  | 4l -> Some Toggle_full_view
-  | 5l -> Some Incr_maximum_visible_space
-  | 6l -> Some Decr_maximum_visible_space
+let switch_to_string = function On -> "on" | Off -> "off" | Toggle -> "toggle"
+
+type operation = Incr | Decr
+
+let operation_of_string_opt = function
+  | "increment" -> Some Incr
+  | "decrement" -> Some Decr
   | _ -> None
 
-let of_int32_exn i =
-  match of_int32 i with
-  | Some res -> res
-  | None -> raise (Invalid_argument "Spatial_sway_ipc.of_int32_exn")
+let operation_to_string = function Incr -> "increment" | Decr -> "decrement"
+
+type command =
+  | Focus of direction
+  | Move of direction
+  | Maximize of switch
+  | Split of operation
+
+let ( <$> ) = Option.map
+
+let command_of_string str =
+  String.split_on_char ' ' str
+  |> List.filter (function "" -> false | _ -> true)
+  |> function
+  | [ "focus"; dir ] -> (fun x -> Focus x) <$> direction_of_string_opt dir
+  | [ "move"; dir ] -> (fun x -> Move x) <$> direction_of_string_opt dir
+  | [ "maximize"; switch ] ->
+      (fun x -> Maximize x) <$> switch_of_string_opt switch
+  | [ "split"; op ] -> (fun x -> Split x) <$> operation_of_string_opt op
+  | _ -> None
+
+let command_of_string_exn str =
+  match command_of_string str with
+  | Some x -> x
+  | None -> raise (Invalid_argument "Spatial_sway_ipc.command_of_string_exn")
+
+let command_to_string = function
+  | Focus dir -> Format.sprintf "focus %s" (direction_to_string dir)
+  | Move dir -> Format.sprintf "move %s" (direction_to_string dir)
+  | Maximize switch -> Format.sprintf "maximize %s" (switch_to_string switch)
+  | Split op -> Format.sprintf "split %s" (operation_to_string op)
+
+type 'a t = Run_command : command -> unit t
+
+let reply_to_string : type a. a t -> a -> string =
+ fun cmd reply -> match (cmd, reply) with Run_command _, () -> ""
+
+let reply_of_string : type a. a t -> string -> a option =
+ fun cmd reply ->
+  match (cmd, reply) with Run_command _, "" -> Some () | _, _ -> None
+
+let reply_of_string_exn cmd reply =
+  match reply_of_string cmd reply with
+  | Some x -> x
+  | None -> failwith "cannot parse reply"
+
+let to_raw_message : type a. a t -> Raw_message.t = function
+  | Run_command cmd -> (0l, command_to_string cmd)
+
+type packed = Packed : 'a t -> packed
+
+let of_raw_message (op, payload) =
+  match op with
+  | 0l -> (fun x -> Packed (Run_command x)) <$> command_of_string payload
+  | _ -> None
+
+exception Spatial_ipc_error of Socket.error
+
+type socket = Socket.socket
+
+let connect () : socket Lwt.t = Socket.connect socket_path
+let close socket = Socket.close socket
+
+let trust_spatial f =
+  let open Lwt.Syntax in
+  let* x = f () in
+  match x with Ok x -> Lwt.return x | Error e -> raise (Spatial_ipc_error e)
+
+let with_socket f = Socket.with_socket socket_path f
+
+let socket_from_option = function
+  | Some socket -> Lwt.return socket
+  | None -> connect ()
+
+let send_command ?socket cmd =
+  let open Lwt.Syntax in
+  let* socket = 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
+  in
+  let* op', payload =
+    trust_spatial @@ fun () -> Socket.read_raw_message ~magic_string socket
+  in
+  assert (op = op');
+  Lwt.return @@ reply_of_string_exn cmd payload
+
+type ('a, 'b) handler = { handler : 'r. 'a -> 'r t -> ('b option * 'r) Lwt.t }
+
+let handle_next_command ~socket input { handler } =
+  let open Lwt.Syntax in
+  let* res = Socket.read_raw_message ~magic_string socket in
+  match res with
+  | Ok ((op, _) as raw) -> (
+      let cmd = of_raw_message raw in
+      match cmd with
+      | Some (Packed cmd) ->
+          let* output, reply = handler input cmd in
+          let* _ =
+            Socket.write_raw_message ~magic_string socket
+              (op, reply_to_string cmd reply)
+          in
+          Lwt.return output
+      | None ->
+          let* _ = Socket.write_raw_message ~magic_string socket (op, "") in
+          Lwt.return None)
+  | Error _ ->
+      let* _ = Socket.write_raw_message ~magic_string socket (-1l, "") in
+      Lwt.return None
+
+let create_server () = Socket.create_server socket_path
diff --git a/lib/spatial_sway_ipc/spatial_sway_ipc.mli b/lib/spatial_sway_ipc/spatial_sway_ipc.mli
new file mode 100644
index 0000000..a99592f
--- /dev/null
+++ b/lib/spatial_sway_ipc/spatial_sway_ipc.mli
@@ -0,0 +1,35 @@
+(* This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at https://mozilla.org/MPL/2.0/. *)
+
+val socket_path : string
+
+type direction = Left | Right
+type switch = On | Off | Toggle
+type operation = Incr | Decr
+
+type command =
+  | Focus of direction
+  | Move of direction
+  | Maximize of switch
+  | Split of operation
+
+val command_of_string : string -> command option
+
+val command_of_string_exn : string -> command
+(** @raise [Invalid_argument] *)
+
+type 'a t = Run_command : command -> unit t
+type socket
+
+val connect : unit -> socket Lwt.t
+val close : socket -> unit Lwt.t
+val with_socket : (socket -> 'a Lwt.t) -> 'a Lwt.t
+val send_command : ?socket:socket -> 'a t -> 'a Lwt.t
+
+type ('a, 'b) handler = { handler : 'r. 'a -> 'r t -> ('b option * 'r) Lwt.t }
+
+val handle_next_command :
+  socket:socket -> 'u -> ('u, 'v) handler -> 'v option Lwt.t
+
+val create_server : unit -> socket Lwt_stream.t Lwt.t