#lang scheme

(require (for-syntax (planet synx/displayz)))
(require (for-syntax "insert-prefix.ss"))

(define (write-element write value)
  (if (procedure? value) (value write)
      (write (encode value))))

(define (encode value)
    [(keyword? value) (keyword->string value)]
    [(symbol? value) (symbol->string value)]
    [(string? value) value]
    [(bytes? value) (bytes->string/utf-8 value)] ; err...
    [(number? value) (number->string value)]
    [else (error (format "No XML encoding for ~s" value))]))
(define start-element
  (λ (attrs values name empty?)
     "<" (encode name)
     (if (null? attrs) ""
          " "
          (string-join (map (λ (a v) (string-append (encode a) "=\"" (encode v) "\"")) attrs values) " ")))
     (if empty? 
         " />"

(define (end-element name)
  (string-append "</" (encode name) ">\n"))

(define (cdata data)
  (string-append "<!--/* <![CDATA[ */\n" (encode data) "\n/* ]]> */-->"))

(define writer
   (λ (attrs values name . body)
     (λ (write)
       (if (eq? name 'lit) body
             (write (start-element attrs values name (null? body)))
             ; notice that the start tag gets written before the body is ever
             ; processed.
              (λ (item) (write-element write item))
             (when (not (null? body)) (write (end-element name)))))))))

(define (joiner l)
  (λ (write)
    (map (λ (item) (write-element write item)) l)))
(define-syntax gen
  (λ (form)
     ; using #'writer not 'writer is VERY IMPORTANT for module renaming
     (insert-prefix (cadr (syntax->datum form)) #'writer #'joiner)

(provide gen writer joiner encode cdata)