<commit_before>
#|
This file is a part of rsbag-renderer
Author: <NAME> <<EMAIL>>
|#

(in-package #:rsbag-renderer)

(defvar *json-output*)
(defvar *started*)
(defparameter *string-replaces*
  (let ((map (make-hash-table :test 'eql)))
    (loop for (k v) in '((#\\ "\\\\")
                         (#\" "\\\"")
                         (#\Backspace "\\b")
                         (#\Page "\\f")
                         (#\Newline "\\n")
                         (#\Return "\\r")
                         (#\Tab "\\t"))
          do (setf (gethash k map) v))
    map))

(declaim (inline json-delimiter
                 json-null
                 json-false
                 json-true)
         (type stream *json-output*)
         (type boolean *started*))

(defun json-delimiter (&optional (dest *json-output*))
  (declare (optimize speed) (type stream dest))
  (if *started*
      (write-byte (char-code #\,) dest)
      (setf *started* T)))

(defun json-null (&optional (dest *json-output*))
  (declare (optimize speed) (type stream dest))
  (write-string "null" dest))

(defun json-false (&optional (dest *json-output*))
  (declare (optimize speed) (type stream dest))
  (write-sequence #.(sb-ext:string-to-octets "false") dest))

(defun json-true (&optional (dest *json-output*))
  (declare (optimize speed) (type stream dest))
  (write-sequence #.(sb-ext:string-to-octets "true") dest))

(declaim (inline write-json))
(defun write-json (object &optional (dest *json-output*))
  (declare (optimize speed)
	   (type stream dest)
	   (notinline write-json))
  (typecase object
    (integer
     (princ object dest))
    
    (ratio
     (write-json (coerce object 'double-float) dest))
    
    (float
     (let ((*read-default-float-format* 'double-float))
       (format dest "~F" (coerce object 'double-float))))
    
    (string
     (write-byte (char-code #\") dest)
     (loop with start = 0 while start
	  with rep = nil
	  for end = (position-if (lambda (c) (setf rep (gethash c *string-replaces*)))
				 object :start start)
	do
	  (write-sequence (sb-ext:string-to-octets object :start start :end end) dest)
	  (when end
	    (write-string (string rep) dest)
	    (incf end))
	  (setf start end))
     (write-byte (char-code #\") dest))
    
    (list
     (with-json-array (dest)
       (loop for i in object
             do (entry i))))
    
    (vector
     (with-json-array (dest)
       (loop for i across object
             do (entry i))))
    
    (T (write-json (princ-to-string object) dest)))
  object)

(define-compiler-macro write-json (&whole whole object &optional (dest *json-output*)
				   &environment env)
  (if (constantp object env)
      (let ((value (eval object)))
	(typecase value
	  (string
	   (if (position-if (lambda (c) (gethash c *string-replaces*)) value)
	       whole
	       `(write-sequence ,(sb-ext:string-to-octets (format nil "\"~A\"" value)) ,dest)))
	  (t
	   whole)))
      whole))

(defmacro with-delimiters ((destination left right) &body body)
  `(progn
     (let ((*started* NIL))
       (write-char ,left ,destination)<commit_msg>Fix compiler-macro for write-json<commit_after>
#|
This file is a part of rsbag-renderer
Author: <NAME> <<EMAIL>>
|#

(in-package #:rsbag-renderer)

(defvar *json-output*)
(defvar *started*)
(defparameter *string-replaces*
  (let ((map (make-hash-table :test 'eql)))
    (loop for (k v) in '((#\\ "\\\\")
                         (#\" "\\\"")
                         (#\Backspace "\\b")
                         (#\Page "\\f")
                         (#\Newline "\\n")
                         (#\Return "\\r")
                         (#\Tab "\\t"))
          do (setf (gethash k map) v))
    map))

(declaim (inline json-delimiter
                 json-null
                 json-false
                 json-true)
         (type stream *json-output*)
         (type boolean *started*))

(defun json-delimiter (&optional (dest *json-output*))
  (declare (optimize speed) (type stream dest))
  (if *started*
      (write-byte (char-code #\,) dest)
      (setf *started* T)))

(defun json-null (&optional (dest *json-output*))
  (declare (optimize speed) (type stream dest))
  (write-string "null" dest))

(defun json-false (&optional (dest *json-output*))
  (declare (optimize speed) (type stream dest))
  (write-sequence #.(sb-ext:string-to-octets "false") dest))

(defun json-true (&optional (dest *json-output*))
  (declare (optimize speed) (type stream dest))
  (write-sequence #.(sb-ext:string-to-octets "true") dest))

(declaim (inline write-json))
(defun write-json (object &optional (dest *json-output*))
  (declare (optimize speed)
	   (type stream dest)
	   (notinline write-json))
  (typecase object
    (integer
     (princ object dest))
    
    (ratio
     (write-json (coerce object 'double-float) dest))
    
    (float
     (let ((*read-default-float-format* 'double-float))
       (format dest "~F" (coerce object 'double-float))))
    
    (string
     (write-byte (char-code #\") dest)
     (loop with start = 0 while start
	  with rep = nil
	  for end = (position-if (lambda (c) (setf rep (gethash c *string-replaces*)))
				 object :start start)
	do
	  (write-sequence (sb-ext:string-to-octets object :start start :end end) dest)
	  (when end
	    (write-string (string rep) dest)
	    (incf end))
	  (setf start end))
     (write-byte (char-code #\") dest))
    
    (list
     (with-json-array (dest)
       (loop for i in object
             do (entry i))))
    
    (vector
     (with-json-array (dest)
       (loop for i across object
             do (entry i))))
    
    (T (write-json (princ-to-string object) dest)))
  object)

(define-compiler-macro write-json (&whole whole object &optional (dest '*json-output*)
				   &environment env)
  (if (constantp object env)
      (let ((value (eval object)))
	(typecase value
	  (string
	   (if (position-if (lambda (c) (gethash c *string-replaces*)) value)
	       whole
	       `(write-sequence ,(sb-ext:string-to-octets (format nil "\"~A\"" value)) ,dest)))
	  (t
	   whole)))
      whole))

(defmacro with-delimiters ((destination left right) &body body)
  `(progn
     (let ((*started* NIL))
       (write-char ,left ,destination)
{'fraction_non_alphanumeric': 0.16196615632554393, 'fraction_numerical': 0.00032232070910556004, 'mean_word_length': 2.2940552016985136, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 9, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5228817', 'n_tokens_mistral': 2134, 'n_tokens_neox': 2008, 'n_words': 584}