;;; -*-Scheme-*-

;;;; NS runtime support -- part 2

(ns-base-uri "http://swiss.csail.mit.edu/users/cph/ns-runtime")

(define (ns-cons car cdr)
  (let ((name (make-rdf-bnode)))
    (rdf:List name
	      rdf:first car
	      rdf:rest cdr)
    name))

(define (ns-list . resources)
  (let loop ((resources resources))
    (if (pair? resources)
	(ns-cons (car resources)
		 (loop (cdr resources)))
	rdf:nil)))

;;;; Schema support

(define (nss-class class . pps)
  (let ((class (ns-canonicalize-subject class)))
    (trips class rdf:type rdfs:Class)
    (%nss-defined-by class)
    (for-each (lambda (pp) (pp class)) pps)
    class))

(define (nss-property predicate range . pps)
  (let ((predicate (ns-canonicalize-subject predicate)))
    (trips predicate
	   rdf:type rdf:Property
	   rdfs:range range)
    (%nss-defined-by predicate)
    (for-each (lambda (pp) (pp predicate)) pps)
    (lambda (domain)
      (trips predicate rdfs:domain domain))))

(define (%nss-defined-by subject)
  (if (and (uri? subject)
	   (uri-fragment subject))
      (let ((base-uri (get-ns-base-uri)))
	(if (and base-uri
		 (uri=? (make-uri (uri-scheme subject)
				  (uri-authority subject)
				  (uri-path subject)
				  (uri-query subject)
				  #f)
			base-uri))
	    (trips subject rdfs:isDefinedBy base-uri)))))

(define (%nss-simple-property predicate)
  (let ((predicate (canonicalize-rdf-predicate predicate)))
    (lambda (object)
      (let ((object (canonicalize-rdf-object object)))
	(lambda (class)
	  (trips class predicate object))))))

(define nss-superclass    (%nss-simple-property rdfs:subClassOf))
(define nss-superproperty (%nss-simple-property rdfs:subPropertyOf))
(define nss-label         (%nss-simple-property rdfs:label))
(define nss-comment       (%nss-simple-property rdfs:comment))
(define nss-see-also      (%nss-simple-property rdfs:seeAlso))
(define nss-value         (%nss-simple-property rdf:value))