Merge pull request #6 from naryl/indexes

Indexes

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)

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))))

driver/packages.lisp

@@ -81,4 +81,12 @@
            #:iterate-cursor
            #:docursor
            #:with-cursor
+
+           ;; indexes
+           #:create-index
+           #:ensure-index
+           #:drop-indexes
+           #:reindex
+           #:index-information
+           #:indexes
            ))