mirror of https://codeberg.org/cage/tinmop/
- added some scaffolding for RPC;
- added 'read-delimited-into-array'.
This commit is contained in:
parent
d937235d6c
commit
db30d2b47d
|
@ -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 ())
|
|
@ -482,6 +482,48 @@ to the array"
|
||||||
(setf raw (reverse rev))))
|
(setf raw (reverse rev))))
|
||||||
(misc:list->array raw '(unsigned-byte 8))))))
|
(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
|
;; sequence utils
|
||||||
|
|
||||||
(defun safe-elt (sequence index)
|
(defun safe-elt (sequence index)
|
||||||
|
|
|
@ -185,6 +185,9 @@
|
||||||
:read-array
|
:read-array
|
||||||
:read-all
|
:read-all
|
||||||
:read-line-into-array
|
:read-line-into-array
|
||||||
|
:delimiter-not-found
|
||||||
|
:*read-delimiter*
|
||||||
|
:read-delimited-into-array
|
||||||
:definline
|
:definline
|
||||||
:+cache-invalid-value+
|
:+cache-invalid-value+
|
||||||
:defcached
|
:defcached
|
||||||
|
@ -3041,6 +3044,20 @@
|
||||||
(:shadowing-import-from :misc :random-elt :shuffle)
|
(:shadowing-import-from :misc :random-elt :shuffle)
|
||||||
(:export))
|
(: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
|
(defpackage :main
|
||||||
(:use
|
(:use
|
||||||
:cl
|
:cl
|
||||||
|
|
|
@ -23,3 +23,38 @@
|
||||||
(assert-true
|
(assert-true
|
||||||
(let ((bag (loop repeat 1000 collect (num:lcg-next-upto 1000))))
|
(let ((bag (loop repeat 1000 collect (num:lcg-next-upto 1000))))
|
||||||
(null (set-difference bag (shuffle bag))))))
|
(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)))
|
||||||
|
|
|
@ -27,6 +27,7 @@
|
||||||
:tooter
|
:tooter
|
||||||
:croatoan
|
:croatoan
|
||||||
:osicat
|
:osicat
|
||||||
|
:flexi-streams
|
||||||
:cl-spark
|
:cl-spark
|
||||||
:access
|
:access
|
||||||
:sqlite
|
:sqlite
|
||||||
|
@ -145,6 +146,8 @@
|
||||||
(:file "scheduled-events")
|
(:file "scheduled-events")
|
||||||
(:file "modules")
|
(:file "modules")
|
||||||
(:file "json-rpc2")
|
(:file "json-rpc2")
|
||||||
|
(:module gui
|
||||||
|
:components ((:file "json-rpc-communication")))
|
||||||
(:file "main")
|
(:file "main")
|
||||||
(:module tests
|
(:module tests
|
||||||
:components ((:file "package")
|
:components ((:file "package")
|
||||||
|
|
Loading…
Reference in New Issue