29bedf5 · distributed-process

git.iko.soy/distributed-process

on master help sign in

Added warning message to the tryUntilNoIOErr loop.

29bedf5Ryan Newton15 years ago

network-transport-pipes/network-transport-pipes.cabal+3−2

compare with master

unifiedsplit

@@ -1,5 +1,5 @@

1Name: network-transport-pipes

2−Version: 0.0.1.1

2+Version: 0.0.1.2

3-- Version History:

4-- 0.0.1.1 - Initial

@@ -25,7 +25,8 @@ Library

25 unix >= 2.4,

26 random,

27 directory,

28− unix-bytestring >= 0.3.5.3

28+ unix-bytestring >= 0.3.5.3,

29+ time

29 Exposed-modules: Network.Transport.Pipes

30 Exposed-modules: Network.Transport.Pipes

30-- Extensions: BangPatterns

31-- Extensions: BangPatterns

31 ghc-options: -Wall

32 ghc-options: -Wall

network-transport-pipes/src/Network/Transport/Pipes.hs+19−4

@@ -25,6 +25,7 @@ import Data.Int

25import Data.IORef

26import qualified Data.IntMap as IntMap

27import qualified Data.ByteString.Char8 as BS

28+import Data.Time.Clock (getCurrentTime, diffUTCTime) -- Not in 6.10

29-- For some STRANGE reason this is not working with Data.Binary [2012.02.20]:

30-- For some STRANGE reason this is not working with Data.Binary [2012.02.20]:

30#define CEREAL

31#define CEREAL

@@ -212,6 +213,7 @@ spinTillThere filename = mkBackoff >>= loop

212 loop bkoff = do b <- doesFileExist filename

213 loop bkoff = do b <- doesFileExist filename

213 unless b $ do bkoff; loop bkoff

214 unless b $ do bkoff; loop bkoff

214

215

216+-- Wait successively longer between attempts.

215mkBackoff :: IO (IO ())

217mkBackoff :: IO (IO ())

216mkBackoff =

218mkBackoff =

217 do tref <- newIORef 1

219 do tref <- newIORef 1

@@ -222,17 +224,30 @@ mkBackoff =

222 maxwait = 50 * 1000

224 maxwait = 50 * 1000

223

225

224tryUntilNoIOErr :: IO a -> IO a

226tryUntilNoIOErr :: IO a -> IO a

225−tryUntilNoIOErr action = mkBackoff >>= loop

227+tryUntilNoIOErr action =

228+ do startTime <- getCurrentTime

229+ bkoff <- mkBackoff

230+ loop startTime bkoff

231+

226 where

232 where

227− loop bkoff =

233+ loop start bkoff =

228 handle (\ (e :: IOException) ->

234 handle (\ (e :: IOException) ->

235+ do maybeWarn start

229− do bkoff

236+ bkoff

230-- BSS.hPutStr stderr$ BSS.pack$ " got IO err: " ++ show e

237-- BSS.hPutStr stderr$ BSS.pack$ " got IO err: " ++ show e

231 -- case ioeGetHandle e of

238 -- case ioeGetHandle e of

232 -- Nothing -> BSS.hPutStrLn stderr$ BSS.pack$ " no hndl io err."

239 -- Nothing -> BSS.hPutStrLn stderr$ BSS.pack$ " no hndl io err."

233 -- Just x -> BSS.hPutStrLn stderr$ BSS.pack$ " HNDL on io err!" ++ show x

240 -- Just x -> BSS.hPutStrLn stderr$ BSS.pack$ " HNDL on io err!" ++ show x

234− loop bkoff) $

241+ loop start bkoff) $

235 action

242 action

243+ -- After how many milleseconds should we start warning?

244+ warn_lvl = 3000

245+ maybeWarn start = do

246+ now <- getCurrentTime

247+ let seconds :: Double = fromRational $ toRational $ diffUTCTime now start

248+ when (seconds * 1000 >= warn_lvl) $

249+ BS.hPutStrLn stderr$ BS.pack$ "WARNING: have been trying an IO action for "++show seconds++ " seconds without success"

250+

236

251

237-- Execute an action on its own OS thread. Return an MVar to synchronize on.

252-- Execute an action on its own OS thread. Return an MVar to synchronize on.

238onOSThread :: IO a -> IO (MVar a)

253onOSThread :: IO a -> IO (MVar a)