git.iko.soy/typeable/postgresql-simple
on master help sign in
Improve the IOError location adjustment in Notification
c3262a5Leon P Smith
src/Database/PostgreSQL/Simple/Notification.hs+7−11
compare with master
unifiedsplit
@@ -37,7 +37,7 @@ module Database.PostgreSQL.Simple.Notification
37 ) where
37 ) where
38
38
39import Control.Monad ( join, void )
39import Control.Monad ( join, void )
40−import Control.Exception ( throwIO, try )
40+import Control.Exception ( throwIO, catch )
41import qualified Data.ByteString as B
41import qualified Data.ByteString as B
42import qualified Data.ByteString.Char8 as B8
42import qualified Data.ByteString.Char8 as B8
43import Database.PostgreSQL.Simple.Internal
43import Database.PostgreSQL.Simple.Internal
@@ -107,10 +107,8 @@ getNotification conn = join $ withConnection conn fetch
107 -- unlucky, then we could end up waiting a long time.
107 -- unlucky, then we could end up waiting a long time.
108 Just fd -> do
108 Just fd -> do
109 return $ do
109 return $ do
110− merr <- try (threadWaitRead fd)
110+ threadWaitRead fd `catch` (throwIO . setIOErrorLocation)
111− case merr of
112− Left err -> throwIO $! setLoc err
113− Right _ -> loop
111+ loop
114#else
112#else
115 -- This case fixes the race condition above. By registering
113 -- This case fixes the race condition above. By registering
116 -- our interest in the descriptor before we drop the lock,
114 -- our interest in the descriptor before we drop the lock,
@@ -124,18 +122,16 @@ getNotification conn = join $ withConnection conn fetch
124 Just fd -> do
122 Just fd -> do
125 (waitRead, _) <- threadWaitReadSTM fd
123 (waitRead, _) <- threadWaitReadSTM fd
126 return $ do
124 return $ do
127− merr <- try (atomically waitRead)
125+ atomically waitRead `catch` (throwIO . setIOErrorLocation)
128− case merr of
129− Left err -> throwIO $! setLoc err
130− Right _ -> loop
126+ loop
131#endif
127#endif
132
128
133 loop = join $ withConnection conn $ \c -> do
129 loop = join $ withConnection conn $ \c -> do
134 void $ PQ.consumeInput c
130 void $ PQ.consumeInput c
135 fetch c
131 fetch c
136
132
137− setLoc :: IOError -> IOError
133+ setIOErrorLocation :: IOError -> IOError
138− setLoc err = err { ioe_location = B8.unpack funcName }
134+ setIOErrorLocation err = err { ioe_location = B8.unpack funcName }
139
135
140
136
141-- | Non-blocking variant of 'getNotification'. Returns a single notification,
137-- | Non-blocking variant of 'getNotification'. Returns a single notification,