;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; schematic-format.scm
;;;
;;; This is a program for formatting Scheme source. Currently, that
;;; means slightly opinionated autoindentation of R7RS forms.
;;;
;;; See this project's README for more information.
;;;
;;; Copyright (c) 2013-2014, Evan Hanson <evhan@foldling.org>
;;; See LICENSE for details.
;;;

(import (schematic format)
        (schematic process)
        (scheme base)
        (scheme char)
        (scheme file)
        (scheme process-context)
        (scheme read)
        (scheme write))

(define (every? pred? lst)
  (or (null? lst)
      (and (pred? (car lst))
           (every? pred? (cdr lst)))))

;; XXX Drops the error's irritants' tail.
(define (prefix-error e msg)
  (error (string-append msg ": " (error-object-message e))
         (car (error-object-irritants e))))

;; The default behavior for keywords is to use the offset given by
;; `keyword-indent`, but that may be overridden by a user-specified file
;; containing custom indentation rules.
(define keyword-indentation-function keyword-indent)

;;
;; An indentation file contains a single S-expression, which should be a
;; list of indentation rules where each rule is one of the following
;; forms:
;;
;;     (keyword . integer)
;;     (keyword integer ...)
;;
(define read-indentation-file
  (let ((valid-indentation-rule?
         (lambda (p)
           (or (and (list? p) (every? integer? (cdr p)))
               (and (pair? p) (integer? (cdr p)))))))
    (lambda (path)
      (guard (e ((prefix-error e "Unable to read indentation file")))
        (map (lambda (p)
               (cond ((valid-indentation-rule? p) p)
                     ((error "Invalid indentation rule" p))))
             (let ((forms (with-input-from-file path read)))
               (cond ((list? forms) forms)
                     ((error "Not an alist" path)))))))))

(with-exception-handler error-exit
 (lambda ()
   (for-each
    (lambda (option)
      (case (car option)
        ((-b)
         (bracket-parentheses? #t))
        ((-c)
         (bracket-closure? #t))
        ((-t)
         (let ((t (string->number (cdr option))))
           (if (and (integer? t) (positive? t))
               (tabstop-length t)
               (error "Invalid tabstop" (cdr option)))))
        ((-h --help)
         (display "Usage: ")
         (display (car (command-line)))
         (display " [-b | -c] [-t tabstop] [indent-file]")
         (newline)
         (exit))
        ((-v --version)
         (display version)
         (newline)
         (exit))
        ((--)
         (case (length option)
           ((1)) ; No indent file specified.
           ((2)
            (let ((rules (read-indentation-file (cadr option))))
              (set! keyword-indentation-function
                (lambda (keyword eol?)
                  (cond ((assq keyword rules) => cdr)
                        ((keyword-indent keyword eol?))
                        (else #f))))))
           (else
            (error "Unrecognized command line arguments" (cdr option)))))))
    (command-line-options
     '((-b)
       (-c)
       (-t . <tabstop>))))))

(format-scheme
 keyword-indentation-function
 (current-input-port)
 (current-output-port))