From ed440ac1c18058da9a0b7fa2cb62834f20f5d1ee Mon Sep 17 00:00:00 2001 From: Munyoki Kilyungi Date: Mon, 3 Jul 2023 13:49:39 +0300 Subject: Add table-dump? option to dump-configuration record * dump/special-forms.scm: Export dump-configuration-table-dump?. (): Add dump-configuration-table-dump. (dump-configuration): Make table-dump? default to #t. Signed-off-by: Munyoki Kilyungi --- dump/special-forms.scm | 49 ++++++++++++++++++++++--------------------------- 1 file changed, 22 insertions(+), 27 deletions(-) diff --git a/dump/special-forms.scm b/dump/special-forms.scm index 0099f73..ded0db5 100644 --- a/dump/special-forms.scm +++ b/dump/special-forms.scm @@ -21,6 +21,7 @@ map-alist dump-configuration dump-configuration-table-metadata? + dump-configuration-table-dump? dump-configuration-auto-document-path define-dump)) @@ -28,10 +29,13 @@ (%dump-configuration table-metadata? auto-document-path) dump-configuration? (table-metadata? dump-configuration-table-metadata?) + (table-dump? dump-configuration-table-dump?) (auto-document-path dump-configuration-auto-document-path)) (define* (dump-configuration - #:optional (table-metadata? #f) + #:optional + (table-dump? #t) + (table-metadata? #f) (auto-document-path #f)) "Return a new configuration." (%dump-configuration table-metadata? auto-document-path)) @@ -441,30 +445,21 @@ must be remedied." #'(predicate-clauses ...)))) (when (dump-configuration-auto-document-path configuration) (for-each (match-lambda - ((predicate . object) - (format #f "Subject:~a Predicate:~a Object:~a.~%" - #,(car (collect-keys - (field->key #'subject))) - predicate object))) - (map-alist - '() - #,@(translate-forms 'field - (lambda (x) - (symbol->string - (syntax->datum - ((syntax-rules (field) - ((field (query alias)) alias) - ((field table column) column) - ((field table column alias) alias)) - x)))) - #'(predicate-clauses ...)) - ))) - (sql-for-each (lambda (row) - (scm->triples - (map-alist row #,@(field->key #'(predicate-clauses ...))) - #,(field->assoc-ref #'row #'subject))) - db - (select-query #,(collect-fields #'(subject predicate-clauses ...)) - (primary-table other-tables ...) - tables-raw ...))))) + ((predicate . object) + (format #f "Subject:~a Predicate:~a Object:~a.~%" + #,(car (collect-keys + (field->key #'subject))) + predicate object))) + (map-alist + '() + #,@(translate-forms 'field + (lambda (x) + (symbol->string + (syntax->datum + ((syntax-rules (field) + ((field (query alias)) alias) + ((field table column) column) + ((field table column alias) alias)) + x)))) + #'(predicate-clauses ...))))) (_ (error "Invalid define-dump syntax:" (syntax->datum x)))))) -- cgit v1.2.3