anchor.diff:  (in-package #:cl-mtgnet)
   
  -;;; TODO: have marshall/unmarshall only deal with string<->struct
  -;;; conversions (don't expose or accept intermediate json-obj)
  +(defun encode-field (field value &optional (encoder #'json:encode-json))
  +  "Encode VALUE as an object field named FIELD, using ENCODER to
  +encode VALUE."
  +  (json:as-object-member (field)
  +    (funcall encoder value)))
  +
  +(defun serial-slot-p (s)
  +  (or (symbolp s)
  +      (and (listp s)
  +           (destructuring-bind (name &key (marshall t) &allow-other-keys)
  +               s
  +             (declare (ignore name))
  +             marshall))))
  +
  +(defun optional-slot-p (s)
  +  (and (listp s)
  +       (destructuring-bind (name &key optional &allow-other-keys)
  +           s
  +         (declare (ignore name))
  +         optional)))
  +
  +(defun slot-symbol (s)
  +  (etypecase s
  +    (symbol s)
  +    (list (destructuring-bind (name &rest r) s
  +            (declare (ignore r))
  +            name))))
  +
  +(defun slot-optional-p (symbol optional-slots type)
  +  (check-type symbol symbol)
  +  (check-type optional-slots list)
  +  (check-type type keyword)
  +  (let ((cell (assoc symbol optional-slots)))
  +    (and cell
  +         (ecase type
  +           (:write
  +            (or (eq (cdr cell) :write)
  +                (eq (cdr cell) :both)))
  +           (:read
  +            (or (eq (cdr cell) :read)
  +                (eq (cdr cell) :both)))
  +           (:both (eq (cdr cell) :both))))))
  +
  +(defun cat-symbol (symbol &rest rest)
  +  (intern (format nil "~{~A~}" (mapcar #'symbol-name
  +                                       (cons symbol rest)))))
  +
  +;; TODO: See if it's possible to include docstrings for these things
  +(defmacro define-json-obj (name &body body)
  +  (let* ((slots (if (stringp (first body))
  +                    (first (cdr body))
  +                    (first body)))
  +         (serialized-slots (mapcar #'slot-symbol
  +                                   (remove-if-not #'serial-slot-p slots)))
  +         (optional-slots (remove-if #'null (mapcar (lambda (s)
  +                                                     (let ((optional (optional-slot-p s)))
  +                                                       (if optional
  +                                                           (cons (slot-symbol s) optional)
  +                                                           nil)))
  +                                                   slots)))
  +         (struct-opts (if (stringp (first body))
  +                          (nthcdr 2  body)
  +                          (cdr 1 body)))
  +         (make-func (cat-symbol '#:make- name))
  +         (ctor-func (intern (format)))
  +         (build-func (cat-symbol '#:build- name))
  +         (unmarshall-func (cat-symbol '#:unmarshall- name))
  +         (marshall-func (cat-symbol '#:marshall- name)))
  +    `(progn
  +       (defstruct (,name (:constructor (intern (format nil "~A*" make-func))))
  +         ;; Optional docstring
  +         ,@(if (stringp (first body))
  +               (list (first body))
  +               nil)
  +         ;; Slot list
  +         ,@(loop for slot in slots
  +              collect
  +                (etypecase slot
  +                  (symbol slot)
  +                  (list
  +                   (destructuring-bind (name &rest keyword-pairs &key initial
  +                                             &allow-other-keys)
  +                       slot
  +                     `(,name ,initial :allow-other-keys t ,@keyword-pairs))))))
  +       ;; Produce a structure from a decoded json object
  +       (defun ,build-func (json-obj)
  +         (let ((arglist '()))
  +           ,@(loop for s in serialized-slots
  +                collect `(let ((cell (assoc (json-key ',s) json-obj)))
  +                           ,@(unless (slot-optional-p s optional-slots :read)
  +                                     `((unless cell
  +                                         (error 'invalid-json-obj :type ',name :json json-obj))))
  +                           (when cell
  +                             (setf (getf arglist ,(intern (symbol-name s) 'keyword))
  +                                   (cdr cell)))))
  +           (apply #',make-func arglist)
  +           ;; TODO: optionally call an initializer func here to fill
  +           ;; in any non-serial slots
  +           ))
  +       (defun ,unmarshall-func (json-string)
  +         (let ((json-obj (json:decode-json-from-string json-string)))
  +           (,build-func json-obj)))
  +       (defun ,marshall-func (obj)
  +         (json:with-object ()
  +           ,@(flet ((accessor (field)
  +                              (intern (format nil "~A-~A" name field))))
  +                   (loop for s in serialized-slots
  +                      collect (let ((encode-form `(encode-field ',s (,(accessor s) obj))))
  +                                (if (slot-optional-p s optional-slots :write)
  +                                    `(when (,(accessor s) obj)
  +                                       ,encode-form)
  +                                    encode-form)))))))))
  +
  +(define-json-obj rpc-call
  +  "A single method invocation."
  +  (service :initial "" :type string :read-only t)
  +  (method :initial "" :type string :read-only t)
  +  (args :initial '() :type arglist :read-only t)
  +  (id :initial nil :read-only t))
  +
   (defmacro encode-fields ((obj) &rest fields)
  -  "JSON-encode the FIELDS slots of OBJ. Expects to be run inside a JSON:WITH-OBJECT block."
  -  `(progn
  -     ,@(loop for f in fields collect
  -            (if (listp f)
  -                `(json:as-object-member ((quote ,(first f)))
  -                   (funcall ,(second f) (slot-value ,obj (quote ,(first f)))))
  -                `(json:encode-object-member (quote ,f)
  -                                            (slot-value ,obj (quote ,f)))))))
  +  "JSON-encode the FIELDS slots of OBJ. Expects to be run inside a
  +JSON:WITH-OBJECT block."
  +  (let ((obj-var (gensym)))
  +    `(let ((,obj-var ,obj))
  +       (progn
  +         ,@(loop for f in fields collect
  +                (if (listp f)
  +                    `(encode-field (quote ,(first f))
  +                                   (slot-value ,obj-var (quote ,(first f)))
  +                                   ,(second f))
  +                    `(encode-field (quote ,f)
  +                                   (slot-value ,obj-var (quote ,f)))))))))
   
   (defun json-key (symb)
     "Return the symbol produced by JSON encoding and decoding SYMB."
  
positive.code:                    args
                     id)))
  
  (defun json-is-call (json-obj)
    "Return T if JSON-OBJ could be unmarshalled to a CALL object, NIL otherwise."
    (and (listp json-obj)
         (every #'listp json-obj)
         (find-fields (json-obj)
                      service
                      method
                      args
                      id)))
  
  (defun intermediate-to-call (obj)
    "Convert an intermediate-format object to a call object."
    (let ((call (make-rpc-call)))
      (copy-slots-from-alist
       (obj call)
       service
       method
       args
       id)
      call))
  
  (defun unmarshall-call (json-string)
    "Unmarshall a CALL object from the decoded JSON-STRING."
    (let ((json-obj (json:decode-json-from-string json-string)))
      (when (not (json-is-call json-obj))
        (format *debug-io* "Invalid rpc-call json object ~S~%" json-obj)
        (error 'invalid-json-obj :type 'rpc-call :json json-obj))
      (intermediate-to-call json-obj)))
  
  ;;; Result object, one per (non-notification) method call
  (defstruct rpc-result
    "A single result from a method invocation."
    (data)
    (error)
    (warnings)
    (id))
  
  (defun valid-result-p (obj)
    "Return T if OBJ is a valid RESULT object, NIL otherwise."
    (check-type obj rpc-result)
    (flet ((slot-has-value (obj slot)
             (and (slot-boundp obj slot)
                  (slot-value obj slot))))
      (and (rpc-result-p obj)
           ;; Can't (shouldn't) have both data and error slots set.
           (and (or (slot-has-value obj 'result)
                    (slot-has-value obj 'error))
                (not (and (slot-has-value obj 'result)
                          (slot-has-value obj 'error)))))))
  
  (define-condition invalid-result-obj ()
    ((obj :initarg :obj)))
  
  (defun result-to-intermediate (result)
    "Convert a result object into an intermediate-format object."
    (check-type result rpc-result "an RPC Result Object")
    (let ((obj '()))
      (maybe-copy-slots-to-alist
       (result obj)
       data
       error
       warnings
       id)
      obj))
  
  (defun marshall-result (obj &optional (data-encoder-func #'json:encode-json))
    "Marshall the RESULT object OBJ to JSON."
    (when (and (slot-value obj 'error)
               (slot-value obj 'data))
      (error 'invalid-result-obj :obj obj))
    (json:with-object ()
      (encode-fields (obj)
                     warnings
                     id)
      (if (slot-value obj 'error)
          (encode-fields (obj)
                         error)
          (encode-fields (obj)
                         (data data-encoder-func)))))
  
  (defun json-is-result (json-obj)
    "Return T if JSON-OBJ could be unmarshalled to a RESULT object, NIL otherwise."
    (and (listp json-obj)
         (every #'listp json-obj)
         (find-fields (json-obj)
                      id)
         (or (find-fields (json-obj)
                          data)
             (find-fields (json-obj)
                          error))
         (not (find-fields (json-obj)
                           data
                           error))))
  
  (define-condition invalid-json-obj ()
    ((type :initarg :type)
     (json :initarg :json)))
  
  (defun intermediate-to-result (obj)
    "Convert an intermediate-format object to a result object."
    (macrolet ((maybe-set-fields ((obj json-obj) &rest fields)
                 `(progn
                    ,@(loop for f in fields collect
                           `(when (find-fields (,json-obj) ,f)
                              (copy-slots-from-alist (,json-obj ,obj)
                                          ,f))))))
      (let ((result (make-rpc-result)))
        (copy-slots-from-alist
         (obj result)
         id)
        (maybe-set-fields (result obj)
                          data
                          error
                          warnings)
        result)))
  
  (defun unmarshall-result (json-string)
    "Unmarshall a RESULT object from the decoded JSON object JSON-STRING."
    (let ((json-obj (json:decode-json-from-string json-string)))
      (when (not (json-is-result json-obj))
        (format *debug-io* "Invalid rpc-result json object ~S~%" json-obj)
        (error 'invalid-json-obj :type 'rpc-result :json json-obj))
      (intermediate-to-result json-obj)))
  
  ;;; Request, a list of CALLs
  (defun rpc-request-p (obj)
  
negative.code: 
  (deftype rpc-response () '(and list (satisfies response-p)))
  
  ;; TODO: as convenient as this is, it seems like marshall-* should
  ;; return a string, rather than writing to json:*json-output*
  (defun marshall-response (obj)
    "Marshall the RPC-RESPONSE object OBJ to JSON."
    (check-type obj rpc-response)
    (json:with-array ()
      (loop for result in obj
         do (json:as-array-member ()
              (marshall-result result)))))
  
  (defun unmarshall-response (json-string)
    "Unmarshall a RESPONSE object from the decoded JSON object JSON-STRING."
    (let ((json-obj (json:decode-json-from-string json-string)))
      (unless (listp json-obj)
        (error 'invalid-json-obj :type 'rpc-response :json json-obj))
      (mapcar #'build-result json-obj)))
  