diff options
Diffstat (limited to 'transform/special-forms.scm')
| -rw-r--r-- | transform/special-forms.scm | 50 |
1 files changed, 46 insertions, 4 deletions
diff --git a/transform/special-forms.scm b/transform/special-forms.scm index ddb3180..35dc2f3 100644 --- a/transform/special-forms.scm +++ b/transform/special-forms.scm @@ -1,10 +1,12 @@ (define-module (transform special-forms) #:use-module (srfi srfi-1) + #:use-module (ice-9 regex) #:use-module (ice-9 match) #:use-module (srfi srfi-26) #:use-module (transform sql) #:use-module (transform table) #:use-module (transform triples) + #:use-module (transform strings) #:export (translate-forms collect-forms collect-keys @@ -18,8 +20,47 @@ syntax-let map-alist with-documentation + emit-short-turtle define-transformer)) +(define (emit-short-turtle subject po-alist) + (let loop ((pairs po-alist) (first? #t)) + (match pairs + ;; Skip pairs with blank string objects + (((p . o) rest ...) + (if (and (string? o) (string-blank? o)) + (loop rest first?) ; ← skip entirely + (begin + ;; subject only on first emitted line + (when first? + (format #t "~a " subject)) + (when (not first?) + (format #t "\t")) ; indent following lines + + ;; emit predicate–object + (match o + ((? symbol?) + (format #t "~a ~a" p (symbol->string o))) + ((or (? (lambda (el) + (and (string? el) + (string-match "^\\(.*\\)$" el)))) + (? (lambda (el) + (and (string? el) + (string-match "^\\[.*\\]$" el))))) + (format #t "~a ~s" p o)) + (_ + (format #t "~a \"~a\"" p o))) + + ;; separator + (if (null? rest) + (format #t " .~%") + (format #t " ;~%")) + + (loop rest #f)))) + + (() #f)))) + + (define (key->assoc-ref alist x) "Recursively translate (key k) forms in source X to (assoc-ref ALIST k) forms." @@ -505,10 +546,11 @@ The above query results to triples that have the form: (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 ...))) - #,(field->assoc-ref #'row #'subject))) + (sql-for-each (lambda (row) + (let* ((subject-val #,(field->assoc-ref #'row #'subject)) + (po-alist + (map-alist row #,@(field->key #'(predicate-clauses ...))))) + (emit-short-turtle subject-val po-alist))) db (select-query #,(collect-fields #'(subject predicate-clauses ...)) (primary-table other-tables ...) |
