diff options
-rw-r--r-- | doc/ref/guile.texi | 1 | ||||
-rw-r--r-- | doc/ref/guile/web.texi | 92 | ||||
-rw-r--r-- | module/calp/html/vcomponent.scm | 4 | ||||
-rw-r--r-- | module/calp/server/routes.scm | 4 | ||||
-rw-r--r-- | module/web/http/make-routes.scm | 1 | ||||
-rw-r--r-- | module/web/query.scm | 13 | ||||
-rw-r--r-- | module/web/uri-query.scm | 4 | ||||
-rw-r--r-- | po/sv.po | 8 | ||||
-rw-r--r-- | static/clock.ts | 31 | ||||
-rw-r--r-- | static/script.ts | 6 | ||||
-rwxr-xr-x | tests/run-tests.scm | 2 | ||||
-rw-r--r-- | tests/test/web-query.scm | 38 |
12 files changed, 189 insertions, 15 deletions
diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi index eb9e3bcc..2594b9e1 100644 --- a/doc/ref/guile.texi +++ b/doc/ref/guile.texi @@ -6,6 +6,7 @@ @include guile/util.texi @include guile/util-path.texi @include guile/util-config.texi +@include guile/web.texi @include guile/vcomponent.texi @node Errors and Conditions diff --git a/doc/ref/guile/web.texi b/doc/ref/guile/web.texi new file mode 100644 index 00000000..69ab726f --- /dev/null +++ b/doc/ref/guile/web.texi @@ -0,0 +1,92 @@ +@node Web Stuff +@section Web Stuff + +@subsection (web query) + +@defun parse-query query-string [encoding=''UTF-8''] +Given a string like ``?key=value&other=something'', returns +@code{(key: "value" other: "something")}. Performs uri-decoding of +both key and value. A key without a value decodes to that key, with +itself as its value +@end defun + + +@subsection (web uri-query) + +@defun encode-query-parameters parameters +Given the association list @var{parameter}, encode it into a query +string on the form ``key=value&...''. +@end defun + +@subsection (web http make-routes) + +@defun parse-endpoint-string str +Only really public for tests. +@end defun + +@defmac make-routes routes ... +Expands a number of endpoint specifiers into a procedure suitable for +use as a handler in @xref{Web Server,run-server,run-server,guile}. + +Each form conists of +@itemize +@item the method (``GET'', ``POST'', ...), +@item the path, possibly with embedded parameters, +@item a list of parameters to capture, and +@item the body. +@end itemize + +@example +(make-routes + (GET "/path/:a" (a b) + (return '((content-type text/plain)) + (format #f "a=~a, b=~a" a b))) + ...) +@end example + +The paths can contain embedded variables, which start with +colon, and their name continues until the next slash or period (or end +of string). Each path-embedded parameter must be present in the +parameter list. + +The parameter list must contain all path-embedded parameters, and can +contain any other parameters, which will be bound from the query +parameters, or stay @code{#f} if not supplied by the browser. + +The body should return one to three values, either directly, or +through an early return by calling the procedure @code{return}. + +@defun return headers [body] [new-state] +@end defun + +Inside the body, the following variables are bound to enable producing +the body: + +@defvar request +@defvarx body +The raw request headers and request body. +@end defvar + +@defvar state +The optional state. +@end defvar + +@defvar r:method +@defvarx r:uri +@defvarx r:version +@defvarx r:headers +@defvarx r:meta +The requests components +@end defvar + +@defvar r:scheme +@defvarx r:userinfo +@defvarx r:host +@defvarx r:port +@defvarx r:path +@defvarx r:query +@defvarx r:fragment +The request uri's components. +@end defvar + +@end defmac diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index 574ad954..9e70f910 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -481,7 +481,7 @@ ;; description in sidebar / tab of popup ;; Template data for <vevent-description /> (define-public (description-template) - '(template + `(template (@ (id "vevent-description")) (div (@ (class " vevent eventtext summary-tab " ())) (h3 ((span (@ (class "repeating")) @@ -563,7 +563,7 @@ (dd (input-list (@ (name ,name)) (input (@ (type "number") (min ,min) (max ,max))))))) - '((bysecond ,(_ "By Second") 0 60) + `((bysecond ,(_ "By Second") 0 60) (byminute ,(_ "By Minute") 0 59) (byhour ,(_ "By Hour") 0 23) (bymonthday ,(_ "By Month Day") -31 31) ; except 0 diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm index 2e8f1131..762681d9 100644 --- a/module/calp/server/routes.scm +++ b/module/calp/server/routes.scm @@ -71,7 +71,7 @@ (drop-right 1) (xcons "/static") path-join))) - "Return up"))) + ,(_ "Return up")))) ,@(map (lambda (k) (let* ((stat (lstat (path-append prefix dir k)))) `(tr (td ,(case (stat:type stat) @@ -447,7 +447,7 @@ (lambda () ((sxml->output html) (xhtml-doc - (head (title (_ "Calp directory listing for ") path) + (head (title ,(_ "Calp directory listing for ") path) ,(include-css "/static/directory-listing.css")) (body ,(directory-table (static-dir) path)))))))) diff --git a/module/web/http/make-routes.scm b/module/web/http/make-routes.scm index 11f7dfb4..105bba50 100644 --- a/module/web/http/make-routes.scm +++ b/module/web/http/make-routes.scm @@ -102,6 +102,7 @@ (append ((@ (web query) parse-query) r:query) + ;; TODO what's happening here? (let ((content-type (assoc-ref r:headers 'content-type))) ((@ (hnh util) when) content-type (let ((type (car content-type)) diff --git a/module/web/query.scm b/module/web/query.scm index e5057a24..a70903bc 100644 --- a/module/web/query.scm +++ b/module/web/query.scm @@ -8,9 +8,12 @@ (fold (lambda (str list) ;; only split on the first equal. ;; Does HTTP allow multiple equal signs in a data field? - ;; NOTE that this fails if str lacks an equal sign. - (define idx (string-index str #\=)) - (define key (uri-decode (substring str 0 idx) encoding: encoding)) - (define val (uri-decode (substring str (1+ idx)) encoding: encoding)) - (cons* (-> key string->symbol symbol->keyword) val list)) + (let* ((key val + (cond ((string-index str #\=) + => (lambda (idx) + (values (uri-decode (substring str 0 idx) encoding: encoding) + (uri-decode (substring str (1+ idx)) encoding: encoding)))) + (else (let ((v (uri-decode str encoding: encoding))) + (values v v)))))) + (cons* (-> key string->symbol symbol->keyword) val list))) '() (string-split query-string #\&)))) diff --git a/module/web/uri-query.scm b/module/web/uri-query.scm index 40d89b11..56f3aef9 100644 --- a/module/web/uri-query.scm +++ b/module/web/uri-query.scm @@ -3,6 +3,10 @@ :use-module ((web uri) :select (uri-encode)) ) +;; TODO why this format for values? +;; TODO why aren't we encoding the keys? +;; TODO why isn't this in the same module as `parse-query'? +;; TODO why isn't this on the same format as `parse-query'? (define-public (encode-query-parameters parameters) (string-join @@ -959,3 +959,11 @@ msgstr "Vilka filer att läsa in. Tar en lista av filvägar eller en ensam " msgid "Default calendar to use for operations. Set to empty string to unset" msgstr "Standardkalendar att utgå från. En tom sträng \"rensar\" fältet" + +msgid "<p><b>update-zoneinfo</b> in theory downloads and updates our local\n" + "zoneinfo database, but is currently broken.</p>" +msgstr "<p><b>update-zoneinfo</b> laddar i teori ner och uppdaterar vår " + "lokala zoninfo-databas, men är för tillfället trasig.</p>" + +msgid "Return up" +msgstr "Återvänd uppåt" diff --git a/static/clock.ts b/static/clock.ts index b0ddae00..bbd15de0 100644 --- a/static/clock.ts +++ b/static/clock.ts @@ -1,4 +1,7 @@ -export { SmallcalCellHighlight, Timebar } +export { + SmallcalCellHighlight, Timebar, + initialize_clock_components +} import { makeElement, date_to_percent } from './lib' @@ -96,15 +99,29 @@ class ClockElement extends HTMLElement { return ['timer_id'] } - update(now: Date) { /* noop */ } + update(_: Date) { /* noop */ } } + class TodayButton extends ClockElement { + a: HTMLAnchorElement; + + constructor() { + super(); + this.a = document.createElement('a'); + this.a.textContent = 'Idag'; + this.a.classList.add('btn'); + } + + connectedCallback() { + super.connectedCallback(); + this.replaceChildren(this.a); + } + update(now: Date) { - (this.querySelector('a') as any).href = now.format("~Y-~m-~d.html") + this.a.href = now.format("~Y-~m-~d.html") } } -customElements.define('today-button', TodayButton) class CurrentTime extends ClockElement { @@ -112,4 +129,8 @@ class CurrentTime extends ClockElement { this.textContent = now.format('~H:~M:~S') } } -customElements.define('current-time', CurrentTime) + +function initialize_clock_components() { + customElements.define('today-button', TodayButton) + customElements.define('current-time', CurrentTime) +} diff --git a/static/script.ts b/static/script.ts index 650a5aa0..ec771773 100644 --- a/static/script.ts +++ b/static/script.ts @@ -1,5 +1,8 @@ import { VEvent, xml_to_vcal } from './vevent' -import { SmallcalCellHighlight, Timebar } from './clock' +import { + SmallcalCellHighlight, Timebar, + initialize_clock_components +} from './clock' import { vcal_objects, event_calendar_mapping } from './globals' import { EventCreator } from './event-creator' import { PopupElement, setup_popup_element } from './components/popup-element' @@ -40,6 +43,7 @@ window.addEventListener('load', function() { } } + initialize_clock_components(); initialize_components(); /* A full redraw here is WAY to slow */ diff --git a/tests/run-tests.scm b/tests/run-tests.scm index 692bf00a..008090d0 100755 --- a/tests/run-tests.scm +++ b/tests/run-tests.scm @@ -51,6 +51,8 @@ fi (define (yellow s) (escaped 33 s)) (define (bold s) (escaped 1 s)) +;;; TODO handle nested grups in a better fassion + (define (construct-test-runner) (define runner (test-runner-null)) ;; end of individual test case diff --git a/tests/test/web-query.scm b/tests/test/web-query.scm new file mode 100644 index 00000000..76c0a76d --- /dev/null +++ b/tests/test/web-query.scm @@ -0,0 +1,38 @@ +(define-module (test web-query) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((web query) :select (parse-query))) + +(test-begin "Web Query") + +(test-equal "Empty query gives empty assoc list" + '() (parse-query "")) +(test-equal "Simple key-value query" + '(key: "value") (parse-query "key=value")) + +;; Slightly cumbersome check, since keys aren't ordered +(test-group + "Simple key-value query, with multiple keys" + (let ((kv-list (parse-query "k1=value&k2=1"))) + (test-equal "value" (and=> (memv k1: kv-list) cadr)) + (test-equal "1" (and=> (memv k2: kv-list) cadr)))) + +(test-equal "Values are HTTP-decoded" + '(key: " ") (parse-query "key=%20")) +(test-equal "Keys are HTTP-decoded" + '(A: "test") (parse-query "%41=test")) + +(test-equal "Query with only key, value becomes key" + '(key: "key") (parse-query "key")) + +(test-group + "Some with only key" + (let ((kv-list (parse-query "k1&k2=10"))) + (test-equal "k1" (and=> (memv k1: kv-list) cadr)) + (test-equal "10" (and=> (memv k2: kv-list) cadr)))) + +;; I don't know if HTTP allows this, but my code works like this +(test-equal "Value with equal in it" + '(key: "=") (parse-query "key==")) + +(test-end "Web Query") |