Merge fix for ghc-8.4
This commit is contained in:
commit
7d23189fdd
4 changed files with 28 additions and 20 deletions
24
.travis.yml
24
.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:
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue