book-me.scm

;;; % book-me.scm
;;; % by [Karol Marcjan](http://github.org/szabba/) (<karol.marcjan@gmail.com>)
;;; % [Fork me on github!](http://github.org/szabba/book-me)
;;;
;;; `book-me.scm` is an R7RS Scheme script that formats source code for
;;; printing. It strips a so-called comment marker from lines that start
;;; with it, indents code by 4-spaces and does some mumbo-jumbo with
;;; empty lines.
;;;
;;; The overall effect is, that if you format stuff in the lines
;;; prefixed with the comment marker as Markdown it will produce a
;;; Markdown document with the text interwoven with the code.
;;;
;;; In the spirit of `pbook.el`, created by [Luke
;;; Gorrie](http://github.org/lukego), it can be run on itself. Neat,
;;; huh?
;;;
;;; # License
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;
;;; # Imports
;;;
;;; R7RS introduced a new library system. It is by design incompatible
;;; with the one present in R6RS.

(import (scheme base)
        (scheme write)
        (scheme file)
        (scheme process-context)
        (book-me gen)
        (book-me transform))

;;; * `(scheme base)` is a library that corresponds to what one would
;;; call built-ins in other languages.
;;; * `(scheme write)` contains the *O* of the I/O.
;;; * `(scheme file)` gives us the `open-input-file` and
;;; `open-output-file` procedures. Those can come in handy.
;;; * `(scheme process-context)`, amongst other things, gives us access
;;; to the command line arguments through the `command-line` procedure.
;;; * `(book-me gen)` implements Python-like generators on top of
;;; `call/cc`.
;;; * `(book-me transform)` provides the core transformation and an
;;; input as generators.
;;;
;;; # Command line parsing machinery
;;;
;;; We need to parse the command line some way. `build-option-parser`
;;; takes the default options and a list of option handlers and produces
;;; a procedure that will parse the arguments specified at the command
;;; line.
;;;
;;; While I use association lists to represent the options, anything
;;; would work really -- as long as the option handlers specified would
;;; know how to deal with it.

(define (build-option-parser default-options option-handlers)
  (lambda (arguments)

;;; We loop over the argument list, successively trying out all the
;;; option handlers.
;;;
;;; Awe at Scheme's expressiveness -- in C, Python or whatever, we'd
;;; have to make two nested loops. Not in Scheme land though.

    (let loop ((current-handler (car option-handlers))
               (other-handlers (cdr option-handlers))
               (options default-options)
               (arguments arguments))

;;; When the argument list is empty we're done.

      (cond ((null? arguments)

             options)

;;; Each option handler is a procedure. When the argument list begins
;;; with something the handler is interested in -- it consumes it and
;;; conses the new options with the arguments it doesn't care about.
;;; Otherwise it returns `#f`.

            ((current-handler options arguments)
             =>
             (lambda (opts-and-args)
               (let ((options (car opts-and-args))
                     (arguments (cdr opts-and-args)))

                 (loop (car option-handlers)
                       (cdr option-handlers)
                       options
                       arguments))))

;;; Something is clearly wrong if the argument list is not empty and
;;; none of the handlers shows interest it's content.

            ((null? other-handlers)

             (error "Cannot parse rest of argument list!"
                    arguments
                    options))

;;; We still have handlers to try? Great, lest try another one!

            (else
             (loop (car other-handlers)
                   (cdr other-handlers)
                   options
                   arguments))))))


;;; # Nice option handlers
;;;
;;; The option handler interface is somewhat unwieldy. Since all option
;;; handlers are going to do similar stuff we're gonna abstract some of
;;; it away.

(define (make-option-handler option-names handler-proc)

;;; All options need names.

  (when (null? option-names)
    (error "At least one option name must be specified!"))

;;; The first name specified is "canonical" and gets special treatment.

  (let ((canonical-name (car option-names)))

    (lambda (options arguments)

;;; When the first argument is one of the option's names, we feed the
;;; rest to the handler procedure. It produces a pair containing the new
;;; value of the option and the arguments it didn't consume.

      (cond ((member (car arguments)
                     option-names
                     string=?)

             (let ((value-and-args (handler-proc (cdr arguments))))

;;; Then we cons together the new options and arguments.

               (let ((value (car value-and-args))
                     (arguments (cdr value-and-args)))

                 (cons (cons (cons canonical-name
                                   value)
                             options)
                       arguments))))

;;; When the name is NOT one of the option's names, the option handler
;;; returns false, just as `build-option-parser` expects.

            (else #f)))))

;;; # Our options
;;;
;;; We only have three options -- two of which specify the input and
;;; output ports (and default to the standard input and output). The
;;; third one sets the comment mark to be used.

(define config `(("--input" . ,(current-input-port))
                 ("--output" . ,(current-output-port))
                 ("--comment-mark" . ";;;")))

;;; All of our options take exactly one argument, so we make another
;;; helper procedure so we won't need to repeat ourselves. It takes a
;;; procedure and returns a handler procedure that applies the first one
;;; to the first argument and conses it with the rest.
;;;
;;; But first we check that we've got enough arguments to consume!

(define (take-one-argument proc)
  (lambda (arguments)

    (when (null? arguments)
      (error "The argument list is too short!"))

    (cons (proc (car arguments))
          (cdr arguments))))

;;; Finally, we build our option parser.

(define parse-options
  (build-option-parser
   config

;;; Two options open files for us.

   (list (make-option-handler
          '("--input" "--from" "-i" "-f")
          (take-one-argument open-input-file))

         (make-option-handler
          '("--output" "--to" "-o" "-t")
          (take-one-argument open-output-file))

;;; One just gives us a string.

         (make-option-handler
          '("--comment-mark" "-m")
          (take-one-argument (lambda (x) x))))))

;;; # Program body
;;;
;;; We get the command line and parse it. Per R7RS the first element of
;;; `(command-line)` is the command name and is implementation specific.
;;; We don't care about it so we take the rest of the list.

(let ((options (parse-options (cdr (command-line)))))

;;; Bind the option values to handy names.

  (let ((input (cdr (assoc "--input" options)))
        (output (cdr (assoc "--output" options)))
        (mark (cdr (assoc "--comment-mark" options))))

;;; Dynamically bind the current input and output ports as inside-out
;;; operates on them.

    (parameterize ((current-input-port input)
                   (current-output-port output))

;;; Plumb the generators together.

      (generator-for-each
        (lambda (line)
          (write-string line)
          (newline))
        ((inside-out mark) (input-lines))))

;;; Close the ports. Not really necessary here, but it's a good habit to
;;; do so.

    (close-port input)
    (close-port output)))

;;; # Generating PDFs
;;;
;;; `pandoc` is pretty good at producing PDFs out of Markdown. It adds
;;; some extensions of it's own to the vanilla format. Try it -- you'll
;;; have a printable version of your code!