diff --git a/src/Foreign/C/Error/Safe.hs b/src/Foreign/C/Error/Safe.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/C/Error/Safe.hs @@ -0,0 +1,126 @@ + +{-# OPTIONS_GHC -Wall -fwarn-tabs #-} +---------------------------------------------------------------- +-- 2011.06.29 +-- | +-- Module : Foreign.C.Error.Safe +-- Copyright : Copyright (c) 2010--2011 wren ng thornton +-- License : BSD +-- Maintainer : wren@community.haskell.org +-- Stability : provisional +-- Portability : portable (H98+FFI) +-- +-- Provides a variant of the "Foreign.C.Error" API which returns +-- errors explicitly, instead of throwing exceptions. +-- +-- /Since: 0.3.5/ +---------------------------------------------------------------- +module Foreign.C.Error.Safe + ( + -- * Primitive handlers + eitherErrnoIf + , eitherErrnoIfRetry + , eitherErrnoIfRetryMayBlock + -- * Derived handlers + -- ** With predicate @(-1 ==)@ + , eitherErrnoIfMinus1 + , eitherErrnoIfMinus1Retry + , eitherErrnoIfMinus1RetryMayBlock + -- ** With predicate @(nullPtr ==)@ + , eitherErrnoIfNull + , eitherErrnoIfNullRetry + , eitherErrnoIfNullRetryMayBlock + ) where + +import qualified Foreign.C.Error as C +import qualified Foreign.Ptr as FFI + +---------------------------------------------------------------- +---------------------------------------------------------------- + +-- | A variant of 'C.throwErrnoIf' which returns @Either@ instead +-- of throwing an errno error. +eitherErrnoIf + :: (a -> Bool) -- ^ Predicate to apply to the result value of + -- the @IO@ operation. + -> IO a -- ^ The @IO@ operation to be executed. + -> IO (Either C.Errno a) +eitherErrnoIf p io = do + a <- io + if p a + then do + errno <- C.getErrno + return (Left errno) + else return (Right a) + + +-- | A variant of 'C.throwErrnoIfRetry' which returns @Either@ +-- instead of throwing an errno error. +eitherErrnoIfRetry + :: (a -> Bool) -- ^ Predicate to apply to the result value of + -- the @IO@ operation. + -> IO a -- ^ The @IO@ operation to be executed. + -> IO (Either C.Errno a) +eitherErrnoIfRetry p io = loop + where + loop = do + a <- io + if p a + then do + errno <- C.getErrno + if errno == C.eINTR + then loop + else return (Left errno) + else return (Right a) + + +-- | A variant of 'C.throwErrnoIfRetryMayBlock' which returns +-- @Either@ instead of throwing an errno error. +eitherErrnoIfRetryMayBlock + :: (a -> Bool) -- ^ Predicate to apply to the result value of + -- the @IO@ operation. + -> IO a -- ^ The @IO@ operation to be executed. + -> IO b -- ^ Action to execute before retrying if an + -- immediate retry would block. + -> IO (Either C.Errno a) +eitherErrnoIfRetryMayBlock p f on_block = loop + where + loop = do + a <- f + if p a + then do + errno <- C.getErrno + if errno == C.eINTR + then loop + else if errno == C.eWOULDBLOCK || errno == C.eAGAIN + then on_block >> loop + else return (Left errno) + else return (Right a) + +---------------------------------------------------------------- + +eitherErrnoIfMinus1 :: (Num a) => IO a -> IO (Either C.Errno a) +eitherErrnoIfMinus1 = eitherErrnoIf (-1 ==) + +eitherErrnoIfMinus1Retry :: (Num a) => IO a -> IO (Either C.Errno a) +eitherErrnoIfMinus1Retry = eitherErrnoIfRetry (-1 ==) + +eitherErrnoIfMinus1RetryMayBlock + :: (Num a) => IO a -> IO b -> IO (Either C.Errno a) +eitherErrnoIfMinus1RetryMayBlock = + eitherErrnoIfRetryMayBlock (-1 ==) + + +eitherErrnoIfNull :: IO (FFI.Ptr a) -> IO (Either C.Errno (FFI.Ptr a)) +eitherErrnoIfNull = eitherErrnoIf (== FFI.nullPtr) + +eitherErrnoIfNullRetry :: IO (FFI.Ptr a) -> IO (Either C.Errno (FFI.Ptr a)) +eitherErrnoIfNullRetry = eitherErrnoIfRetry (== FFI.nullPtr) + +eitherErrnoIfNullRetryMayBlock + :: IO (FFI.Ptr a) -> IO b -> IO (Either C.Errno (FFI.Ptr a)) +eitherErrnoIfNullRetryMayBlock = + eitherErrnoIfRetryMayBlock (== FFI.nullPtr) + +---------------------------------------------------------------- +----------------------------------------------------------- fin. diff --git a/src/System/Posix/IO/ByteString.hsc b/src/System/Posix/IO/ByteString.hsc --- a/src/System/Posix/IO/ByteString.hsc +++ b/src/System/Posix/IO/ByteString.hsc @@ -11,7 +11,7 @@ {-# LANGUAGE ForeignFunctionInterface #-} {-# OPTIONS_GHC -Wall -fwarn-tabs #-} ---------------------------------------------------------------- --- 2011.03.17 +-- 2011.06.29 -- | -- Module : System.Posix.IO.ByteString -- Copyright : Copyright (c) 2010--2011 wren ng thornton @@ -60,6 +60,14 @@ , fdPwrite , fdPwriteBuf , tryFdPwriteBuf + + -- ** Seeking + -- | These functions are not 'ByteString' related, but are + -- provided here for API completeness. + + -- *** The POSIX.1 @lseek(2)@ syscall + , fdSeek + , tryFdSeek ) where import Data.Word (Word8) @@ -67,12 +75,14 @@ import qualified Data.ByteString.Internal as BSI import qualified Data.ByteString.Unsafe as BSU +import System.IO (SeekMode(..)) import qualified System.IO.Error as IOE import System.Posix.Types.Iovec import System.Posix.Types (Fd, ByteCount, FileOffset , CSsize, COff) import Foreign.C.Types (CInt, CSize, CChar) import qualified Foreign.C.Error as C +import Foreign.C.Error.Safe import Foreign.Ptr (Ptr, castPtr, plusPtr) import qualified Foreign.Marshal.Array as FMA (withArrayLen) @@ -95,27 +105,6 @@ "EOF") --- | A variant of 'C.throwErrnoIfMinus1Retry' which returns 'Either' --- instead of throwing an errno error. -eitherErrnoIfMinus1Retry :: (Num a) => IO a -> IO (Either C.Errno a) -eitherErrnoIfMinus1Retry = eitherErrnoIfRetry (-1 ==) - - --- | A variant of 'C.throwErrnoIfRetry' which returns 'Either' --- instead of throwing an errno error. -eitherErrnoIfRetry :: (a -> Bool) -> IO a -> IO (Either C.Errno a) -eitherErrnoIfRetry p io = loop - where - loop = do - a <- io - if p a - then do - errno <- C.getErrno - if errno == C.eINTR - then loop - else return (Left errno) - else return (Right a) - ---------------------------------------------------------------- foreign import ccall safe "read" -- ssize_t read(int fildes, void *buf, size_t nbyte); @@ -748,6 +737,46 @@ -- alter the buffer. BSU.unsafeUseAsCStringLen s $ \(buf,len) -> do fdPwriteBuf fd (castPtr buf) (fromIntegral len) offset + + +---------------------------------------------------------------- +-- It's not clear whether the @unix@ version uses a safe or unsafe call. +foreign import ccall safe "lseek" + -- off_t lseek(int fildes, off_t offset, int whence); + c_safe_lseek :: CInt -> COff -> CInt -> IO COff + + +mode2Int :: SeekMode -> CInt +mode2Int AbsoluteSeek = (#const SEEK_SET) +mode2Int RelativeSeek = (#const SEEK_CUR) +mode2Int SeekFromEnd = (#const SEEK_END) + + +-- | Repositions the offset of the file descriptor according to the +-- offset and the seeking mode. This is exactly equivalent to the +-- POSIX.1 @lseek(2)@ system call. If there are any errors, then +-- they are thrown as 'IOE.IOError' exceptions. +-- +-- This is the same as 'System.Posix.IO.fdSeek' in @unix-2.4.2.0@, +-- but provided here for consistency. +-- +-- /Since: 0.3.5/ +fdSeek :: Fd -> SeekMode -> FileOffset -> IO FileOffset +fdSeek fd mode off = + C.throwErrnoIfMinus1 "fdSeek" + $ c_safe_lseek (fromIntegral fd) off (mode2Int mode) + + +-- | Repositions the offset of the file descriptor according to the +-- offset and the seeking mode. This is a variation of 'fdSeek' +-- which returns errors with an @Either@ instead of throwing +-- exceptions. +-- +-- /Since: 0.3.5/ +tryFdSeek :: Fd -> SeekMode -> FileOffset -> IO (Either C.Errno FileOffset) +tryFdSeek fd mode off = + eitherErrnoIfMinus1 + $ c_safe_lseek (fromIntegral fd) off (mode2Int mode) ---------------------------------------------------------------- ----------------------------------------------------------- fin. diff --git a/unix-bytestring.cabal b/unix-bytestring.cabal --- a/unix-bytestring.cabal +++ b/unix-bytestring.cabal @@ -1,9 +1,9 @@ ---------------------------------------------------------------- --- wren ng thornton ~ 2011.04.03 +-- wren ng thornton ~ 2011.06.28 ---------------------------------------------------------------- Name: unix-bytestring -Version: 0.3.4.1 +Version: 0.3.5 -- Source-Repository requires version 1.6 Cabal-Version: >= 1.6 -- We need a custom build in order to define __HADDOCK__ @@ -38,7 +38,8 @@ ---------------------------------------------------------------- Library Hs-Source-Dirs: src - Exposed-Modules: System.Posix.IO.ByteString + Exposed-Modules: Foreign.C.Error.Safe + , System.Posix.IO.ByteString , System.Posix.IO.ByteString.Lazy , System.Posix.Types.Iovec