aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMunyoki Kilyungi2023-07-18 13:29:40 +0300
committerMunyoki Kilyungi2023-07-21 14:36:39 +0300
commitcf86f4bd8093f34db72f386e30b84d618d01da2a (patch)
treee9dcc3344660338f4fe113aca19e00d85dfdd7d8
parent21f2b3544e118176e6ff1b0242f5f66ba7612898 (diff)
downloadgn-transform-databases-cf86f4bd8093f34db72f386e30b84d618d01da2a.tar.gz
Rewrite dump-with-documentation to be order-agnostic
Signed-off-by: Munyoki Kilyungi <me@bonfacemunyoki.com>
-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"))))))))
+