;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; schematic-markdown.scm
;;;
;;; This script converts program source to markdown.
;;;
;;; It should run in any R7RS-compatible Scheme, so long as this
;;; project's lib directory is added to the include path. In Chibi,
;;; that's done with the -I flag.
;;;
;;; See this project's README for more information.
;;;
;;; Copyright (c) 2013, Evan Hanson <evhan@foldling.org>
;;; See LICENSE for details.
;;;

(cond-expand
  (chicken
   (define error-object-message (condition-property-accessor 'exn 'message))
   (define error-object-irritants (condition-property-accessor 'exn 'arguments)))
  (else))

;; For this script.
(import (scheme base)
        (scheme read)
        (scheme file)
        (scheme process-context)
        (foldling command-line))

;; For schematic-reader.scm.
(import (scheme char)
        (scheme write)
        (scheme case-lambda))

(include "schematic-reader.scm")

(define program-version "0.1.1")

;; The language is hardcoded to Lisp/Scheme for now.
(define comment-strings '(";;" ";;;"))

;; Print an error message for `e` to standard error, then exit.
(define (error-exit e)
  (parameterize ((current-output-port (current-error-port)))
    (display "Error: ")
    (display (error-object-message e))
    (let ((args (error-object-irritants e)))
      (unless (null? args)
        (display ": ")
        (display (car args))))
    (newline)
    (exit 1)))

;; This should probably be replaced by the host's implementation.
(define (string-split str char)
  (let ((len (string-length str)))
    (let lp ((c 0)
             (a '()))
      (if (> c len)
          (reverse a)
          (do ((i c (+ i 1)))
              ((or (= i len)
                   (char=? (string-ref str i) char))
               (lp (+ i 1)
                   (cons (substring str c i) a))))))))

(define (string-null? s) (string=? s ""))

(define (process-input reader)
  (let-values (((docs code) (reader)))
    (unless (eof-object? docs)
      (unless (string-null? docs)
        (display docs)
        (newline)
        (newline))
      (unless (string-null? code)
        (for-each
         (lambda (line)
           (display "    ")
           (display line)
           (newline))
         (string-split code #\newline))
        (newline))
      (process-input reader))))

(define (process-file file)
  (call-with-input-file file
   (lambda (port)
     (process-input
      (make-source-section-reader comment-strings port)))))

(define (main files)
  (with-exception-handler error-exit
   (lambda ()
     (if (pair? files)
         (for-each process-file files)
         (process-input (make-source-section-reader comment-strings))))))

;; Parse the command line, invoking `main` with the list of input files.
(for-each
 (lambda (option)
   (case (car option)
     ((-h --help)
      (display "Usage: ")
      (display (car (command-line)))
      (display " [file ...]")
      (newline)
      (exit))
     ((-v --version)
      (display program-version)
      (newline)
      (exit))
     ((--)
      (main (cdr option)))))
 (parse-command-line
  '(((-h --help))
    ((-v --version)))))