add hierarchical-cmdline

from syntax-objects/Summer2021#16
cc @Metaxal

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")))
+)

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 ...)))
+

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}
+

index.scrbl

@@ -37,6 +37,7 @@
 @include-example{syntax-class-contract}
 @include-example{except-in-quiet}
 @include-example{dot-underscore}
+@include-example{hierarchical-cmdline}
 @include-example{try-catch-finally}
 @include-example{kw-ctc}
 @include-example{pyret-for}