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

;; Copyright (C) 2007, 2009, 2010 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 ()
  #:use-module ((ttn-do zzz banalities) #:select (check-hv
                                                  qop<-args))
  #:use-module ((ttn-do zzz personally) #:select (forms<-port
                                                  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)
  (let ((o (open-output-file (string-append stem ".css"))))
    (FE (forms<-port (open-input-file (string-append stem ".sexp")))
        (lambda (rule)
          (flatten-to o (css-tree rule))))
    (close-port o)))

(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