/
writer.lisp
95 lines (83 loc) · 2.71 KB
/
writer.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
(in-package :jsown)
(declaim (optimize (speed 3) (debug 3) (safety 0)))
;;;;;;;;;;;;;;;;;;
;; generic writing
(defgeneric to-json (object)
(:documentation "Writes the given object to json in a generic way."))
(defmethod to-json ((string string))
(with-output-to-string (stream)
(write-string string stream)))
(defmethod to-json ((number number))
(with-output-to-string (stream)
(write number :stream stream :pretty nil)))
(defmethod to-json ((ratio ratio))
(to-json (coerce ratio 'float)))
(defmethod to-json ((list list))
(let ((*print-pretty* nil)) ;; *pretty-print* makes printing very slow, internal json objects needn't have this
(if (eq (car list) :obj)
(object-to-json (cdr list))
(list-to-json list))))
(defun object-to-json (list)
(format nil "{~{~{~A:~A~}~^,~}}"
(loop for item in list collect
(list (to-json (car item))
(to-json (cdr item))))))
(defun list-to-json (list)
(format nil "[~{~A~^,~}]"
(mapcar #'to-json list)))
;;;;;;;;;;;;;;;;;
;; speedy writing
(defun list-is-object-p (list)
(declare (type (or cons nil) list))
(and (consp list)
(eq (car list) :obj)))
(defun to-json* (object)
"Converts an object in internal jsown representation to a string containing the json representation"
(let ((*print-pretty* nil))
(with-output-to-string (output)
(write-object-to-stream object output))))
(defun write-number* (object output)
(declare (type number object)
(type stream output))
(write object :stream output))
(defun write-string* (object output)
(declare (type string object)
(type stream output))
(write-string object output))
(declaim (inline write-number* write-string*))
(defun write-object-to-stream (object output)
(declare (type stream output))
(typecase object
(ratio (write (coerce object 'float) :stream output))
(number (write-number* object output))
(string (write-string* object output))
(T (if (list-is-object-p object)
(if (null (cdr object))
"{}"
(progn
(format output "{")
(write-string* (caadr object) output)
(format output ":")
(write-object-to-stream (cdadr object) output)
(loop
for curr-obj in (cdr object)
do (progn
(let ((k (car curr-obj))
(v (cdr curr-obj)))
(declare (type string k))
(format output ",")
(write-string* k output)
(format output ":")
(write-object-to-stream v output))))
(format output "}")))
(progn
(if (null (cdr object))
(format output "[]")
(progn
(format output "[")
(write-object-to-stream (first object) output)
(loop for item in (rest object)
do (progn
(format output ",")
(write-object-to-stream item output)))
(format output "]"))))))))