Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix for ghc 8.4 #91

Merged
merged 6 commits into from
May 3, 2018
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
24 changes: 12 additions & 12 deletions .travis.yml
Original file line number Diff line number Diff line change
Expand Up @@ -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:

Expand Down Expand Up @@ -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:
Expand Down
5 changes: 5 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
15 changes: 8 additions & 7 deletions Database/MongoDB/Internal/Protocol.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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
Expand All @@ -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"
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
4 changes: 3 additions & 1 deletion mongoDB.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -106,6 +107,7 @@ Benchmark bench
, cryptohash -any
, network -any
, nonce >= 1.0.5
, stm
, parsec -any
, random -any
, random-shuffle -any
Expand Down