diff options
| -rwxr-xr-x | dump.scm | 65 |
1 files changed, 33 insertions, 32 deletions
diff --git a/dump.scm b/dump.scm index 1333842..112086b 100755 --- a/dump.scm +++ b/dump.scm @@ -280,7 +280,7 @@ must be remedied." #'(schema-triples))) ((triples subject predicate-clauses ...) (triples) (find-clause #'(clauses ...) 'triples))) - #`(define (name db) + #`(define* (name db #:optional (table-metadata? #f)) #,(syntax-case #'schema-triples-clause (schema-triples) ((schema-triples (triple-subject triple-predicate triple-object) ...) #`(for-each triple @@ -288,37 +288,38 @@ must be remedied." (list 'triple-predicate ...) (list 'triple-object ...))) (_ (error "Invalid schema triples clause:" #'schema-triples-clause))) - #,@(let ((dump-table (symbol->string (syntax->datum #'primary-table))) - (subject-type (any (lambda (predicate) - (syntax-case predicate (rdf:type) - ((_ rdf:type type) #'type) - (_ #f))) - #'(predicate-clauses ...)))) - (map (lambda (predicate-clause) - (syntax-case predicate-clause () - ((_ predicate _) - ;; Dump metadata about the dump itself. - #`(begin - (scm->triples - (map-alist '() - (set rdf:type 'gn:dump) - (set gn:createsPredicate 'predicate) - (filter-set gn:forSubjectType #,subject-type) - (multiset gn:dependsOn - '#,(map (lambda (field) - (match (syntax->datum field) - ((table-name column-name _ ...) - (datum->syntax - x (column-id (symbol->string table-name) - (symbol->string column-name)))))) - (collect-fields predicate-clause)))) - #,(dump-id dump-table (syntax->datum #'predicate))) - ;; Automatically create domain triples - ;; for predicates. - (when #,subject-type - (triple 'predicate 'rdfs:domain #,subject-type)))) - (_ (error "Invalid predicate clause:" predicate-clause)))) - #'(predicate-clauses ...))) + (when table-metadata? + #,@(let ((dump-table (symbol->string (syntax->datum #'primary-table))) + (subject-type (any (lambda (predicate) + (syntax-case predicate (rdf:type) + ((_ rdf:type type) #'type) + (_ #f))) + #'(predicate-clauses ...)))) + (map (lambda (predicate-clause) + (syntax-case predicate-clause () + ((_ predicate _) + ;; Dump metadata about the dump itself. + #`(begin + (scm->triples + (map-alist '() + (set rdf:type 'gn:dump) + (set gn:createsPredicate 'predicate) + (filter-set gn:forSubjectType #,subject-type) + (multiset gn:dependsOn + '#,(map (lambda (field) + (match (syntax->datum field) + ((table-name column-name _ ...) + (datum->syntax + x (column-id (symbol->string table-name) + (symbol->string column-name)))))) + (collect-fields predicate-clause)))) + #,(dump-id dump-table (syntax->datum #'predicate))) + ;; Automatically create domain triples + ;; for predicates. + (when #,subject-type + (triple 'predicate 'rdfs:domain #,subject-type)))) + (_ (error "Invalid predicate clause:" predicate-clause)))) + #'(predicate-clauses ...)))) (sql-for-each (lambda (row) (scm->triples (map-alist row #,@(field->key #'(predicate-clauses ...))) |