diff --git a/hierarchical-cmdline/hierarchical-cmdline-test.rkt b/hierarchical-cmdline/hierarchical-cmdline-test.rkt
new file mode 100644
index 0000000..95e532a
--- /dev/null
+++ b/hierarchical-cmdline/hierarchical-cmdline-test.rkt
@@ -0,0 +1,64 @@
+#lang racket/base
+(module+ test
+ (require rackunit racket/cmdline racket/port syntax-parse-example/hierarchical-cmdline/hierarchical-cmdline)
+
+ (test-begin
+ (define prog "my-prog")
+
+ (define (parse-relative)
+ (parameterize-help-if-empty-ccla
+ (command-line
+ #:program (string-append prog " --relative")
+ #:once-each
+ [("--left") => (shift-command-line-arguments
+ (displayln "You're going left!")
+ (parse-main))
+ '("Go to the left")]
+ [("--right") => (shift-command-line-arguments
+ (displayln "You're going right!")
+ (parse-main))
+ '("Go to the right")])))
+
+ (define (parse-absolute)
+ (parameterize-help-if-empty-ccla
+ (command-line
+ #:program (string-append prog " --absolute")
+ #:once-each
+ [("--north") => (shift-command-line-arguments
+ (displayln "You're going north!")
+ (parse-main))
+ '("Go to the north")]
+ [("--south") => (shift-command-line-arguments
+ (displayln "You're going south!")
+ (parse-main))
+ '("Go to the south")])))
+
+ (define (parse-move)
+ (parameterize-help-if-empty-ccla
+ (command-line
+ #:program (string-append prog " --move")
+ #:once-each
+ [("--relative") => (shift-command-line-arguments (parse-relative))
+ '("Specify a relative direction")]
+ [("--absolute") => (shift-command-line-arguments (parse-absolute))
+ '("Specify an absolute direction")])))
+
+ (define (parse-main)
+ (command-line
+ #:program prog
+ #:once-each
+ [("--move") => (shift-command-line-arguments (parse-move))
+ '("Specify directions")]
+ [("--jump") => (shift-command-line-arguments
+ (displayln "You're jumping!")
+ (parse-main))
+ '("jump")]))
+
+ (test-case "ex1"
+ (check-equal?
+ (with-output-to-string
+ (lambda ()
+ (parameterize ([current-command-line-arguments (vector "--move" "--relative" "--left" "--jump" "--jump" "--move" "--absolute" "--south" "--jump")])
+ (parse-main))))
+ "You're going left!\nYou're jumping!\nYou're jumping!\nYou're going south!\nYou're jumping!\n")))
+)
diff --git a/hierarchical-cmdline/hierarchical-cmdline.rkt b/hierarchical-cmdline/hierarchical-cmdline.rkt
new file mode 100644
index 0000000..ab9bb12
--- /dev/null
+++ b/hierarchical-cmdline/hierarchical-cmdline.rkt
@@ -0,0 +1,20 @@
+#lang racket/base
+(provide shift-command-line-arguments parameterize-help-if-empty-ccla)
+(require syntax/parse/define racket/vector)
+
+;; Remove the first argument of the command line arguments
+(define-syntax-parse-rule (shift-command-line-arguments body ...)
+ (λ args
+ (parameterize ([current-command-line-arguments (vector-copy (current-command-line-arguments) 1)])
+ body ...)))
+
+;; If the command line arguments are empty, re-parameterize it to
+;; default to #("--help")
+(define-syntax-parse-rule (parameterize-help-if-empty-ccla body ...)
+ (let ([ccla (current-command-line-arguments)])
+ (parameterize ([current-command-line-arguments
+ (if (vector-empty? ccla)
+ #("--help")
+ ccla)])
+ body ...)))
+
diff --git a/hierarchical-cmdline/hierarchical-cmdline.scrbl b/hierarchical-cmdline/hierarchical-cmdline.scrbl
new file mode 100644
index 0000000..7246d2b
--- /dev/null
+++ b/hierarchical-cmdline/hierarchical-cmdline.scrbl
@@ -0,0 +1,89 @@
+#lang syntax-parse-example
+@require[
+ (for-label racket/base racket/cmdline syntax/parse syntax-parse-example/hierarchical-cmdline/hierarchical-cmdline)]
+
+@(define hierarchical-cmdline-eval
+ (make-base-eval '(require racket/cmdline syntax-parse-example/hierarchical-cmdline/hierarchical-cmdline)))
+
+@title{Hierarchical parsing of command-line arguments}
+@stxbee2021["Metaxal" 16]
+@nested[#:style 'inset @emph{Adapted from a @hyperlink["https://github.com/jackfirth/resyntax/pull/147/files" @elem{PR to @tt{resyntax}}]}]
+
+@; =============================================================================
+
+@defmodule[syntax-parse-example/hierarchical-cmdline/hierarchical-cmdline]{}
+
+@defform[(shift-command-line-arguments body ...)]{
+}
+
+@defform[(parameterize-help-if-empty-ccla body ...)]{
+}
+
+The purpose of the first macro is to make it easy to parse command line
+arguments in a hierarchical way using the built-in @racket[command-line] form. The
+second macro is an additional helper that displays the help message
+automatically when no command-line argument is specified at this level, which
+avoids the case where the user tries one argument is then has no information
+about what to do next.
+
+@examples[#:eval hierarchical-cmdline-eval
+ (define prog "my-prog")
+
+ (define (parse-relative)
+ (parameterize-help-if-empty-ccla
+ (command-line
+ #:program (string-append prog " --relative")
+ #:once-each
+ [("--left") => (shift-command-line-arguments
+ (displayln "You're going left!")
+ (parse-main))
+ '("Go to the left")]
+ [("--right") => (shift-command-line-arguments
+ (displayln "You're going right!")
+ (parse-main))
+ '("Go to the right")])))
+
+ (define (parse-absolute)
+ (parameterize-help-if-empty-ccla
+ (command-line
+ #:program (string-append prog " --absolute")
+ #:once-each
+ [("--north") => (shift-command-line-arguments
+ (displayln "You're going north!")
+ (parse-main))
+ '("Go to the north")]
+ [("--south") => (shift-command-line-arguments
+ (displayln "You're going south!")
+ (parse-main))
+ '("Go to the south")])))
+
+ (define (parse-move)
+ (parameterize-help-if-empty-ccla
+ (command-line
+ #:program (string-append prog " --move")
+ #:once-each
+ [("--relative") => (shift-command-line-arguments (parse-relative))
+ '("Specify a relative direction")]
+ [("--absolute") => (shift-command-line-arguments (parse-absolute))
+ '("Specify an absolute direction")])))
+
+ (define (parse-main)
+ (command-line
+ #:program prog
+ #:once-each
+ [("--move") => (shift-command-line-arguments (parse-move))
+ '("Specify directions")]
+ [("--jump") => (shift-command-line-arguments
+ (displayln "You're jumping!")
+ (parse-main))
+ '("jump")]))
+
+ (code:comment "$ racket syntax-bee.rkt --move --relative --left --jump --jump --move --absolute --south --jump")
+ (parameterize ([current-command-line-arguments (vector "--move" "--relative" "--left" "--jump" "--jump" "--move" "--absolute" "--south" "--jump")])
+ (parse-main))
+]
+
+Implementation:
+
+@racketfile{hierarchical-cmdline.rkt}
+
diff --git a/index.scrbl b/index.scrbl
index e184da9..89360a0 100644
--- a/index.scrbl
+++ b/index.scrbl
@@ -40,6 +40,7 @@
@include-example{try-catch-finally}
@include-example{kw-ctc}
@include-example{pyret-for}
+@include-example{hierarchical-cmdline}
@include-example{flaggable-app}
@include-example{js-dict}
@include-example{define-freevar}
pFad - Phonifier reborn
Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.
Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.
Alternative Proxies:
Alternative Proxy
pFad Proxy
pFad v3 Proxy
pFad v4 Proxy