about summary refs log tree commit diff
path: root/transform/special-forms.scm
diff options
context:
space:
mode:
Diffstat (limited to 'transform/special-forms.scm')
-rw-r--r--transform/special-forms.scm50
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 ...)