From 77117e6e6bdb69f53fc0b723d79689c5ebdc02b5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
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(-)

(limited to 'scripts')

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 c82421cd8b45438507db02c788a32d45087378a9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
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

(limited to 'scripts')

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"))
+
+
-- 
cgit v1.2.3