mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

catch non-IO exceptions too

Browse source
This commit is contained in:
Joey Hess 2016-12-02 14:16:50 -04:00
parent 881274d021
commit c29f2e262a
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
1 changed files with 4 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

8
P2P/IO.hs
View file

@ -63,14 +63,14 @@ runNetProto runenv = go
runNet :: (MonadIO m, MonadMask m) => RunEnv -> RunProto m -> NetF (Proto a) -> m (Maybe a) runNet :: (MonadIO m, MonadMask m) => RunEnv -> RunProto m -> NetF (Proto a) -> m (Maybe a)
runNet runenv runner f = case f of runNet runenv runner f = case f of
SendMessage m next -> do SendMessage m next -> do
v <- liftIO $ tryIO $ do v <- liftIO $ tryNonAsync $ do
hPutStrLn (runOhdl runenv) (unwords (formatMessage m)) hPutStrLn (runOhdl runenv) (unwords (formatMessage m))
hFlush (runOhdl runenv) hFlush (runOhdl runenv)
case v of case v of
Left _e -> return Nothing Left _e -> return Nothing
Right () -> runner next Right () -> runner next
ReceiveMessage next -> do ReceiveMessage next -> do
v <- liftIO $ tryIO $ hGetLine (runIhdl runenv) v <- liftIO $ tryNonAsync $ hGetLine (runIhdl runenv)
case v of case v of
Left _e -> return Nothing Left _e -> return Nothing
Right l -> case parseMessage l of Right l -> case parseMessage l of
@ -80,7 +80,7 @@ runNet runenv runner f = case f of
net $ sendMessage e net $ sendMessage e
next e next e
SendBytes len b next -> do SendBytes len b next -> do
v <- liftIO $ tryIO $ do v <- liftIO $ tryNonAsync $ do
ok <- sendExactly len b (runOhdl runenv) ok <- sendExactly len b (runOhdl runenv)
hFlush (runOhdl runenv) hFlush (runOhdl runenv)
return ok return ok
@ -88,7 +88,7 @@ runNet runenv runner f = case f of
Right True -> runner next Right True -> runner next
_ -> return Nothing _ -> return Nothing
ReceiveBytes (Len n) next -> do ReceiveBytes (Len n) next -> do
v <- liftIO $ tryIO $ L.hGet (runIhdl runenv) (fromIntegral n) v <- liftIO $ tryNonAsync $ L.hGet (runIhdl runenv) (fromIntegral n)
case v of case v of
Left _e -> return Nothing Left _e -> return Nothing
Right b -> runner (next b) Right b -> runner (next b)