Don't inline the first part of a pgroup unless the subject is inline
authorChris Hanson <org/chris-hanson/cph>
Tue, 14 Aug 2007 02:57:34 +0000 (02:57 +0000)
committerChris Hanson <org/chris-hanson/cph>
Tue, 14 Aug 2007 02:57:34 +0000 (02:57 +0000)
(which it might not be if it's a graph).  Do inline if there's only
one pgroup and the object is linear.  Suppress final dot in subgraph,
and don't add extra blank lines between triple groups.

v7/src/xml/turtle.scm

index bc39837b45ca048fef01b651605759f465bbba2d..477a748d635fadd2850f9adb89c19bb18a34c168 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: turtle.scm,v 1.29 2007/08/14 02:18:54 cph Exp $
+$Id: turtle.scm,v 1.30 2007/08/14 02:57:34 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -65,8 +65,7 @@ USA.
          (alt (seq "prefix"
                    parse:ws+)
               (error #f "Unknown directive name"))
-         (alt (seq parse:prefix-name
-                   ":"
+         (alt (seq parse:prefix
                    parse:ws+)
               (error #f "Expected prefix name"))
          (alt parse:uriref
@@ -116,8 +115,7 @@ USA.
   (*parser
    (alt (map string->uri parse:uriref)
        (encapsulate (lambda (v) (cons 'QNAME (vector->list v)))
-         (seq parse:prefix-name
-              ":"
+         (seq parse:prefix
               (alt parse:name (values #f)))))))
 
 (define parse:blank
@@ -151,13 +149,9 @@ USA.
      (seq "{"
          parse:ws*
          (? (seq parse:triples
-                 parse:ws*
-                 (* (seq "."
-                         parse:ws*
-                         parse:triples
-                         parse:ws*))
-                 (? (seq "."
-                         parse:ws*))))
+                 (* (seq parse:ws* "." parse:ws* parse:triples))
+                 (? (seq parse:ws* "."))
+                 parse:ws*))
          "}"))))
 
 (define parse:name
@@ -168,8 +162,10 @@ USA.
    (seq (alphabet alphabet:name-start-char)
        (* (alphabet alphabet:name-char)))))
 
-(define parse:prefix-name
-  (*parser (match match:prefix-name)))
+(define parse:prefix
+  (*parser
+   (seq (match match:prefix-name)
+       ":")))
 
 (define match:prefix-name
   (*matcher
@@ -690,36 +686,42 @@ USA.
 \f
 (define (write-top-level ts indentation inline-bnode port)
   (for-each (lambda (group)
-             (if (not (let ((t
-                             (inline-bnode (rdf-triple-subject (car group)))))
-                        (and t
-                             (= (car t) 1))))
-                 (write-top-level-group group indentation inline-bnode port)))
-           (group-triples-by-subject ts)))
-
-(define (write-top-level-group ts indentation inline-bnode port)
+             (write-group group indentation inline-bnode port)
+             (write-string "." port)
+             (newline port))
+           (groups-to-write ts inline-bnode)))
+
+(define (groups-to-write ts inline-bnode)
+  (delete-matching-items (group-triples-by-subject ts)
+    (lambda (group)
+      (let ((t (inline-bnode (rdf-triple-subject (car group)))))
+       (and t
+            (= (car t) 1))))))
+
+(define (write-group ts indentation inline-bnode port)
   (write-indentation indentation port)
   (let ((groups (group-triples ts rdf-triple-predicate))
        (indentation (indent+ indentation)))
-    (write-subject (rdf-triple-subject (caar groups))
-                  indentation
-                  inline-bnode
-                  port)
-    (let ((writer
-          (and (eq? (rdf-triple-predicate (caar groups)) rdf:type)
-               (null? (cdar groups))
-               (linear-object-writer (rdf-triple-object (caar groups))
-                                     inline-bnode))))
-      (if writer
-         (begin
-           (space port)
-           (write-predicate rdf:type port)
-           (space port)
-           (writer port)
-           (write-pgroups-tail groups indentation inline-bnode port))
-         (write-pgroups groups indentation inline-bnode port))))
-  (write-string "." port)
-  (newline port))
+    (let ((subject-inline?
+          (write-subject (rdf-triple-subject (caar groups))
+                         indentation
+                         inline-bnode
+                         port)))
+      (let ((writer
+            (and subject-inline?
+                 (or (eq? (rdf-triple-predicate (caar groups)) rdf:type)
+                     (null? (cdr groups)))
+                 (null? (cdar groups))
+                 (linear-object-writer (rdf-triple-object (caar groups))
+                                       inline-bnode))))
+       (if writer
+           (begin
+             (space port)
+             (write-predicate (rdf-triple-predicate (caar groups)) port)
+             (space port)
+             (writer port)
+             (write-pgroups-tail groups indentation inline-bnode port))
+           (write-pgroups groups indentation inline-bnode port))))))
 
 (define (linear-object-writer o inline-bnode)
   (cond ((rdf-list->list o inline-bnode)
@@ -812,24 +814,35 @@ USA.
     (write-string "]" port)))
 \f
 (define (write-subject s indentation inline-bnode port)
-  (cond ((uri? s) (write-rdf/turtle-uri s port))
+  (cond ((uri? s)
+        (write-rdf/turtle-uri s port)
+        #t)
        ((rdf-bnode? s)
         (let ((ts (inline-bnode s)))
           (if (and ts (= (car ts) 0))
               (write-string "[]" port)
-              (write-rdf/nt-bnode s port))))
+              (write-rdf/nt-bnode s port)))
+        #t)
        ((rdf-graph? s)
         (if (null? (rdf-graph-triples s))
-            (write-string "{}" port)
-            (write-graph s indentation inline-bnode port)))
-       (else (error "Unknown RDF subject:" s))))
+            (begin
+              (write-string "{}" port)
+              #t)
+            (begin
+              (write-graph s indentation inline-bnode port)
+              #f)))
+       (else
+        (error "Unknown RDF subject:" s))))
 
 (define (write-graph graph indentation inline-bnode port)
   (write-string "{" port)
-  (write-top-level (rdf-graph-triples graph)
-                  (indent+ indentation)
-                  inline-bnode
-                  port)
+  (let ((indentation (indent+ indentation)))
+    (do ((groups (groups-to-write (rdf-graph-triples graph) inline-bnode)
+                (cdr groups)))
+       ((not (pair? groups)))
+      (write-group (car groups) indentation inline-bnode port)
+      (if (pair? (cdr groups))
+         (write-string "." port))))
   (write-indentation indentation port)
   (write-string "}" port))
 
@@ -837,7 +850,7 @@ USA.
   (if (eq? p rdf:type)
       (write-string "a" port)
       (write-rdf/turtle-uri p port)))
-
+\f
 (define (write-rdf/turtle-literal literal port)
   (let ((text (rdf-literal-text literal)))
     (if (let ((type (rdf-literal-type literal)))