collects/pkg/name.rkt

14                                   (#:complain (-> string? string? any)
32 (define (validate-name name complain inferred?)
38          (complain (~a (if inferred? "inferred " "")
42          (complain (~a (if inferred? "inferred " "")
46 (define (extract-archive-name name+ext complain)
53    complain
71 (define (extract-git-name url p complain-name)
75         (validate-name (last sub) complain-name #t)
77           (validate-name (regexp-replace #rx"[.]git$" s "") complain-name #t)))))
83 (define-syntax-rule (cor v complain)
84   (or v (begin complain #f)))
88                                    #:complain [complain-proc void]
93   (define (complain msg)
94     (complain-proc s msg))
95   (define complain-name
96     (if must-infer-name? complain void))
105                   (complain "ill-formed path"))
107                   (complain "path does not end with a recognized archive extension"))
112                (extract-archive-name name+ext complain-name))))
120         (complain "ill-formed path"))
126                                      (complain "no elements in path")
127                                      (complain "ending path element is not a name")))
129       (values (validate-name dir-name complain-name #t)
132       (complain "ill-formed path")
138     (values (validate-name s complain #f) 'name)]
141 …(complain "repository URL must start 'http', 'https', 'git', 'git+http', 'git+https', or 'github'")
149      #:complain complain-proc
160                                              (complain "cannot parse URL")
175                 (complain "URL scheme is not 'git' or 'github'"))
182                           (complain "URL path is empty"))
185                               (complain "URL host is not 'github.com'")))
193 …                                  (complain "URL does not have two path elements (name and repo)"))
196 …                                    (complain "URL includes a directory indicator as an element")))
199                                         (complain "URL path is empty"))
201                                         (complain "URL path ends with a directory indicator"))
203                                         (complain "URL path ends with two empty elements"))))
210                                          (complain "path query includes a directory indicator"))))
211                               (extract-git-name url p complain-name))
217                                      (complain "URL does not have at least three path elements"))
219                                      (complain "URL includes a directory indicator"))
224                                  complain-name
237                           (complain "URL path is empty"))
239                           (complain "URL does not end with a recognized archive extension"))
240                      (extract-archive-name (last-non-empty p) complain-name)))
252                           (complain "URL path is empty"))
254                           (complain "URL path ends with two empty elements"))
256                           (complain "URL path ends with a directory indicator"))
257                      (extract-git-name url p complain-name)))
264                           (complain "URL path is empty"))
266                           (complain "URL has no non-empty path"))
268                           (complain "URL's last path element is a directory indicator"))
269                      (validate-name (last-non-empty p) complain-name #t)))
272     (values (validate-name name complain-name #f)
278                                                 (complain "cannot parse URL")
291                         (complain "URL contains an unrecognized `type' query")
300     (complain "unrecognized URL scheme")