(load "bknr/init.lisp")

(excl:delete-directory-and-files "/tmp/tutorial-store/"
                                 :if-does-not-exist :ignore)
(excl:delete-directory-and-files "/tmp/object-store/"
                                 :if-does-not-exist :ignore)

(asdf:oos 'asdf:load-op :bknr-datastore)
(in-package :bknr.datastore)

;;; BKNR DATASTORE

(defclass tutorial-store (mp-store)
  ((counter :initform 0 :accessor tutorial-store-counter)))

(defmethod restore-store :before ((store tutorial-store) &key until)
  (declare (ignore until))
  (setf (tutorial-store-counter store) 0))

(deftransaction incf-counter ()
  (incf (tutorial-store-counter *store*)))

(deftransaction decf-counter ()
  (decf (tutorial-store-counter *store*)))

(make-instance 'tutorial-store :directory "/tmp/tutorial-store/"
	       :subsystems nil)
*store*

(tutorial-store-counter *store*)
(incf-counter)
(incf-counter)
(decf-counter)

(snapshot)
*store*
(close-store)
*store*

(make-instance 'tutorial-store :directory "/tmp/tutorial-store/"
	       :subsystems nil)
*store*
(tutorial-store-counter *store*)
(incf-counter)

;;; OBJECT DATASTORE

(make-instance 'mp-store :directory "/tmp/object-store/"
	       :subsystems (list
			    (make-instance 'store-object-subsystem)))
(all-store-objects)

(make-object 'store-object)
(make-object 'store-object)
(all-store-objects)
(all-store-classes)
(class-instances 'store-object)

(delete-object (store-object-with-id 1))

(define-persistent-class tutorial-object ()
  ((a :read)))

(make-object 'tutorial-object :a 2)
(make-object 'tutorial-object :a 2)
(make-object 'tutorial-object :a 2)
(store-object-with-id 5)
(all-store-classes)
(class-instances 'tutorial-object)

(setf (slot-value (store-object-with-id 5) 'b) 4)
(change-slot-values (store-object-with-id 5) 'b 4)

(snapshot)
(close-store)
(make-instance 'mp-store :directory "/tmp/object-store/"
	       :subsystems (list
			    (make-instance 'store-object-subsystem)))

;;; BKNR INDICES

(in-package :bknr.indices)

(defclass gorilla ()
  ((name        :initarg :name
		:reader gorilla-name
		:type string)
   (description :initarg :description
		:reader gorilla-description)))

(defmethod print-object ((gorilla gorilla) stream)
  (print-unreadable-object (gorilla stream :type t)
    (format stream "~S" (gorilla-name gorilla))))

(defvar *gorillas* nil)

(setf *gorillas*
      (list
       (make-instance 'gorilla :name "Lucy"
		      :description :aggressive)
       (make-instance 'gorilla :name "Robert"
		      :description :playful)
       (make-instance 'gorilla :name "John"
		      :description :aggressive)))

(defun all-gorillas ()
  (copy-list *gorillas*))

(defun gorilla-with-name (name)
  (find name *gorillas* :test #'string-equal
	:key #'gorilla-name))

(defun gorillas-with-description (description)
  (remove description *gorillas* :test-not #'eql :key
	  #'gorilla-description))

(all-gorillas)
(gorilla-with-name "Lucy")
(gorillas-with-description :aggressive)
(gorilla-with-name "Manuel")

(defclass gorilla ()
  ((name :initarg :name :reader gorilla-name
	 :index-type slot-index
	 :index-initargs (:test #'equal)
	 :index-reader gorilla-with-name
	 :index-values all-gorillas)
   (description :initarg :description
		:reader gorilla-description
		:index-type keyword-index
		:index-reader gorillas-with-description))
  (:metaclass indexed-class))

(make-instance 'gorilla :name "Lucy" :description :aggressive)
(make-instance 'gorilla :name "Robert" :description :playful)
(make-instance 'gorilla :name "John" :description :aggressive)))

(all-gorillas)
(gorilla-with-name "Lucy")
(gorillas-with-description :aggressive)

(defclass gorilla ()
  ((name :initarg :name :reader gorilla-name
	 :index-type slot-index
	 :index-initargs (:test #'equal)
	 :index-reader gorilla-with-name
	 :index-values all-gorillas)
   (description :initarg :description
		:reader gorilla-description
		:index-type keyword-index
		:index-reader gorillas-with-description)
   (x :initarg :x :reader gorilla-x)
   (y :initarg :y :reader gorilla-y))
  (:metaclass indexed-class)
  (:class-indices (coords :index-type array-index
			  :slots (x y)
			  :index-reader gorilla-with-coords
			  :index-initargs (:dimensions '(256 256)))))

(make-instance 'gorilla :name "Pete" :description
	       :playful :x 5 :y 8)

(gorilla-with-coords '(5 8))

(let ((lucy (gorilla-with-name "Lucy")))
  (with-slots (x y) lucy
    (setf x 0 y 0)))

(gorilla-with-coords '(0 0))

;;; Persistent objects with indices

(in-package :bknr.datastore)

(define-persistent-class gibbon ()
  ((name :read :index-type string-slot-index
	 :index-reader gibbon-with-name
	 :index-values all-gibbons)
   (mood :read :index-type keyword-index
	 :index-reader gibbons-with-mood
	 :index-keys all-gibbon-moods)))

(make-object 'gibbon :name "lucy" :mood :aggressive)
(make-object 'gibbon :name "john" :mood :playful)
(make-object 'gibbon :name "peter" :mood :playful)
(gibbon-with-name "lucy")
(gibbons-with-mood :playful)

;;; BKNR XML Import/Export

(asdf:oos 'asdf:load-op :bknr-impex)
(in-package :bknr.impex)

(defclass book ()
  ((author :initarg :author :reader book-author)
   (id :initarg :id :reader book-id :type integer)
   (isbn :initarg :isbn :reader book-isbn)
   (title :initarg :title :reader book-title)))

(defmethod print-object ((book book) stream)
  (print-unreadable-object (book stream :type t :identity t)
    (format stream "~S" (book-title book))))

(defvar *tutorial-dtd*
  (cxml:parse-dtd-file "bknr/src/xml-impex/tutorial.dtd"))

(defclass book ()
  ((author :initarg :author :reader book-author
	   :element "author")
   (id :initarg :id :reader book-id :type integer
       :attribute "id" :parser #'parse-integer)
   (isbn :initarg :isbn :reader book-isbn
	 :attribute "isbn")
   (title :initarg :title :reader book-title
	  :element "title"))
  (:metaclass xml-class)
  (:dtd *tutorial-dtd*)
  (:element "book"))

(parse-xml-file "bknr/src/xml-impex/tutorial.xml" (list (find-class 'book)))
(setf *books*
      (getf (parse-xml-file "bknr/src/xml-impex/tutorial.xml"
			    (list (find-class 'book)))
	    :BOOK))
(write-to-xml *books* :name "books")

(defclass book ()
  ((author :initarg :author :reader book-author
	   :element "author"
	   :index-type keyword-index :index-initargs (:test #'equal)
	   :index-reader books-with-author
	   :index-keys all-authors)
   (id :initarg :id :reader book-id :type integer
       :attribute "id" :parser #'parse-integer
       :index-type slot-index :index-reader book-with-id
       :index-values all-books)
   (isbn :initarg :isbn :reader book-isbn
	 :attribute "isbn"
	 :index-type slot-index :index-initargs (:test #'equal)
	 :index-reader book-with-isbn)
   (title :initarg :title :reader book-title
	  :element "title"))
  (:metaclass xml-class)
  (:dtd *tutorial-dtd*)
  (:element "book"))

(parse-xml-file "bknr/src/xml-impex/tutorial.xml" (list (find-class 'book)))
(all-authors)
(all-books)
(books-with-author (first (all-authors)))
(book-with-id 1)
(write-to-xml *books* :name "books")