(module scss (scss->css)

(import scheme chicken)
(use data-structures srfi-1 srfi-13 extras ports scss-plus)

(define (write-declaration decl)
  (let* ((decl (if (eq? '! (car decl))
                   (list (caadr decl) (conc (cadadr decl) " !important"))
                   decl)))
    (apply printf  "~A: ~A" decl)))

(define (combinator? c)
  (member c '(// > +)))

(define (write-combinator c)
  (if (eq? '// c) 
      (display " ")
      (printf " ~A " c)))

(define (write-interspersed write items separator)
  (for-each (lambda (item)
              (write item)
              (display separator))
            (butlast items))
  (write (last items)))

(define (selector? selector)
  (or (symbol? selector)
      (and (pair? selector)
           (eq? '= (car selector)))))

(define (error-invalid-selector selector)
  (error 'scss->css (format "invalid selector: ~S" selector)))

(define (normalize-selector selector)
  (cond ((symbol? selector) selector)
        ((or (< (length selector) 3) (> (length selector) 4))
         (error-invalid-selector selector))
        (else (string->symbol
               (conc 
                (if (= (length selector) 4)
                    (normalize-selector (third selector))
                    "")
                (case (cadr selector)
                  ((class) (conc "." (last selector)))
                  ((id) (conc "#" (last selector)))
                  ((pclass) (conc ":" (last selector)))
                  (else (error-invalid-selector selector))))))))

(define (write-selector selector)
  (cond ((selector? selector) (display (normalize-selector selector)))
        ((not (list? selector))
         (error 'scss->css (format "not a selector: ~S" selector)))
        ((null? selector) (error 'scss->css "null selector"))
        (else (write-selectors (cadr selector))
              (unless (null? (cddr selector))
                (write-combinator (car selector))
                (write-selectors (cddr selector))))))

(define (write-selectors selectors)
  (let* ((selectors (if (selector? selectors) 
                        (list selectors)
                        selectors))
         (selectors (if (and (pair? selectors) (combinator? (car selectors)))
                        (list selectors)
                        selectors)))
    (write-interspersed write-selector selectors ", ")))

(define (write-expression expr)
  (let ((selector (car expr))
        (decls (cdr expr)))
    (unless (null? decls)
      (write-selectors selector)
      (display " { ")
      (write-interspersed write-declaration decls "; ")
      (display " } "))))

(define (write-import url)
  (printf "@import url(~A); " url))

(define (scss->css scss #!optional (port (current-output-port)))
  (case (and (pair? scss) (car scss))
    ((css) (with-output-to-port port
             (lambda ()
               (receive (imports expressions)
                 (span (compose (cut eq? 'import <>) car) (cdr scss))
                 (for-each write-import (map cadr imports))
                 (for-each write-expression expressions)))))
    ((css+) (scss->css (cons 'css (scss-plus->scss (cdr scss))) port))
    (else (error 'scss->css (format "not an scss document (missing tag?)")))))

)