[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/03: Fix request->path-components-and-mime-type
From: |
Christopher Baines |
Subject: |
01/03: Fix request->path-components-and-mime-type |
Date: |
Wed, 12 May 2021 03:29:31 -0400 (EDT) |
cbaines pushed a commit to branch master
in repository data-service.
commit d13a7187afb149b0c2cb2acfba7f0598d8af26b7
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Wed May 12 08:26:15 2021 +0100
Fix request->path-components-and-mime-type
Previously, it wouldn't pull the mime types out of the request properly, I
think it does a better job of that now.
---
guix-data-service/web/util.scm | 13 ++++++++-----
1 file changed, 8 insertions(+), 5 deletions(-)
diff --git a/guix-data-service/web/util.scm b/guix-data-service/web/util.scm
index d5c18c4..439c581 100644
--- a/guix-data-service/web/util.scm
+++ b/guix-data-service/web/util.scm
@@ -53,10 +53,13 @@
path))
(map car extensions-to-mime-types)))
+ (define accept-mime-types
+ (map car (request-accept request)))
+
(match (split-and-decode-uri-path (uri-path (request-uri request)))
(()
(values '()
- (or (request-accept request)
+ (or accept-mime-types
(list 'text/html))))
((single-component)
(if (ends-with-recognised-extension? single-component)
@@ -65,10 +68,10 @@
(values (list (string-join first-parts "."))
(or (cons
(assoc-ref extensions-to-mime-types extension)
- (or (request-accept request)
+ (or accept-mime-types
(list 'text/html)))))))
(values (list single-component)
- (or (request-accept request)
+ (or accept-mime-types
(list 'text/html)))))
((first-components ... last-component)
(if (ends-with-recognised-extension? last-component)
@@ -78,11 +81,11 @@
(list (string-join first-parts ".")))
(or (cons
(assoc-ref extensions-to-mime-types extension)
- (or (request-accept request)
+ (or accept-mime-types
(list 'text/html)))))))
(values (append first-components
(list last-component))
- (or (request-accept request)
+ (or accept-mime-types
(list 'text/html)))))))
(define (file-extension file-name)