From d123460b4077c4d918ece8d7aa83f559c9fd8b79 Mon Sep 17 00:00:00 2001
From: Victor Denisov <denisovenator@gmail.com>
Date: Sun, 22 May 2016 17:38:07 -0700
Subject: [PATCH] Implement insert using command mechanism

---
 Database/MongoDB/Query.hs | 24 ++++++++++++++++++++++--
 1 file changed, 22 insertions(+), 2 deletions(-)

diff --git a/Database/MongoDB/Query.hs b/Database/MongoDB/Query.hs
index c336aa1..2b00e21 100644
--- a/Database/MongoDB/Query.hs
+++ b/Database/MongoDB/Query.hs
@@ -412,8 +412,28 @@ insert' :: (MonadIO m) => [InsertOption] -> Collection -> [Document] -> Action m
 insert' opts col docs = do
     db <- thisDatabase
     docs' <- liftIO $ mapM assignId docs
-    write (Insert (db <.> col) opts docs')
-    return $ map (valueAt "_id") docs'
+
+    p <- asks mongoPipe
+    let sd = P.serverData p
+    if (maxWireVersion sd < 2)
+      then do
+        write (Insert (db <.> col) opts docs')
+        return $ map (valueAt "_id") docs'
+      else do
+        doc <- runCommand $
+          [ "insert" =: col
+          , "ordered" =: (KeepGoing `notElem` opts)
+          , "documents" =: docs'
+          ]
+        liftIO $ putStrLn $ show doc
+        case (look "writeErrors" doc, look "writeConcernError" doc) of
+          (Nothing, Nothing) -> return $ map (valueAt "_id") docs'
+          (Just err, Nothing) -> do
+            liftIO $ throwIO $ WriteFailure (maybe 0 id $ lookup "ok" doc) (show err)
+          (Nothing, Just err) -> do
+            liftIO $ throwIO $ WriteFailure (maybe 0 id $ lookup "ok" doc) (show err)
+          (Just err, Just writeConcernErr) -> do
+            liftIO $ throwIO $ WriteFailure (maybe 0 id $ lookup "ok" doc) (show err ++ show writeConcernErr)
 
 assignId :: Document -> IO Document
 -- ^ Assign a unique value to _id field if missing