(define-module (sfx)
  #:use-module (ice-9 receive)
  #:use-module (oop goops describe)
  #:use-module (skribilo reader skribe))

;; debug

(define (debug procedure text)
  (display "debug,  ")
  (display procedure)
  (display ": ")
  (display text)
  (newline))

;;

(define (warning text)
  (format #t "warning: ~a " text)
  (newline))


(define (file->sexpr file)
  (define reader (make-skribe-reader))
  (reader (open-input-file file)))


;; dispatch table for consumers

(define consumers (make-hash-table))

(define (consumer-get symbol)
  (hash-ref consumers (string->symbol (string-append "consume-" (symbol->string symbol)))))

(define (consumer-set! procedure)
  (hash-set! consumers (procedure-name procedure) procedure))

;; dispatch table for rewriter

(define rewriters (make-hash-table))

(define (rewriter-get symbol)
  (hash-ref rewriters (string->symbol (string-append "rewrite-" (symbol->string symbol)))))

(define (rewriter-set! procedure)
  (hash-set! rewriters (procedure-name procedure) procedure))

;; consumers

(define (consume-keywords sexpr keywords)
  (cond ((null? sexpr) sexpr)
	((keyword? (car sexpr))
	 (hash-set! keywords (keyword->symbol (car sexpr)) (cadr sexpr))
	 (consume-keywords (cddr sexpr) keywords))
	(else sexpr)))

(define (consume-node name environment output sexpr continue)
  (let* ((keywords (make-hash-table))
	 (body (consume-keywords sexpr keywords))
	 (id (hash-ref keywords `id))
	 (classes (hash-ref keywords `classes))
	 (href (hash-ref keywords `href)))
    (output (format #f "<~a" name))
    (if id (output (format #f " id=~s" (symbol->string id))))
    (if classes (output (format #f " class=~s" classes)))
    (if href (output (format #f " href=~s" href)))
    (output ">")
    (continue environment output body)
    (output (format #f "" name))))


(define (consume-simple-node name environment output sexpr continue)
  (let ((keywords (make-hash-table)))
    (consume-keywords sexpr keywords)
    (output (format #f "<~a " name))
    (hash-for-each (lambda (key value) (output (format #f "~a=~s " (symbol->string key) value)))  keywords)
    (output "/>")))

(define (consume-sexpr environment output sexpr)
  (cond ((null? sexpr))
	((and (symbol? (car sexpr)) (consumer-get (car sexpr))) ((consumer-get (car sexpr)) environment output (cdr sexpr)))
	((and (symbol? (car sexpr)) (rewriter-get (car sexpr)))  (consume-sexpr environment output ((rewriter-get (car sexpr)) environment (cdr sexpr))))
	((list? (car sexpr)) (consume-sexpr environment output (car sexpr)) (consume-sexpr environment output (cdr sexpr)))
	((equal? `quasiquote (car sexpr)) (consume-sexpr environment output (cdr sexpr)))
	((equal? `unquote (car sexpr)) (consume-sexpr environment output (cdr sexpr)))
	((string? (car sexpr)) (output (car sexpr)) (consume-sexpr environment output (cdr sexpr)))))

(define (quote environment output sexpr)
  (consume-node "cite" environment output sexpr consume-sexpr))
(consumer-set! quote)

(define (consume-division environment output sexpr)
  (consume-node "div" environment output sexpr consume-sexpr))
(consumer-set! consume-division)

(define (consume-ordered-list environment output sexpr)
  (consume-node "ol" environment output sexpr consume-sexpr))
(consumer-set! consume-ordered-list)

(define (consume-list environment output sexpr)
  (consume-node "ul" environment output sexpr consume-sexpr))
(consumer-set! consume-list)
  
(define (consume-item environment output sexpr)
  (consume-node "li" environment output sexpr consume-sexpr))
(consumer-set! consume-item)

(define (consume-link environment output sexpr)
  (let* ((keywords (make-hash-table))
	 (body (consume-keywords sexpr keywords))
	 (id (hash-ref keywords `id))
	 (classes (hash-ref keywords `classes))
	 (href (hash-ref keywords `href))
	 (name "a"))
    (output (format #f "<~a" name))
    (if id (output (format #f " id=~s" (symbol->string id))))
    (if classes (output (format #f " class=~s" classes)))
    (if (and href (string-suffix? ".sfx" href))
	(let* ((basename (car (string-split href #\.)))
	       (output-name (string-append basename ".html")))
	  (consume href)
	  (output (format #f " href=~s" output-name)))
	(if href (output (format #f " href=~s" href))))
    (output ">")
    (consume-sexpr environment output body)
    (output (format #f "" name))))

(consumer-set! consume-link)

(define (consume-bold environment output sexpr)
  (consume-node "bold" environment output sexpr consume-sexpr))
(consumer-set! consume-bold)

(define (consume-span environment output sexpr)
  (consume-node "span" environment output sexpr consume-sexpr))
(consumer-set! consume-span)

(define (consume-italic environment output sexpr)
  (consume-node "i" environment output sexpr consume-sexpr))
(consumer-set! consume-italic)

(define (consume-paragraph environment output sexpr)
  (consume-node "p" environment output sexpr consume-sexpr))
(consumer-set! consume-paragraph)

(define (consume-title environment output sexpr)
  (consume-node "h1" environment output sexpr consume-sexpr))
(consumer-set! consume-title)

(define (consume-subtitle environment output sexpr)
  (consume-node "h2" environment output sexpr consume-sexpr))
(consumer-set! consume-subtitle)

(define (consume-subsubtitle environment output sexpr)
  (consume-node "h3" environment output sexpr consume-sexpr))
(consumer-set! consume-subsubtitle)

(define (consume-subsubsubtitle environment output sexpr)
  (consume-node "h4" environment output sexpr consume-sexpr))
(consumer-set! consume-subsubsubtitle)

(define (consume-html environment output sexpr)
  (output "")
  (consume-node "html" environment output sexpr consume-sexpr))
(consumer-set! consume-html)

(define (consume-head environment output sexpr)
  (consume-node "head" environment output sexpr consume-sexpr))
(consumer-set! consume-head)

(define (consume-body environment output sexpr)
  (consume-node "body" environment output sexpr consume-sexpr))
(consumer-set! consume-body)

(define (consume-super-title environment output sexpr)
  (consume-node "title" environment output sexpr consume-sexpr))
(consumer-set! consume-super-title)

(define (consume-super-link environment output sexpr)
  (consume-simple-node "link" environment output sexpr consume-sexpr))
(consumer-set! consume-super-link)

(define (consume-meta environment output sexpr)
  (consume-simple-node "meta" environment output sexpr consume-sexpr))
(consumer-set! consume-meta)

(define (consume-html-document environment output sexpr)
  (let* ((keywords (make-hash-table))
	 (body (consume-keywords sexpr keywords))
	 (title (hash-ref keywords `title))
	 (style (hash-ref keywords `style)))
    (output "")
    (if title (output (format #f "" title)))
    (if style (output (format #f "" style)))
    (output "")
    (output "")
    (if body (consume-sexpr environment output body))
    (output "")))
(consumer-set! consume-html-document)


(define (consume-template environment output sexpr)
  (let* ((keywords (make-hash-table))
	(body (consume-keywords sexpr keywords)))
    (consume-sexpr environment output body)
    (cond ((hash-ref keywords `extends)
	   (consume-sexpr environment output (file->sexpr (hash-ref keywords `extends)))))))
(consumer-set! consume-template)

(define (consume-define environment output sexpr)
  (hash-set! environment (car sexpr) (cadr sexpr)))
(consumer-set! consume-define)

(define (rewrite-for-rec symbol values code sexpr)
  (cond ((null? values) sexpr)
	(else
	 (rewrite-for-rec symbol 
			  (cdr values) 
			  code 
			  (cons sexpr 
				(quasiquote ((define ,symbol ,(car values)) ,code)))))))

(define (rewrite-for environment sexpr)
  (let ((symbol (car sexpr))
	(value (cadr sexpr))
	(code (caddr sexpr)))
    (rewrite-for-rec symbol (if (symbol? value) (hash-ref environment value) value) code (list))))
(rewriter-set! rewrite-for)

(define (consume-display environment output sexpr)
  (let ((value (hash-ref environment (car sexpr))))
    (output (if value value (format #f "{{ ~a }}" (symbol->string (car sexpr)))))))
(consumer-set! consume-display)

(define (rewrite-consume environment sexpr)
  (hash-ref environment (car sexpr)))
(rewriter-set! rewrite-consume)

(define (consume filename)
  (display (format #f "processing ~s\n" filename))
  (let* ((basename (car (string-split filename #\.)))
	 (output-file (open-output-file (string-append basename ".html")))
	 (output (lambda (text) (display text output-file)))
	 (sexpr (file->sexpr filename))
	 (environment (make-hash-table)))
    (consume-sexpr environment output sexpr)
    (close output-file)))

(consume "index.sfx")