(define-library (config-generation sway)
  (import (scheme base)
	  (scheme write))
  (export ;;sway-config
	  scm->sway-config)
  (cond-expand
   (guile (import (ice-9 match))))
  (cond-expand
   ((not chibi)
    (import (srfi 13))))
  (cond-expand
   ((not guile) (import (srfi 0))))
  (begin
    ;; (cond-expand
    ;;  (chibi
    ;;   (define (string-join ls . options)
    ;; 	(let ((delimiter (if (> (length options) 0) (car options) " "))
    ;; 	      (grammer (if (> (length options) 1) (cadr options) 'infix)))
    ;; 	  (if (pair? ls)
    ;; 	      (string-append
    ;; 	       (if (equal? grammer 'prefix) delimiter "")
    ;; 	       (car ls)
    ;; 	       (if (or (equal? grammer 'suffix)
    ;; 		       (and (equal? grammer 'infix)
    ;; 			    (pair? (cdr ls))))
    ;; 		   delimiter
    ;; 		   "")
    ;; 	       (if (pair? (cdr ls))
    ;; 		   (string-join (cdr ls) delimiter grammer)
    ;; 		   ""))
    ;; 	      ""))))
    ;;  (else))
    
    ;; (define-syntax make-string-from-ellipsis
    ;;   (syntax-rules ()
    ;; 	((_ text ...)
    ;; 	 (string-join (map (lambda (x)
    ;; 			     (cond
    ;; 			      ((string? x) (string-append "\"" x "\""))
    ;; 			      ((symbol? x) (symbol->string x))
    ;; 			      ((number? x) (number->string x))
    ;; 			      (else x)))
    ;; 			   '(text ...))))))
    
    ;; (define-syntax sway-config
    ;;   (syntax-rules (bindsyms bindsym set for-window)
    ;; 	;; Support binding group extension
    ;; 	((_ (bindsyms (binding ...) ...) lines ...)
    ;; 	 (string-append
    ;; 	  (sway-config (bindsym binding ...) ...)
    ;; 	  (sway-config lines) ...))

    ;; 	;; Support multi-binding extension
    ;; 	((_ (bindsym (shortcut ...) . action) lines ...)
    ;; 	 (string-append
    ;; 	  (sway-config (bindsym shortcut . action) ...)
    ;; 	  (sway-config lines) ...))
    ;; 	((_ (bindsym shortcut (actions ...) ...) lines ...)
    ;; 	 (string-append
    ;; 	  "bindsym " (symbol->string 'shortcut) " "
    ;; 	  (string-join
    ;; 	   (map
    ;; 	    (lambda (ls)
    ;; 	      (string-join
    ;; 	       (map
    ;; 		(lambda (x)
    ;; 		  (cond
    ;; 		   ((symbol? x) (symbol->string x))
    ;; 		   ((number? x) (number->string x))
    ;; 		   (else x)))
    ;; 		ls)))
    ;; 	    '((actions ...) ...))
    ;; 	   "; ")
    ;; 	  "\n"
    ;; 	  (sway-config lines) ...))
    ;; 	((_ (bindsym shortcut action ...) lines ...)
    ;; 	 (string-append
    ;; 	  "bindsym " (make-string-from-ellipsis shortcut action ...) "\n"
    ;; 	  (sway-config lines) ...))

    ;; 	;; for_window support
    ;; 	((_ (for-window (criteria ...) command ...) lines ...)
    ;; 	 (letrec-syntax ((criteria->string
    ;; 			  (syntax-rules ::: ()
    ;; 					((_ attribute value rest :::)
    ;; 					 (string-append " ["(symbol->string 'attribute) "=" "\"" value "\"] " (criteria->string rest :::)))
    ;; 					((_) ""))))
    ;; 	   (string-append
    ;; 	    "for_window" (criteria->string criteria ...) (make-string-from-ellipsis command ...) "\n"
    ;; 	    (sway-config lines) ...)))

    ;; 	;; Support blocks (such as for mode definitions like resize mode)
    ;; 	((_ (block-start ... (block-body ...)))
    ;; 	 (string-append
    ;; 	  (make-string-from-ellipsis block-start ...) " {\n"
    ;; 	  (sway-config block-body ...)
    ;; 	  "}\n"))

    ;; 	;; set block
    ;; 	((_  (set variables ...) lines ...)
    ;; 	 (letrec-syntax ((aux (syntax-rules ()
    ;; 				((_ var val . rest)
    ;; 				 (string-append
    ;; 				  "set " (make-string-from-ellipsis var val) "\n"
    ;; 				  (aux . rest)))
    ;; 				((_) ""))))
    ;; 	   (string-append (aux variables ...)
    ;; 			  (sway-config lines ...))))

    ;; 	;; Default parsing
    ;; 	((_ (line ...))
    ;; 	 (string-append (make-string-from-ellipsis line ...) "\n"))
    ;; 	((_ line lines ...)
    ;; 	 (string-append
    ;; 	  (sway-config line)
    ;; 	  (sway-config lines ...)))))

    (define (scm->sway-config scm)
      (define (ensure-string s)
	(cond
	 ((string? s) (string-append "\"" s "\""))
	 ((symbol? s) (symbol->string s))
	 ((number? s) (number->string s))))

      (define (plist->list-of-lists pl)
	(if (null? pl)
	    '()
	    (cons (list (car pl) (cadr pl))
		  (plist->list-of-lists (cddr pl)))))

      (match scm
	;; Base case
	(() "")
	;; Support binding group extension
	((('bindsyms (bindings ...) ...) . lines)
	 (string-append
	  (scm->sway-config (map (lambda (b) (cons 'bindsym b)) bindings))
	  (scm->sway-config lines)))
	;; Support multi-binding extension
	((('bindsym (shortcuts ...) action ...) . lines)
	 (string-append
	  (apply string-append
		 (map (lambda (s)
			(string-append "bindsym "
				       (ensure-string s)
				       " "
				       (string-join (map ensure-string action))
				       "\n"))
		      shortcuts))
	  (scm->sway-config lines)))
	;; Support bindings with multiple actions (not an extension)
	((('bindsym shortcut (actions ...) ...) . lines)
	 (string-append
	  "bindsym " (ensure-string shortcut) " "
	  (string-join
	   (map
	    (lambda (ls)
	      (string-join (map ensure-string ls)))
	    actions)
	   "; ")
	  "\n"
	  (scm->sway-config lines)))
	;; for_window support
	((('for-window (criteria ...) command ...) . lines)
	 (let ((criteria->string
		(lambda (c)
		  (string-append " [" (ensure-string (car c)) "=" (ensure-string (cadr c)) "] " ))))
	   (string-append
	    "for_window"
	    (criteria->string criteria)
	    (string-join (map ensure-string command))
	    "\n"
	    (scm->sway-config lines))))
	;; Support blocks (such as for mode definitions like resize mode)
	(((block-start ... (block-body ...)) . lines)
	 (string-append
	  (string-join (map ensure-string block-start)) " {\n"
	  (scm->sway-config block-body)
	  "}\n"
	  (scm->sway-config lines)))
	;; set block
	((('set . variables) . lines)
	 (apply string-append
	  (append
	   (map (lambda (v) (string-join (list "set" (scm->sway-config (list v)))))
		(plist->list-of-lists variables))
	   (list (scm->sway-config lines)))))
	;; Default parsing
	((line . lines)
	 (string-append
	  (string-join (map ensure-string line))
	  "\n"
	  (scm->sway-config lines)))))))