#lang racket
(require (prefix-in CU: (planet cobbe/contract-utils:4/contract-utils)))
(struct spec (program help commands) #:transparent)
(struct command (name short-help long-help positional-args
rest-arg flags function) #:transparent)
(struct flag () #:transparent)
(struct optional-flag flag (switches keyword help args) #:transparent)
(struct multi-flag flag (switches keyword help args) #:transparent)
(struct group flag (flags) #:transparent)
(provide/contract
(struct spec ([program string?]
[help string?]
[commands (CU:nelistof/c command?)]))
(struct command ([name string?]
[short-help string?]
[long-help string?]
[positional-args (listof symbol?)]
[rest-arg (CU:optional/c symbol?)]
[flags (listof flag?)]
[function procedure?]))
(struct (optional-flag flag) ([switches set?] [keyword keyword?]
[help (CU:nelistof/c string?)]
[args (listof symbol?)]))
(struct (multi-flag flag) ([switches set?] [keyword keyword?]
[help (CU:nelistof/c string?)]
[args (CU:nelistof/c symbol?)]))
(struct (group flag) ([flags (CU:nelistof/c optional-flag?)]))
[switch? (string? . -> . boolean?)]
[short-switch? (string? . -> . boolean?)]
[long-switch? (string? . -> . boolean?)]
[find-command (spec? string? . -> . (CU:optional/c command?))])
(define switch?
(lambda (x)
(or (short-switch? x) (long-switch? x))))
(define short-switch?
(lambda (str)
(and (regexp-match #rx"^-[A-Za-z]$" str) #t)))
(define long-switch?
(lambda (str)
(and (regexp-match #rx"^--[A-Za-z0-9][-A-Za-z0-9]*$" str) #t)))
(define find-command
(lambda (spec cmd-name)
(findf (lambda (c) (string=? cmd-name (command-name c)))
(spec-commands spec))))