#lang scheme

;;;; This file handles xml in scheme.
;;;; It differs from xnode.ss in three important ways:
;;;; - our data-definition allows attributes in xml tags;
;;;; - we don't use structs -- just lists (of lists of ...)
;;;; - we write some functions which process xml trees.


; An xnode is:
;  - an string, or
;  - a xtag

; An xtag is:
; (list symbol (list-of attr+val) xnode...)
;                                        
; Note that the '...' is shorthand for 0-or-more; we really mean:
; (cons [symbol] (cons (list-of attr+val) (list-of xnode)))

; An attr+val is:
; (list string string)



;; Examples of the data:
;; xnode:
(define x1 "hello there")
(define x2 '(em {} "wowy zowy"))
(define x3 '(p {} "hello" (em {} "wowy zowy")))
(define x4 '(p {["align" "center"] ["style" "footnote"]}
               "hello"
               (em {} "wowy zowy")))

;; Here is the result of parsing a string:
;"<p align="center" style="footnote"><em>hi</em> to all the <b>very <b>very ;<b><b>very</b></b></b></b></p>"

'(p {["align" "center"] ["style" "footnote"]}
    (em {} "hi")
    " to all the "
    (b {} "very "
       (b {} "very"
          (b {} (b {} "very")))))


(define xtag-tag first)
(define xtag-attrs second)
(define (xtag-contents x) (rest (rest x)))

;; We won't actually call 'make-xtag' (since
;; we'll just make the lists manually),
;; but there's no reason why we couldn't:
;;
(define (make-xtag tag attrs contents)
  (cons tag (cons attrs contents)))
  ; Or, if we want to use the fancy quasiquote syntax:
  ; `(tg attrs ,@bod))


(define (xtag? x) (and (list? x)
                       (>= (length x) 2)
                       (symbol? (xtag-tag x))
                       (attrs? (xtag-attrs x))
                       (xlist? (xtag-contents x))))
(define (attr+val? a+v) (and (list? a+v)
                             (= 2 (length a+v))
                             (string? (first a+v))
                             (string? (second a+v))))
(define (attrs? a+vs) (andmap attr+val? a+vs))
(define (xlist? xx) (andmap xnode? xx))
(define (xnode? x) (or (string? x) (xtag? x)))



(define (xnode->string x)
  (cond [(string? x) x]
        [(xtag? x) (string-append "<" (symbol->string (xtag-tag x)) ">"
                                  (foldl (lambda (f rr) (string-append (xnode->string f) rr)) "" (xtag-contents x))
                                  "</" (symbol->string (xtag-tag x)) ">")]))



; Example handlers

;; (-> xtag xtag)
;; Transform an xtag into one
;; which is "i" *and* font w/ color "blue"
(define (handle-em x)
    `(i ,(xtag->attrs x)
        (font {["color" "blue"]}
              ,@(xtag->contents x))))
;; What if we want to add an anchor as well:
;;  <i id="em7">...</i>

  


; An example list-of-processors:
`((em ,handle-em)
  (itec380 ,(lambda (nd) ...) `(dummy identity))-
  (p ,(lambda (nd) ...)  `(dummy identity)))
  (ul ,(lambda (nd) ...) `(li ,make-strong) )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Code to *process* an xml tree.
;;;  We'll pass in a association-list [java.util.ListMap] 
;;;  of (tag-name + (-> xnode xnode)).

(define (process xnode processors)
  (cond [(string? xnode) xnode]
        [(xtag? xnode)
         (let* {[tag-process-info  (assoc/default (xtag-tag xnode)
                                                  processors 
                                                  (list identity [dummy identity])]
                [the-real-processor (first tag-process-info)]
                [the-new-context (second tag-process-info)]
                [processed-root
                 (the-real-processor
                  xnode)]
                }
           (make-xtag
            (xtag-tag processed-root)
            (xtag-attrs processed-root)
            (process (xtag-contents processed-root)
                     (cons the-new-context processors))))]))
           






(define (process-list xnodes processors)
  (map (lambda (xn) (process xn processors))
       xnodes))


; A built-in 'dictionary-get':
(assoc 'hi    '((ciao 9) (tag 17) (hi 4) (hello 99)))
(assoc 'aloha '((ciao 9) (tag 17) (hi 4) (hello 99)))

(define (assoc/default key dict default)
  (let* {[val (assoc key dict)]}
    (if val
        (second val)
        default)))

; A built-in 'dicitonary-get':
(assoc/default 'hi    '((ciao 9) (tag 17) (hi 4) (hello 99)) 777)
(assoc/default 'aloha '((ciao 9) (tag 17) (hi 4) (hello 99)) 777)