8f8f8cb · distributed-process

git.iko.soy/distributed-process

Use throwIO instead of throw

commit8f8f8cb8a4e197cabed2d6c9b4c208d1da59c22f authorEdsko de Vries <edsko@edsko.net> dateWed 23 May 2012, 09:23 (14 years ago) parentb4da726

7 files changed+33−30

compare with master

unifiedsplit

network-transport/src/Network/Transport/Chan.hs+3−3 network-transport/src/Network/Transport/Internal.hs+2−2 network-transport/src/Network/Transport/Internal/TCP.hs+4−4 network-transport/src/Network/Transport/TCP.hs+14−10 network-transport/tests/TestTCP.hs+6−6 network-transport/tests/TestTransport.hs−1 network-transport/tests/Traced.hs+4−4

network-transport/src/Network/Transport/Chan.hs+3−3

@@ -6,7 +6,7 @@ import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)

66import Control.Applicative ((<$>))

77import Control.Category ((>>>))

88import Control.Concurrent.MVar (MVar, newMVar, modifyMVar, modifyMVar_, readMVar)

9−import Control.Exception (throw)

9+import Control.Exception (throwIO)

1010import Control.Monad (forM_, when)

1111import Data.Map (Map)

1212import qualified Data.Map as Map (empty, insert, size, delete, findWithDefault)

@@ -34,7 +34,7 @@ createTransport = do

3434 , _multigroups = Map.empty

3535 }

3636 return Transport { newEndPoint = apiNewEndPoint state

37− , closeTransport = throw (userError "closeEndPoint not implemented")

37+ , closeTransport = throwIO (userError "closeEndPoint not implemented")

3838 }

3939

4040-- | Create a new end point

@@ -47,7 +47,7 @@ apiNewEndPoint state = do

4747 return . Right $ EndPoint { receive = readChan chan

4848 , address = addr

4949 , connect = apiConnect addr state

50− , closeEndPoint = throw (userError "closeEndPoint not implemented")

50+ , closeEndPoint = throwIO (userError "closeEndPoint not implemented")

5151 , newMulticastGroup = apiNewMulticastGroup state addr

5252 , resolveMulticastGroup = apiResolveMulticastGroup state addr

5353 }

network-transport/src/Network/Transport/Internal.hs+2−2

@@ -22,7 +22,7 @@ import Data.ByteString (ByteString)

2222import qualified Data.ByteString as BS (length)

2323import qualified Data.ByteString.Internal as BSI (unsafeCreate, toForeignPtr, inlinePerformIO)

2424import Control.Monad.IO.Class (MonadIO, liftIO)

25−import Control.Exception (IOException, Exception, catch, try, throw)

25+import Control.Exception (IOException, Exception, catch, try, throwIO)

2626--import Control.Concurrent (myThreadId)

2727

2828foreign import ccall unsafe "htonl" htonl :: CInt -> CInt

@@ -66,7 +66,7 @@ prependLength bss = encodeInt32 (sum . map BS.length $ bss) : bss

6666

6767-- | Translate exceptions that arise in IO computations

6868mapExceptionIO :: (Exception e1, Exception e2) => (e1 -> e2) -> IO a -> IO a

69−mapExceptionIO f p = catch p (throw . f)

69+mapExceptionIO f p = catch p (throwIO . f)

7070

7171-- | Like 'try', but lifted and specialized to IOExceptions

7272tryIO :: MonadIO m => IO a -> m (Either IOException a)

network-transport/src/Network/Transport/Internal/TCP.hs+4−4

@@ -27,7 +27,7 @@ import qualified Network.Socket as N ( HostName

2727import qualified Network.Socket.ByteString as NBS (recv)

2828import Control.Concurrent (ThreadId, forkIOWithUnmask)

2929import Control.Monad (liftM, forever)

30−import Control.Exception (SomeException, catch, bracketOnError, throw, mask_)

30+import Control.Exception (SomeException, catch, bracketOnError, throwIO, mask_)

3131import Data.ByteString (ByteString)

3232import qualified Data.ByteString as BS (length, concat, null)

3333import Data.Int (Int32)

@@ -84,7 +84,7 @@ recvInt32 :: Num a => N.Socket -> IO a

8484recvInt32 sock = do

8585 mi <- liftM (decodeInt32 . BS.concat) $ recvExact sock 4

8686 case mi of

87− Nothing -> throw (userError "Invalid integer")

87+ Nothing -> throwIO (userError "Invalid integer")

8888 Just i -> return i

8989

9090-- | Read an exact number of bytes from a socket

@@ -94,7 +94,7 @@ recvInt32 sock = do

9494recvExact :: N.Socket -- ^ Socket to read from

9595 -> Int32 -- ^ Number of bytes to read

9696 -> IO [ByteString]

97−recvExact _ len | len <= 0 = throw (userError "Negative length")

97+recvExact _ len | len <= 0 = throwIO (userError "Negative length")

9898recvExact sock len = go [] len

9999 where

100100 go :: [ByteString] -> Int32 -> IO [ByteString]

@@ -102,5 +102,5 @@ recvExact sock len = go [] len

102102 go acc l = do

103103 bs <- NBS.recv sock (fromIntegral l `min` 4096)

104104 if BS.null bs

105− then throw (userError "Socket closed")

105+ then throwIO (userError "Socket closed")

106106 else go (bs : acc) (l - fromIntegral (BS.length bs))

network-transport/src/Network/Transport/TCP.hs+14−10

@@ -80,7 +80,7 @@ import Control.Monad.Error (ErrorT(..), runErrorT)

8080import Control.Exception ( IOException

8181 , SomeException

8282 , handle

83− , throw

83+ , throwIO

8484 , try

8585 , bracketOnError

8686 , mask

@@ -475,6 +475,10 @@ apiClose (ourEndPoint, theirEndPoint) connId connAlive = void . tryIO $ do

475475-- GUARANTEE: The state of the remote endpoint will not be changed.

476476apiSend :: EndPointPair -> ConnectionId -> IORef Bool -> [ByteString] -> IO (Either (TransportError SendErrorCode) ())

477477apiSend (ourEndPoint, theirEndPoint) connId connAlive payload =

478+ -- The 'join' joins the inner exception that we explicitly return) for

479+ -- instance if the connection is closed) with the outer exception (which is

480+ -- returned by 'try' when an exception is thrown by 'sendOn', and handled

481+ -- by 'withRemoteState')

478482 join <$> (try . mapExceptionIO sendFailed $ withRemoteState (ourEndPoint, theirEndPoint)

479483 -- RemoteEndPointInvalid

480484 (\_ -> fail "apiSend RELY violation")

@@ -636,7 +640,7 @@ createLocalEndPoint transport = do

636640 }

637641 return (TransportValid . (localEndPointAt addr ^= Just localEndPoint) . (nextEndPointId ^= ix + 1) $ vst, localEndPoint)

638642 TransportClosed ->

639− throw (TransportError NewEndPointFailed "Transport closed")

643+ throwIO (TransportError NewEndPointFailed "Transport closed")

640644

641645-- | Request a connection to a remote endpoint

642646--

@@ -676,7 +680,7 @@ requestConnectionTo ourEndPoint theirAddress = go

676680 -- won't matter.

677681 case endPointStateSnapshot of

678682 RemoteEndPointInvalid err ->

679− throw err

683+ throwIO err

680684

681685 RemoteEndPointClosing resolved _ ->

682686 -- If the remote endpoint is closing, then we need to block until

@@ -700,7 +704,7 @@ requestConnectionTo ourEndPoint theirAddress = go

700704 reply <- mapExceptionIO connectFailed $ doRemoteRequest (ourEndPoint, theirEndPoint) RequestConnectionId

701705 case decodeInt32 . BS.concat $ reply of

702706 Nothing ->

703− throw (connectFailed $ userError "Invalid integer")

707+ throwIO (connectFailed $ userError "Invalid integer")

704708 Just cid ->

705709 return (theirEndPoint, cid)

706710

@@ -712,7 +716,7 @@ requestConnectionTo ourEndPoint theirAddress = go

712716 findTheirEndPoint = do

713717 (theirEndPoint, isNew) <- modifyMVar ourState $ \st -> case st of

714718 LocalEndPointClosed ->

715− throw (TransportError ConnectFailed "Local endpoint closed")

719+ throwIO (TransportError ConnectFailed "Local endpoint closed")

716720 LocalEndPointValid vst ->

717721 case vst ^. localConnectionTo theirAddress of

718722 Just theirEndPoint ->

@@ -809,7 +813,7 @@ socketToEndPoint :: EndPointAddress -- ^ Our address

809813 -> IO (Either (TransportError ConnectErrorCode) (N.Socket, ConnectionRequestResponse))

810814socketToEndPoint (EndPointAddress ourAddress) theirAddress = try $ do

811815 (host, port, theirEndPointId) <- case decodeEndPointAddress theirAddress of

812− Nothing -> throw (failed . userError $ "Could not parse")

816+ Nothing -> throwIO (failed . userError $ "Could not parse")

813817 Just dec -> return dec

814818 addr:_ <- mapExceptionIO invalidAddress $ N.getAddrInfo Nothing (Just host) (Just port)

815819 bracketOnError (createSocket addr) N.sClose $ \sock -> do

@@ -819,7 +823,7 @@ socketToEndPoint (EndPointAddress ourAddress) theirAddress = try $ do

819823 sendMany sock (encodeInt32 theirEndPointId : prependLength [ourAddress])

820824 recvInt32 sock

821825 case tryToEnum response of

822− Nothing -> throw (failed . userError $ "Unexpected response")

826+ Nothing -> throwIO (failed . userError $ "Unexpected response")

823827 Just r -> return (sock, r)

824828 where

825829 createSocket :: N.AddrInfo -> IO N.Socket

@@ -892,7 +896,7 @@ doRemoteRequest (ourEndPoint, theirEndPoint) header = do

892896 let reqId = vst ^. nextCtrlRequestId

893897 return (LocalEndPointValid . (nextCtrlRequestId ^: (+ 1)) . (pendingCtrlRequestsAt reqId ^= Just reply) $ vst, reqId)

894898 LocalEndPointClosed ->

895− throw (userError "Local endpoint closed")

899+ throwIO (userError "Local endpoint closed")

896900 withRemoteState (ourEndPoint, theirEndPoint)

897901 -- RemoteEndPointInvalid

898902 (\_ -> fail "doRemoteRequest RELY violation")

@@ -901,7 +905,7 @@ doRemoteRequest (ourEndPoint, theirEndPoint) header = do

901905 -- RemoteEndPointClosing

902906 (\_ -> fail "doRemoteRequest RELY violation")

903907 -- RemoteEndPointClosed

904− (throw (userError "Remote endpoint closed"))

908+ (throwIO (userError "Remote endpoint closed"))

905909 takeMVar reply

906910

907911-- | Check if the remote endpoint is unused, and if so, send a CloseSocket request

@@ -1012,7 +1016,7 @@ modifyRemoteState (ourEndPoint, theirEndPoint) caseInvalid caseValid caseClosing

10121016 let err = TransportError (EventConnectionLost (remoteAddress theirEndPoint) incoming) (show ex)

10131017 writeChan (localChannel ourEndPoint) $ ErrorEvent err

10141018 -- .. and finally rethrow the exception

1015− throw ex

1019+ throwIO ex

10161020

10171021 -- Returns the set of incoming connections if we closed the connection, or

10181022 -- 'Nothing' if the endpoint was already closed

network-transport/tests/TestTCP.hs+6−6

@@ -24,7 +24,7 @@ import Control.Concurrent.MVar ( MVar

2424 )

2525import Control.Monad (replicateM, guard, forM_, replicateM_, when)

2626import Control.Applicative ((<$>))

27−import Control.Exception (throw, try, SomeException)

27+import Control.Exception (throwIO, try, SomeException)

2828import Network.Transport.TCP ( ControlHeader(..)

2929 , ConnectionRequestResponse(..)

3030 , socketToEndPoint

@@ -135,7 +135,7 @@ testEarlyDisconnect nextPort = do

135135 putMVar clientAddr ourAddress

136136

137137 -- Listen for incoming messages

138− forkServer "127.0.0.1" clientPort 5 throw $ \sock -> do

138+ forkServer "127.0.0.1" clientPort 5 throwIO $ \sock -> do

139139 -- Initial setup

140140 0 <- recvInt32 sock :: IO Int

141141 _ <- recvWithLength sock

@@ -246,7 +246,7 @@ testEarlyCloseSocket nextPort = do

246246 putMVar clientAddr ourAddress

247247

248248 -- Listen for incoming messages

249− forkServer "127.0.0.1" clientPort 5 throw $ \sock -> do

249+ forkServer "127.0.0.1" clientPort 5 throwIO $ \sock -> do

250250 -- Initial setup

251251 0 <- recvInt32 sock :: IO Int

252252 _ <- recvWithLength sock

@@ -509,7 +509,7 @@ testMany nextPort = do

509509 case (ioe_errno ex) of

510510 Just no | Errno no == eADDRNOTAVAIL -> putStrLn "(ADDRNOTAVAIL)"

511511 _ -> return ()

512− throw ex

512+ throwIO ex

513513 Right transport ->

514514 replicateM_ 3 $ do

515515 Right endpoint <- newEndPoint transport

@@ -549,7 +549,7 @@ testReconnect nextPort = do

549549

550550 counter <- newMVar (0 :: Int)

551551

552− forkServer "127.0.0.1" serverPort 5 throw $ \sock -> do

552+ forkServer "127.0.0.1" serverPort 5 throwIO $ \sock -> do

553553 -- Accept the connection

554554 Right 0 <- tryIO $ (recvInt32 sock :: IO Int)

555555 Right _ <- tryIO $ recvWithLength sock

@@ -617,7 +617,7 @@ testUnidirectionalError nextPort = do

617617 serverGotPing <- newEmptyMVar

618618

619619 -- Server

620− forkServer "127.0.0.1" serverPort 5 throw $ \sock -> do

620+ forkServer "127.0.0.1" serverPort 5 throwIO $ \sock -> do

621621 -- We accept connections, but when an exception occurs we don't do

622622 -- anything (in particular, we don't close the socket). This is important

623623 -- because when we shutdown one direction of the socket a recv here will

network-transport/tests/TestTransport.hs−1

@@ -16,7 +16,6 @@ import Data.Map (Map)

1616import qualified Data.Map as Map (empty, insert, delete, findWithDefault, adjust, null, toList, map)

1717import Data.String (fromString)

1818import Traced

19−import Control.Concurrent (threadDelay)

2019

2120-- | We overload connect to always pass the default hints

2221connect :: EndPoint -> EndPointAddress -> Reliability -> IO (Either (TransportError ConnectErrorCode) Connection)

network-transport/tests/Traced.hs+4−4

@@ -52,7 +52,7 @@ module Traced ( MonadS(..)

5252

5353import Prelude hiding ((>>=), return, fail, catch, (>>))

5454import qualified Prelude

55−import Control.Exception (catches, Handler(..), SomeException, throw, Exception(..), IOException)

55+import Control.Exception (catches, Handler(..), SomeException, throwIO, Exception(..), IOException)

5656import Control.Applicative ((<$>))

5757import Data.Typeable (Typeable)

5858import Data.Maybe (catMaybes)

@@ -180,9 +180,9 @@ instance Show TracedException where

180180

181181traceHandlers :: Traceable a => a -> [Handler b]

182182traceHandlers a = case trace a of

183− Nothing -> [ Handler $ \ex -> throw (ex :: SomeException) ]

184− Just t -> [ Handler $ \(TracedException ts ex) -> throw $ TracedException (show t : ts) ex

185− , Handler $ \ex -> throw $ TracedException [show t] (ex :: SomeException)

183+ Nothing -> [ Handler $ \ex -> throwIO (ex :: SomeException) ]

184+ Just t -> [ Handler $ \(TracedException ts ex) -> throwIO $ TracedException (show t : ts) ex

185+ , Handler $ \ex -> throwIO $ TracedException [show t] (ex :: SomeException)

186186 ]

187187

188188-- | Definition of 'ifThenElse' for use with RebindableSyntax