#!/bin/sh
exec ${GUILE-guile} -e '(ttn-do format-css)' -s $0 "$@" # -*-scheme-*-
!#
;;; format-css

;; Copyright (C) 2007, 2009, 2010, 2011 Thien-Thi Nguyen
;;
;; This file is part of ttn-do, released under the terms of the
;; GNU General Public License as published by the Free Software
;; Foundation; either version 3, or (at your option) any later
;; version.  There is NO WARRANTY.  See file COPYING for details.

;;; Commentary:

;; Usage: format-css [-v | --verbose] [FILE.sexp ...]
;;
;; Format contents of each FILE.sexp, writing FILE.css.
;; Contents are zero or more CSS rules, each a list
;; suitable for ‘(ttn-do zzz publishing) css-tree’ expansion.
;; If no files are specified, process all ‘*.sexp’ in cwd.

;;; Code:

(define-module (ttn-do format-css)
  #:export (main)
  #:use-module ((ttn-do zzz 0gx forms-from) #:select (forms<-file))
  #:use-module ((ttn-do zzz banalities) #:select (check-hv
                                                  qop<-args))
  #:use-module ((ttn-do zzz personally) #:select (FE fso))
  #:use-module ((ttn-do zzz publishing) #:select (flatten-to
                                                  css-tree))
  #:use-module ((ttn-do zzz filesystem) #:select (filtered-files
                                                  extract-stem-proc)))

(define (process stem)
  (define (w/ext extension)
    (string-append stem extension))
  (call-with-output-file (w/ext ".css")
    (lambda (port)
      (FE (forms<-file (w/ext ".sexp"))
          (lambda (rule)
            (flatten-to port (css-tree rule)))))))

(define get-stem (extract-stem-proc "sexp"))

(define (main/qop qop)
  (FE (if (null? (qop '()))
          (filtered-files get-stem ".")
          (map get-stem (qop '())))
      (lambda (stem)
        (process stem)
        (and (qop 'verbose)
             (fso "Wrote ~A.css~%" stem)))))

(define (main args)
  (check-hv args '((package . "ttn-do")
                   (version . "1.0")
                   (help . commentary)))
  (main/qop
   (qop<-args
    args '((verbose (single-char #\v))))))

;;; format-css ends here