From 62cbe389288e4a0ed70b5d98e20b533f533746f7 Mon Sep 17 00:00:00 2001
From: Alexander Suhoverhov <cy@ngs.ru>
Date: Mon, 16 Sep 2013 18:29:26 +0400
Subject: [PATCH 1/2] Implementing indexes

---
 driver/indexes.lisp  | 50 +++++++++++++++++++++++++++++++++++++-------
 driver/packages.lisp |  8 +++++++
 2 files changed, 50 insertions(+), 8 deletions(-)

diff --git a/driver/indexes.lisp b/driver/indexes.lisp
index aa1df17..63964f4 100644
--- a/driver/indexes.lisp
+++ b/driver/indexes.lisp
@@ -7,12 +7,46 @@
 
 (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))
+    (insert-op index-collection index)))
+
+(defun ensure-index (collection keys &optional (options (son)))
+  ;; Should be cached
+  (create-index collection keys options))
+
+(defun drop-indexes (collection &optional (name "*"))
+  (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
            ))

From c3181450977fbe17068b433c098662cbde32cdab Mon Sep 17 00:00:00 2001
From: Alexander Suhoverhov <cy@ngs.ru>
Date: Thu, 26 Sep 2013 18:30:14 +0400
Subject: [PATCH 2/2] Implement ensure-index properly

---
 driver/collection.lisp | 1 +
 driver/indexes.lisp    | 8 ++++++--
 2 files changed, 7 insertions(+), 2 deletions(-)

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 63964f4..3201cee 100644
--- a/driver/indexes.lisp
+++ b/driver/indexes.lisp
@@ -21,13 +21,17 @@
     (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)))
-  ;; Should be cached
-  (create-index collection keys options))
+  (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