From 1bb806b91bba112d72b26d1f23008478912ec337 Mon Sep 17 00:00:00 2001 From: Ben Greenman Date: Sun, 10 Oct 2021 21:12:48 -0400 Subject: [PATCH] add hierarchical-cmdline from https://github.com/syntax-objects/Summer2021/issues/16 cc @Metaxal --- .../hierarchical-cmdline-test.rkt | 64 +++++++++++++ hierarchical-cmdline/hierarchical-cmdline.rkt | 20 +++++ .../hierarchical-cmdline.scrbl | 89 +++++++++++++++++++ index.scrbl | 1 + 4 files changed, 174 insertions(+) create mode 100644 hierarchical-cmdline/hierarchical-cmdline-test.rkt create mode 100644 hierarchical-cmdline/hierarchical-cmdline.rkt create mode 100644 hierarchical-cmdline/hierarchical-cmdline.scrbl 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