From ab3342171fba016b0c5f19b860336ed49a08f3fb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 10 Jul 2022 14:56:19 +0200 Subject: Change JS formatters interface. Now the application of formatters are centralized. It also allowed me to easily suround stuff in try-catch, since I otherwise had problems with formatters failing, and nothing showing up. --- doc/ref/javascript/formatters.texi | 6 ++++++ static/components/vevent-description.ts | 11 ++--------- static/formatters.ts | 26 +++++++++++++++++++++----- static/user/user-additions.js | 2 +- 4 files changed, 30 insertions(+), 15 deletions(-) diff --git a/doc/ref/javascript/formatters.texi b/doc/ref/javascript/formatters.texi index 71394b39..a3086aa9 100644 --- a/doc/ref/javascript/formatters.texi +++ b/doc/ref/javascript/formatters.texi @@ -4,6 +4,12 @@ Formatting procedures used by some components. @c TODO can we have a backref of every node containing @ref{formatters-proc}? +@deftypefun void format(targetElement:HTMLElement, data:VEvent, key:string) +Checks if a specific formatter exists for the given key, and executes +it. +Defaults to 'default', and also runs that if the regular formatter throws. +@end deftypefun + @deftypevar {Map void>} formatters @anchor{formatters-proc} diff --git a/static/components/vevent-description.ts b/static/components/vevent-description.ts index 463725f1..b44185e7 100644 --- a/static/components/vevent-description.ts +++ b/static/components/vevent-description.ts @@ -2,7 +2,7 @@ export { ComponentDescription } import { VEvent } from '../vevent' import { ComponentVEvent } from './vevent' -import { formatters } from '../formatters' +import { format } from '../formatters' /* @@ -23,14 +23,7 @@ class ComponentDescription extends ComponentVEvent { for (let el of body.querySelectorAll('[data-property]')) { if (!(el instanceof HTMLElement)) continue; - let p = el.dataset.property!; - let d; - if ((d = data.getProperty(p))) { - let key = p.toLowerCase(); - let f = formatters.get(key); - if (f) f(el, data, d); - else window.formatters.get('default')!(el, data, d); - } + format(el, data, el.dataset.property!); } let repeating = body.getElementsByClassName('repeating')[0] as HTMLElement diff --git a/static/formatters.ts b/static/formatters.ts index 5605e051..e0018278 100644 --- a/static/formatters.ts +++ b/static/formatters.ts @@ -1,11 +1,11 @@ export { - formatters, + format } import { makeElement } from './lib' import { VEvent } from './vevent' -type formatter = (e: HTMLElement, d: VEvent, s: any) => void +type formatter = (e: HTMLElement, d: VEvent, s: any) => Promise declare global { interface Window { @@ -16,8 +16,24 @@ declare global { let formatters: Map; formatters = window.formatters = new Map(); +async function format(targetElement: HTMLElement, data: VEvent, key: string): Promise { + let d = data.getProperty(key); + if (!d) return + let formatter = formatters.get(key.toLowerCase()); + if (formatter) { + try { + await formatter(targetElement, data, d); + } catch (error) { + console.warn('Formatter failed') + console.warn(error); + formatters.get('default')!(targetElement, data, d); + } + } else { + formatters.get('default')!(targetElement, data, d); + } +} -formatters.set('categories', (el, _, d) => { +formatters.set('categories', async (el, _, d) => { for (let item of d) { let q = encodeURIComponent( `(member "${item}" (or (prop event (quote CATEGORIES)) (quote ())))`) @@ -28,7 +44,7 @@ formatters.set('categories', (el, _, d) => { } }) -function format_time_tag(el: HTMLElement, ev: VEvent, d: any): void { +async function format_time_tag(el: HTMLElement, ev: VEvent, d: any): Promise { if (el instanceof HTMLTimeElement) { if (d instanceof Date) { let fmt = ''; @@ -49,7 +65,7 @@ function format_time_tag(el: HTMLElement, ev: VEvent, d: any): void { formatters.set('dtstart', format_time_tag) formatters.set('dtend', format_time_tag) -formatters.set('default', (el, _, d) => { +formatters.set('default', async (el, _, d) => { let fmt; if ((fmt = el.dataset.fmt)) { el.textContent = d.format(fmt); diff --git a/static/user/user-additions.js b/static/user/user-additions.js index 7291f232..bfc0391d 100644 --- a/static/user/user-additions.js +++ b/static/user/user-additions.js @@ -1,4 +1,4 @@ -window.formatters.set('description', (el, ev, d) => { +window.formatters.set('description', async (el, ev, d) => { if (ev.getProperty('X-MICROSOFT-SKYPETEAMSMEETINGURL')) { /* parse Microsoft Teams meeting entries */ /* Replace lines with propper
tags */ -- cgit v1.2.3 From 77117e6e6bdb69f53fc0b723d79689c5ebdc02b5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 21 Jul 2022 15:59:29 +0200 Subject: Cleanup in fetch-liu-map script. --- scripts/fetch-liu-map-index.scm | 40 +++++++++++++++++----------------------- 1 file changed, 17 insertions(+), 23 deletions(-) diff --git a/scripts/fetch-liu-map-index.scm b/scripts/fetch-liu-map-index.scm index 31db3844..a9518c8d 100755 --- a/scripts/fetch-liu-map-index.scm +++ b/scripts/fetch-liu-map-index.scm @@ -19,35 +19,29 @@ (ice-9 getopt-long) (sxml gumbo) (sxml match) - ((hnh util) :select (->)) + ((sxml xpath) :select (sxpath)) + ((hnh util) :select (-> ->>)) (json)) ;; Parse string as HTML, find all links which are "map links", ;; and return them as an association list from name to url-fragments. -(define (get-data string) - (define data (html->sxml string)) - +(define (extract-data string) (define rx (make-regexp "^karta\\?")) - (define links - (map (lambda (node) - (sxml-match node - [(a (@ (href ,href)) ,b0 ,body ...) - (cons href b0)])) - (((@ (sxml xpath) sxpath) '(// a)) data))) - - (define map-links (filter (lambda (pair) (regexp-exec rx (car pair))) - links)) - - (define link-table (make-hash-table)) - (for-each (lambda (pair) (hash-set! link-table (string-upcase (string-trim-both (cdr pair))) - (car pair))) - map-links) + ;; for (let el of document.querySelectorAll('a[href*="karta?"]')) { + ;; ret[el.textContent.trim().toUpperCase()] = el.href + ;; } - (hash-map->list (lambda (name frag) - `(,name . ,frag)) - link-table)) + (->> (html->sxml string) + ((sxpath '(// a))) + (map (lambda (node) + (sxml-match node + [(a (@ (href ,href)) ,b0 ,body ...) + (cons href b0)]))) + (filter (lambda (pair) (regexp-exec rx (car pair)))) + (map (lambda (pair) (cons (string-upcase (string-trim-both (cdr pair))) + (car pair)))))) ;; Open a HTTP request to the given URL, and return the ;; response body as a port. @@ -85,9 +79,9 @@ (let ((port (cond ((option-ref options 'url #f) => open-input-url) - ((and=> (option-ref options 'file #f) (lambda (s) (string=? s "-"))) + ((string=? "-" (option-ref options 'file "")) (current-input-port)) ((option-ref options 'file #f) => open-input-file) (else (open-input-url "https://old.liu.se/karta/list?l=sv"))))) - (-> port read-string get-data scm->json) + (-> port read-string extract-data scm->json) (newline))) -- cgit v1.2.3 From 322a9e0620931e39f6727c55d7c970044336c26f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 21 Jul 2022 15:58:21 +0200 Subject: Add call-with-tmpfile. --- module/hnh/util/io.scm | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/module/hnh/util/io.scm b/module/hnh/util/io.scm index d638ebb4..d73a1de8 100644 --- a/module/hnh/util/io.scm +++ b/module/hnh/util/io.scm @@ -4,7 +4,8 @@ :export (open-input-port open-output-port read-lines - with-atomic-output-to-file)) + with-atomic-output-to-file + call-with-tmpfile)) (define (open-input-port str) (if (string=? "-" str) @@ -62,3 +63,12 @@ ;; counted on, since anything with an unspecified return ;; value might as well return #f) #f)))) + +(define* (call-with-tmpfile proc key: (tmpl "/tmp/file-XXXXXXX")) + (let* ((filename (string-copy tmpl)) + (port (mkstemp! filename))) + (with-continuation-barrier + (lambda () + (begin1 + (proc port filename) + (close-port port)))))) -- cgit v1.2.3 From fb456223db78e8a890eea3fdb7997dd86a0f1a61 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 21 Jul 2022 16:01:42 +0200 Subject: Add diff view to test runner. --- tests/run-tests.scm | 43 +++++++++++++++++++++++++++++++++---------- 1 file changed, 33 insertions(+), 10 deletions(-) diff --git a/tests/run-tests.scm b/tests/run-tests.scm index 3955a6a2..986d1ac4 100755 --- a/tests/run-tests.scm +++ b/tests/run-tests.scm @@ -22,12 +22,17 @@ fi (srfi srfi-64) (srfi srfi-88) (hnh util) + ((hnh util io) :select (call-with-tmpfile)) (ice-9 ftw) (ice-9 format) (ice-9 pretty-print) (ice-9 getopt-long) (ice-9 match) (ice-9 regex) + ((ice-9 popen) + :select (open-pipe* + close-pipe)) + ((ice-9 rdelim) :select (read-string)) (system vm coverage) ((all-modules) :select (fs-find)) ) @@ -59,18 +64,29 @@ fi (string-replace s1 s2 0 (string-length s2))) +(define (diff s1 s2) + (let ((filename1 (call-with-tmpfile (lambda (p f) (display s1 p) f))) + (filename2 (call-with-tmpfile (lambda (p f) (display s2 p) f)))) + (let ((pipe (open-pipe* + OPEN_READ + ;; "git" "diff" "--no-index" + "diff" + filename1 filename2))) + (begin1 (begin + (read-string pipe)) + (close-pipe pipe))))) + (define (pp form indent prefix-1) (let ((prefix (make-string (+ (string-length indent) (string-length prefix-1)) #\space))) - (display - (string-replace-head - (with-output-to-string - (lambda () (pretty-print - form - per-line-prefix: prefix - width: (- 79 (string-length indent))))) - (string-append indent prefix-1))))) + (string-replace-head + (with-output-to-string + (lambda () (pretty-print + form + per-line-prefix: prefix + width: (- 79 (string-length indent))))) + (string-append indent prefix-1)))) (define (construct-test-runner) @@ -120,8 +136,15 @@ fi (if (eq? expected unknown-expected) (format #t "~aAssertion failed~%" indent) (begin - (pp expected indent "Expected: ") - (pp actual indent "Received: ")))))))) + (display (pp expected indent "Expected: ")) + (display (pp actual indent "Received: ")) + (let ((d (diff (pp expected "" "") + (pp actual "" "")))) + (display + (string-join + (map (lambda (line) (string-append indent "|" line)) + (string-split d #\newline)) + "\n" 'suffix)))))))))) (format #t "~aNear ~a:~a~%" (make-indent (1+ depth)) (test-result-ref runner 'source-file) -- cgit v1.2.3 From c82421cd8b45438507db02c788a32d45087378a9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 21 Jul 2022 16:02:11 +0200 Subject: Add script to generate graphviz output from peg deffinitions. --- scripts/peg-to-graph.scm | 56 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) create mode 100755 scripts/peg-to-graph.scm diff --git a/scripts/peg-to-graph.scm b/scripts/peg-to-graph.scm new file mode 100755 index 00000000..7edcd556 --- /dev/null +++ b/scripts/peg-to-graph.scm @@ -0,0 +1,56 @@ +#!/usr/bin/env bash +GUILE=${GUILE:-guile} +set -x +exec $GUILE -e main -s "$0" "$@" +!# + +(add-to-load-path (dirname (current-filename))) +(add-to-load-path (string-append (dirname (current-filename)) "/use2dot")) + + +(use-modules ((graphviz) :prefix #{gv:}#) + ((module-introspection) :select (get-forms unique-symbols)) + (srfi srfi-1) + (ice-9 match)) + +(define peg-primitives + '(and or * + ? followed-by not-followed-by peg-any range + ignore capture peg)) + +(define graph (gv:digraph "G")) + +(define (handle-peg-form form) + (match form + (`(define-peg-pattern ,name ,capture ,body) + (let ((node (gv:node graph (format #f "~a" name)))) + (gv:setv node "style" + (case capture + ((all) "solid") + ((body) "dashed") + ((none) "dotted")))) + (for-each (lambda (symbol) + (gv:edge graph + (format #f "~a" name) + (format #f "~a" symbol))) + (remove (lambda (x) (memv x peg-primitives)) + (unique-symbols (list body))))))) + +(define (main args) + (when (< 2 (length args)) + (format #t "Usage: ~a ~%" (car args)) + (exit 1)) + + (let ((input-file (cadr args))) + (for-each handle-peg-form + (filter (lambda (x) + (and (list? x) + (not (null? x)) + (eq? 'define-peg-pattern (car x)))) + (call-with-input-file input-file get-forms)))) + + (gv:layout graph "dot") + (gv:render graph "pdf" "lex2.pdf") + + (display "done\n")) + + -- cgit v1.2.3