;;;; cl-xml.lisp

(in-package #:cl-xml)

(defun tagp (exp)
  (symbolp (car exp)))

(defun print-contents (contents indentation stream)
  "Print the contents of a tag with correct indentation. Every element in CONTENTS is on a separate line."
  (mapc (lambda (s) (format stream "~a~a~%" indentation s)) contents))

(defun next-tags (list)
  "Get the next tags in the tree."
  (cond ((null list) nil)
        ((eq 'cons (type-of (car list))) list)
        (t (next-tags (cdr list)))))

(defun handle-keywords (keywords)
  "Turn keyword-value pairs on the form :key \"value\" into key=\"value\"."
  (cond ((or (null keywords)
             (consp (car keywords)))
         "")
        ((keywordp (car keywords))
         (format nil " ~a=\"~a\"~a"
                 (string-downcase (symbol-name (car keywords)))
                 (cadr keywords)
                 (handle-keywords (cddr keywords))))))

(defun indentation (level)
  "Create a string of LEVEL length consisting of spaces."
  (make-string level :initial-element #\Space))

(defun sexp-to-xml (sexp indentation-level &optional (stream t))
  "Turn an s-expression into an xml form."
  (cond ((null sexp) nil)
        ((stringp (car sexp)) (print-contents sexp (indentation indentation-level) stream))
        ((consp (car sexp))
         (sexp-to-xml (car sexp) (1+ indentation-level) stream)
         (sexp-to-xml (cdr sexp) indentation-level stream))
        ((tagp sexp)
         (let ((tag-name (string-downcase (symbol-name (car sexp))))
               (spaces (indentation indentation-level)))
           (format stream "~a<~a~a>~%"
                   spaces
                   tag-name
                   (handle-keywords (cdr sexp)))
           (let ((next-tags (next-tags (cdr sexp))))
             (unless (null next-tags)
               (sexp-to-xml next-tags (1+ indentation-level) stream)))
           (format stream "~a</~a>~%" spaces tag-name)))))

(defmacro xml (form)
  "Macro interface to SEXP-TO-XML."
  (sexp-to-xml form 0))

(defun sexp-to-xml-string (form)
  "Captures the output of SEXP-TO-XML into a string."
  (with-open-stream (stream (make-string-output-stream))
    (sexp-to-xml form 0 stream)
    (get-output-stream-string stream)))

(defmacro xml-string (form)
  "Macro interface to SEXP-TO-XML-STRING."
  (sexp-to-xml-string form))