[Use cxml-types for deserialization clinton@unknownlamer.org**20090502013243 Ignore-this: 35d129dbe457dee3641e287bfc7c5def * Deserializers for custom types should be implemented as CXML-TYPE:DATA-TYPEs * `xml->lisp-value' and `lisp->xml-value' are now passed a CXML-TYPES:DATA-TYPE instance instead of the symbolic type name * Lispified type names * Redefine all codecs using new interface The basic type codec protocol and implementation seem fairly sane now. ] hunk ./src/codec.lisp 3 +(defvar *xmlisp-type-to-cxml-type* (make-hash-table)) + +(defun add-xmlisp-type-mapping (xmlisp-name cxml-type-name) + (setf (gethash xmlisp-name *xmlisp-type-to-cxml-type*) + (make-instance cxml-type-name))) + +(defun find-cxml-type (xmlisp-type-name) + (gethash xmlisp-type-name *xmlisp-type-to-cxml-type*)) + hunk ./src/codec.lisp 15 -(defmacro define-xml-type (XML-TYPE XML-SUPERS LISP-TYPE-SPEC PARSE UNPARSE) +(defmethod xml->lisp-value (xml-value (xml-type cxml-types:data-type)) + (cxml-types:parse xml-type xml-value)) + +(defmacro define-xml-type (XML-TYPE XML-SUPERS LISP-TYPE-SPEC CXML-TYPE UNPARSE) hunk ./src/codec.lisp 24 - (defcodec ,xml-type ,parse ,unparse))) + (eval-when (:load-toplevel) + (add-xmlisp-type-mapping ',xml-type ',cxml-type)) + (defcodec ,xml-type ,cxml-type ,unparse))) hunk ./src/codec.lisp 29 - ((xml-value-name lisp-type-name) &body parse) + cxml-type hunk ./src/codec.lisp 33 - (defmethod xml->lisp-value (,xml-value-name (,lisp-type-name (eql ',type))) - ,@parse) - (defmethod lisp->xml-value ((,lisp-value-name ,lisp-type) (,xml-type-name (eql ',type))) + (defmethod lisp->xml-value ((,lisp-value-name ,lisp-type) (,xml-type-name ,cxml-type)) hunk ./src/codec.lisp 37 - (parse &optional (assert nil assert-p)) + cxml-type hunk ./src/codec.lisp 39 - (with-unique-names (xml-value lisp-value lisp-type xml-type maybe-parsed) - `(define-xml-type ,type-name ,supers ,type-spec - ((,xml-value ,lisp-type) - (let ((,maybe-parsed (,parse ,xml-value))) - (assert ,(if assert-p - `(,assert ,maybe-parsed) - `(typep ,maybe-parsed ,lisp-type))) - ,maybe-parsed)) - ((,lisp-value ,xml-type ,lisp-type-name) - (declare (ignore ,xml-type)) - (,unparse ,lisp-value))))) + (with-unique-names (lisp-value xml-type) + `(define-xml-type ,type-name ,supers ,type-spec ,cxml-type + ((,lisp-value ,xml-type ,lisp-type-name) + (declare (ignore ,xml-type)) + (,unparse ,lisp-value))))) hunk ./src/codec.lisp 51 - ,(second def) - (read-from-string) - (princ-to-string ,(second def)))) + ,(second def) ,(third def) + (princ-to-string ,(second def)))) hunk ./src/codec.lisp 55 - ((xmlisp2.types:decimal) number) - ((xmlisp2.types:float) single-float) - ((xmlisp2.types:double) double-float))) + ((xmlisp2.types:decimal) number cxml-types:decimal-type) + ((xmlisp2.types:float) single-float cxml-types:float-type) + ((xmlisp2.types:double) double-float cxml-types:double-type))) hunk ./src/codec.lisp 59 -(define-simple-xml-type (xmlisp2.types:integer xmlisp2.types:decimal) integer - (parse-integer) (princ-to-string integer)) +(define-simple-xml-type (xmlisp2.types:integer xmlisp2.types:decimal) + integer cxml-types:integer-type + (princ-to-string integer)) hunk ./src/codec.lisp 63 -(define-simple-xml-type (XMLISP2.TYPES:|nonPositiveInteger| xmlisp2.types:integer) - (integer * 0) - (parse-integer) (princ-to-string integer)) +(define-simple-xml-type (xmlisp2.types:non-positive-integer xmlisp2.types:integer) + (integer * 0) cxml-types:non-positive-integer-type + (princ-to-string integer)) hunk ./src/codec.lisp 67 -(define-simple-xml-type (XMLISP2.TYPES:|negativeInteger| - XMLISP2.TYPES:|nonPositiveInteger|) - (integer * -1) - (parse-integer) (princ-to-string integer)) +(define-simple-xml-type (xmlisp2.types:negative-integer xmlisp2.types:non-positive-integer) + (integer * -1) cxml-types:non-positive-integer-type + (princ-to-string integer)) hunk ./src/codec.lisp 72 - (integer -9223372036854775808 9223372036854775807) - (parse-integer) (princ-to-string integer)) + (integer -9223372036854775808 9223372036854775807) cxml-types:long-type + (princ-to-string integer)) hunk ./src/codec.lisp 76 - (integer -2147483648 2147483647) - (parse-integer) (princ-to-string integer)) + (integer -2147483648 2147483647) cxml-types:int-type + (princ-to-string integer)) hunk ./src/codec.lisp 80 - (integer -32768 32767) - (parse-integer) (princ-to-string integer)) + (integer -32768 32767) cxml-types:short-type + (princ-to-string integer)) hunk ./src/codec.lisp 84 - (integer -128 127) - (parse-integer) (princ-to-string integer)) + (integer -128 127) cxml-types:byte-type + (princ-to-string integer)) hunk ./src/codec.lisp 87 -(define-simple-xml-type (XMLISP2.TYPES:|nonNegativeInteger| - xmlisp2.types:integer) - (integer 0 *) - (parse-integer) (princ-to-string integer)) +(define-simple-xml-type (xmlisp2.types:non-negative-integer + xmlisp2.types:integer) + (integer 0 *) cxml-types:non-negative-integer-type + (princ-to-string integer)) hunk ./src/codec.lisp 92 -(define-simple-xml-type (XMLISP2.TYPES:|unsignedLong| - XMLISP2.TYPES:|nonNegativeInteger|) - - (integer 0 18446744073709551615) - (parse-integer) (princ-to-string integer)) +(define-simple-xml-type (xmlisp2.types:unsigned-long xmlisp2.types:non-negative-integer) + (integer 0 18446744073709551615) cxml-types:unsigned-long-type + (princ-to-string integer)) hunk ./src/codec.lisp 96 -(define-simple-xml-type (xmlisp2.types:|unsignedInt| xmlisp2.types:|unsignedLong|) - (integer 0 2147483647) - (parse-integer) (princ-to-string integer)) +(define-simple-xml-type (xmlisp2.types:unsigned-int xmlisp2.types:unsigned-long) + (integer 0 2147483647) cxml-types:unsigned-int-type + (princ-to-string integer)) hunk ./src/codec.lisp 100 -(define-simple-xml-type (xmlisp2.types:|unsignedShort| xmlisp2.types:|unsignedInt|) - (integer 0 32767) - (parse-integer) (princ-to-string integer)) +(define-simple-xml-type (xmlisp2.types:unsigned-short xmlisp2.types:unsigned-int) + (integer 0 32767) cxml-types:unsigned-short-type + (princ-to-string integer)) hunk ./src/codec.lisp 104 -(define-simple-xml-type (xmlisp2.types:|unsignedByte| xmlisp2.types:|unsignedShort|) - (integer 0 127) - (parse-integer) (princ-to-string integer)) +(define-simple-xml-type (xmlisp2.types:unsigned-byte xmlisp2.types:unsigned-short) + (integer 0 127) cxml-types:unsigned-byte-type + (princ-to-string integer)) hunk ./src/codec.lisp 108 -(define-simple-xml-type (XMLISP2.TYPES:|positiveInteger| - XMLISP2.TYPES:|nonNegativeInteger|) +(define-simple-xml-type (xmlisp2.types:positive-integer + xmlisp2.types:non-negative-integer) hunk ./src/codec.lisp 111 - (integer 1 *) - (parse-integer) (princ-to-string integer)) + (integer 1 *) cxml-types:positive-integer-type + (princ-to-string integer)) hunk ./src/codec.lisp 114 -(define-xml-type xmlisp2.types:boolean () (member t nil) - ((xml-value lisp-type) - (cond ((or (string= xml-value "1") (string= xml-value "true")) t) - ((or (string= xml-value "0") (string= xml-value "false")) nil) - (t (error "invalid boolean value")))) +(define-xml-type xmlisp2.types:boolean () (member t nil) cxml-types:boolean-type hunk ./src/codec.lisp 120 -(define-simple-xml-type (xmlisp2.types:string) cl:string (identity) +(define-simple-xml-type (xmlisp2.types:string) cl:string cxml-types:string-type hunk ./src/packages.lisp 8 - :lisp->xml-value)) + :lisp->xml-value + + :define-xml-type + :define-simple-xml-type + + :find-cxml-type)) hunk ./src/packages.lisp 57 - #:|nonPositiveInteger| - #:|negativeInteger| + #:non-positive-integer + #:negative-integer hunk ./src/packages.lisp 63 - #:|nonNegativeInteger| - #:|unsignedLong| - #:|unsignedInt| - #:|unsignedShort| - #:|unsignedByte| - #:|positiveInteger|)) + #:non-negative-integer + #:unsigned-long + #:unsigned-int + #:unsigned-short + #:unsigned-byte + #:positive-integer)) hunk ./src/serializer-class.lisp 18 - (c2mop:slot-definition-type slot-definition))) + (find-cxml-type + (c2mop:slot-definition-type slot-definition)))) hunk ./src/unparse.lisp 75 - type) + (find-cxml-type type)) hunk ./tests/test.lisp 12 - ((bar :initform 0 :type xmlisp2.types:decimal) + ((bar :initform 0 :type xmlisp2.types:non-positive-integer) hunk ./tests/test.xml 2 - + hunk ./xmlisp.asd 20 - :depends-on ("protocol" "codec" "vars" "packages")) + :depends-on ("protocol" "codec" + "serializer-class" "vars" "packages")) hunk ./xmlisp.asd 24 - :depends-on (:closer-mop :cxml :arnesi)) + :depends-on (:closer-mop :cxml :cxml-rng :arnesi))