Skip to content

Commit 0675ce0

Browse files
bennnbennn
committed
add hierarchical-cmdline
from syntax-objects/Summer2021#16 cc @Metaxal
1 parent 6238503 commit 0675ce0

File tree

4 files changed

+174
-0
lines changed

4 files changed

+174
-0
lines changed

‎hierarchical-cmdline/hierarchical-cmdline-test.rkt

+64
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,64 @@
1+
#lang racket/base
2+
(module+ test
3+
(require rackunit racket/cmdline racket/port syntax-parse-example/hierarchical-cmdline/hierarchical-cmdline)
4+
5+
(test-begin
6+
(define prog "my-prog")
7+
8+
(define (parse-relative)
9+
(parameterize-help-if-empty-ccla
10+
(command-line
11+
#:program (string-append prog " --relative")
12+
#:once-each
13+
[("--left") => (shift-command-line-arguments
14+
(displayln "You're going left!")
15+
(parse-main))
16+
'("Go to the left")]
17+
[("--right") => (shift-command-line-arguments
18+
(displayln "You're going right!")
19+
(parse-main))
20+
'("Go to the right")])))
21+
22+
(define (parse-absolute)
23+
(parameterize-help-if-empty-ccla
24+
(command-line
25+
#:program (string-append prog " --absolute")
26+
#:once-each
27+
[("--north") => (shift-command-line-arguments
28+
(displayln "You're going north!")
29+
(parse-main))
30+
'("Go to the north")]
31+
[("--south") => (shift-command-line-arguments
32+
(displayln "You're going south!")
33+
(parse-main))
34+
'("Go to the south")])))
35+
36+
(define (parse-move)
37+
(parameterize-help-if-empty-ccla
38+
(command-line
39+
#:program (string-append prog " --move")
40+
#:once-each
41+
[("--relative") => (shift-command-line-arguments (parse-relative))
42+
'("Specify a relative direction")]
43+
[("--absolute") => (shift-command-line-arguments (parse-absolute))
44+
'("Specify an absolute direction")])))
45+
46+
(define (parse-main)
47+
(command-line
48+
#:program prog
49+
#:once-each
50+
[("--move") => (shift-command-line-arguments (parse-move))
51+
'("Specify directions")]
52+
[("--jump") => (shift-command-line-arguments
53+
(displayln "You're jumping!")
54+
(parse-main))
55+
'("jump")]))
56+
57+
(test-case "ex1"
58+
(check-equal?
59+
(with-output-to-string
60+
(lambda ()
61+
(parameterize ([current-command-line-arguments (vector "--move" "--relative" "--left" "--jump" "--jump" "--move" "--absolute" "--south" "--jump")])
62+
(parse-main))))
63+
"You're going left!\nYou're jumping!\nYou're jumping!\nYou're going south!\nYou're jumping!\n")))
64+
)

‎hierarchical-cmdline/hierarchical-cmdline.rkt

+20
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
#lang racket/base
2+
(provide shift-command-line-arguments parameterize-help-if-empty-ccla)
3+
(require syntax/parse/define racket/vector)
4+
5+
;; Remove the first argument of the command line arguments
6+
(define-syntax-parse-rule (shift-command-line-arguments body ...)
7+
(λ args
8+
(parameterize ([current-command-line-arguments (vector-copy (current-command-line-arguments) 1)])
9+
body ...)))
10+
11+
;; If the command line arguments are empty, re-parameterize it to
12+
;; default to #("--help")
13+
(define-syntax-parse-rule (parameterize-help-if-empty-ccla body ...)
14+
(let ([ccla (current-command-line-arguments)])
15+
(parameterize ([current-command-line-arguments
16+
(if (vector-empty? ccla)
17+
#("--help")
18+
ccla)])
19+
body ...)))
20+

‎hierarchical-cmdline/hierarchical-cmdline.scrbl

+89
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,89 @@
1+
#lang syntax-parse-example
2+
@require[
3+
(for-label racket/base racket/cmdline syntax/parse syntax-parse-example/hierarchical-cmdline/hierarchical-cmdline)]
4+
5+
@(define hierarchical-cmdline-eval
6+
(make-base-eval '(require racket/cmdline syntax-parse-example/hierarchical-cmdline/hierarchical-cmdline)))
7+
8+
@title{Hierarchical parsing of command-line arguments}
9+
@stxbee2021["Metaxal" 16]
10+
@nested[#:style 'inset @emph{Adapted from a @hyperlink["https://github.com/jackfirth/resyntax/pull/147/files" @elem{PR to @tt{resyntax}}]}]
11+
12+
@; =============================================================================
13+
14+
@defmodule[syntax-parse-example/hierarchical-cmdline/hierarchical-cmdline]{}
15+
16+
@defform[(shift-command-line-arguments body ...)]{
17+
}
18+
19+
@defform[(parameterize-help-if-empty-ccla body ...)]{
20+
}
21+
22+
The purpose of the first macro is to make it easy to parse command line
23+
arguments in a hierarchical way using the built-in @racket[command-line] form. The
24+
second macro is an additional helper that displays the help message
25+
automatically when no command-line argument is specified at this level, which
26+
avoids the case where the user tries one argument is then has no information
27+
about what to do next.
28+
29+
@examples[#:eval hierarchical-cmdline-eval
30+
(define prog "my-prog")
31+
32+
(define (parse-relative)
33+
(parameterize-help-if-empty-ccla
34+
(command-line
35+
#:program (string-append prog " --relative")
36+
#:once-each
37+
[("--left") => (shift-command-line-arguments
38+
(displayln "You're going left!")
39+
(parse-main))
40+
'("Go to the left")]
41+
[("--right") => (shift-command-line-arguments
42+
(displayln "You're going right!")
43+
(parse-main))
44+
'("Go to the right")])))
45+
46+
(define (parse-absolute)
47+
(parameterize-help-if-empty-ccla
48+
(command-line
49+
#:program (string-append prog " --absolute")
50+
#:once-each
51+
[("--north") => (shift-command-line-arguments
52+
(displayln "You're going north!")
53+
(parse-main))
54+
'("Go to the north")]
55+
[("--south") => (shift-command-line-arguments
56+
(displayln "You're going south!")
57+
(parse-main))
58+
'("Go to the south")])))
59+
60+
(define (parse-move)
61+
(parameterize-help-if-empty-ccla
62+
(command-line
63+
#:program (string-append prog " --move")
64+
#:once-each
65+
[("--relative") => (shift-command-line-arguments (parse-relative))
66+
'("Specify a relative direction")]
67+
[("--absolute") => (shift-command-line-arguments (parse-absolute))
68+
'("Specify an absolute direction")])))
69+
70+
(define (parse-main)
71+
(command-line
72+
#:program prog
73+
#:once-each
74+
[("--move") => (shift-command-line-arguments (parse-move))
75+
'("Specify directions")]
76+
[("--jump") => (shift-command-line-arguments
77+
(displayln "You're jumping!")
78+
(parse-main))
79+
'("jump")]))
80+
81+
(code:comment "$ racket syntax-bee.rkt --move --relative --left --jump --jump --move --absolute --south --jump")
82+
(parameterize ([current-command-line-arguments (vector "--move" "--relative" "--left" "--jump" "--jump" "--move" "--absolute" "--south" "--jump")])
83+
(parse-main))
84+
]
85+
86+
Implementation:
87+
88+
@racketfile{hierarchical-cmdline.rkt}
89+

‎index.scrbl

+1
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,7 @@
4040
@include-example{try-catch-finally}
4141
@include-example{kw-ctc}
4242
@include-example{pyret-for}
43+
@include-example{hierarchical-cmdline}
4344
@include-example{flaggable-app}
4445
@include-example{js-dict}
4546
@include-example{define-freevar}

0 commit comments

Comments
 (0)