diff options
| author | Christopher Baines <mail@cbaines.net> | 2019-05-12 09:32:58 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2019-05-12 09:32:58 +0100 |
| commit | bd8b9f951cdcba9eaab6e614ba5f0927176b2600 (patch) | |
| tree | 36383257a392e700d251869c3b5152b4e1311f7d | |
| parent | b15c8f706e5d31ed410fc285815f6c292b005a6e (diff) | |
| download | data-service-bd8b9f951cdcba9eaab6e614ba5f0927176b2600.tar data-service-bd8b9f951cdcba9eaab6e614ba5f0927176b2600.tar.gz | |
Fix extension handling a bit more
Previously, it was spliting versions up for the package pages. To stop this,
now it just matches the extensions it knows about (currently .html and .json).
| -rw-r--r-- | guix-data-service/web/util.scm | 54 |
1 files changed, 30 insertions, 24 deletions
diff --git a/guix-data-service/web/util.scm b/guix-data-service/web/util.scm index 3792389..108c9ec 100644 --- a/guix-data-service/web/util.scm +++ b/guix-data-service/web/util.scm @@ -46,37 +46,43 @@ '(("json" . application/json) ("html" . text/html))) + (define (ends-with-recognised-extension? path) + (any (lambda (extension) + (string-suffix? (string-append "." extension) + path)) + (map car extensions-to-mime-types))) + (match (split-and-decode-uri-path (uri-path (request-uri request))) (() (values '() (or (request-accept request) (list 'text/html)))) ((single-component) - (match (string-split single-component #\.) - ((part) - (values (list single-component) - (or (request-accept request) - (list 'text/html)))) - ((first-parts ... extension) - (values (list (string-join first-parts ".")) - (or (cons - (or (assoc-ref extensions-to-mime-types extension) - 'text/html) - (request-accept request))))))) + (if (ends-with-recognised-extension? single-component) + (match (string-split single-component #\.) + ((first-parts ... extension) + (values (list (string-join first-parts ".")) + (or (cons + (assoc-ref extensions-to-mime-types extension) + (or (request-accept request) + (list 'text/html))))))) + (values (list single-component) + (or (request-accept request) + (list 'text/html))))) ((first-components ... last-component) - (match (string-split last-component #\.) - ((part) - (values (append first-components - (list part)) - (or (request-accept request) - (list 'text/html)))) - ((first-parts ... extension) - (values (append first-components - (list (string-join first-parts "."))) - (or (cons - (or (assoc-ref extensions-to-mime-types extension) - 'text/html) - (request-accept request))))))))) + (if (ends-with-recognised-extension? last-component) + (match (string-split last-component #\.) + ((first-parts ... extension) + (values (append first-components + (list (string-join first-parts "."))) + (or (cons + (assoc-ref extensions-to-mime-types extension) + (or (request-accept request) + (list 'text/html))))))) + (values (append first-components + (list last-component)) + (or (request-accept request) + (list 'text/html))))))) (define (file-extension file-name) (last (string-split file-name #\.))) |