Merge fix for ghc-8.4

Author: VictorDenisov

.travis.yml

@@ -11,18 +11,15 @@ env:
  #- GHCVER=7.8.4  CABALVER=1.22  MONGO=2.6.12
  #- GHCVER=7.10.3 CABALVER=1.22  MONGO=2.6.12
  #- GHCVER=8.0.2 CABALVER=1.24  MONGO=2.6.12
- - GHCVER=7.8.4  CABALVER=1.22  MONGO=3.0
- - GHCVER=7.10.3 CABALVER=1.22  MONGO=3.0
- - GHCVER=8.0.2 CABALVER=1.24  MONGO=3.0
- - GHCVER=7.8.4  CABALVER=1.22  MONGO=3.2
- - GHCVER=7.10.3 CABALVER=1.22  MONGO=3.2
- - GHCVER=8.0.2 CABALVER=1.24  MONGO=3.2
- - GHCVER=7.8.4  CABALVER=1.22  MONGO=3.4
- - GHCVER=7.10.3 CABALVER=1.22  MONGO=3.4
- - GHCVER=8.0.2 CABALVER=1.24  MONGO=3.4
- - GHCVER=7.8.4  CABALVER=1.22  MONGO=3.6
- - GHCVER=7.10.3 CABALVER=1.22  MONGO=3.6
- - GHCVER=8.0.2 CABALVER=1.24  MONGO=3.6
+ - GHCVER=8.4.2 CABALVER=2.2  MONGO=3.6 STACKAGE=nightly
+ - GHCVER=8.2.2 CABALVER=1.24  MONGO=3.6 STACKAGE=lts-11.6
+ - GHCVER=8.0.2 CABALVER=1.24  MONGO=3.6 STACKAGE=lts-9.21
+ - GHCVER=8.2.2 CABALVER=1.24  MONGO=3.0 STACKAGE=lts-11.6
+ - GHCVER=8.0.2 CABALVER=1.24  MONGO=3.0 STACKAGE=lts-9.21
+ - GHCVER=8.2.2 CABALVER=1.24  MONGO=3.4 STACKAGE=lts-11.6
+ - GHCVER=8.0.2 CABALVER=1.24  MONGO=3.4 STACKAGE=lts-9.21
+ - GHCVER=8.2.2 CABALVER=1.24  MONGO=3.2 STACKAGE=lts-11.6
+ - GHCVER=8.0.2 CABALVER=1.24  MONGO=3.2 STACKAGE=lts-9.21
 
 before_install:
 
@@ -56,6 +53,9 @@ install:
  # Install the combined dependencies for this package and all other packages
  # needed to reduce conflicts.
  - cabal sandbox init
+ - wget https://www.stackage.org/$STACKAGE/cabal.config
+ - sed -e '/mongoDB/d' cabal.config > cabal.config.new
+ - mv cabal.config.new cabal.config
  - cabal install --only-dependencies --enable-tests --enable-benchmarks
 
 script:

CHANGELOG.md

@@ -2,6 +2,11 @@
 All notable changes to this project will be documented in this file.
 This project adheres to [Package Versioning Policy](https://wiki.haskell.org/Package_versioning_policy).
 
+## [Unreleased]
+
+### Fixed
+- GHC 8.4 compatibility. isEmptyChan is not available in base 4.11 anymore.
+
 ## [2.3.0.5] - 2018-03-15
 
 ### Fixed

Database/MongoDB/Internal/Protocol.hs

@@ -47,8 +47,9 @@ import System.IO.Unsafe (unsafePerformIO)
 import Data.Maybe (maybeToList)
 import GHC.Conc (ThreadStatus(..), threadStatus)
 import Control.Monad (forever)
-import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan, isEmptyChan)
+import Control.Monad.STM (atomically)
 import Control.Concurrent (ThreadId, killThread, forkFinally)
+import Control.Concurrent.STM.TChan (TChan, newTChan, readTChan, writeTChan, isEmptyTChan)
 
 import Control.Exception.Lifted (onException, throwIO, try)
 
@@ -87,7 +88,7 @@ mkWeakMVar = addMVarFinalizer
 -- | Thread-safe and pipelined connection
 data Pipeline = Pipeline
     { vStream :: MVar Transport -- ^ Mutex on handle, so only one thread at a time can write to it
-    , responseQueue :: Chan (MVar (Either IOError Response)) -- ^ Queue of threads waiting for responses. Every time a response arrive we pop the next thread and give it the response.
+    , responseQueue :: TChan (MVar (Either IOError Response)) -- ^ Queue of threads waiting for responses. Every time a response arrive we pop the next thread and give it the response.
     , listenThread :: ThreadId
     , finished :: MVar ()
     , serverData :: ServerData
@@ -106,14 +107,14 @@ data ServerData = ServerData
 newPipeline :: ServerData -> Transport -> IO Pipeline
 newPipeline serverData stream = do
     vStream <- newMVar stream
-    responseQueue <- newChan
+    responseQueue <- atomically newTChan
     finished <- newEmptyMVar
     let drainReplies = do
-          chanEmpty <- isEmptyChan responseQueue
+          chanEmpty <- atomically $ isEmptyTChan responseQueue
           if chanEmpty
             then return ()
             else do
-              var <- readChan responseQueue
+              var <- atomically $ readTChan responseQueue
               putMVar var $ Left $ mkIOError
                                         doesNotExistErrorType
                                         "Handle has been closed"
@@ -159,7 +160,7 @@ listen Pipeline{..} = do
     stream <- readMVar vStream
     forever $ do
         e <- try $ readMessage stream
-        var <- readChan responseQueue
+        var <- atomically $ readTChan responseQueue
         putMVar var e
         case e of
             Left err -> Tr.close stream >> ioError err  -- close and stop looping
@@ -182,7 +183,7 @@ pcall p@Pipeline{..} message = do
     doCall stream = do
         writeMessage stream message
         var <- newEmptyMVar
-        liftIO $ writeChan responseQueue var
+        liftIO $ atomically $ writeTChan responseQueue var
         return $ readMVar var >>= either throwIO return -- return promise
 
 -- * Pipe

mongoDB.cabal

@@ -42,8 +42,9 @@ Library
                     , monad-control >= 0.3.1
                     , lifted-base >= 0.1.0.3
                     , pureMD5
+                    , stm
                     , tagged
-                    , tls >= 1.2.0
+                    , tls >= 1.3.0
                     , time
                     , data-default-class -any
                     , transformers
@@ -106,6 +107,7 @@ Benchmark bench
                     , cryptohash -any
                     , network -any
                     , nonce >= 1.0.5
+                    , stm
                     , parsec -any
                     , random -any
                     , random-shuffle -any