-
Notifications
You must be signed in to change notification settings - Fork 5
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
from syntax-objects/Summer2021#16 cc @Metaxal
- Loading branch information
Showing
4 changed files
with
174 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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"))) | ||
) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 ...))) | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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} | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters