(in-package #:vivace-graph-v2)

  The foundation of the serialization code comes from   
  " Object - Oriented Programming in Common Lisp . "   Thanks  !

(defgeneric serialize (thing stream))
(defgeneric serialize-action (action stream &rest args))

(defmethod serialize :around (thing stream)
  (handler-case
      (call-next-method)
    (error (condition)
      (error 'serialization-error :instance thing :reason condition))))

(defun serialize-integer (int stream)
  (let ((n-bytes (ceiling (integer-length int) 8)))
    (write-byte n-bytes stream)
    (dotimes (i n-bytes)
      (write-byte (ldb (byte 8 0) int) stream)
      (setq int (ash int -8)))))

(defmethod serialize ((int integer) (stream stream))
  "Encodes integers between
(- (1- (expt 2 (* 8 255))))
 and
(1- (expt 2 (* 8 255)))"
  (if (minusp int)
      (progn
	(write-byte +negative-integer+ stream)
	(setq int (abs int)))
      (write-byte +positive-integer+ stream))
  (serialize-integer int stream))

(defmethod serialize ((ratio ratio) (stream stream))
  (let* ((numerator (numerator ratio)) (denominator (denominator ratio)))
    (write-byte +ratio+ stream)
    (serialize numerator stream)
    (serialize denominator stream)))

(defmethod serialize ((float single-float) (stream stream))
  (write-byte +single-float+ stream)
  (serialize-integer (ieee-floats:encode-float32 float) stream))

(defmethod serialize ((float double-float) (stream stream))
  (write-byte +single-float+ stream)
  (serialize-integer (ieee-floats:encode-float64 float) stream))

(defmethod serialize ((char character) (stream stream))
  (write-byte +character+ stream)
  (serialize-integer (char-code char) stream))

(defmethod serialize ((string string) (stream stream))
  ;; FIXME: what is the right length to enable compression?
  (if (and *compression-enabled?* (> (length string) 20))
      (let* ((comp (salza2:compress-data
		    (babel:string-to-octets string) 'salza2:zlib-compressor))
	     (length (length comp)))
	(write-byte +compressed-string+ stream)
	(serialize length stream)
	(dotimes (i length)
	  (write-byte (aref comp i) stream)))
      (let* ((unicode (babel:string-to-octets string))
	     (length (length unicode)))
	(write-byte +string+ stream)
	(serialize length stream)
	(dotimes (i length)
	  (write-byte (aref unicode i) stream)))))

(defmethod serialize ((symbol symbol) (stream stream))
  (cond ((null symbol)
	 (write-byte +null+ stream))
        ((eq symbol t)
	 (write-byte +t+ stream))
        (t
	 (write-byte +symbol+ stream)
	 (serialize (symbol-name symbol) stream)
	 (serialize (package-name (symbol-package symbol)) stream))))

(defmethod serialize ((uuid uuid:uuid) (stream stream))
  (write-byte +uuid+ stream)
  (uuid:serialize-uuid uuid stream))

(defun serialize-sequence (seq stream code)
  (let ((length (length seq)))
    (write-byte code stream)
    (serialize length stream)
    (dotimes (i length)
      (serialize (elt seq i) stream))))

(defmethod serialize ((list list) (stream stream))
  (serialize-sequence list stream +list+))

(defmethod serialize ((vector vector) (stream stream))
  (serialize-sequence vector stream +vector+))

(defun serialize-triple-help (triple stream)
  (let ((graph-pkg (find-package 'graph-words)))
    (if (and (symbolp (subject triple))
	     (eq (symbol-package (subject triple)) graph-pkg))
	(serialize (symbol-name (subject triple)) stream)
	(serialize (subject triple) stream))
    (if (and (symbolp (predicate triple))
	     (eq (symbol-package (predicate triple)) graph-pkg))
	(serialize (symbol-name (predicate triple)) stream)
	(serialize (predicate triple) stream))
    (if (and (symbolp (object triple))
	     (eq (symbol-package (object triple)) graph-pkg))
	(serialize (symbol-name (object triple)) stream)
	(serialize (object triple) stream))
    (if (and (symbolp (graph triple))
	     (eq (symbol-package (graph triple)) graph-pkg))
	(serialize (symbol-name (graph triple)) stream)
	(serialize (graph triple) stream))
    (serialize (id triple) stream)
    (serialize (deleted? triple) stream)
    (serialize (cf triple) stream)))

(defmethod serialize ((triple triple) (stream stream))
  (write-byte +triple+ stream)
  (serialize-triple-help triple stream))

(defmethod serialize-action ((action (eql :add-triple)) stream &rest args)
  (logger :debug "Serialize-action ~A: ~A~%" action args)
  (write-byte +add-triple+ stream)
  (if (triple? (first args))
      ;; We generally want to avoid this, as the triple could change between
      ;; requested serialization and actual serialization.
      (serialize-triple-help (first args) stream)
      (let ((subject (nth 0 args))
            (predicate (nth 1 args))
            (object (nth 2 args))
	    (graph (nth 3 args)) (graph-pkg (find-package 'graph-words)))
	(if (and (symbolp subject) (eq (symbol-package subject) graph-pkg))
	    (serialize (symbol-name subject) stream)
	    (serialize subject stream))
	(if (and (symbolp predicate)
                 (eq (symbol-package predicate) graph-pkg))
	    (serialize (symbol-name predicate) stream)
	    (serialize predicate stream))
	(if (and (symbolp object) (eq (symbol-package object) graph-pkg))
	    (serialize (symbol-name object) stream)
	    (serialize object stream))
	(if (and (symbolp graph) (eq (symbol-package graph) graph-pkg))
	    (serialize (symbol-name graph) stream)
	    (serialize graph stream))
	(serialize (nth 4 args) stream)	    ;; id
	(serialize (nth 5 args) stream)	    ;; deleted?
	(serialize (nth 6 args) stream)))) ;; cf

(defmethod serialize-action ((action (eql :delete-triple)) stream &rest args)
  (write-byte +delete-triple+ stream)
  (serialize (nth 0 args) stream)  ;; id
  (serialize (nth 1 args) stream)) ;; timestamp

(defmethod serialize-action ((action (eql :undelete-triple)) stream &rest
                             args)
  (write-byte +undelete-triple+ stream)
  (serialize (nth 0 args) stream)) ;; id

(defmethod serialize-action ((action (eql :set-cf)) stream &rest args)
  (write-byte +set-cf+ stream)
  (serialize (nth 0 args) stream)  ;; id
  (serialize (nth 1 args) stream)) ;; cf

(defmethod serialize-action ((action (eql :transaction)) stream &rest args)
  (write-byte +transaction+ stream)
  (let ((tx (nth 0 args)))
( serialize ( length ( tx - queue tx ) ) stream )
    (dolist (a (reverse (tx-queue tx)))
      (logger :debug "TX: serializing ~A / ~A~%" (first a) (rest a))
      (apply #'serialize-action
	     (nconc (list (first a) stream) (rest a))))))

(defun test-serializer (file)
  (with-open-file (stream file
			  :direction :output
			  :element-type '(unsigned-byte 8)
			  :if-exists :overwrite
			  :if-does-not-exist :create)
    (let ((uuid (make-uuid))
	  (vec (make-array 5)))
      (setf (aref vec 0) 1)
      (setf (aref vec 1) #\a)
      (setf (aref vec 2) "string")
      (setf (aref vec 3) 'symbol)
      (setf (aref vec 4) uuid)
      (format t "UUID IS ~A~%" uuid)
      (serialize 123 stream)
      (serialize 123.123 stream)
      (serialize 123/555 stream)
      (serialize #\a stream)
      (serialize "string" stream)
      (serialize 'symbol stream)
      (serialize uuid stream)
      (serialize (list 1 #\a "string" 'symbol uuid) stream)
      (serialize vec stream)))
  (deserialize-file file))

 FIXME: what is the right length to enable compression?
 We generally want to avoid this, as the triple could change between
 requested serialization and actual serialization.
 id
 deleted?
 cf
 id
 timestamp
 id
 id
 cf
(in-package #:vivace-graph-v2)

  The foundation of the serialization code comes from   
  " Object - Oriented Programming in Common Lisp . "   Thanks  !

(defgeneric serialize (thing stream))
(defgeneric serialize-action (action stream &rest args))

(defmethod serialize :around (thing stream)
  (handler-case
      (call-next-method)
    (error (condition)
      (error 'serialization-error :instance thing :reason condition))))

(defun serialize-integer (int stream)
  (let ((n-bytes (ceiling (integer-length int) 8)))
    (write-byte n-bytes stream)
    (dotimes (i n-bytes)
      (write-byte (ldb (byte 8 0) int) stream)
      (setq int (ash int -8)))))

(defmethod serialize ((int integer) (stream stream))
  "Encodes integers between
(- (1- (expt 2 (* 8 255))))
 and
(1- (expt 2 (* 8 255)))"
  (if (minusp int)
      (progn
	(write-byte +negative-integer+ stream)
	(setq int (abs int)))
      (write-byte +positive-integer+ stream))
  (serialize-integer int stream))

(defmethod serialize ((ratio ratio) (stream stream))
  (let* ((numerator (numerator ratio)) (denominator (denominator ratio)))
    (write-byte +ratio+ stream)
    (serialize numerator stream)
    (serialize denominator stream)))

(defmethod serialize ((float single-float) (stream stream))
  (write-byte +single-float+ stream)
  (serialize-integer (ieee-floats:encode-float32 float) stream))

(defmethod serialize ((float double-float) (stream stream))
  (write-byte +single-float+ stream)
  (serialize-integer (ieee-floats:encode-float64 float) stream))

(defmethod serialize ((char character) (stream stream))
  (write-byte +character+ stream)
  (serialize-integer (char-code char) stream))

(defmethod serialize ((string string) (stream stream))
  (if (and *compression-enabled?* (> (length string) 20))
      (let* ((comp (salza2:compress-data
		    (babel:string-to-octets string) 'salza2:zlib-compressor))
	     (length (length comp)))
	(write-byte +compressed-string+ stream)
	(serialize length stream)
	(dotimes (i length)
	  (write-byte (aref comp i) stream)))
      (let* ((unicode (babel:string-to-octets string))
	     (length (length unicode)))
	(write-byte +string+ stream)
	(serialize length stream)
	(dotimes (i length)
	  (write-byte (aref unicode i) stream)))))

(defmethod serialize ((symbol symbol) (stream stream))
  (cond ((null symbol)
	 (write-byte +null+ stream))
        ((eq symbol t)
	 (write-byte +t+ stream))
        (t
	 (write-byte +symbol+ stream)
	 (serialize (symbol-name symbol) stream)
	 (serialize (package-name (symbol-package symbol)) stream))))

(defmethod serialize ((uuid uuid:uuid) (stream stream))
  (write-byte +uuid+ stream)
  (uuid:serialize-uuid uuid stream))

(defun serialize-sequence (seq stream code)
  (let ((length (length seq)))
    (write-byte code stream)
    (serialize length stream)
    (dotimes (i length)
      (serialize (elt seq i) stream))))

(defmethod serialize ((list list) (stream stream))
  (serialize-sequence list stream +list+))

(defmethod serialize ((vector vector) (stream stream))
  (serialize-sequence vector stream +vector+))

(defun serialize-triple-help (triple stream)
  (let ((graph-pkg (find-package 'graph-words)))
    (if (and (symbolp (subject triple))
	     (eq (symbol-package (subject triple)) graph-pkg))
	(serialize (symbol-name (subject triple)) stream)
	(serialize (subject triple) stream))
    (if (and (symbolp (predicate triple))
	     (eq (symbol-package (predicate triple)) graph-pkg))
	(serialize (symbol-name (predicate triple)) stream)
	(serialize (predicate triple) stream))
    (if (and (symbolp (object triple))
	     (eq (symbol-package (object triple)) graph-pkg))
	(serialize (symbol-name (object triple)) stream)
	(serialize (object triple) stream))
    (if (and (symbolp (graph triple))
	     (eq (symbol-package (graph triple)) graph-pkg))
	(serialize (symbol-name (graph triple)) stream)
	(serialize (graph triple) stream))
    (serialize (id triple) stream)
    (serialize (deleted? triple) stream)
    (serialize (cf triple) stream)))

(defmethod serialize ((triple triple) (stream stream))
  (write-byte +triple+ stream)
  (serialize-triple-help triple stream))

(defmethod serialize-action ((action (eql :add-triple)) stream &rest args)
  (logger :debug "Serialize-action ~A: ~A~%" action args)
  (write-byte +add-triple+ stream)
  (if (triple? (first args))
      (serialize-triple-help (first args) stream)
      (let ((subject (nth 0 args))
            (predicate (nth 1 args))
            (object (nth 2 args))
	    (graph (nth 3 args)) (graph-pkg (find-package 'graph-words)))
	(if (and (symbolp subject) (eq (symbol-package subject) graph-pkg))
	    (serialize (symbol-name subject) stream)
	    (serialize subject stream))
	(if (and (symbolp predicate)
                 (eq (symbol-package predicate) graph-pkg))
	    (serialize (symbol-name predicate) stream)
	    (serialize predicate stream))
	(if (and (symbolp object) (eq (symbol-package object) graph-pkg))
	    (serialize (symbol-name object) stream)
	    (serialize object stream))
	(if (and (symbolp graph) (eq (symbol-package graph) graph-pkg))
	    (serialize (symbol-name graph) stream)
	    (serialize graph stream))

(defmethod serialize-action ((action (eql :delete-triple)) stream &rest args)
  (write-byte +delete-triple+ stream)

(defmethod serialize-action ((action (eql :undelete-triple)) stream &rest
                             args)
  (write-byte +undelete-triple+ stream)

(defmethod serialize-action ((action (eql :set-cf)) stream &rest args)
  (write-byte +set-cf+ stream)

(defmethod serialize-action ((action (eql :transaction)) stream &rest args)
  (write-byte +transaction+ stream)
  (let ((tx (nth 0 args)))
( serialize ( length ( tx - queue tx ) ) stream )
    (dolist (a (reverse (tx-queue tx)))
      (logger :debug "TX: serializing ~A / ~A~%" (first a) (rest a))
      (apply #'serialize-action
	     (nconc (list (first a) stream) (rest a))))))

(defun test-serializer (file)
  (with-open-file (stream file
			  :direction :output
			  :element-type '(unsigned-byte 8)
			  :if-exists :overwrite
			  :if-does-not-exist :create)
    (let ((uuid (make-uuid))
	  (vec (make-array 5)))
      (setf (aref vec 0) 1)
      (setf (aref vec 1) #\a)
      (setf (aref vec 2) "string")
      (setf (aref vec 3) 'symbol)
      (setf (aref vec 4) uuid)
      (format t "UUID IS ~A~%" uuid)
      (serialize 123 stream)
      (serialize 123.123 stream)
      (serialize 123/555 stream)
      (serialize #\a stream)
      (serialize "string" stream)
      (serialize 'symbol stream)
      (serialize uuid stream)
      (serialize (list 1 #\a "string" 'symbol uuid) stream)
      (serialize vec stream)))
  (deserialize-file file))
