(in-package :common-lisp-user)

;; file:///Users/ruttenbe/Desktop/CurrentProjects/lisp/biopax/pellet-1.3-beta2/doc/javadoc/org/mindswap/pellet/KnowledgeBase.html
;; http://www.cwi.nl/projects/MetaEnv/aterm/doc/aterm-javadoc/index.html

(eval-when (:load-toplevel :execute)
  (#"setProperty" 'system "console" "false"))

(defstruct (kb (:print-function print-kb-struct))
  loaded-from
  pkb
  jena-reasoner
  jena-model
  jena-unreasoned-model
  owlapi-reasoner
  ontologies
  name2entity
  properties
  uri2label
  uri2comment
  explicit-supers)

(defun kb-kb (thing)
  (cond ((kb-p thing)
	 (kb-pkb thing))
	((typep thing 'owl-ontology)
	 (kb-pkb (kb thing)))
	(t (error "Don't know how to get kb of ~a" thing))))

(defvar *default-kb* nil)

(defun print-kb-struct (kb stream depth)
  (print-unreadable-object (kb stream)
    (format stream "Pellet KB on ~a" (kb-loaded-from kb))))

(defun clear-the-freakin-caches (model)
  ;; nailed the *&%&^% cached file problem. 
  ;; hint: http://sourceforge.net/mailarchive/message.php?msg_id=E864E95CB35C1C46B72FEA0626A2E808032743A0%400-mail-br1.hpl.hp.com
  (let ((mm (#"getImportModelMaker" model)))
    (let* ((graphmaker (#"getGraphMaker" mm))
	   (graphs (#"listGraphs"graphmaker)))
      (loop while (#"hasNext" graphs) collect (#"next" graphs) into them
	 finally
	   (loop for it in them do (#"removeGraph" graphmaker it))))))

(defun imported (kb)
  (let ((mm (#"getImportModelMaker" (kb-jena-model kb))))
    (let* ((graphmaker (#"getGraphMaker" mm))
	   (graphs (#"listGraphs"graphmaker)))
      (loop while (#"hasNext" graphs) collect (#"next" graphs)))))

(defun ignored-imports ()
  (with-constant-signature ((hasnext "hasNext") (next "next"))
    (loop with iterator =  (#"listIgnoredImports" (#"getInstance" 'com.hp.hpl.jena.ontology.OntDocumentManager))
       while (hasNext iterator)
       for item = (next iterator)
       collect item)))

(defun dont-import (&rest urls)
  "don't import any of these urls. useful for controlling imports of ontologies that are imported from the web, when already importing a local version"
  (loop for url in urls do 
       (#"addIgnoreImport"
	(#"getInstance" 'com.hp.hpl.jena.ontology.OntDocumentManager)
	url)))

(defun do-import (&rest urls)
  "do import some ontology that was previously passed to dont-import"
  (loop for url in urls do
       (#"removeIgnoreImport"
	(#"getInstance" 'com.hp.hpl.jena.ontology.OntDocumentManager)
	url)))

(defun clear-dont-imports ()
  "remove all instructions not to import some url"
  (loop for url in (ignored-imports) do (do-import url)))

(defun maybe-convert-from-obo(uri)
  (if (and (stringp uri) (#"matches"  uri "http.*\\.obo"))
      (format nil "http://www.berkeleybop.org/obo-conv.cgi?url=~a&format=owl&style=basic&.submit=convert&.cgifields=names_from_ids"
	       uri)
      uri))

(defun pellet-major-version ()
  (or (ignore-errors (parse-integer (#"replaceAll" (#"getVersionString" (new 'org.mindswap.pellet.utils.VersionInfo)) "(\\d+)(.*)" "$1")))
      1))

(defun load-kb-jena (ontology)
  (let ((version (pellet-major-version)))
    (if (eql version 1)
	(load-kb-jena-v1 ontology)
	(if (eql version 2)
	    (load-kb-jena-v2 ontology)
	    (error "Don't know how to load pellet version ~a" version)))))

;; This version loads in such a way as to make the jena-model suitable for sparql'ing  against.
(defun load-kb-jena-v1 (&optional (ontology "file:///users/ruttenbe/desktop/currentprojects/biopax/biopax-level2.owl"))
  (setq ontology (if (uri-p ontology) (uri-full ontology) ontology))
  (setq ontology (maybe-convert-from-obo ontology))
  (let ((dont (ignore-imports-of-standard-ontology ontology)))
    (unwind-protect
	 (progn
	   (loop for url in dont do (dont-import url))
	   (setq ontology (maybe-url-filename ontology))
	   (let* ((model (#"createOntologyModel" 'com.hp.hpl.jena.rdf.model.ModelFactory (get-java-field 'org.mindswap.pellet.jena.PelletReasonerFactory "THE_SPEC"))))
	     (clear-the-freakin-caches model)
	     (#"clearCache" (#"getDocumentManager" model))
	     (#"setCacheModels" (#"getDocumentManager" model) nil)
	     (let ((default-base (#"replaceFirst" ontology "(.*/).*" "$1")))
	       (#"read" model (new 'bufferedinputstream (#"getInputStream" (#"openConnection" (new 'java.net.url ontology)))) default-base))
	     (let ((reasoner (#"getOWLReasoner" (#"getGraph" model))))
	       (#"load" reasoner model)
					;      (print-db (#"size" (get-java-field (get-java-field (get-java-field (#"getDocumentManager" model) "m_fileMgr" t) "modelCache" t) "modelCache" t)))
	       (kb-setup (make-kb :pkb (#"getKB" (#"getGraph" model)) :jena-reasoner reasoner :jena-model model :loaded-from ontology))))
      )
      (loop for url in dont do (do-import url)))))

(defun load-kb-jena-v2 (&optional (ontology "file:///users/ruttenbe/desktop/currentprojects/biopax/biopax-level2.owl"))
  (setq ontology (if (uri-p ontology) (uri-full ontology) ontology))
  (setq ontology (maybe-convert-from-obo ontology))
  (let ((dont (ignore-imports-of-standard-ontology ontology)))
    (unwind-protect
	 (progn
	   (loop for url in dont do (dont-import url))
	   (setq ontology (maybe-url-filename ontology))
	   (let* ((model (#"createOntologyModel" 'com.hp.hpl.jena.rdf.model.ModelFactory (get-java-field 'org.mindswap.pellet.jena.PelletReasonerFactory "THE_SPEC"))))
					;(clear-the-freakin-caches model)
					;(#"clearCache" (#"getDocumentManager" model))
					;(#"setCacheModels" (#"getDocumentManager" model) nil)
	     (setq @ model)
	     (#"read" model ontology)
	     (#"prepare" model)
	     (kb-setup (make-kb :pkb (#"getKB" (#"getGraph" model)) :jena-reasoner (#"getReasoner" (#"getGraph" model)) :jena-model model :loaded-from ontology)))
	   )
      (loop for url in dont do (do-import url)))))


;; so that models don't force a classification
(if (and (>= SYSTEM:*FASL-VERSION* 35) (find-java-class "com.hp.hpl.jena.ontology.impl.OntModelImpl"))
    (defmethod print-object ((obj (jclass "com.hp.hpl.jena.ontology.impl.OntModelImpl")) stream) 
      (print-unreadable-object (obj stream :identity t)
	(format stream "com.hp.hpl.jena.ontology.impl.OntModelImpl"))))

'(defun load-kb-jena (&optional (ontology "file:///users/ruttenbe/desktop/currentprojects/biopax/biopax-level2.owl"))
  (setq ontology (if (uri-p ontology) (uri-full ontology) ontology))
  (setq ontology (maybe-convert-from-obo ontology))
  (let ((dont (ignore-imports-of-standard-ontology ontology)))
    (unwind-protect
	 (progn
	   (loop for url in dont do (dont-import url))
	   (setq ontology (maybe-url-filename ontology))
	   (let* ((model (#"createDefaultModel" 'com.hp.hpl.jena.rdf.model.ModelFactory)))
	     ;(clear-the-freakin-caches model)
	     ;(#"clearCache" (#"getDocumentManager" model))
	     ;(#"setCacheModels" (#"getDocumentManager" model) nil)
	     (#"read" model ontology )
	     (let ((reasoner (#"create" (#"theInstance" 'org.mindswap.pellet.jena.PelletReasonerFactory))))
	       (let ((model (#"createInfModel"
			     'com.hp.hpl.jena.rdf.model.ModelFactory
			     reasoner model)))
		 (setq @ (#"getGraph" model))
		 (#"load" reasoner model)
		 (#"rebind" model)
		 (make-kb  :jena-reasoner reasoner :jena-model model :loaded-from ontology)))))
      (loop for url in dont do (do-import url)))))



(defun load-from-jena-model (jena-model)
  (let* ((reasoner (new 'pellet.jena.OWLReasoner ))
	 (model (#"createOntologyModel" 'com.hp.hpl.jena.rdf.model.ModelFactory (get-java-field 'PelletReasonerFactory "THE_SPEC"))))
    (let ((reasoner (#"getOWLReasoner" (#"getGraph" model))))
      (#"load" reasoner jena-model)
      (kb-setup (make-kb :pkb (#"getKB" reasoner) :jena-reasoner reasoner :jena-model jena-model :loaded-from 'jena)))))

(defun load-kb-jena-from-string (string &optional name)
  (let* ((model (#"createOntologyModel" 'com.hp.hpl.jena.rdf.model.ModelFactory (get-java-field 'PelletReasonerFactory "THE_SPEC"))))
    (clear-the-freakin-caches model)
    (#"read" model (new 'StringReader string) "")
    (let ((reasoner (#"getOWLReasoner" (#"getGraph" model))))
      (#"load" reasoner model)
      (kb-setup (make-kb :pkb (#"getKB" reasoner) :jena-reasoner reasoner :jena-model model :loaded-from (or name "string"))))))

(defun load-kb-owlapi (&optional (ontology "file:///users/ruttenbe/desktop/currentprojects/biopax/biopax-level2.owl") (fix-ontology-fn (lambda(e) e)))
  (setq ontology (maybe-url-filename ontology))
  (let* ((reasoner (new 'pellet.owlapi.Reasoner))
	 (parser (new 'OWLRDFParser))
	 (conn (new 'OWLConnectionImpl)))
    (#"setConnection" parser conn)
    (let ((ont (#"parseOntology" parser (new 'java.net.URI ontology))))
      (setq ont (funcall fix-ontology-fn ont))
      (#"setOntology" reasoner ont)
      (kb-setup (make-kb :pkb (#"getKB" reasoner) :owlapi-reasoner reasoner :loaded-from ontology )))))

(defun load-kb-owlapi-from-string (string)
  (let* ((reasoner (new 'pellet.owlapi.Reasoner))
	 (parser (new 'OWLRDFParser))
	 (conn (new 'OWLConnectionImpl)))
    (#"setConnection" parser conn)
    (let ((ont (#"parseOntology" parser (new 'StringReader string) (new 'java.net.uri "http://www.example.com/"))))
      (#"setOntology" reasoner ont)
      (kb-setup (make-kb :pkb (#"getKB" reasoner) :owlapi-reasoner reasoner :loaded-from "string" )))))

;; perhaps (set-java-field 'JenaParameters "disableBNodeUIDGeneration" t) 
(defparameter *bnode-prefix-length* (if (< (pellet-major-version) 2) (length (get-java-field 'PelletOptions "BNODE")) 0))
(defparameter *anon-prefix-length* (if (< (pellet-major-version) 2) (length (get-java-field 'PelletOptions "ANON")) 0))

(defun kb-setup (kb)
  (if (> (pellet-major-version) 1)
      (format t ";; Not turning loggin off in pellet 2 - FIXME")
      (progn
	(log-abox "OFF" kb)
	(log-tbox "OFF" kb)
	(log-kb "OFF" kb)
	(log-taxonomy-builder "OFF" kb)))
  (ignore-errors (set-java-field 'PelletOptions "SHOW_CLASSIFICATION_PROGRESS" nil))

  (let ((n2e (make-hash-table :test 'equal)))
    (loop for individual in (set-to-list (#"getIndividuals" (kb-kb kb)))
       for name = (#"getName" individual)
       do
       (cond ((#"isBnode" 'AtermUtils individual)
	      (setq name (format nil "~a~a" *blankprefix* *bnode-prefix-length*)))
	     ((#"isAnon" 'AtermUtils individual)
	      (setq name (format nil "~a~a" *blankprefix* *anon-prefix-length*))))
       (setf (gethash name n2e) (cons :individual individual)))
    (loop for class in (set-to-list (#"getClasses" (kb-kb kb)))
       for name = (#"getName" class)
       do (setf (gethash name n2e)  (cons :class class)))
					;    (loop for prop in (set-to-list (#"getProperties" (kb-kb kb))) ;; bug getProperties doesn't return annotation or ontology properties.
    (loop for prop in (set-to-list (#"getRoleNames" (#"getRBox" (kb-kb kb))))
       for name = (#"getName" prop)
       with kb-kb = (kb-kb kb)
       for ptype = (cond ((#"isAnnotationProperty" kb-kb prop) :annotation-property)
			 ((#"isDatatypeProperty" kb-kb prop) :datatype-property)
			 ((#"isObjectProperty" kb-kb prop) :object-property)
			 ((#"isOntologyProperty" kb-kb prop) :ontology-property)
			 (t (error "Don't know what type of property ~a is" name)))
       do
       (push prop (kb-properties kb))
       (setf (gethash name n2e) (cons ptype prop)))

    (setf (gethash (uri-full !owl:Thing) n2e) (cons :class (get-java-field 'atermutils "TOP")))
    (setf (gethash (uri-full !owl:Nothing) n2e) (cons :class (get-java-field 'atermutils "BOTTOM")))
    (setf (kb-name2entity kb) n2e))
  kb)

(defun get-entity (name &optional (kb *default-kb*))
  (if (uri-p name) 
      (setq name (uri-full name)))
  (let ((it (or (gethash name (kb-name2entity (if (typep kb 'owl-ontology) (kb kb) kb)))
		(gethash (maybe-unabbreviate-namespace name) (kb-name2entity (if (typep kb 'owl-ontology) (kb kb) kb))))))
    (assert it (name) "Kb Doesn't have an entity named ~a" name)
    (values (cdr it) (car it))))

(defun has-entity? (name &optional (kb *default-kb*))
  (when (typep kb 'owl-ontology) (setq kb (kb kb)))
  (if (uri-p name) 
      (setq name (uri-full name)))
  (or (gethash name (kb-name2entity kb))
      (gethash (maybe-unabbreviate-namespace name) (kb-name2entity kb))))


(defun get-same-individuals (ent &optional (kb *default-kb*))
  (when (stringp ent)
      (setq ent (get-entity ent kb)))
  (map 'list 'aterm-to-sexp 
       (set-to-list 
	(#"getSames" (kb-kb kb) ent))))

(defun check-abox-consistency (&optional (kb *default-kb*) &key verbose-debug force)
  (let* ((abox (#"getABox" (kb-kb kb)))
	 (abox-consistent (#"isConsistent" abox)))
    (when force (#"clearCaches" (#"getABox" (kb-kb kb)) t))
    (set-java-field abox "DEBUG" (make-immediate-object verbose-debug :boolean))
    (or abox-consistent
	(if verbose-debug (format *debug-io* "abox inconsistent. Trying again with explanation"))
	(let ((explain (#"doExplanation" abox)))
	  (#"setDoExplanation" abox t)
	  (#"isConsistent" abox)
	  (#"setDoExplanation" abox explain)
	  (values nil (list :reason (#"getExplanation" abox)))))))

(defun get-dl-expressivity (&optional (kb *default-kb*))
  (#"toString" (#"getExpressivity" (kb-kb kb))))

(defun get-owl-species (&optional (kb *default-kb*) (allow-owl11 t))
  (if (typep kb 'owl-ontology) (setq kb (kb kb)))
  (if (kb-jena-reasoner kb)
      (let ((species 
	     (intern (concatenate 'string "OWL-" (string-upcase (#"toString" (#"getSpecies" (kb-jena-reasoner kb))))) 'keyword)))
	(if (eq species :owl-full)
	    (let ((messages (get-owl-full-features kb)))
	      (if (and allow-owl11 (every (lambda(message) (#"matches" message "^Multiple Types:.*is defined both as.*")) messages))
		  :owl-1.1
		  (values species messages)))
	    species))
      :unknown-use-jena))

(defun get-owl-full-features (&optional (kb *default-kb*))
  (let* ((report (#"getReport" (#"getSpecies" (kb-jena-reasoner kb))))
	 (field (find "messages" (#"getDeclaredFields" (find-java-class "org.mindswap.pellet.jena.OWLSpeciesReport")) :key #"toString" :test 'search)))
    (#"setAccessible" field t)
    (let ((messages (#"get" field report)))
      (declare (ignore messages))
      (let ((full-messages (set-to-list (elt messages (get-java-field 'OWLSpecies "FULL")))))
	(loop for message in full-messages
	     collect
	     (let* ((renderer (new 'atermabstractsyntaxrenderer ))
		    (sw (new 'stringwriter))
		    (formatter (new 'pellet.output.outputformatter sw nil )))
	       (#"setWriter" renderer formatter)
	       (#"print" message renderer)
	       (#"toString" sw)))))))

;; not
(defun get-annotation-property-values (ind prop &optional (kb *default-kb*))
  (let ((outedges
	 (#"getOutEdges" (#"getIndividual" (#"getABox" (kb-kb kb)) (get-entity ind kb ))))
	(prop
	  (#"getRole" (#"getRBox" (kb-kb kb)) (get-entity prop kb ))))
    (values outedges (#"getEdges" outedges prop))))

(defun all-object-properties (kb)
  (loop for prop in (set-to-list (#"getRoleNames" (#"getRBox" (kb-kb kb))))
     for name = (#"getName" prop)
     with kb-kb = (kb-kb kb)
     when (and (#"isObjectProperty" kb-kb prop) (not (equal name "inv")))
     collect (make-uri name)))

(defun all-datatype-properties (kb)
  (loop for prop in (set-to-list (#"getRoleNames" (#"getRBox" (kb-kb kb))))
     for name = (#"getName" prop)
     with kb-kb = (kb-kb kb)
     when (#"isDatatypeProperty" kb-kb prop)
     collect (make-uri name)))

(defun foreach-individual (f &optional (kb *default-kb*))
  (maphash (lambda(name type-entity)
	     (destructuring-bind (type . entity) type-entity
	       (when (eq type :individual)
		 (funcall f name entity))))
	   (kb-name2entity kb)))

(defun collect-sames (&optional (kb *default-kb*))
  (let ((seen (make-hash-table :test 'equal))
	(all nil))
    (flet ((see (thing) (setf (gethash thing seen) t) thing)
	   (seen (thing)  (gethash thing seen)))
    (foreach-individual 
     (lambda(name entity)
       (let ((name (maybe-abbreviate-namespace name)))
	 (let ((sames (get-same-individuals entity)))
	   (when (and sames (not (seen name)))
	     (push (sort (cons name (mapcar #'see (mapcar 'maybe-abbreviate-namespace sames))) 'string-lessp) all)
	     ))))
     kb)
    all)))

(defun annotation-property-values-or-labels (entity &optional (kb *default-kb*))
   (sparql `(:select (?p ?v) (:distinct t) 
		     (:union
		      ((?p :a !owl:AnnotationProperty)
		       (,(make-uri entity) ?p ?v)
		       (:filter (not (isblank ?v))))
		      ((?p :a !owl:AnnotationProperty)
		       (,(make-uri entity) ?p ?v1)
		       (?v1 !rdfs:label ?v)
		       (:filter (isblank ?v1)))
		      )) :kb kb 
			 :use-reasoner :none))


(defun kb-unsatisfiable-classes (&optional (kb *default-kb*))
  (let ((found 
	 (loop for class being the hash-values of (kb-name2entity kb)
	    using (hash-key name)
	    when (and (eq (car class) :class) (not (#"isSatisfiable" (kb-kb kb) (cdr class))))
	    collect (make-uri name))))
    found))

(defun property-type (uri kb)
  (car (gethash (uri-full uri) (kb-name2entity kb))))

(defun abox-summary-report (abox)
  (let ((nodes (set-to-list (#"getNodes" abox)))
	(classogram (make-hash-table :test 'equalp))
	(relatogram (make-hash-table :test 'equalp)))
    (loop for node in nodes
	 for types = (set-to-list (#"getTypes" node))
	 for relations = (mapcar #"getName" (set-to-list (#"getRoles" (#"getOutEdges" node))))
	 do
	 (loop for type in types do (incf (gethash (aterm-to-sexp type) classogram 0)))
	 (loop for relation in relations do (incf (gethash (aterm-to-sexp relation) relatogram 0))))
    (list classogram relatogram)))
	 


;(log-abox)


;    (#"addAppender" logger (new 'consoleappender (new 'simplelayout)))

;(foreach-individual (lambda(name ent) (unless (#"isSatisfiable" (#"getABox" (kb-kb *default-kb*))  ent) (print name) (sleep 1))))

;;(#"setLevel" (#"getLogger" (get-java-field (#"getABox" (kb-kb *default-kb*)) "log")) (get-java-field  'org.apache.log4j.Level "ALL"))
;; (#"addAppender" logger (new 'consoleappender (new 'simplelayout)))
;;(#"setLevel" (#"getLogger" (get-java-field (#"getABox" (kb-kb *default-kb*)) "log")) (get-java-field  'org.apache.log4j.Level "OFF"))