;(get-sub-class-hierarchy :kb "http://purl.obolibrary.org/kb/iao")

(defpackage :ol)

(defvar *default-owl-link-server* "http://127.0.0.1:8080/")
(defparameter *owl-link-ns* "http://www.owllink.org/owllink#")
(defvar *owl-link-server-kbs* (make-hash-table :test 'equal))

(defmacro def-owl-link-message (name args expansion &rest parser)
  (let ((name (intern (string name) :ol)))
    `(progn
       (export ',name :ol)
       (defun ,name ,(append args '(&optional (server *default-owl-link-server*)))
	 (funcall ,(cond ((and (null (cdr parser)) (symbolp (car parser)))
			  (list 'quote (car parser)))
			 ((and (null (cdr parser)) (functionp parser))
			  (car parser))
			 (t `(lambda(response)
			       ,@parser)))
		  (cl-user::post-url-xml server (owl-link-xml-request ,expansion)))))))

;; ****************************************************************

;; Api functions

(def-owl-link-message create-kb (uri)
  `("CreateKB" ((:kb ,uri)))
  (expect-owl-link-response-element response "KB")
  (pushnew uri (gethash server *owl-link-server-kbs*) :test 'equal)
  )

(def-owl-link-message release-kb (uri)
  `("ReleaseKB" ((:kb ,uri)))
  (expect-owl-link-response-element response "OK")
  (setf (gethash server *owl-link-server-kbs*)
	(remove uri (gethash server *owl-link-server-kbs*) :test 'equal)))

(def-owl-link-message load-ontology (kb-uri ontology-uri)
  `("LoadOntologies" ((:kb ,kb-uri))
		     ("OntologyIRI" (("IRI" ,ontology-uri))))
  (expect-owl-link-response-element response "OK"))

(def-owl-link-message get-description ()
  `("GetDescription")
  debone-owl-link-response)

(def-owl-link-message get-settings (kb)
  `("GetSettings" ((:kb ,kb)))
  debone-owl-link-response)

(def-owl-link-message get-subclass-hierarchy (kb)
  `("GetSubClassHierarchy" ((:kb ,kb)))
  parse-owl-link-subclass-hierarchy)

(defun parse-owl-link-subclass-hierarchy (response)
  (loop for el in (find-elements-with-tag (car (debone-owl-link-response response)) "ClassSubClassesPair"  )
     for super = (attribute-named  (find-element-with-tag (third el) "Class") "IRI")
     for subs  = (mapcar (lambda(e) (attribute-named (find-element-with-tag e "Class") "IRI")) (find-elements-with-tag (fourth el) "ClassSynset"))
     append (mapcar (lambda(e) (list super e)) subs)
     ))

(export 'ol::get-kbs 'ol)

(defun ol::get-kbs (&optional (server *default-owl-link-server*))
  (gethash server *owl-link-server-kbs*))

;; ****************************************************************

(defun owl-link-xml-request (&rest messages)
  (xmls::toxml
   `(("RequestMessage" . "http://www.owllink.org/owllink#")
     (("schemaLocation" "http://www.owllink.org/owllink# http://www.owllink.org/owllink-20091116.xsd"))
     ,@(mapcar 'owl-link-xml-element messages))))

(defun expect-owl-link-response-element (xml element)
  (let ((parsed (xmls:parse xml)))
    (let ((body (cddr parsed)))
      (assert (null (cdr body)) () "Expected a single element but got ~a" body)
      (if (member (caaar body) '("Error" "KBError") :test 'equal)
	  (owl-link-error (second (assoc "error" (second (car body)) :test 'equal)))
	  (if (equal (caaar body) element)
	      t
	      (error "Expected ~a but got ~a in ~a" element (caar body) xml))))))

(defun owl-link-error (message)
  (error message))

(defun owl-link-xml-element (element)
  (destructuring-bind (name attrs &rest elements) element
      `(,(owl-link-term name)
	 ,(loop for (attr value) in attrs
	     collect (list (owl-link-attribute attr) value))
	 ,@(mapcar 'owl-link-xml-element elements))))

(defun owl-link-term (name)
  (let ((*owl-link-ns* nil))  ;; FIXME - server doesn't handle namespaces properly, so don't use them for now.
    (cond ((keywordp  name)
	   (cons (format nil "~{~:(~a~)~}" (split-at-char (string name) #\-)) *owl-link-ns*))
	  ((stringp name) (cons name *owl-link-ns*))
	  (t (error "not yet")))))

(defun owl-link-attribute (name)
  (cond ((keywordp  name) (string-downcase (string name)))
	((stringp name) name)
	(t (error "not yet"))))

(defun debone-owl-link-response (xml)
  (labels ((without-namespaces (e)
	     (cond ((atom e) e)
		   ((and (consp e) (stringp (cdr e))) (car e))
		   (t (mapcar #'without-namespaces e)))))
    (without-namespaces (cddr (xmls:parse xml)))))


(defun test-owl-link ()
  (ol:create-kb "http://purl.obolibrary.org/kb/iao.owl")
  (ol:load-ontology "http://purl.obolibrary.org/kb/iao.owl" "http://purl.obolibrary.org/obo/iao.owl")
  (format t "~a direct subclass relations for the inferred hierarchy~%"
	  (length (ol:get-subclass-hierarchy "http://purl.obolibrary.org/kb/iao.owl")))
  (ol:release-kb "http://purl.obolibrary.org/kb/iao.owl"))


#|(#"createOWLOntologyManager" 'org.semanticweb.owl.apibinding.OWLManager)
OWLOntologyManager manager = ...;
URL reasonerURL = new URL( ... );//URL of the HTTP service of the reasoner, e.g., http://localhost:8080

(setq ontology (#"loadOntologyFromPhysicalURI" manager (new 'java.net.uri "http://purl.obolibrary.org/obo/iao.owl")))

(setq reasoner (new 'OWLlinkHTTPXMLReasoner manager (new 'java.net.URL "http://127.0.0.1:8080/")))

OWLlinkReasoner reasoner = new OWLlinkHTTPXMLReasoner(manager, resonerURL);
//Create a new knowledge base...
CreateKB createKB = new CreateKB();
KB kb = reasoner.answer(createKB);
IRI kbIRI = kb.getKB();
//...and transfer an ontology to it
Tell tell = new Tell(kbIRI, ontology.getAxioms());
OK ok = reasoner.answer(tell);
GetSubClasses getSubClasses = new GetSubClasses(kbIRI, B);
ClassSynsets synsets = reasoner.answer(getSubClasses);
ReleaseKb releaseKB = new ReleaseKb(kbIRI);
reasoner.answer(releaseKB);

http://alignapi.gforge.inria.fr/tutorial/tutorial2/MyApp.java

(setq message "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<RequestMessage xmlns=\"http://www.owllink.org/owllink#\"
    xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"
    xsi:schemaLocation=\"http://www.owllink.org/owllink# 
      http://www.owllink.org/owllink-20091116.xsd\">
    <GetDescription/>
</RequestMessage>")

http://www.owllink.org/
|#