;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: case-management.lsp
;;;;    System: 
;;;;    Author: Shawn Nicholson
;;;;   Created: June 21, 2002 10:07:13
;;;;   Purpose: Provides case manipulation functionality for FIREs working memory and KB
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Thursday, March 18, 2004 at 00:38:41 by usher
;;;; ---------------------------------------------------------------------------

(in-package :fire)

;; This is for debugging only
(defparameter *current-managed-case* nil)
(defun in-current-managed-case (case-name) (setf *current-managed-case* case-name))
(defmacro with-current-managed-case (case-name &rest body)
  `(let ((*current-managed-case* ,case-name))
     ,@body))


(defun case-management-info-label ()
  (if (mixed-case?) 
    'data::caseManagementInfo
    'data::case-management-info))

;;; I introduce a new term into the reasoner to store case management information
;;;  eg - deleted, selected, accepted, etc
(defun make-case-management-info-fact (case-name fact)
  `(,(case-management-info-label) ,case-name ,fact))





;; Since we don't store case-names with explicit-case-fn wrapped around them
;;  before calling fire::make-case-fact I need to strip the wrapper off
(defmethod make-case-KB-fact ((case-name list) fact)
  (make-case-fact (prepare-casename-for-KB-query (first case-name) (rest case-name))
                  fact))

(defmethod make-case-KB-fact ((case-name t) fact)
  (make-case-fact case-name fact))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Instances
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun fetch-isas-from-case (entity case-name &key (reasoner fire:*reasoner*))
  (let ((query (make-case-KB-fact case-name (make-isa entity 'd::?coll))))
    (ask-it query 
            :reasoner reasoner
            :response 'd::?coll 
            :effort :wm-only)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Cases
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; In Mixed-Case KBs the form of isa is:  (isa name collection)
;;  in hyphenated KBs the form is (collection name)
(defun case-definition-fact (case-name)
  (if (mixed-case?)
    `(data::isa ,case-name data::Case)
    `(data::case ,case-name)))


(defgeneric prepare-casename-for-KB-query (type specs)
  (:documentation "Returns the case-name to use for a query to the KB. I need a method here
    to strip off the type in some cases and not in others."))

(defmethod prepare-casename-for-KB-query (type specs)
  (cons type specs))

(defmethod prepare-casename-for-KB-query ((type (eql 'data::ExplicitCaseFn)) specs)
  (prepare-casename-for-KB-query 'data::explicit-case-fn specs))

(defmethod prepare-casename-for-KB-query ((type (eql 'data::explicit-case-fn)) specs)
  (first specs))

(defmethod prepare-casename-for-KB-query ((type (eql 'data::explicitCaseFn)) specs)
  (prepare-casename-for-KB-query 'data::explicit-case-fn specs))


    
;;;;;;;;;;;;;;;;;
;;; Case determination backchainer
;;;  this was an experiment to compare speed
;;;  this method lost... big.
(defun make-case-determination-rule ()
  `(data::implies 
    ,(if (mixed-case?)
       '(data::ist-Information ?case-name ?case-fact)
       '(data::ist--information ?case-name ?case-fact))
    (data::isa ?case-name data::Case)))


(defun add-case-determination-backchainer (reasoner)
  (let ((backchainer (fire:create-chainer-from-axioms 
                      "Case Determination Rule"
                      (list (make-case-determination-rule)))))
    (setf (getf (plist reasoner) :case-determination-backchainer) backchainer)
    (fire:add-chainer-to-reasoner backchainer reasoner)
    backchainer))

(defun get-case-determination-backchainer (reasoner)
  (let ((chainer (getf (plist reasoner) :case-determination-backchainer)))
    (unless chainer
      (setf chainer (add-case-determination-backchainer reasoner)))
    chainer))
  
(defun query-case-determination-backchainer (reasoner query &key (response :pattern))
  (with-reasoner reasoner
    (let* ((backchainer (get-case-determination-backchainer reasoner))
           (results (and backchainer 
                         (query-within-chainer query backchainer 5 :all)))
           (binding-sets (mapcar #'car results)))
      (mapcar #'(lambda (result)
                  (fire:install-query-reasons-in-wm (cdr result)
                                                    :reasoner reasoner))
        results)
      (case response
        (:bindings binding-sets)
        (:pattern (mapcar #'(lambda (bindings)
                              (sublis bindings query)) 
                    binding-sets))
        (t 
         (mapcar #'(lambda (bindings)
                       (sublis bindings response))
             binding-sets))))))

(defun get-stored-cases (&key (reasoner *reasoner*))
  (query-case-determination-backchainer reasoner
                                        '(data::isa ?case-name data::Case)
                                        :response '?case-name))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Common filters
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun mark-case-fact (fact mark &key (case-name *current-managed-case*) (reasoner *reasoner*))
  ;; Mark can be any predicate: deleted selected...
  (let ((marked-fact (make-case-management-info-fact case-name (list mark fact))))
    (fire:tell marked-fact reasoner :user-marked :all)))

(defun unmark-case-fact (fact mark &key (case-name *current-managed-case*) (reasoner *reasoner*))
  ;; Mark can be any predicate: deleted selected...
  (let ((marked-fact (make-case-management-info-fact case-name (list mark fact))))
    (fire:untell marked-fact reasoner :user-marked :all)))


(defun current-case-fact-marks (&key (case-name *current-managed-case*) (reasoner *reasoner*))
  (ask-it (make-case-management-info-fact case-name '?marked-fact)
               :reasoner reasoner
               :response '?marked-fact))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Accessing Case Elements
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun case-loaded-in-WM? (case-name &key (reasoner *reasoner*))
  (ask-it (make-case-management-info-fact case-name (list 'data::case-loaded case-name))
          :reasoner reasoner :effort :wm-only))

(defun case-fact-deleted? (fact &key (case-name *current-managed-case*) (reasoner *reasoner*))
  (ask-it (make-case-management-info-fact case-name (list 'data::deleted fact))
               :reasoner reasoner :effort :wm-only))

(defun case-fact-selected? (fact &key (case-name *current-managed-case*) (reasoner *reasoner*))
  (ask-it (make-case-management-info-fact case-name (list 'data::selected fact))
               :reasoner reasoner :effort :wm-only))

(defun case-fact-invalid? (fact &key (case-name *current-managed-case*) (reasoner *reasoner*))
  (ask-it (make-case-management-info-fact case-name (list 'data::invalid fact))
               :reasoner reasoner :effort :wm-only))


(defun case-fact-rejected? (fact &key (case-name *current-managed-case*) (reasoner *reasoner*))
  (ask-it (make-case-management-info-fact case-name (list 'data::rejected fact))
               :reasoner reasoner :effort :wm-only))


  
(defmethod lookup-case-facts (case-name 
                              &key (reasoner *reasoner*) (response '?fact))
  "case-name is always a list of (type specs) eg (explicit-case-fn <name>)"
  (get-case-facts reasoner case-name (case-type case-name)
                  :response response))

(defun case-type (casename)
  (cond ((null casename) nil)
        ((symbolp casename) :explicit)
        ((and (consp casename) 
              (eq (car casename) 'd::ExplicitCaseFn))   :explicit)
        ((and (consp casename) 
              (eq (car casename) 'd::explicit-case-fn)) :explicit)
        ((and (consp casename) 
              (eq (car casename) 'd::MinimalCaseFn))    :minimal)
        ((and (consp casename) 
              (eq (car casename) 'd::minimal-case-fn))  :minimal)
        ((and (consp casename) 
              (eq (car casename) 'd::CaseFn))           :casefn)
        ((and (consp casename) 
              (eq (car casename) 'd::GroundCaseFn))     :ground)
        ((and (consp casename) 
              (eq (car casename) 'd::ground-case-fn))   :ground)
        (t nil)))



(defmethod get-case-facts (reasoner casename casetype &key response)
  (declare (ignore reasoner casename casetype response))
  nil)

(defmethod get-case-facts ((reasoner reasoner) (casename cons)
                           (casetype (eql :explicit)) &key response)
  (get-case-facts reasoner (second casename) casetype :response response))

(defmethod get-case-facts ((reasoner reasoner) (casename symbol)
                           (casetype (eql :explicit)) &key response)
  (let* ((analogy-src (analogy-source-of reasoner))
         (facts (and analogy-src
                     (fire:gather-dgroup-facts 
                      'd::ExplicitCaseFn (list casename) analogy-src))))
    (if (eq response :pattern)
      (mapcar #'(lambda (fact)
                  (make-case-fact casename fact))
        facts)
      facts)))

(defmethod get-case-facts ((reasoner reasoner) (casename cons)
                           (casetype (eql :minimal)) &key response)
  (let* ((analogy-src (analogy-source-of reasoner))
         (facts (and analogy-src
                     (fire:gather-dgroup-facts 
                      'd::MinimalCaseFn (list (second casename)) 
                      analogy-src))))
    (if (eq response :pattern)
      (mapcar #'(lambda (fact)
                  (make-case-fact casename fact))
        facts)
      facts)))

(defmethod get-case-facts ((reasoner reasoner) (casename cons)
                           (casetype (eql :ground)) &key response)
  (let* ((analogy-src (analogy-source-of reasoner))
         (facts (and analogy-src
                     (fire:gather-dgroup-facts 
                      'd::GroundCaseFn (list (second casename)) 
                      analogy-src))))
    (if (eq response :pattern)
      (mapcar #'(lambda (fact)
                  (make-case-fact casename fact))
        facts)
      facts)))



(defmethod gather-case-entities-and-expressions (case-name 
                                                 &key (reasoner *reasoner*))
  (let ((facts (lookup-case-facts case-name :reasoner reasoner)))
    (multiple-value-bind (ents exprs)
        (extract-entities-and-expressions 
         (delete nil (mapcar #'fire->sme-expression facts))
         (analogy-source-of reasoner))
      (values ents (delete nil (mapcar #'sme->fire-expression exprs))))))


    
(defgeneric case-individuals (case-name &key reasoner filter)
  (:documentation "Returns the individuals from the case filtered by the filter function - TRUE it's in the result, FALSE it is filtered"))

(defmethod case-individuals (case-name &key (reasoner *reasoner*) (filter #'(lambda (fact) (declare (ignore fact)) t)))
  ;; filter-func is a function of one argument - the fact - that if TRUE the element is returned, if it is FALSE, it is removed
  (multiple-value-bind (ents exprs)
      (gather-case-entities-and-expressions case-name :reasoner reasoner)
    (declare (ignore exprs))
    (remove-if-not #'(lambda (ent)
                       (with-current-managed-case case-name
                         (with-reasoner reasoner
                           (funcall filter ent))))
                   ents)))
     
     
(defgeneric case-expressions (case-name &key reasoner filter)
  (:documentation "Returns the expressions from the case filtered by the filter function"))

(defmethod case-expressions (case-name &key (reasoner *reasoner*) (filter #'(lambda (fact) (declare (ignore fact)) t)))
  (let ((exprs (lookup-case-facts case-name :reasoner reasoner)))
    (remove-if-not #'(lambda (exp)
                       (with-current-managed-case case-name
                         (with-reasoner reasoner
                           (funcall filter exp))))
                   exprs)))



(defun list-currently-loaded-cases (&key (reasoner *reasoner*))
  (ask-it (make-case-management-info-fact '?casename '(data::case-loaded ?casename))
          :reasoner reasoner :effort :wm-only :response '?casename))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;  Deleting
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun get-full-case-fact-form (case-fact)
  (let ((informant (ltre:informant-of case-fact)))
    (if (eq informant :kb)
      (list 'data::in-kb case-fact)
      case-fact)))


(defgeneric delete-case-from-WM (case-name &key reasoner)
  (:documentation "Removes the case from the working memory"))

(defmethod delete-case-from-WM (case-name &key (reasoner *reasoner*))
  (let ((current-case-management-facts (ask-it (make-case-management-info-fact case-name '(?pred ?fact))
                                               :reasoner reasoner :effort :wm-only))
        (case-facts (lookup-case-facts case-name :reasoner reasoner 
                                       :response :pattern))
        (case-def-fact (case-definition-fact case-name)))
    (dolist (fact current-case-management-facts)
      (fire:untell fact reasoner (ltre:informant-of fact) :all))
    (dolist (fact case-facts)
      (let ((full-fact (get-full-case-fact-form fact)))
        (fire:untell full-fact reasoner (ltre:informant-of full-fact) :all)))
    (fire:untell case-def-fact reasoner (ltre:informant-of case-def-fact) :all)))


(defgeneric delete-case-from-KB (case-name &key (kb *kb*))
  (:documentation "Removes all facts about case from the KB."))

(defmethod delete-case-from-KB (case-name &key (kb *kb*))
  (forget (make-case-KB-fact case-name '?x) :kb kb :extent :all)
  (forget (case-definition-fact case-name) :kb kb))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Loading
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun case-loaded-fact (case-name)
  (make-case-management-info-fact case-name (list 'data::case-loaded case-name)))


(defun add-case-loaded-fact (casename reason &key (reasoner *reasoner*))
  (fire:tell (case-loaded-fact casename) reasoner reason :all))



(defgeneric load-case-from-KB (case-name &key reasoner)
  (:documentation "Loads the case represented by case-name from the KB into the managed case"))

(defmethod load-case-from-KB (case-name &key (reasoner *reasoner*))
  (gather-dgroup-facts (first case-name) (rest case-name) 
                       (analogy-source-of reasoner))
  (add-case-loaded-fact case-name :kb-load :reasoner reasoner)
  case-name)



(defgeneric load-case-file-to-WM (pathname file-type &key reasoner)
  (:documentation "pathname is a pathname of the file, the file-type does not 
     have a period in it.  This separation is to allow different systems to load different types of files
     as they need (specialize on the file extension). Returns the case-name of the case represented in the file.  
     If there exists no assertion in the file to be loaded of the form:  (isa ?x case) indicating that ?x is a
     case, then no modification to the reasoner will occur and the case-name returned will be nil.  This method is
     not exported.  Use load-case-from file."))


(defun ensure-tagged (case-name)
  (cond ((null case-name) nil)
        ((listp case-name) case-name)
        (t (encase-explicit case-name))))

(defun prepare-fact-for-kb-query (fact)
  (let ((ist-portion (first fact))
        (casename (second fact))
        (ist-fact (third fact)))
    (list ist-portion (prepare-casename-for-KB-query (first casename) (rest casename)) ist-fact)))

(defun rehydrate-sme-pred (arg-list vocab)
  (sme::rehydrate-predicate (first arg-list) vocab (sme::keywordize (third arg-list))
                            (second arg-list) (cdddr arg-list)))
                            
(defun get-dehydrated-case-assertions (file-name)
  (let ((assertions nil))
    (with-open-file (dcf-file file-name :direction :input :if-does-not-exist nil)
      (when dcf-file
        (let ((vocab (sme::create-empty-vocabulary "test"))
              (vocab-empty? t))
          (sme::with-vocabulary vocab
            (do ((line (read-in-package dcf-file nil 'done nil (find-package :data))
                       (read-in-package dcf-file nil 'done nil (find-package :data))))
                ((eq line 'done) 'done)
              (case (first line)
                (sme::rehydratePredicate
                 (progn 
                   (rehydrate-sme-pred (rest line) vocab)
                   (setf vocab-empty? nil)))
                ((data::defdescription sme::defdescription)
                 (progn
                   (setq assertions (nconc assertions (defdescription->assertions line *kb*)))))))
            (if assertions
              (if vocab-empty?
                (values nil assertions)
                (values vocab assertions))
              (values nil nil))))))))

(defun case-vocabulary-fact (case-name vocab)
  `(data::caseSpecialVocabulary ,case-name ,vocab))

(defun add-case-vocabulary-fact (case-name vocab &key (reasoner *reasoner*))
  (fire::tell-it (make-case-management-info-fact case-name (case-vocabulary-fact case-name vocab))
                 :reasoner reasoner))

(defmethod load-case-file-to-WM (pathname (file-extension (eql 'data::dcf)) &key (reasoner *reasoner*))
  (multiple-value-bind (vocab assertions)
      (get-dehydrated-case-assertions (namestring pathname))
    (when assertions
      (let ((case-name (second (find (case-definition-fact 'x) assertions
                                     :test #'(lambda (item list-elem)
                                               (and (equal (first item) (first list-elem))
                                                    (equal (third item) (third list-elem))))))))
        (when case-name
          (when vocab
            (setf (sme::name vocab) (format nil "~A-Vocabulary" case-name))
            (add-case-vocabulary-fact case-name vocab :reasoner reasoner))
          (dolist (fact assertions) (fire:tell (prepare-fact-for-kb-query fact) reasoner :case-file-load :all))
          (add-case-loaded-fact case-name :kb-load :reasoner reasoner))
        
        case-name))))
    
    
(defmethod load-case-file-to-WM (pathname (file-extension t) &key (reasoner *reasoner*))
  (let ((assertions (flat-file->assertions (namestring pathname))))
    (when assertions
      (let ((case-name (second (find (case-definition-fact 'x) assertions
                                     :test #'(lambda (item list-elem)
                                               (and (equal (first item) (first list-elem))
                                                    (equal (third item) (third list-elem))))))))
        (when case-name
          (dolist (fact assertions) (fire:tell (prepare-fact-for-kb-query fact) reasoner :case-file-load :all))
          (add-case-loaded-fact case-name :kb-load :reasoner reasoner))
          
        case-name))))


    

(defgeneric load-case-from-file (file &key reasoner)
  (:documentation "Loads the case represented in file.  This method will call load-case-file which can be specialized
     on a particular file extension type."))

(defmethod load-case-from-file ((file pathname) &key (reasoner *reasoner*))
  (load-case-file-to-WM file (intern (pathname-type file)) :reasoner reasoner))

(defmethod load-case-from-file ((file string) &key (reasoner *reasoner*))
  (load-case-from-file (pathname file) :reasoner reasoner))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Storing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defgeneric case-stored-in-WM? (case-name &key reasoner)
  (:documentation "Returns non-nil if the case exists in the WM of the reasoner"))

(defmethod case-stored-in-WM? (case-name &key (reasoner *reasoner*))
  (case-loaded-in-WM? case-name :reasoner reasoner))

(defgeneric case-stored-in-KB? (case-name &key reasoner)
  (:documentation "Returns non-nil if the case has already been stored in the KB"))

(defmethod case-stored-in-KB? (case-name &key (reasoner *reasoner*))
  (declare (ignore reasoner))
  (retrieve (case-definition-fact case-name)))



(defgeneric store-case-in-KB (case-name &key reasoner kb)
  (:documentation "Stores a case in the KB.  Any new? statements or entities will be marked old.
      Any case with the same name as the current case already in the KB will be deleted first."))

(defmethod store-case-in-KB (case-name &key (reasoner *reasoner*) (kb *kb*))
  (when (case-stored-in-KB? case-name :reasoner reasoner)
    (delete-case-from-KB case-name :kb kb))
  
  (dolist (expr (case-expressions case-name :reasoner reasoner
                                  :filter #'(lambda (expr) (and (not (case-fact-rejected? expr))
                                                                (not (case-fact-invalid? expr))))))
    (store-no-testing (make-case-KB-fact case-name expr) kb))
  (store-no-testing (case-definition-fact (prepare-casename-for-KB-query (first case-name)
                                                                         (rest case-name)))
                    kb))
  

              
(defmethod save-case-to-flat-file (case-name file &key (reasoner *reasoner*))
  (declare (ignore reasoner))
  (let ((individuals-to-save (case-individuals case-name :filter #'(lambda (indv) 
                                                                     (and (not (case-fact-rejected? indv))
                                                                          (not (case-fact-invalid? indv))))))
        (expressions-to-save (case-expressions case-name :filter #'(lambda (expr) 
                                                                (and (not (case-fact-rejected? expr))
                                                                     (not (case-fact-invalid? expr))))))
        (case-name-string (format nil "~A" case-name)))
  (with-open-file (str file :direction :output :if-exists :supersede)
    (format str "(sme:defdescription ~A~% entities ~A~% expressions ~A~%)~%" case-name-string
        individuals-to-save expressions-to-save))))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copying
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defmethod copy-case-in-WM (case-name new-casename &key (reasoner *reasoner*))
  (let ((case-facts (lookup-case-facts case-name :reasoner reasoner))
        (case-meta-facts (current-case-fact-marks :case-name case-name :reasoner reasoner)))
    (dolist (fact case-facts) (fire:tell (make-case-KB-fact new-casename fact) reasoner :case-copied :all))
    (dolist (fact case-meta-facts) 
      (unless (equal fact (case-loaded-fact case-name))
        (fire:tell (make-case-management-info-fact new-casename fact)
              reasoner :case-copied :all)))
    (fire:tell (case-loaded-fact new-casename) reasoner :case-copied :all)))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Editing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun case-fact-in-case? (case-name fact &key (reasoner *reasoner*))
  (fire::ask-it (make-case-KB-fact case-name fact) :effort :wm-only :reasoner reasoner))

(defun add-case-fact (case-name fact &key (reasoner *reasoner*))
  (unless (case-fact-in-case? case-name fact :reasoner reasoner)
    (fire:tell (make-case-KB-fact case-name fact) reasoner :user-created-fact :all)))

(defun delete-case-fact (case-name fact &key (reasoner *reasoner*) (purge? nil))
  ;; if purge? is true it will REALLY delete the fact (ie untell it). Otherwise it will 
  ;;  simply mark the fact as deleted
  (if purge?
    (let* ((case-fact (make-case-KB-fact case-name fact))
           (full-fact (get-full-case-fact-form case-fact)))
      ;; When you purge facts - you need to also remove the 'deleted mark
      (unmark-case-fact fact 'data::deleted :case-name case-name :reasoner reasoner)
      (fire:untell full-fact reasoner (ltre:informant-of full-fact) :all))
    (mark-case-fact fact 'data::deleted :case-name case-name :reasoner reasoner)))

(defun undelete-case-fact (case-name fact &key (reasoner *reasoner*))
  (unmark-case-fact fact 'data::deleted :case-name case-name :reasoner reasoner))

(defun currently-deleted-case-facts (case-name &key (reasoner *reasoner*) (retrieve-all? t) (deletion-list nil))
  "If retrieve-all? is true - all currently deleted facts in the working memory.  Otherwise it 
    returns the currently deleted facts in deletion-list"
  (if retrieve-all?
    (fire:ask-it (make-case-management-info-fact case-name (list 'data::deleted '?fact)) :reasoner reasoner  
                 :response '?fact :effort :wm-only)
    (remove-if-not #'(lambda (datum)
                       (case-fact-deleted? datum
                                           :case-name case-name
                                           :reasoner reasoner))
                   deletion-list)))


(defun select-case-fact (case-name fact &key (reasoner *reasoner*))
  (mark-case-fact fact 'data::selected :case-name case-name :reasoner reasoner))

(defun deselect-case-fact (case-name fact &key (reasoner *reasoner*))
  (unmark-case-fact fact 'data::selected :case-name case-name :reasoner reasoner))

(defun currently-selected-case-facts (case-name &key (reasoner *reasoner*) (retrieve-all? t) (selection-list nil))
  "If retrieve-all? is true - all currently selected facts in the working memory.  Otherwise it 
    returns the currently selected facts in selection-list"
  (if retrieve-all?
    (fire:ask-it (make-case-management-info-fact case-name (list 'data::selected '?fact)) :reasoner reasoner  
                 :response '?fact :effort :wm-only)
    (remove-if-not #'(lambda (datum)
                       (case-fact-selected? datum
                                            :case-name case-name
                                            :reasoner reasoner))
                   selection-list)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Viewing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;







;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Case Library Methods
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; library will always be a NAT describing the library


(defun case-library-definition-fact (library)
  "Returns the form of the fact defining a case library"
  (if (mixed-case?)
    `(data::isa ,library data::CaseLibrary)
    `(data::case-library ,library)))

(defun encase-explicit-caselibrary (library)
  (if (mixed-case?)
    `(data::CaseLibraryFn ,library)
    `(data::case-library-fn ,library)))

;;;; Case Library Library methods

(defun list-current-case-libraries (&key (reasoner fire::*reasoner*))
  "Returns a list of all the case libraries that currently exist"
  (fire:ask-it (case-library-definition-fact 'data::?x) :reasoner reasoner :response 'data::?x))

(defmethod case-library-in-WM? (library &key (reasoner *reasoner*))
  "Returns true if there exists a case-library named library in the WM already"
  (ask-it (case-library-definition-fact library) :reasoner reasoner :effort :wm-only))


(defmethod case-library-in-KB? (library &key (reasoner *reasoner*))
  "Returns true if there exists a case-library named library in the KB already"
  (declare (ignore reasoner))
  (retrieve (case-library-definition-fact library)))

;;;
;;; FIRE has a new function of the same name as this and it handles the metadata
;;; correctly, so we'll just retire this one. (JMU 1/14/2004)
;;;
;;;(defun create-case-library (library &key (reasoner fire::*reasoner*))
;;;  "Asserts a case library definition fact to the WM - to store to kb see store-case-library-in-KB"
;;;  (tell-it (case-library-definition-fact library) :reasoner reasoner))
;;;

(defmethod store-case-library-in-KB (library &key (reasoner fire::*reasoner*) (kb fire:*kb*))
  "Stores the library into the KB"
  (unless (case-library-in-KB? library :reasoner reasoner)
    (store-no-testing (case-library-definition-fact library) kb)))

(defmethod delete-case-library-from-WM (library &key (reasoner fire::*reasoner*))
  "Removes the case library library from the WM.  When you do this it also removes every 
    element-of statment for each case that was part of that case library"
  (when (case-library-in-WM? library :reasoner reasoner)
    (let ((full-fact (get-full-case-fact-form (case-library-definition-fact library))))
      (untell full-fact reasoner (ltre:informant-of full-fact) :all)
      (dolist (case (get-library-cases library :reasoner reasoner))
        (delete-case-library-case-from-WM case library :reasoner reasoner)))))

(defmethod delete-case-library-from-KB (library &key (reasoner fire::*reasoner*) (kb fire:*kb*))
  "Removes the case library library from the KB.  When you do this it also removes every 
    element-of statment for each case that was part of that case library"
  (when (case-library-in-KB? library :reasoner reasoner)
    (forget (case-library-definition-fact library) :kb kb)
    (dolist (case (get-library-cases library :reasoner reasoner))
      (delete-case-library-case-from-KB case library :reasoner reasoner :kb kb))))


;;;; Case Library Cases methods

(defun get-library-cases (library &key (reasoner fire::*reasoner*))
  "Returns all cases in the library library"
  (when (consp library)
    (let* ((type (first library))
           (specs (rest library)))
      (mapcar #'ensure-tagged 
        (gather-case-library-contents type specs (first (sources reasoner)))))))

(defun get-all-library-cases (libraries-list &key (reasoner fire::*reasoner*))
  "Returns an assoc list where the key is the library (always a NAT) from libraries-list
    and a the value is a list of all the cases in that library"
  (mapcar #'(lambda (library)
              (list library (get-library-cases library :reasoner reasoner)))
    libraries-list))



(defun case-library-member? (case-name library &key (reasoner fire::*reasoner*))
  "Returns true if case-name is an element of the set of cases in the case library library"
  (fire::ask-it (fire::make-element-statement case-name library) :reasoner reasoner))

(defun add-case-library-case (case-name library &key (reasoner fire::*reasoner*))
  "Asserts an element-of statement to the WM indicating case-name is now part of the case library library
     if the case-name isn't already part of the library"
  (unless (case-library-member? case-name library :reasoner reasoner)
    (fire::tell-it (fire::make-element-statement case-name library) :reasoner reasoner)))

(defmethod case-library-case-in-WM? (case-name library &key (reasoner *reasoner*))
  "Returns true if it is stored in the WM that case-name is an element-of the case library library"
  (ask-it (fire::make-element-statement case-name library)
          :reasoner reasoner
          :effort :wm-only))

(defmethod case-library-case-in-KB? (case-name library &key (reasoner *reasoner*))
  "Returns true if it is stored in the KB that case-name is an element-of the case library library"
  (declare (ignore reasoner))
  (retrieve (fire::make-element-statement case-name library)))

(defmethod store-case-library-case-in-KB (case-name library &key (reasoner fire::*reasoner*) (kb fire:*kb*))
  "Stores the element-of statement indicating that case-name is part of library to the KB"
  (unless (case-library-case-in-KB? case-name library :reasoner reasoner)
    (store-no-testing (fire::make-element-statement case-name library) kb)))

(defmethod delete-case-library-case-from-WM (case-name library &key (reasoner fire::*reasoner*))
  "Removes the statement that case-name was part of the case library from the WM"
  (when (case-library-case-in-WM? case-name library :reasoner reasoner)
    (let ((full-fact (get-full-case-fact-form (fire::make-element-statement case-name library))))
      (untell full-fact reasoner (ltre:informant-of full-fact) :all))))


(defmethod delete-case-library-case-from-KB (case-name library &key (reasoner fire::*reasoner*) (kb fire:*kb*))
  "Removes the statement that case-name was part of the case library from the KB"
  (when (case-library-case-in-KB? case-name library :reasoner reasoner)
    (forget (fire::make-element-statement case-name library) :kb kb)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; CASE TESTING
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defparameter *test-case-management-kb-name* "qrg-darpa")
(defparameter *test-case-management-kb-path* (get-path :subdirs '("fire" "kbs" "qrg-darpa")))
(defparameter *test-case-management-case-pathname* (get-fire-path :subdirs '("case-manager" "tests")
                                                                  :filename "sample1"
                                                                  :filetype "dgr"))


(defun test-case-management ()
  (open-or-create-kb :kb-path (namestring *test-case-management-kb-path*) :kb-name *test-case-management-kb-name*)
  (let ((reas (make-reasoner "Case Manager Case")))
    (add-analogy-source reas)))

(defun test-case-management-kb-load (&optional (case-name 'data::base-10))
  (in-current-managed-case case-name)
  (load-case-from-KB case-name))


(defun test-case-management-file-load (&optional (filename *test-case-management-case-pathname*))
  (let ((case-name (load-case-from-file filename :reasoner *reasoner*)))
    (in-current-managed-case case-name)
    case-name))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; End of Code