about summary refs log tree commit diff
path: root/dump
diff options
context:
space:
mode:
authorMunyoki Kilyungi2023-07-18 13:29:40 +0300
committerMunyoki Kilyungi2023-07-21 14:36:39 +0300
commitcf86f4bd8093f34db72f386e30b84d618d01da2a (patch)
treee9dcc3344660338f4fe113aca19e00d85dfdd7d8 /dump
parent21f2b3544e118176e6ff1b0242f5f66ba7612898 (diff)
downloadgn-transform-databases-cf86f4bd8093f34db72f386e30b84d618d01da2a.tar.gz
Rewrite dump-with-documentation to be order-agnostic
Signed-off-by: Munyoki Kilyungi <me@bonfacemunyoki.com>
Diffstat (limited to 'dump')
-rw-r--r--dump/special-forms.scm87
1 files changed, 57 insertions, 30 deletions
diff --git a/dump/special-forms.scm b/dump/special-forms.scm
index cc58919..b37cbd3 100644
--- a/dump/special-forms.scm
+++ b/dump/special-forms.scm
@@ -544,33 +544,60 @@ The above query results to triples that have the form:
 
 (define-syntax dump-with-documentation
   (syntax-rules ()
-    ((_ (name n)
-        (connection conn)
-        (table-metadata? t?)
-        (prefixes ((pref uri) ...))
-        (inputs (in ...))
-        (outputs out))
-     (let ((rdf-path
-            (get-keyword-value `out #:rdf ""))
-           (doc-path
-            (get-keyword-value `out #:documentation "")))
-       ;; Dumping documentation
-       (call-with-target-database
-        conn
-        (lambda (db)
-          (with-output-to-file		;
-              doc-path
-            (lambda ()
-              (format #t "# ~a" n)
-              (in db #f #f
-                  (lambda () (prefix pref uri #f) ...)) ...)
-            #:encoding "utf8")
-          ;; Dumping the actual data
-          (with-output-to-file
-              rdf-path
-            (lambda ()
-              ;; Add the prefixes
-              (prefix pref uri) ...
-              (newline)
-              (in db #f #t #f) ...)
-            #:encoding "utf8")))))))
+    ((_ (key value) ...)
+     (let ((name "")
+           (connection "")
+           (table-metadata? "")
+           (prefixes "")
+           (inputs "")
+           (outputs ""))
+       (for-each
+        (match-lambda
+          (('name n)
+           (set! name n))
+          (('connection conn)
+           (set! connection conn))
+          (('table-metadata? t-metadata?)
+           (set! table-metadata? t-metadata?))
+          (('prefixes p)
+           (set! prefixes p))
+          (('inputs i)
+           (set! inputs i))
+          (('outputs o)
+           (set! outputs o)))
+        (list (list 'key value) ...))
+       (let ((rdf-path (get-keyword-value outputs #:rdf ""))
+             (doc-path (get-keyword-value outputs #:documentation ""))
+             (prefix-thunk (lambda ()  (for-each
+                                        (match-lambda
+                                          ((k v)
+                                           (begin
+                                             (prefix k v))))
+                                        prefixes))))
+          ;; Dumping the documentation first
+          (call-with-target-database
+           connection
+           (lambda (db)
+             (with-output-to-file       ;
+                 doc-path
+               (lambda ()
+                 (format #t "# ~a" name)
+                 (for-each
+                  (lambda (proc)
+                    (proc db #f #f prefix-thunk))
+                  inputs))
+               #:encoding "utf8")
+
+             ;; Dumping the actual data
+             (with-output-to-file
+                 rdf-path
+               (lambda ()
+                 ;; Add the prefixes
+                 (prefix-thunk)
+                 (newline)
+                 (for-each
+                  (lambda (proc)
+                    (proc db #f #t #f))
+                  inputs))
+               #:encoding "utf8"))))))))
+