aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2021-12-23 17:53:07 +0530
committerArun Isaac2021-12-23 17:56:20 +0530
commit1deb7d533866f7b67e9df112e5ad89dd42ee70cd (patch)
tree600570196642f956d8e128436834b8dcff1afe72
parent289bdd9c8c1b579e8e36d74677144fac105e6a3f (diff)
downloadgn-transform-databases-1deb7d533866f7b67e9df112e5ad89dd42ee70cd.tar.gz
Dump metadata about the dump itself.
* dump.scm (remove-namespace, dump-id): New functions. (define-dump): Dump metadata about the dump itself.
-rwxr-xr-xdump.scm46
1 files changed, 43 insertions, 3 deletions
diff --git a/dump.scm b/dump.scm
index 882438b..c92a0cd 100755
--- a/dump.scm
+++ b/dump.scm
@@ -197,6 +197,10 @@ ALIST field-name) forms."
key))))
clauses))
+(define (remove-namespace str)
+ "Remove RDF namespace prefix from STR."
+ (substring str (1+ (string-index str #\:))))
+
(define (column-id table-name column-name)
(string->identifier
"field" (string-append
@@ -206,6 +210,13 @@ ALIST field-name) forms."
"user2" table-name)
"__" column-name)))
+(define (dump-id dump-table predicate)
+ (symbol->string
+ (string->identifier
+ "dump"
+ (string-append
+ dump-table "_" (remove-namespace (symbol->string predicate))))))
+
(define-syntax define-dump
(lambda (x)
(syntax-case x (tables schema-triples triples)
@@ -215,8 +226,8 @@ ALIST field-name) forms."
#'(schema-triples)))
(triples-clause (find-clause #'(clauses ...) 'triples)))
(syntax-case triples-clause (triples)
- ((triples subject predicates ...)
- (let ((fields (collect-fields #'(subject predicates ...))))
+ ((triples subject predicate-clauses ...)
+ (let ((fields (collect-fields #'(subject predicate-clauses ...))))
#`(define (name db)
#,(syntax-case schema-triples-clause (schema-triples)
((schema-triples (triple-subject triple-predicate triple-object) ...)
@@ -225,9 +236,38 @@ ALIST field-name) forms."
(list 'triple-predicate ...)
(list 'triple-object ...)))
(_ (error "Invalid schema triples clause:" schema-triples-clause)))
+ #,@(let ((dump-table (syntax-case tables-clause (tables)
+ ((tables (primary-table _ ...) _ ...)
+ (symbol->string (syntax->datum #'primary-table)))
+ (_ (error "Invalid tables clause:" (syntax->datum tables-clause)))))
+ (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.
+ #`(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))))
+ (_ (error "Invalid predicate clause:" predicate-clause))))
+ #'(predicate-clauses ...)))
(sql-for-each (lambda (row)
(scm->triples
- (map-alist row #,@(field->key #'(predicates ...)))
+ (map-alist row #,@(field->key #'(predicate-clauses ...)))
#,(field->assoc-ref #'row #'subject)))
db
#,(syntax-case tables-clause (tables)