diff options
| author | Munyoki Kilyungi | 2023-07-21 14:29:33 +0300 |
|---|---|---|
| committer | Munyoki Kilyungi | 2023-07-21 14:36:43 +0300 |
| commit | ed59e1ec947b2b04e94936db749716733e7dbfa5 (patch) | |
| tree | 022b73a6e7d3ec3f9cb3452dfbdbddcacc27a18c /dump | |
| parent | 07e42e3d64773a63f1f08ddd6b2f8d9ef19c8d67 (diff) | |
| download | gn-transform-databases-ed59e1ec947b2b04e94936db749716733e7dbfa5.tar.gz | |
Make define-dump take extra args as key
Signed-off-by: Munyoki Kilyungi <me@bonfacemunyoki.com>
Diffstat (limited to 'dump')
| -rw-r--r-- | dump/special-forms.scm | 99 |
1 files changed, 49 insertions, 50 deletions
diff --git a/dump/special-forms.scm b/dump/special-forms.scm index 1c0b15c..fe9dbe6 100644 --- a/dump/special-forms.scm +++ b/dump/special-forms.scm @@ -395,19 +395,10 @@ must be remedied." #'(schema-triples))) ((triples subject predicate-clauses ...) (triples) (find-clause #'(clauses ...) 'triples))) - #`(define* (name db - #:optional + #`(define* (name db #:key (dump-metadata? #f) (dump-data? #t) (dump-documentation? #f)) - (when dump-data? - #,(syntax-case #'schema-triples-clause (schema-triples) - ((schema-triples (triple-subject triple-predicate triple-object) ...) - #`(for-each triple - (list 'triple-subject ...) - (list 'triple-predicate ...) - (list 'triple-object ...))) - (_ (error "Invalid schema triples clause:" #'schema-triples-clause)))) (when dump-metadata? #,@(let ((dump-table (symbol->string (syntax->datum #'primary-table))) (subject-type (any (lambda (predicate) @@ -529,6 +520,13 @@ The above query results to triples that have the form: tables-raw ...))) (format #t "```~%~%")) (when dump-data? + #,(syntax-case #'schema-triples-clause (schema-triples) + ((schema-triples (triple-subject triple-predicate triple-object) ...) + #`(for-each triple + (list 'triple-subject ...) + (list 'triple-predicate ...) + (list 'triple-object ...))) + (_ (error "Invalid schema triples clause:" #'schema-triples-clause))) (sql-for-each (lambda (row) (scm->triples (map-alist row #,@(field->key #'(predicate-clauses ...))) @@ -571,43 +569,44 @@ The above query results to triples that have the form: (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 - (lambda () (for-each - (match-lambda - ((k v) - (begin - (prefix k v #f)))) - prefixes)))) - 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")))))))) - + (doc-path (get-keyword-value outputs #:documentation ""))) + ;; 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 + #:dump-metadata? #f + #:dump-data? #f + #:dump-documentation? + (lambda () (for-each + (match-lambda + ((k v) + (begin + (prefix k v #f)))) + prefixes)))) + inputs)) + #:encoding "utf8") + + ;; Dumping the actual data + (with-output-to-file + rdf-path + (lambda () + ;; Add the prefixes + (for-each + (match-lambda + ((k v) + (begin + (prefix k v)))) + prefixes) + (newline) + (for-each + (lambda (proc) + (proc db #:dump-metadata? table-metadata?)) + inputs)) + #:encoding "utf8")))))))) |