2
\$\begingroup\$

This is a function intended to take an XML element (in closure XML format) and a name and find a piece of simple data by that name (either in a tag or attribute) within that XML element. It works, but I'm still new to LISP - can it be written more elegantly?

(defun find-data-inside-xml (element name)
  ;; Maybe there's an attribute?
  (if (dom:has-attribute element name) (dom:get-attribute element name)
  ;; There isn't, we have to do it the ugly way. Find suitable subnodes.
    (let ((candidate-values (loop for node across (dom:child-nodes element) 
                           when (string= (dom:node-name node) name) collect node)))
     ;; Check there was only one of them.
     (cond
        ((> (length candidate-values) 1) (error "XML element has multiple ~S elements." name))
        ((= (length candidate-values) 0) (error "XML element missing ~S element." name))
        (t (let ((cand-children (dom:child-nodes (car candidate-values))))
            ;; Check the one there was, has only one child node.
            (cond
             ((> (length cand-children) 1) (error "XML ~S element has complex content." name))
             ((= (length cand-children) 0) (error "~S element has no content." name))
             (t (let ((content-node (elt cand-children 0)))
                 ;; If that child node is text, that's our value. Otherwise, error.
                 (if (eq (dom:node-type content-node) :text)
                     (dom:node-value content-node)
                     (error "~S element value is not text." name)))))))))))
\$\endgroup\$

1 Answer 1

Reset to default
3
\$\begingroup\$
  • you can use REMOVE instead of the LOOP
  • you can replace the CONDs and IFs and ERRORs with ASSERT
  • replace CAR with FIRST

The specific functions make the intent of the code a bit more clear.

Untested:

(defun find-data-inside-xml (element name)
  (if (dom:has-attribute element name)
      (dom:get-attribute element name)
    (let* ((candidates (remove name (dom:child-nodes element)
                               :key #'dom:node-name
                               :test-not #'string=))
           (n-candidates (length candidates)))
      (assert (not (> n-candidates 1)) ()
              "XML element has multiple ~S elements." name)
      (assert (not (= n-candidates 0)) ()
              "XML element missing ~S element."       name)
      (let* ((candidate-children (dom:child-nodes (first candidate-values)))
             (n-candidate-children (length candidate-children)))
        (assert (not (> n-candidate-children 1)) ()
                "XML ~S element has complex content." name)
        (assert (not (= n-candidate-children 0)) ()
                "~S element has no content."          name)
        (let ((content-node (elt candidate-children 0)))
          (assert (eq (dom:node-type content-node) :text) ()
                   "~S element value is not text." name)
          (dom:node-value content-node))))))

Sometimes one also sees a bit macrology, to make the intent even clearer on the code level. But that has other costs:

(defmacro with-length-checked ((varn var &rest exprs) &body body)
  (let ((asserts (loop for (test test-a msg . args) in exprs
                       collect `(assert (not (,test ,var ,test-a)) ,msg ,@args))))
    `(let ((,var (length ,varn)))
       ,@asserts
       ,@body)))

(defun find-data-inside-xml (element name)
  (if (dom:has-attribute element name)
      (dom:get-attribute element name)
    (let ((candidates (remove name (dom:child-nodes element)
                              :key #'dom:node-name
                              :test-not #'string=)))
      (with-length-checked (candidates n-candidates
                            (> 1 "XML element has multiple ~S elements." name)
                            (= 0 "XML element missing ~S element."       name))
        (let ((candidate-children   (dom:child-nodes (first candidate-values))))
          (with-length-checked (candidate-children n-candidate-children
                                (> 1 "XML ~S element has complex content." name)
                                (= 0  "~S element has no content."         name))
             (let ((content-node (elt candidate-children 0)))
               (assert (eq (dom:node-type content-node) :text) ()
                 "~S element value is not text." name)
               (dom:node-value content-node))))))))
\$\endgroup\$

You must log in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.