(module scss

(write-css
 scss->css)

(import scheme)

(cond-expand
  (chicken-4
   (import chicken matchable)
   (use data-structures ports))
  (chicken-5
   (import (chicken base)
	   (chicken io)
	   (chicken port)
	   matchable)))

(define +skip-separator+
  (list 'skip-separator))

(define (for-each/separator proc separator list)
  (unless (null? list)
    (let loop ((list list))
      (let ((result (proc (car list))))
        (unless (null? (cdr list))
          (unless (eq? +skip-separator+ result)
            (display separator))
          (loop (cdr list)))))))

(define-constant +combinators+
  '((// . " ")
    (>  . " > ")
    (+  . " + ")))

(define (combinator-ref c)
  (alist-ref c +combinators+))

(define-constant +selector-types+
  '((id     . #\#)
    (class  . #\.)
    (pclass . #\:)))

(define (selector-type-ref s)
  (alist-ref s +selector-types+))

(define (write-selector selector)
  (cond ((symbol? selector)
         (display selector))
        ((not (pair? selector))
         (error "An SCSS selector must be a symbol or a list but was" selector))
        ((combinator-ref (car selector)) =>
         (lambda (combinator)
           (for-each/separator write-selector combinator (cdr selector))))
        ((eq? '= (car selector))
         (match (cdr selector)
           (() (error "Invalid SCSS selector" selector))
           ((selector-type selector-args ...)
            (let ((selector-type* (selector-type-ref selector-type)))
              (unless selector-type*
                (error "Invalid SCSS selector type" selector))
              (match selector-args
                ((arg)
                 (display selector-type*)
                 (display arg))
                ((arg0 arg1)
                 (write-selector arg0)
                 (display selector-type*)
                 (display arg1))
                (else
                 (error "Invalid SCSS selector" selector)))))))
        (else
         (for-each/separator write-selector ", " selector))))

(define (write-declaration declaration)
  (match declaration
    (('! declaration*)
     (write-declaration declaration*)
     (display " !important"))
    ((property values ...)
     (display property)
     (display ": ")
     (for-each/separator display #\space values))
    (else
     (error "Invalid SCSS declaration" declaration))))

(define (write-declarations declarations)
  (display " { ")
  (for-each/separator write-declaration "; " declarations)
  (display " }"))

(define (write-ruleset ruleset)
  (cond ((not (pair? ruleset))
         (error "An SCSS ruleset must be a list of (selector[s] declarations ...) but was"
                ruleset))
        ((null? (cdr ruleset))
         ;; ignore empty rulesets
         +skip-separator+)
        ((eq? 'import (car ruleset))
         (when (null? (cdr ruleset))
           (error "Invalid SCSS import" ruleset))
         (display "@import url(")
         (for-each/separator display #\space (cdr ruleset))
         (display ");"))
        (else
         (write-selector (car ruleset))
         (write-declarations (cdr ruleset)))))

(define (import-ruleset? ruleset)
  (match ruleset
    (('import _) #t)
    (else #f)))

(define (media-ruleset? ruleset)
  (match ruleset
    (('media (? string?) _ ...) #t)
    (else #f)))

(define (write-media-ruleset selector rulesets)
  (display "@media ")
  (display selector)
  (display " { ")
  (for-each/separator write-ruleset #\space rulesets)
  (display " }"))

(define (write-css-rulesets rulesets)
  (for-each/separator
   (lambda (ruleset)
     (if (media-ruleset? ruleset)
         (write-media-ruleset (cadr ruleset) (cddr ruleset))
         (write-ruleset ruleset)))
   #\space
   rulesets))

(include "scss-plus.scm")

(define (write-css-plus-rulesets rulesets)
  (for-each/separator
   (lambda (ruleset)
     (cond
      ((media-ruleset? ruleset)
       (write-media-ruleset (cadr ruleset) (scss-plus->scss (cddr ruleset))))
      ((import-ruleset? ruleset)
       (write-ruleset ruleset))
      (else
       (for-each/separator
        write-ruleset
        #\space
        (scss-plus->scss (list ruleset))))))
   #\space
   rulesets))

(define (write-css scss #!optional (port (current-output-port)))
  (with-output-to-port port
    (lambda ()
      (match scss
        (('css rulesets ...)
         (write-css-rulesets rulesets))
        (('css+ rulesets ...)
         (write-css-plus-rulesets rulesets))
        (else (error "Invalid SCSS document" scss))))))

(define (scss->css scss)
  (call-with-output-string
    (lambda (port)
      (write-css scss port))))

)