(in-package :cl-user)

(defun describe-entity (name &optional (kb *default-kb*))
  (when (typep kb 'owl-ontology) (setq kb (kb kb)))
  (if (uri-p name)
      (setq name (uri-full name))
      (setq name (maybe-unabbreviate-namespace name)))
  (multiple-value-bind (ent type) (get-entity name kb)
    (labels ((list-of-entity-names (set)
	       (remove-if (lambda(s) 
			    (#"matches" s ".*_TOP_.*"))
			  (mapcar (lambda(s) (maybe-abbreviate-namespace (#"toString" s)))
				  (mapcan 'set-to-list 
					  (set-to-list set)))))
	     (list-of-entity-names2 (set)
	       (mapcar (lambda(s) (maybe-abbreviate-namespace (#"toString" s)))
		       (set-to-list set)))
	     (labeled-entity-list-line (label items)
	       (let ((them (list-of-entity-names  items)))
		 (when them
		   (format t "~a: ~{~a~^, ~}~%" label them)))))
      (ecase type
	(:class 
	 (format t "Class ~a~a~%" name (if (not (#"isSatisfiable" (kb-kb kb) ent)) " is unsatisfiable" ""))
	 (let ((equiv (list-of-entity-names2 (#"getEquivalentClasses" (kb-kb kb) ent))))
	   (when equiv
	     (format t "Equivalent to: ~{~a~^, ~}~%" 
		     (subst "owl:Thing" "_TOP_" 
			    (subst "owl:Nothing" "_BOTTOM_" equiv :test 'equal)
			    :test 'equal))))
	 (labeled-entity-list-line "Direct Superclasses" (#"getSuperClasses" (kb-kb kb) ent t))
	 (labeled-entity-list-line "All Superclasses" (#"getSuperClasses" (kb-kb kb) ent nil))
	 (labeled-entity-list-line "Direct Subclasses" (#"getSubClasses" (kb-kb kb) ent t))
	 (labeled-entity-list-line "All Subclasses" (#"getSubClasses" (kb-kb kb) ent nil))
	 
	 (let ((*print-pretty* t)
	       (*print-case* :downcase))
	   (format t "Axioms:~%~{~s~%~}" 
		   (mapcar 'simplify-aterm-sexp 
			   (mapcar 
			    'aterm-to-sexp
			    (setq axioms 
				  (set-to-list 
				   (#"getAxioms" (#"getTBox" (kb-kb kb)) ent)))))))
	 )
	(:individual
	 (format t "Individual ~a~%" name)
	 (labeled-entity-list-line "All Types" (#"getTypes" (kb-kb kb) ent nil))
 	 (labeled-entity-list-line "Direct Types" (#"getTypes" (kb-kb kb) ent t))
 	 (let ((sames (list-of-entity-names2 (#"getSames" (kb-kb kb) ent ))))
 	   (when sames
 	     (format t "Same as: ~{~s~^, ~}~%" sames)))
	 (let ((*print-case* :downcase))
	   (loop for p in (kb-properties kb) 
	      for jvals = (#"getPropertyValues" (kb-kb kb) p ent)
	      for vals = (mapcar 'simplify-aterm-sexp (mapcar 'aterm-to-sexp (set-to-list jvals)))
	      when vals 
	      do (format t "~a: ~{~s~^, ~}~%" 
			 (let ((p (maybe-abbreviate-namespace (aterm-to-sexp p))))
			   (if (and (listp p) (equal (car p) "inv"))
			     (format nil "inv(~a)" (second p))
			     p))
			 vals)))
	 )
	((:object-property :datatype-property)
	 (format t "Object Property ~a~%" name)
	 (labeled-entity-list-line "Direct Subproperties" (#"getSubProperties" (kb-kb kb) ent t))
	 (labeled-entity-list-line "All Subproperties" (#"getSubProperties" (kb-kb kb) ent ))
	 (labeled-entity-list-line "Direct SuperProperties" (#"getSuperProperties" (kb-kb kb) ent t))
	 (labeled-entity-list-line "All SuperProperties" (#"getSuperProperties" (kb-kb kb) ent ))
;	 (format t "Domain: ~{~a~^, ~}~%" 
;		 (list-of-entity-names2 (#"getDomains" (kb-kb kb) ent)))
	 (let ((*print-case* :downcase))
	   (format t "Domain: ~a~%" 
		   (let ((raw-domain (#"getDomain" (#"getRole" (#"getRBox" (kb-kb kb)) ent))))
		     (if raw-domain
			 (simplify-aterm-sexp 
			  (aterm-to-sexp
			   (#"nnf" 'ATermUtils raw-domain)))
			 ""))))
	 (let ((*print-case* :downcase))
	   (format t "Range: ~a~%" 
		   (let ((raw-range (#"getRange" (#"getRole" (#"getRBox" (kb-kb kb)) ent))))
		     (if raw-range
			 (simplify-aterm-sexp 
			  (aterm-to-sexp
			   (#"nnf" 'ATermUtils raw-range)))
			 ""))))
	 (let ((pprops nil))
	   (when (eq type :object-property)
	     (when (#"isInverseFunctionalProperty" (kb-kb kb) ent)
	       (push "Inverse Functional" pprops))
	     (when (#"isSymmetricProperty" (kb-kb kb) ent) (push "Symmetric" pprops))
	     (when (#"isTransitiveProperty" (kb-kb kb) ent) (push "Transitive" pprops)))
	   (when (#"isFunctionalProperty" (kb-kb kb) ent) (push "Functional" pprops))
	   (when pprops
	     (format t "This property is ~{~a~^, ~}~%" pprops)))

	(when (eq type :object-property)
	   (let ((inverses (mapcar 'aterm-to-sexp (set-to-list (#"getInverses" (kb-kb kb) ent)))))
	     (when inverses
	     (format t "Inverses: ~{~a~^, ~}~%" inverses))))
	 )
	(:annotation-property	 
	 (format t "Annotation Property ~a~%" name))
	(:ontology-property	 
	 (format t "Annotation Property ~a~%" name))
	))
    (princ (tree-tooltip-text kb ent))
    (values)))

(defmethod describe-object ((object uri) stream)
  (if (has-entity? (uri-full object))
      (describe-entity (uri-full object))
      (call-next-method)))