diff options
Diffstat (limited to 'scripts')
| -rwxr-xr-x | scripts/fetch-liu-map-index.scm | 40 | ||||
| -rwxr-xr-x | scripts/peg-to-graph.scm | 56 |
2 files changed, 73 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))) 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 <filename>~%" (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")) + + |