;; @module sxml2xml.lsp
;; @author Cyril Slobin
;; @description Converts internal S-XML to external XML representation

;; This is just an exercise in newlisp programming, not intended to be
;; a production-quality code. Don't take it serouosly.

;; (@link http://wagner.pp.ru/~slobin/newlisp/sxml2xml.lsp source here)

;; @syntax (sxml2xml <exp-consumer> <list-sxml> <int-tab>)
;; @param <exp-consumer> xml stream consumer
;; @param <list-sxml> s-xml expression
;; @param <int-tab> indent per level

;; @example
;; (setq pattern '(database (@ (name "example.xml"))
;;                  (fruit
;;                    (name fruit)
;;                    (color color)
;;                    (price price))))
;;
;; (setq fruit "apple" color "red" price 0.80)
;; (sxml2xml print pattern 4)
;; 
;; ; prints
;;
;; <database name='example.xml'>
;;     <fruit>
;;         <name>apple</name>
;;         <color>red</color>
;;         <price>0.8</price>
;;     </fruit>
;; </database>

;; For <exp-consumer> consider also '(curry net-send soc)'
;; or '(curry write-buffer buf)'

; TODO: allow ((a b)...) instead of (@ (a b)...)

(context 'sxml2xml)

(constant 'entities '(("&" "&amp;") ("<" "&lt;") (">" "&gt;")
                      ("'" "&apos;") ("\"" "&quot;")))

(define (esc x) (replace {[&<>'"]} (string x) (lookup $0 entities) 0))
(define (eva x) (if (symbol? x) (eval x) x))
(define (nam x) (if (symbol? x) (name x) x))
(define (put) (doargs (arg) (action arg)))
(define (ope) (if tab (put (dup " " (* tab level)))))
(define (clo) (if tab (put "\n")))

(define (sxml2xml:sxml2xml action expr tab (level 0))
  (if (or (atom? expr) (exists atom? (1 expr))) (setq tab nil))
  (if (zero? level) (ope))
  (if (atom? expr)
    (begin 
      (put (esc (eva expr))))
    (begin
      (put "<" (nam (expr 0)))
      (if (= (expr 1 0) '@)
        (dolist (pair (1 (expr 1)))
          (put " " (nam (pair 0)) "='" (esc (eva (pair 1))) "'")))
      (put ">") (clo)
      (dolist (value (if (= (expr 1 0) '@) (2 expr) (1 expr)))
        (inc 'level) (ope)
        (sxml2xml action value tab level)
        (clo) (dec 'level))
      (ope) (put "</" (nam (expr 0)) ">")))
  (if (zero? level) (clo)))

(context MAIN)