diff options
Diffstat (limited to 'dump')
| -rw-r--r-- | dump/schema-dump.scm | 20 | ||||
| -rw-r--r-- | dump/special-forms.scm | 36 |
2 files changed, 28 insertions, 28 deletions
diff --git a/dump/schema-dump.scm b/dump/schema-dump.scm index 86626f4..525bf65 100644 --- a/dump/schema-dump.scm +++ b/dump/schema-dump.scm @@ -7,7 +7,7 @@ #:use-module (dump table)) -(define (dump-table-fields db table) +(define (table-fields db table) (format #t "* ~a~%" table) (match (sql-find db (select-query ((TableComments Comment)) @@ -41,10 +41,10 @@ (select-query ((TableComments TableName)) (TableComments)))) -(define (dump-schema-annotations db) +(define (schema-annotations db) (call-with-target-database (lambda (db) - (for-each (cut dump-table-fields db <>) + (for-each (cut table-fields db <>) (get-tables-from-comments db))))) (define (tables db) @@ -70,7 +70,7 @@ is a <table> object." (format #f "WHERE table_schema = '~a'" (assq-ref %connection-settings 'sql-database)))))) -(define (dump-schema db) +(define (schema db) (let ((tables (tables db))) (for-each (lambda (table) (let ((table-id (string->identifier @@ -94,13 +94,13 @@ is a <table> object." (table-columns table)))) tables))) -(define* (dump-data-table db table-name data-field - #:optional (default-dump-directory "")) - (let ((dump-directory (string-append default-dump-directory "/" table-name)) +(define* (data-table db table-name data-field + #:optional (default-directory "")) + (let ((directory (string-append default-directory "/" table-name)) (port #f) (current-strain-id #f)) - (unless (file-exists? dump-directory) - (mkdir dump-directory)) + (unless (file-exists? directory) + (mkdir directory)) (sql-for-each (match-lambda (((_ . strain-id) (_ . value)) @@ -112,7 +112,7 @@ is a <table> object." ;; If no file is open, open new file. (unless port (set! current-strain-id strain-id) - (let ((filename (string-append dump-directory + (let ((filename (string-append directory "/" (number->string strain-id)))) (display filename (current-error-port)) (newline (current-error-port)) diff --git a/dump/special-forms.scm b/dump/special-forms.scm index f771cc1..2650580 100644 --- a/dump/special-forms.scm +++ b/dump/special-forms.scm @@ -14,11 +14,11 @@ find-clause remove-namespace column-id - dump-id + id syntax-let blank-node map-alist - dump-with-documentation + with-documentation define-transformer)) (define (key->assoc-ref alist x) @@ -276,12 +276,12 @@ ALIST field-name) forms." "user2" table-name) "__" column-name))) - (define (dump-id dump-table predicate) + (define (id table predicate) (symbol->string (string->identifier "dump" (string-append - dump-table "_" (remove-namespace (symbol->string predicate))))))) + table "_" (remove-namespace (symbol->string predicate))))))) (define-syntax blank-node (syntax-rules () @@ -396,11 +396,11 @@ must be remedied." ((triples subject predicate-clauses ...) (triples) (find-clause #'(clauses ...) 'triples))) #`(define* (name db #:key - (dump-metadata? #f) - (dump-data? #t) - (dump-documentation? #f)) - (when dump-metadata? - #,@(let ((dump-table (symbol->string (syntax->datum #'primary-table))) + (metadata? #f) + (data? #t) + (documentation? #f)) + (when metadata? + #,@(let ((table (symbol->string (syntax->datum #'primary-table))) (subject-type (any (lambda (predicate) (syntax-case predicate (rdf:type) ((_ rdf:type type) #'type) @@ -427,14 +427,14 @@ must be remedied." (datum->syntax x (column-id query (symbol->string alias)))))) (collect-fields predicate-clause)))) - #,(dump-id dump-table (syntax->datum #'predicate))) + #,(id 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 dump-documentation? + (when documentation? (format #t "~%## '~a'~%~%" (syntax->datum #'name)) #,(syntax-case #'schema-triples-clause (schema-triples) ((schema-triples (triple-subject triple-predicate triple-object) ...) @@ -477,7 +477,7 @@ The above query results to triples that have the form: '() #,@(field->datum #'(predicate-clauses ...)))) (format #t "```~%Here's an example query:~%~%```sparql~%") - (dump-documentation?) + (documentation?) (newline) (let* ((result (map-alist (sql-find @@ -520,7 +520,7 @@ The above query results to triples that have the form: (primary-table other-tables ...) tables-raw ...))) (format #t "```~%~%")) - (when dump-data? + (when data? #,(syntax-case #'schema-triples-clause (schema-triples) ((schema-triples (triple-subject triple-predicate triple-object) ...) #`(for-each triple @@ -545,7 +545,7 @@ The above query results to triples that have the form: (cadr kv) default))) -(define-syntax dump-with-documentation +(define-syntax with-documentation (syntax-rules () ((_ (key value) ...) (let* ((alist `((key . ,value) ...)) @@ -567,9 +567,9 @@ The above query results to triples that have the form: (for-each (lambda (proc) (proc db - #:dump-metadata? #f - #:dump-data? #f - #:dump-documentation? + #:metadata? #f + #:data? #f + #:documentation? (lambda () (for-each (match-lambda ((k v) @@ -593,7 +593,7 @@ The above query results to triples that have the form: (newline) (for-each (lambda (proc) - (proc db #:dump-metadata? table-metadata?)) + (proc db #:metadata? table-metadata?)) inputs)) #:encoding "UTF-8"))))))) |