Permalink
Browse files

More powerful RDFS models (including ranges) to be used in the descri…

…ption of RESTful semantic resources
  • Loading branch information...
1 parent f415861 commit fef958779dbf004e97a8fc86ae1832d5eb48afa6 @antoniogarrote committed Jun 8, 2010
View
169 src/plaza/examples/webapp.clj
@@ -7,6 +7,7 @@
(use 'plaza.utils)
(use 'plaza.rdf.core)
+(use 'plaza.rdf.models)
(use 'plaza.rdf.sparql)
(use 'plaza.rdf.predicates)
(use 'plaza.rdf.implementations.jena)
@@ -19,10 +20,15 @@
(let [args (partition 3 mapping)]
(reduce (fn [acum [k uri f]] (assoc acum k {:uri (if (seq? uri) (apply rdf-resource uri) (rdf-resource uri)) :mapper f})) {} args)))
+(defn model-argument-map [model & mapping]
+ (let [args (partition 2 mapping)]
+ (reduce (fn [acum [k f]] (assoc acum k {:uri (property-uri model k) :mapper f})) {} args)))
+
(defn apply-resource-argument-map [params mapping]
(let [ks (keys mapping)]
- (reduce (fn [acum k] (let [{uri :uri f :mapper} (k mapping)]
- (conj acum [uri (f (get params (keyword-to-string k)))])))
+ (reduce (fn [acum k] (let [{uri :uri f :mapper} (k mapping)
+ arg (get params (keyword-to-string k))]
+ (if (nil? arg) acum (conj acum [uri (f arg)]))))
[] ks)))
(defn random-uuid []
@@ -33,70 +39,141 @@
(defn build-triples-from-resource-map [uri mapping]
(let [resource-uri (if (seq? uri) (apply rdf-resource uri) (rdf-resource uri))]
- (log :info (str "resource uri " resource-uri " and mapping " mapping))
(map #(cons resource-uri %1) mapping)))
+(defn build-query-from-resource-map [mapping resource-type]
+ (concat [[?s ?p ?o]
+ [?s rdf:type resource-type]]
+ (vec (map #(cons ?s %1) mapping))))
+
(defn build-model-from-resource-map [uri map]
(defmodel (model-add-triples (build-triples-from-resource-map uri map))))
(defn render-triples [triples format]
(let [m (defmodel (model-add-triples triples))
- w (java.io.StringWriter.)]
- (output-string m w format)
- (.toString w)))
+ w (java.io.StringWriter.)]
+ (output-string m w format)
+ (.toString w)))
(defonce *mulgara* (build-model :mulgara :rmi "rmi://localhost/server1"))
(def-ts :resource (make-distributed-triple-space "test" *mulgara* :redis-host "localhost" :redis-db "testdist" :redis-port 6379))
-(def *resource-map* (resource-argument-map :name "http://test.com/Person#name" #(l %1)
- :age "http://test.com/Person#age" #(d (Integer/parseInt %1))))
-
-(defn format-to-mime [format]
+(defn supported-format [format]
(condp = format
- "xml" "application/xml"
- "rdf" "application/xml"
- "n3" "text/rdf+n3"
- "ttl" "application/x-turtle"
- "turtle" "application/x-turtle"
- "application/xml"))
-
-(defn mime-to-format [format]
- (condp = format
- "xml" :xml
"application/xml" :xml
- "rdf" :xml
- "n3" :n3
"text/rdf+n3" :n3
- "ttl" :ttl
"application/x-turtle" :turtle
- "turtle" :turtle
- :xml))
-
+ "*/*" :xml
+ nil))
+
+(defn parse-accept-header [accept-str]
+ (if (nil? accept-str)
+ "application/xml"
+ (let [formats-str (aget (.split accept-str ";") 0)
+ formats (seq (.split formats-str ","))
+ supported (map supported-format formats)
+ selected (first (filter #(not (nil? %1)) supported))]
+ (if (nil? selected) :xml selected))))
+
+(defn mime-to-format [request]
+ (let [format (let [fmt (get (:params request) "format")]
+ (if (nil? fmt)
+ (keyword-to-string (parse-accept-header (get (:headers request) "accept")))
+ fmt)) ]
+ (condp = format
+ "xml" :xml
+ "application/xml" :xml
+ "rdf" :xml
+ "n3" :n3
+ "text/rdf+n3" :n3
+ "ttl" :ttl
+ "application/x-turtle" :turtle
+ "turtle" :turtle
+ :xml)))
+
+(defn format-to-mime [request]
+ (let [format (let [fmt (get (:params request) "format")]
+ (if (nil? fmt)
+ (keyword-to-string (parse-accept-header (get (:headers request) "accept")))
+ fmt)) ]
+ (condp = format
+ "xml" "application/xml"
+ "rdf" "application/xml"
+ "n3" "text/rdf+n3"
+ "ttl" "application/x-turtle"
+ "turtle" "application/x-turtle"
+ "application/xml")))
+
+(defn default-uuid-gen [prefix local request]
+ (random-resource-id (str prefix local)))
+
+(defmacro log-request [kind prefix local request & body]
+ `(let [pre# (System/currentTimeMillis)]
+ (log :info (str ~kind " (" ~prefix ~local "): \r\n" ~request "\r\n"))
+ (let [result# (do ~@body)
+ post# (System/currentTimeMillis)]
+ (log :info (str "FINISHED (" (:status result#) "): " (- post# pre#) " millisecs "))
+ result#)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Resource functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def *resource* (make-rdfs-model "http://test.com/Person"
+ :name {:uri "http://test.com/name" :range :string}
+ :age {:uri "http://test.com/age" :range :int}))
+
+
+(def *resource-map* (model-argument-map *resource* :name #(l %1)
+ :age #(d (Integer/parseInt %1))))
+
+(def *resource-type* "http://test.com/Person")
+(def *resource-qname-prefix* "http://test.com/")
+(def *resource-qname-local* "Person")
+(def *id-gen-function* default-uuid-gen)
+(def *resource-ts* :resource)
+
+(defn handle-get-collection [request]
+ (log-request "GET collection" *resource-qname-prefix* *resource-qname-local* request
+ (let [mapping (apply-resource-argument-map (:params request) *resource-map*)
+ query (build-query-from-resource-map mapping *resource-type*)
+ ; _test (doseq [t query] (println t))
+ results (rd (ts *resource-ts*) query)
+ triples (distinct (flatten-1 results))]
+ {:body (render-triples triples (mime-to-format request))
+ :headers {"Content-Type" (format-to-mime request)}
+ :status 200})))
+
+(defn handle-post-collection [request]
+ (log-request "POST collection" *resource-qname-prefix* *resource-qname-local* request
+ (let [mapping (apply-resource-argument-map (:params request) *resource-map*)
+ resource-id (*id-gen-function* *resource-qname-prefix* *resource-qname-local* request)
+ triples-pre (build-triples-from-resource-map resource-id mapping)
+ triples (conj triples-pre [resource-id rdf:type *resource-type*])]
+ (out (ts *resource-ts*) triples)
+ {:body (render-triples triples :xml)
+ :headers {"Content-Type" "application/xml"}
+ :status 201})))
+
+(defn handle-delete-collection [request]
+ (log-request "DELETE collection" *resource-qname-prefix* *resource-qname-local* request
+ (let [mapping (apply-resource-argument-map (:params request) *resource-map*)
+ query (build-query-from-resource-map mapping *resource-type*)
+ results (rd (ts *resource-ts*) query)
+ triples (distinct (flatten-1 results))]
+ {:body (render-triples triples (mime-to-format request))
+ :headers {"Content-Type" (format-to-mime request)}
+ :status 200})))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defroutes example
(GET "/" [] "<h1>Hello World Wide Web mod5!</h1>")
- (POST "/Person" request
- (log :info (str "request: " request))
- (let [mapping (apply-resource-argument-map (:params request) *resource-map*)
- resource-id (random-resource-id "http://test.com/Person/")
- triples-pre (build-triples-from-resource-map resource-id mapping)
- triples (conj triples-pre [resource-id rdf:type "http://test.com/Person"])]
- (out (ts :resource) triples)
- (render-triples triples :xml)))
-
- (GET "/Person.:format" request
- (log :info (str "request: " request))
- (let [results (rd (ts :resource) [[?s ?p ?o]
- [?s rdf:type "http://test.com/Person"]])
- triples (distinct (flatten-1 results))]
- {:body (render-triples triples (mime-to-format (get (:params request) "format")))
- :headers {"Content-Type" (format-to-mime (get (:params request) "format"))}
- :status 200}))
+ (POST "/Person" request (handle-post-collection request))
+ (GET "/Person.:format" request (handle-get-collection request))
+ (GET "/Person" request (handle-get-collection request))
(route/not-found "Page not found"))
-;(future (run-jetty (var example) {:port 8080}))
-
-(run-jetty (var example) {:port 8081})
+;(run-jetty (var example) {:port 8081})
View
18 src/plaza/rdf/implementations/common.clj
@@ -28,6 +28,7 @@
literal))]
(cond
(= "xmlliteral" (.toLowerCase (keyword-to-string lit))) XMLLiteralType/theXMLLiteralType
+ (= "literal" (.toLowerCase (keyword-to-string lit))) XMLLiteralType/theXMLLiteralType
(= "anyuri" (.toLowerCase (keyword-to-string lit))) XSDDatatype/XSDanyURI
(= "boolean" (.toLowerCase (keyword-to-string lit))) XSDDatatype/XSDboolean
(= "byte" (.toLowerCase (keyword-to-string lit))) XSDDatatype/XSDbyte
@@ -42,6 +43,23 @@
(= "string" (.toLowerCase (keyword-to-string lit))) XSDDatatype/XSDstring
:else (throw (Exception. (str "Tyring to parse unknown/not supported datatype " lit)))))))
+
+(defn supported-datatype?
+ "Returns true if the datatype sym is supported"
+ ([sym]
+ (try (do (find-jena-datatype sym) true)
+ (catch Exception ex false))))
+
+(defn datatype-uri
+ "Returns the URI for a datatype symbol like :int :decimal or :anyuri"
+ ([sym]
+ (.getURI (find-jena-datatype sym))))
+
+(defn parse-dataype-string
+ "Parses a string containing a datatype of type sym"
+ ([sym data]
+ (.parse (find-jena-datatype sym) data)))
+
(defn is-filter-expr
"Tests if one Jena expression is a filter expression"
([expr]
View
35 src/plaza/rdf/models.clj
@@ -4,6 +4,7 @@
(ns plaza.rdf.models
(:use (plaza.rdf core sparql predicates)
+ (plaza.rdf.implementations common)
(plaza utils)))
;; auxiliary functions
@@ -15,7 +16,10 @@
"Functions that can be applied to a RDF ontology schema"
(type-uri [model] "Returns the URI of this model")
(to-pattern [model props] [model subject props] "Builds a pattern suitable to look for instances of this type. A list of properties can be passed optionally")
- (to-map [model triples] "Transforms a RDF triple set into a map of properties using the provided keys"))
+ (to-map [model triples] "Transforms a RDF triple set into a map of properties using the provided keys")
+ (property-uri [model alias] "Returns the URI for the alias of a property")
+ (property-alias [model uri] "Returns the alias for a property URI")
+ (parse-prop-value [model alias val] "Parses the provided string value into the right java value for the property defined by alias"))
(defn- build-pattern-for-model
([type-uri subj props properties]
@@ -34,7 +38,7 @@
(make-pattern (concat mandatory-pattern optional-pattern)))))
;; Types
-(deftype RDFSModel [type-uri properties] OntologyModel
+(deftype RDFSModel [type-uri properties ranges] OntologyModel
(type-uri [this] type-uri)
(toString [this] (str type-uri " " properties))
(to-pattern [this subject props] (let [subj (if (instance? plaza.rdf.core.RDFResource subject) subject (if (coll? subject) (apply rdf-resource subject) (rdf-resource subject) ))]
@@ -45,12 +49,25 @@
val (find-property prop triples)]
(if (nil? val) ac (assoc ac it (nth val 2)))))
{}
- (keys properties)))))
+ (keys properties))))
+ (property-uri [model alias] (alias properties))
+ (property-alias [model uri] (first (filter #(= (str (get properties %1)) (str uri)) (keys properties))))
+ (parse-prop-value [model alias val] (let [{kind :kind range :range} (get ranges alias)]
+ (if (= kind :resource) val
+ (.parse (find-jena-datatype range) val)))))
;; Type constructor
-(defn def-rdfs-model
- ( [type-uri-pre & properties]
- (let [type-uri (apply rdf-resource type-uri-pre)
- props-map-pre (apply hash-map properties)
- props-map (reduce (fn [ac it] (assoc ac it (if (coll? (it props-map-pre)) (apply rdf-resource (it props-map-pre)) (rdf-resource (it props-map-pre))))) {} (keys props-map-pre))]
- (plaza.rdf.models.RDFSModel. type-uri props-map))))
+
+(defn make-rdfs-model
+ ([type-uri-pre & properties]
+ (let [type-uri (if (coll? type-uri-pre) (apply rdf-resource type-uri-pre) (rdf-resource type-uri-pre))
+ props-map-pre (apply hash-map properties)
+ maps (reduce (fn [[ac-props ac-ranges] it]
+ (let [{uri :uri range :range} (it props-map-pre)
+ prop-val (if (coll? uri) (apply rdf-resource uri) (rdf-resource uri))
+ range-val (if (supported-datatype? range)
+ {:kind :datatype :range (datatype-uri range)}
+ {:kind :resource :range (if (coll? range) (apply rdf-resource range) range)})]
+ [(assoc ac-props it prop-val)
+ (assoc ac-ranges it range-val)])) [{} {}] (keys props-map-pre))]
+ (plaza.rdf.models.RDFSModel. type-uri (first maps) (second maps)))))
View
9 test/plaza/rdf/core_test.clj
@@ -1,6 +1,6 @@
(ns plaza.rdf.core-test
(:use [plaza.rdf core] :reload-all)
- (:use [plaza.rdf.implementations jena] :reload-all)
+ (:use [plaza.rdf.implementations jena common] :reload-all)
(:use [clojure.test]))
;; rdf/xml used in the tests
@@ -232,3 +232,10 @@
(deftest test-has-meta
(is (:triples (meta (make-triples [[:a :b :c]])))))
+
+(deftest test-suppored-datatype
+ (is (supported-datatype? :int))
+ (is (not (supported-datatype? :foo))))
+
+(deftest datatype-uri-test
+ (is (= "http://www.w3.org/2001/XMLSchema#double" (datatype-uri :double))))
View
16 test/plaza/rdf/models_test.clj
@@ -5,10 +5,13 @@
(init-jena-framework)
-(defonce *test-model* (def-rdfs-model ["http://something/" "Good"] :name "http://test.com/name" :price ["http://test.com/" :price] :number :number))
+(defonce *test-model* (make-rdfs-model ["http://something/" "Good"]
+ :name {:uri "http://test.com/name" :range :string}
+ :price {:uri ["http://test.com/" :price] :range :float}
+ :number {:uri :number :range :int}))
(deftest test-props
- (is (= "http://something/Good") (type-uri *test-model*)))
+ (is (= "http://something/Good" (str (type-uri *test-model*)))))
(deftest test-to-map
(let [m (to-map *test-model* [[:test ["http://test.com/" :name] "name"] [:test ["http://test.com/" :price] (d 120)] [:test :number (d 10)]])]
@@ -24,3 +27,12 @@
(is (= 4 (count p)))
(is (= 2 (count (filter #(:optional (meta %1)) p))))
(doseq [[s _p _o] p] (is (= "http://test.com/Test" (resource-id s))))))
+
+(deftest test-property-uri
+ (is (= "http://test.com/name" (str (property-uri *test-model* :name)))))
+
+(deftest test-property-alias
+ (is (= :name (property-alias *test-model* "http://test.com/name"))))
+
+(deftest test-property-parse-value
+ (is (= 2 (parse-prop-value *test-model* :number "2"))))

0 comments on commit fef9587

Please sign in to comment.