[codec defining convenience macros
clinton@unknownlamer.org**20090501191600
 Ignore-this: 3e0296024a4f6e140c97aecb068dacf8
 * `defcodec' for general codecs
 * `define-simple-codec' for most codecs
 
 The signature of `lisp-value->xml-value' probably should have the slot
 type passed to it--right now a list slot containing `nil' will unparse
 as "false"... no good.
] hunk ./src/codec.lisp 3
-;;; Decode
+(defmacro defcodec (type
+		    ((xml-value-name lisp-type-name) &body parse)
+		    ((lisp-value-name) &body unparse))
+  `(progn
+     (defmethod xml-value->lisp-value (,xml-value-name (,lisp-type-name (eql ',type)))
+       ,@parse)
+     (defmethod lisp-value->xml-value ((,lisp-value-name ,type))
+       ,@unparse)))
hunk ./src/codec.lisp 12
-(defmethod xml-value->lisp-value (xml-value lisp-type)
-  xml-value)
+(defmacro define-simple-codec (type (parse &optional (assert nil assert-p)) unparse)
+  (with-unique-names (xml-value lisp-value lisp-type maybe-parsed)
+    `(defcodec ,type
+	 ((,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)
+	(,unparse ,lisp-value)))))
hunk ./src/codec.lisp 24
-;; todo: use PARSE-NUMBER or similar for number subtypes
-(defmethod xml-value->lisp-value (xml-value (lisp-type (eql 'number)))
-  (let ((number (read-from-string xml-value)))
-    (assert (numberp number))
-    number))
+;;; Numbers
hunk ./src/codec.lisp 26
-(defmethod xml-value->lisp-value (xml-value (lisp-type (eql 'float)))
-  (let ((number (read-from-string xml-value)))
-    (assert (floatp number))
-    number))
-
-;;; todo: short-float single-float double-float
-
-(defmethod xml-value->lisp-value (xml-value (lisp-type (eql 'integer)))
-  (parse-integer xml-value))
+(macrolet ((define-simple-numbers (&rest definitions)
+	     `(progn
+		,@(mapcar (lambda (def)
+			    `(define-simple-codec
+				 ,def
+				 (read-from-string)
+			       princ-to-string))
+			  definitions))))
+  (define-simple-numbers
+    number
+    float
+    single-float
+    double-float)
+  (define-simple-codec integer (parse-integer) princ-to-string))
hunk ./src/codec.lisp 41
+;;; pretty printed t/nil
hunk ./src/codec.lisp 47
-(defmethod xml-value->lisp-value (xml-value (lisp-type (eql 'character)))
-  (assert (= 1 (length xml-value)))
-  (char xml-value 0))
-
-(defmethod xml-value->lisp-value (xml-value (lisp-type (eql 'string)))
-  xml-value)
-
-;;; todo: pathname
-
-(defmethod xml-value->lisp-value (xml-value (lisp-type (eql 'list)))
-  (let ((list (read-from-string xml-value)))
-    (assert (listp list))
-    list))
-
-(defmethod xml-value->lisp-value (xml-value (lisp-type (eql 'array)))
-  (let ((array (read-from-string xml-value)))
-    (assert (arrayp array))
-    array))
-
-;;; Encode
-
-(defmethod lisp-value->xml-value (lisp-value)
-  (princ-to-string lisp-value))
-
hunk ./src/codec.lisp 52
+
+;;; characters/strings
+(defcodec character
+    ((xml-value lisp-type)
+     (assert (= 1 (length xml-value)))
+     (char xml-value 0))
+  ((lisp-value) (string lisp-value)))
+
+(define-simple-codec string (identity) identity)
+
+;;; sequences
+(define-simple-codec list (read-from-string) princ-to-string)
+(define-simple-codec array (read-from-string) princ-to-string)