#|-------------------- 0.4 |# "./.gitignore" 16
*.so
*.import.*
#|-------------------- 0.4 |# "./README" 6442
[[toc:]]
== Description
This is the command-line parser from Mowedline, now an independent
project. It is a simple imperative-style command-line parser, and the
"-a" suffix on its name is there to suggest that this module represents
only one of many possible imperative-style command-line frameworks.
An "imperative" command-line style is one in which the command-line
arguments represent procedures and parameters, to be called in
left-to-right order, a kind of DSL, or mini-language. Contrast this style
with other command-line styles where the options represent simple flags,
and order is not significant. In an imperative-style command-line, the
options represent ''actions'' to take in the order given.
There are times though, when strict left-to-right order is not desired,
and to support these situations, imperative-command-line-a supports
''command groups''. If you want to take certain options out of the
overall ordering, you use groups. When the command-line is processed,
commands from different command groups are first parsed into separate
lists. Then the commands in these lists are called, in the order of their
respective command groups in the {{(groups)}} parameter. Command groups
are notably used to support "-help" and "-version" options, which may
appear anywhere in the command-line (barring positional errors). A
command group could also be used to support order-independent flag options
that need to run before the imperative "actions".
Imperative-command-line-a provides one pre-made command-group,
{{special-options}}, which defines the commands "help" and "version".
These command line options are automatically available in your program,
unless you override them (for which see {{groups}} below). The output of
these commands is configured in part by the parameters {{help-heading}}
and {{help-minimum-intercolumn-space}}.
Each defined command-line option takes a certain number of positional
parameters. Your commands are not limited to a single parameter, but
variable numbers of parameters are not yet supported. Since the
distinction between command and parameter is purely positional, the
conventional leading hyphens on option names are purely stylistic and may
be omitted.
This module has room to grow. The initial set of features are those that
meet the requirements of Mowedline, but now that this is a separate
project, new uses and needs will undoubtedly arise, and future versions of
this egg will be more powerful, flexible, and easier to use.
== Authors
* John J Foerch
== Requirements
* [[miscmacros]]
== API
Any program that uses imperative-command-line-a will define at least one
command group. Typically, you will use {{define-command-group}} to do
this.
(define-command-group name command-def ...)
(define-command-group name #:title title command-def ...)
(define-command-group* name command-def ...)
(define-command-group* name #:title title command-def ...)
{{define-command-group}} is the typical way to define a command group. It
defines the symbol {{name}} as a command group constructed according to
the rest of the arguments. It adds the new group to {{(groups)}}.
The starred form, {{define-command-group*}}, is the same, except that it
does not automatically add the new group to {{(groups)}}.
When no title is given, {{make-title}} is used to generate one
automatically based on {{name}}. The title is used in the -help display.
Each command-def looks like {{((name . args) . body)}} or {{((name . args)
#:doc doc . body)}}. The {{#:doc}} keyword may be used to store a short
docstring for the command, which will be printed in the -help display.
(make-command-group title commands)
You will not normally use this procedure directly. It is part of the
expansion of {{define-command-group}} and {{define-command-group*}}.
make-title
The default value is a procedure that converts a symbol into an upper case
string with hyphens replaced by spaces.
(abort-parse)
Helper procedure for use in command bodies to stop calling of commands,
and inform the calling program that it should exit. This is used by the
built-in special commands {{-help}} and {{-version}} to ensure that only
one command is called.
(parse input)
Parse the list of command-line arguments, input into commands and call
them. Returns {{#t}} on successful completion of calling commands, {{#f}}
if parsing was aborted.
groups
The groups parameter holds the list of command-groups that {{parse}} draws
from. By default, it starts with a single group, special-options, which
contains the commands -help and -version. The syntax form
{{define-command-group}} adds to this list. To remove the provided
special-options group, call {{(group '())}} to initialize the list before
defining any other command groups.
help-heading
The string value of help-heading is printed out by the provided -version
command, and as the first line of the provided -help command. Be sure to
set this.
help-minimum-intercolumn-space
The provided -help command prints command call forms and docstrings in two
columns. The help-minimum-intercolumn-space parameter gives the minimum
number of spaces by which to separate the two columns, defaulting to 3.
=== Commands API
You will generally not need to use this part of the API, unless you write
introspective commands, like your own -help.
(make-command name args doc body)
(command-name cmd)
(command-args cmd)
(command-doc cmd)
(command-body cmd)
(command-name-string cmd)
== Examples
(use srfi-1
(prefix imperative-command-line-a icla:))
(icla:help-heading
"icla-example version 1.0, by Harry S Beethoven")
(icla:define-command-group general-options
((foo)
doc: "print foo"
(print "foo"))
((bar baz)
(print baz)))
(icla:parse (command-line-arguments))
== License
BSD
== Version History
* 0.1 (February 13, 2013) initial release
* 0.2 (February 14, 2013) simpler 'parse' call-form
* 0.3 (February 18, 2013) 'parse' now calls the commands
* 0.4 (February 19, 2013) introducing define-command-group
#|-------------------- 0.4 |# "./imperative-command-line-a.meta" 162
;; -*- scheme -*-
((license "BSD")
(category misc)
(author "John J. Foerch")
(synopsis "A simple, imperative-style command-line parser")
(needs miscmacros))
#|-------------------- 0.4 |# "./imperative-command-line-a.release-info" 219
(repo git "git://github.com/retroj/imperative-command-line-a.git")
(uri targz "https://github.com/retroj/imperative-command-line-a/tarball/{egg-release}")
(release "0.1")
(release "0.2")
(release "0.3")
(release "0.4")
#|-------------------- 0.4 |# "./imperative-command-line-a.scm" 7243
;; Copyright 2011-2013 John J Foerch. All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions are
;; met:
;;
;; 1. Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;;
;; 2. Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in
;; the documentation and/or other materials provided with the
;; distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY JOHN J FOERCH ''AS IS'' AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;; DISCLAIMED. IN NO EVENT SHALL JOHN J FOERCH OR CONTRIBUTORS BE LIABLE
;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
;; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
;; ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(module imperative-command-line-a
(make-command
command-name
command-args
command-doc
command-body
command-name-string
define-command-group
define-command-group*
make-command-group
abort-parse
parse
groups
make-title
help-heading
help-minimum-intercolumn-space
special-options)
(import chicken scheme)
(use srfi-1
srfi-13
data-structures
extras
(only miscmacros dotimes))
;;;
;;; Language
;;;
(define rest cdr)
;;;
;;; Command
;;;
(define-record command
name args doc body)
(define (command-name-string command-def)
(symbol->string (command-name command-def)))
;;;
;;; Command Groups
;;;
(define groups (make-parameter '()))
(define-syntax %make-command
(syntax-rules (#:doc)
((%make-command (name . args) #:doc doc . body)
(make-command 'name 'args doc (lambda args . body)))
((%make-command (name . args) . body)
(%make-command (name . args) #:doc #f . body))))
(define make-title
(make-parameter
(lambda (sym)
(string-map!
(lambda (c) (if (char=? #\- c) #\space c))
(string-upcase! (symbol->string sym))))))
(define-record command-group
title commands)
(define-syntax define-command-group*
(syntax-rules (#:title)
((define-command-group* name #:title title command-def ...)
(define name (make-command-group
title
(list (%make-command . command-def)
...))))
((define-command-group* name . command-defs)
(define-command-group* name
#:title ((make-title) 'name)
. command-defs))))
(define-syntax define-command-group
(syntax-rules ()
((define-command-group name . args)
(begin
(define-command-group* name . args)
(groups (append! (groups) (list name)))))))
(define (find-command-def name command-group)
(find (lambda (x) (equal? name (command-name-string x)))
(command-group-commands command-group)))
;;;
;;; Call Info
;;;
(define-record callinfo
name args thunk)
(define %make-callinfo make-callinfo)
(define (make-callinfo def args)
(let ((name (command-name-string def))
(body (command-body def)))
(%make-callinfo name args
(lambda () (apply body args)))))
;;;
;;; Parser
;;;
(define (abort-parse)
(signal (make-property-condition 'abort-parse)))
(define (%parse input)
(let* ((callinfos (map (lambda (x) (list)) (groups))))
(let loop ((input input)
(count (length input)))
(cond
((null? input) callinfos)
(else
(let* ((opsym (first input))
(input (rest input))
(count (- count 1))
(op (string-trim opsym #\-))
(def #f)
(group-index (list-index
(lambda (group)
(set! def (find-command-def op group))
def)
(groups))))
(unless def
(error (sprintf "unexpected symbol ~S~%" opsym)))
(let ((narg (length (command-args def))))
(when (< count narg)
(error (sprintf "~A requires ~A arguments, but only ~A were given"
op narg count)))
(let ((d (list-tail callinfos group-index)))
(set-car! d (append! (car d) (list (make-callinfo def (take input narg))))))
(loop (list-tail input narg) (- count narg)))))))))
(define (parse input)
(let ((callinfos (apply append! (%parse input)))
(called 0))
(condition-case
(begin
(for-each
(lambda (cmd)
(set! called (+ 1 called))
((callinfo-thunk cmd)))
callinfos)
#t)
((abort-parse)
(let ((uncalled (drop callinfos called)))
(unless (null? uncalled)
(printf "~%Warning: the following commands were ignored:~%")
(for-each
(lambda (x) (printf " ~S~%" (cons (callinfo-name x) (callinfo-args x))))
uncalled))
#f)))))
;;;
;;; Default Command Group(s)
;;;
(define help-heading (make-parameter #f))
(define help-minimum-intercolumn-space (make-parameter 3))
(define-command-group special-options
#:title "SPECIAL OPTIONS (evaluate first one and exit)"
((help)
#:doc "displays this help"
(let ((longest
(fold max 0
(map
(lambda (def)
(apply + 2 (string-length (command-name-string def))
(* 3 (length (command-args def)))
(map (compose string-length symbol->string)
(command-args def))))
(append-map command-group-commands (groups))))))
(define (help-section option-group)
(for-each
(lambda (def)
(let ((col1 (apply string-append " -" (command-name-string def)
(map (lambda (a)
(string-append " <" (symbol->string a) ">"))
(command-args def)))))
(display col1)
(when (command-doc def)
(dotimes (_ (+ (help-minimum-intercolumn-space)
(- longest (string-length col1))))
(display " "))
(display (command-doc def)))
(newline)))
option-group))
(print (help-heading))
(for-each
(lambda (group)
(let ((title (command-group-title group))
(commands (command-group-commands group)))
(printf "~%~A~%~%" title)
(help-section commands)))
(groups))
(newline)
(abort-parse)))
((version)
#:doc "prints the version"
(print (help-heading))
(abort-parse)))
)
#|-------------------- 0.4 |# "./imperative-command-line-a.setup" 273
;; -*- scheme -*-
(compile imperative-command-line-a.scm -J -s -O2 -d0)
(compile imperative-command-line-a.import.scm -s -O2 -d0)
(install-extension
'imperative-command-line-a
'("imperative-command-line-a.so" "imperative-command-line-a.import.so")
'((version "0.4")))