diff --git a/driver/collection.lisp b/driver/collection.lisp index 13ab7ed..7d19f54 100644 --- a/driver/collection.lisp +++ b/driver/collection.lisp @@ -10,6 +10,7 @@ (defclass collection () ((database :initarg :database :reader collection-database) (name :initarg :name :reader collection-name) + (indexes :initform nil :accessor collection-indexes) (fullname :reader fullname))) (defun collection (database name) diff --git a/driver/indexes.lisp b/driver/indexes.lisp index aa1df17..3201cee 100644 --- a/driver/indexes.lisp +++ b/driver/indexes.lisp @@ -7,12 +7,50 @@ (in-package #:mongo-cl-driver) -;; TODO -;; -;; createIndex -;; ensureIndex -;; dropIndex -;; reIndex -;; indexInformation -;; indexes +(defun make-name (keys) + (format nil "~{~A_~A~^_~}" (hash-table-plist keys))) +(defun index-collection (collection) + (collection (collection-database collection) + "system.indexes")) + +(defun create-index (collection keys &optional (options (son))) + (let ((index (copy-hash-table options)) + (index-collection (index-collection collection)) + (name (make-name keys))) + (setf (gethash "key" index) keys + (gethash "ns" index) (fullname collection) + (gethash "name" index) (gethash "name" index name)) + (pushnew name (collection-indexes collection) :test #'equal) + (insert-op index-collection index))) + +(defun ensure-index (collection keys &optional (options (son))) + (unless (find (make-name keys) + (collection-indexes collection) + :test #'equal) + (create-index collection keys options))) + +(defun drop-indexes (collection &optional (name "*")) + (setf (collection-indexes collection) nil) + (let ((cmd (son "dropIndexes" (collection-name collection) + "index" name))) + (maybe-finished + (alet ((reply (run-command (collection-database collection) cmd))) + (case (truncate (gethash "ok" reply)) + (0 (values nil (gethash "errmsg" reply))) + (1 t)))))) + +(defun reindex (collection) + (let ((cmd (son "reIndex" (collection-name collection)))) + (maybe-finished + (alet ((reply (run-command (collection-database collection) cmd))) + reply)))) + +(defun index-information (collection name) + (find-one (index-collection collection) + :query (son "ns" (fullname collection) + "name" name))) + +(defun indexes (collection) + (find-list (index-collection collection) + :query (son "ns" (fullname collection)))) diff --git a/driver/packages.lisp b/driver/packages.lisp index fc1fd71..89bce2b 100644 --- a/driver/packages.lisp +++ b/driver/packages.lisp @@ -81,4 +81,12 @@ #:iterate-cursor #:docursor #:with-cursor + + ;; indexes + #:create-index + #:ensure-index + #:drop-indexes + #:reindex + #:index-information + #:indexes ))