123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778 |
- {-# LANGUAGE ExistentialQuantification #-}
- {- |
- Wraps a target placing reading and writting operations
- unders a timeout. Raises IOError if a timeout occurs.
- -}
- module System.IO.Uniform.Timeout (
- FixedTimeout(..),
- MVarTimeout(..)
- ) where
- import System.IO.Uniform
- import System.Timeout
- --import System.IO.Error
- import Control.Concurrent.MVar
- {- |
- Fixed timeout, set at define time.
- > FixTimeout tm u
- Will wrap u, applying a timeout of
- tm nanoseconds on its IO operations.
- -}
- data FixedTimeout = forall u. UniformIO u => FixedTimeout Int u
- instance UniformIO FixedTimeout where
- uRead (FixedTimeout t u) i = do
- r' <- timeout t $ uRead u i
- case r' of
- Just r -> return r
- Nothing -> doTimeout
- uPut (FixedTimeout t u) tx = do
- r' <- timeout t $ uPut u tx
- case r' of
- Just _ -> return ()
- Nothing -> doTimeout
- uClose (FixedTimeout _ u) = uClose u
- startTls s (FixedTimeout t u) = do
- r' <- timeout t $ startTls s u
- case r' of
- Just r -> return $ FixedTimeout t r
- Nothing -> doTimeout
- isSecure (FixedTimeout _ u) = isSecure u
- isEOF (FixedTimeout _ u) = isEOF u
- {- |
- Variable timeout, set at runtime.
- > MVarTimeout tm u
- Will wrap u, reading the timeout from (and locking) tm
- during every read and write operation.
- -}
- data MVarTimeout = forall u. UniformIO u => MVarTimeout (MVar Int) u
- instance UniformIO MVarTimeout where
- uRead (MVarTimeout t' u) i = withMVar t' $ \t -> do
- r' <- timeout t $ uRead u i
- case r' of
- Just r -> return r
- Nothing -> doTimeout
- uPut (MVarTimeout t' u) tx = withMVar t' $ \t -> do
- r' <- timeout t $ uPut u tx
- case r' of
- Just _ -> return ()
- Nothing -> doTimeout
- uClose (MVarTimeout _ u) = uClose u
- startTls s (MVarTimeout t' u) = withMVar t' $ \t -> do
- r' <- timeout t $ startTls s u
- case r' of
- Just r -> return $ MVarTimeout t' r
- Nothing -> doTimeout
- isSecure (MVarTimeout _ u) = isSecure u
- isEOF (MVarTimeout _ u) = isEOF u
- doTimeout :: IO a
- doTimeout = ioError $ userError "Timeout"
|