From cb4adaa03bcf4bb2848eac200d1c51d01a24a8ba Mon Sep 17 00:00:00 2001
From: "Thomas M. DuBuisson" <tommd@musedev.io>
Date: Sat, 8 Feb 2020 22:02:30 -0800
Subject: [PATCH] Show that index creation is broken badly

---
 mongoDB.cabal     |  1 +
 test/IndexSpec.hs | 30 ++++++++++++++++++++++++++++++
 2 files changed, 31 insertions(+)
 create mode 100644 test/IndexSpec.hs

diff --git a/mongoDB.cabal b/mongoDB.cabal
index 6c42d91..376985c 100644
--- a/mongoDB.cabal
+++ b/mongoDB.cabal
@@ -89,6 +89,7 @@ test-suite test
   main-is: Main.hs
   other-modules:    Spec
                   , QuerySpec
+                  , IndexSpec
                   , TestImport
   ghc-options:       -Wall -with-rtsopts "-K64m"
   type: exitcode-stdio-1.0
diff --git a/test/IndexSpec.hs b/test/IndexSpec.hs
new file mode 100644
index 0000000..7c59c0f
--- /dev/null
+++ b/test/IndexSpec.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules, ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+
+module IndexSpec (spec) where
+
+import TestImport
+import System.Environment (getEnv)
+import System.IO.Error (catchIOError)
+
+testDBName :: Database
+testDBName = "mongodb-haskell-test"
+
+db :: Action IO a -> IO a
+db action = do
+    mongodbHost <- getEnv mongodbHostEnvVariable `catchIOError` (\_ -> return "localhost")
+    pipe <- connect (host mongodbHost)
+    result <- access pipe master testDBName action
+    close pipe
+    return result
+
+withCleanDatabase :: ActionWith () -> IO ()
+withCleanDatabase action = dropDB >> action () >> dropDB >> return ()
+  where
+    dropDB = db $ dropDatabase testDBName
+
+spec :: Spec
+spec = around withCleanDatabase $ do
+  describe "make index" $ do
+    it "single row index" $ do
+      db (createIndex (index "thiscollection" ["field" =: (1::Int)]) >> getIndexes "thiscollection") `shouldReturn` [["field" =: (1::Int)]]