From db30d2b47dbac5acc771ec59f3352fe86fa91cbe Mon Sep 17 00:00:00 2001
From: cage <cage@invalid>
Date: Fri, 23 Dec 2022 13:23:08 +0100
Subject: [PATCH] - added some scaffolding for RPC;

- added 'read-delimited-into-array'.
---
 src/gui/json-rpc-communication.lisp | 13 +++++++++
 src/misc-utils.lisp                 | 42 +++++++++++++++++++++++++++++
 src/package.lisp                    | 17 ++++++++++++
 src/tests/misc-tests.lisp           | 35 ++++++++++++++++++++++++
 tinmop.asd                          |  3 +++
 5 files changed, 110 insertions(+)
 create mode 100644 src/gui/json-rpc-communication.lisp

diff --git a/src/gui/json-rpc-communication.lisp b/src/gui/json-rpc-communication.lisp
new file mode 100644
index 0000000..6a6cac4
--- /dev/null
+++ b/src/gui/json-rpc-communication.lisp
@@ -0,0 +1,13 @@
+(in-package :json-rpc-communication)
+
+(defparameter *server-input-stream* *standard-input*)
+
+(defparameter *server-output-stream* *standard-output*)
+
+(defparameter *client-input-stream* *standard-input*)
+
+(defparameter *client-output-stream* *standard-output*)
+
+(defun start-server ())
+
+(defun read-json ())
diff --git a/src/misc-utils.lisp b/src/misc-utils.lisp
index 0229702..d49b732 100644
--- a/src/misc-utils.lisp
+++ b/src/misc-utils.lisp
@@ -482,6 +482,48 @@ to the array"
             (setf raw (reverse rev))))
         (misc:list->array raw '(unsigned-byte 8))))))
 
+(define-condition delimiter-not-found (error)
+  ((delimiter
+    :initarg :delimiter
+    :reader  delimiter))
+  (:report (lambda (condition stream)
+             (format stream "delimiter ~s not found and stream closed" (delimiter condition))))
+  (:documentation "Condition signalled when a command the user inputed
+  was not found in keybindings tree."))
+
+(defparameter *read-delimiter* 0)
+
+(defun read-delimited-into-array (stream &key
+                                           (delimiter *read-delimiter*)
+                                           (buffer-size 2048)
+                                           (buffer (make-fresh-array buffer-size
+                                                                     0
+                                                                     '(unsigned-byte 8)
+                                                                     t))
+                                           (accum  (make-fresh-array 0
+                                                                     0
+                                                                     '(unsigned-byte 8))))
+  (flet ((delimiter-position ()
+           (position delimiter accum :test #'=)))
+    (let ((read-so-far (read-sequence buffer stream)))
+      (setf accum (concatenate 'vector accum (subseq buffer 0 read-so-far)))
+      (if (< read-so-far buffer-size)
+          (if (or (< (length accum) 1)
+                  (not (delimiter-position)))
+              (error 'delimiter-not-found :delimiter delimiter)
+              (values (subseq accum 0 (1- (length accum)))
+                      #()))
+          (if (delimiter-position)
+              (let* ((delimiter-position (delimiter-position))
+                     (excess             (subseq accum (1+ delimiter-position))))
+                (values (subseq accum 0 delimiter-position)
+                        excess))
+              (read-delimited-into-array stream
+                                         :delimiter   delimiter
+                                         :buffer-size buffer-size
+                                         :buffer      buffer
+                                         :accum       accum))))))
+
 ;; sequence utils
 
 (defun safe-elt (sequence index)
diff --git a/src/package.lisp b/src/package.lisp
index 45d7d3a..9e84dce 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -185,6 +185,9 @@
    :read-array
    :read-all
    :read-line-into-array
+   :delimiter-not-found
+   :*read-delimiter*
+   :read-delimited-into-array
    :definline
    :+cache-invalid-value+
    :defcached
@@ -3041,6 +3044,20 @@
   (:shadowing-import-from :misc :random-elt :shuffle)
   (:export))
 
+(defpackage :json-rpc-communication
+  (:use
+   :cl
+   :config
+   :constants
+   :text-utils
+   :misc-utils)
+  (:local-nicknames (:re  :cl-ppcre-unicode)
+                    (:a   :alexandria)
+                    (:rpc :json-rpc2))
+
+  (:export))
+
+
 (defpackage :main
   (:use
    :cl
diff --git a/src/tests/misc-tests.lisp b/src/tests/misc-tests.lisp
index 62bf7a8..4d9c61a 100644
--- a/src/tests/misc-tests.lisp
+++ b/src/tests/misc-tests.lisp
@@ -23,3 +23,38 @@
   (assert-true
       (let ((bag (loop repeat 1000 collect (num:lcg-next-upto 1000))))
         (null (set-difference bag (shuffle bag))))))
+
+(defun read-delimited-excess (&optional (data '(1 2 3 4 5 6 0 7 8)))
+  (flexi-streams:with-input-from-sequence (stream data)
+    (read-delimited-into-array stream :buffer-size 3)))
+
+(defun read-delimited-aligned-to-buffer (&optional (data '(1 2 3 4 5 0 7 8)))
+  (flexi-streams:with-input-from-sequence (stream data)
+    (read-delimited-into-array stream :buffer-size 3)))
+
+(defun read-delimited-no-excess (&optional (data '(1 2 3 4 5 6 0)))
+  (flexi-streams:with-input-from-sequence (stream data)
+    (read-delimited-into-array stream :buffer-size 3)))
+
+(defun read-delimited-error (&optional (data '(1 2 3 4 5 6 7)))
+  (flexi-streams:with-input-from-sequence (stream data)
+    (read-delimited-into-array stream :buffer-size 3)))
+
+(deftest test-read-delimited-excess (misc-suite)
+  (assert-equalp (values #(1 2 3 4 5 6)
+                         #(7 8))
+      (read-delimited-excess)))
+
+(deftest test-read-delimited-aligned-to-buffer (misc-suite)
+  (assert-equalp (values #(1 2 3 4 5)
+                         #())
+      (read-delimited-aligned-to-buffer)))
+
+(deftest test-read-delimited-no-excess (misc-suite)
+  (assert-equalp (values #(1 2 3 4 5 6)
+                         #())
+      (read-delimited-no-excess)))
+
+(deftest test-read-delimited-no-excess (misc-suite)
+  (assert-condition delimiter-not-found
+      (read-delimited-error)))
diff --git a/tinmop.asd b/tinmop.asd
index 735ac9d..f8d1908 100644
--- a/tinmop.asd
+++ b/tinmop.asd
@@ -27,6 +27,7 @@
                :tooter
                :croatoan
                :osicat
+               :flexi-streams
                :cl-spark
                :access
                :sqlite
@@ -145,6 +146,8 @@
                (:file "scheduled-events")
                (:file "modules")
                (:file "json-rpc2")
+               (:module gui
+                        :components ((:file "json-rpc-communication")))
                (:file "main")
                (:module tests
                         :components ((:file "package")