(in-package :cl-user)

;; repairs: Add object property declarations at beginning of file to placate the abstractparser
;; change comments with double quotes to comments with single quote
;; remove anonymous individual singleton
  
(defun do-branching-and-report (ontology-location name)
  "For now just report on what we know"
  (multiple-value-bind (ont base) (owl-to-lisp-syntax ontology-location name)
    (destructuring-bind (def name options &rest forms) ont
      (setq forms (remove '(individual :_) forms :test 'equal)) 
      (let ((kb (eval `(with-ontology foo () ,(append (property-declarations forms) forms) foo))))
	(print-db (check kb))
	(let ((decls (external-declarations forms)))
	  (flet ((is-external (name)
		   (if (consp name) 
		       (gethash (second name) decls)
		       (gethash name decls))))
	    (setq forms (remove-if #'is-external forms))
	    (map nil 'print (branch-points forms))
	    (let ((kinds (remove-duplicates (loop for form in forms collect (car form)))))
	      (loop for branch-point in (branch-points forms)
		 collect  (second branch-point) into accounted-for
		 append (descendants (second branch-point) kb) into accounted-for 
		 do (format t "Branch ~a:~{~a~^, ~}~%~%" 
			    (third (third branch-point))
			    (mapcar (lambda(e) (cons e (or (rdfs-label e kb) e)) )
				    (cons (second branch-point)
					  (remove-if #'is-external (descendants (second branch-point) kb)))))
		 finally
		   (print-db accounted-for)
		 (format t "Non branch classes: ~{~a~^, ~}~%" 
			 (mapcar 
			  (lambda(e) (cons e (or (rdfs-label e kb) e))) 
			  (set-difference (remove-if #'is-external (descendants !owl:Thing kb)) accounted-for)))))
	      ))
	))))

(defun branch-points (forms)
  "Collect the list of branch points"
  (loop for (kind name . stuff)  in forms
       for point = (find-if (lambda(el) (and (consp el) (eq (first el) 'annotation) (eq (second el) !obi:branch))) stuff)
       when point collect (list kind name point)))

(defun property-declarations (forms)
  "not really branch related, more for the abstract parser"
  (loop for form in forms
       when (member (car form) '(object-property datatype-property annotation-property))
       collect (list (car form) (second form))))

(defun external-declarations (forms)
  "Again, not really branch related, but to compensate for owlapi adding declarations of class and properties used in imports. We don't want to include these in the report"
  (let ((hash (make-hash-table :test 'equal)))
    (loop for form in forms do
	 (pushnew form (gethash (second form) hash)))
    (maphash (lambda(name forms)
	      (unless (and (= (length forms) 1)
			 (not (eql (search "obi:" (uri-abbreviated name)) 0))
			 (or (and (eq (caar forms) 'class)
				  (= (length (car forms)) 3))
			     (and (member (caar forms) '(object-property annotation-property datatype-property))
				  (= (length (car forms)) 2))))
		(remhash name hash)
		))
	     hash)
    hash))