unix-bytestring-0.3.5.4/0000755000000000000000000000000012016530172013217 5ustar0000000000000000unix-bytestring-0.3.5.4/LICENSE0000644000000000000000000000356712016530172014237 0ustar0000000000000000=== Notes === The following license applies to all code in this package, with the exception of the functions System.Posix.IO.ByteString.fdReadBuf and System.Posix.IO.ByteString.fdWriteBuf. Those functions were copied from the unix package and are subject to the license described in LICENSE-unix, as well as this license. === unix-bytestring license === Copyright (c) 2010, 2011, 2012, wren ng thornton. ALL RIGHTS RESERVED. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holders nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. unix-bytestring-0.3.5.4/README0000644000000000000000000000577412016530172014114 0ustar0000000000000000unix-bytestring =============== In general, this is a simple package and should be easy to install. You must have hsc2hs installed in order to compile the package (but then you probably already do). With the cabal-install program you can just do: $> cabal install unix-bytestring Or if you don't have cabal-install, then you can use the Cabal library: $> runhaskell Setup.hs configure $> runhaskell Setup.hs build $> runhaskell Setup.hs test $> runhaskell Setup.hs haddock --hyperlink-source $> runhaskell Setup.hs install FFI Problems ============ The unix-bytestring package uses standard POSIX header files , , and . If Cabal has difficulty finding these files or reports another error, be sure your include path variables are correct. If the problem persists, contact the maintainer. Building for GHC (6.8 and above) ================================ Nothing special to mention. Building for Hugs (September 2006) ================================== I haven't actually compiled this for Hugs because I don't have a new enough version of Cabal for it, but I don't forsee any difficulties. If you do compile this for Hugs, let the maintainer know how it went. When compiling for Hugs, see the following bugs for Cabal's interaction with ffihugs. These bugs do not currently affect this package, but this notice is here in case they affect future versions. For more details and a minimal regression suite, see: (1) Options in hugs-options aren't passed through to ffihugs, most importantly -98 and +o are the ones we'd like to pass. For enabling the +o flag Hugs-Sept06 does not honor: pragma {-# LANGUAGE OverlappingInstances #-} pragma {-# OPTIONS_HUGS +o #-} cabal extensions: OverlappingInstances And the -98 flag has similar issues. Therefore this is a real problem. Immediate solution: The options set in hugs-options should be passed to ffihugs as well. As of Cabal 1.6 they are not passed (verified by Duncan Coutts). The two programs accept all the same options, so this is valid. Ideal solution: Based on the extensions field, Cabal should automatically determine whether -98 and +o need to be enabled (for both hugs and ffihugs). (2) If CPP is being used in conjunction with FFI, then cpp/cpphs is not called before ffihugs is called. Thus, users must pass an -F flag to ffihugs in order to declare a code filter (and must pass all cpp-options to -F manually). For example: --ffihugs-option=-F'cpp -P -traditional -D__HUGS__ -D__BLAH__' This requires duplicating the build specifications, which defeats the point of Cabal. Also it leads to tricky issues about ensuring the proper level of quoting/escaping. (e.g. using the plural, --ffihugs-options=..., breaks it. Wrapping the -F'cpp...' in double quotes breaks it.) ----------------------------------------------------------- fin. unix-bytestring-0.3.5.4/Setup.hs0000644000000000000000000000016212016530172014652 0ustar0000000000000000#!/usr/bin/env runhaskell module Main (main) where import Distribution.Simple main :: IO () main = defaultMain unix-bytestring-0.3.5.4/unix-bytestring.cabal0000644000000000000000000000455612016530172017370 0ustar0000000000000000---------------------------------------------------------------- -- wren ng thornton ~ 2012.08.23 ---------------------------------------------------------------- -- By and large Cabal >=1.2 is fine; but >= 1.6 gives tested-with: -- and source-repository:. Cabal-Version: >= 1.6 Build-Type: Simple Name: unix-bytestring Version: 0.3.5.4 Stability: experimental Homepage: http://code.haskell.org/~wren/ Author: wren ng thornton Maintainer: wren@community.haskell.org Copyright: Copyright (c) 2010--2012 wren ng thornton License: BSD3 License-File: LICENSE Category: System Synopsis: Unix/Posix-specific functions for ByteStrings. Description: Unix\/Posix-specific functions for ByteStrings. . Provides @ByteString@ file-descriptor based I\/O API, designed loosely after the @String@ file-descriptor based I\/O API in "System.Posix.IO". The functions here wrap standard C implementations of the functions specified by the ISO\/IEC 9945-1:1990 (``POSIX.1'') and X\/Open Portability Guide Issue 4, Version 2 (``XPG4.2'') specifications. . Note that this package doesn't require the @unix@ package as a dependency. But you'll need it in order to get your hands on an @Fd@, so we're not offering a complete replacement. Tested-With: GHC == 6.12.1, GHC == 6.12.3 Extra-source-files: README, VERSION Source-Repository head Type: darcs Location: http://community.haskell.org/~wren/unix-bytestring ---------------------------------------------------------------- Library Hs-Source-Dirs: src Exposed-Modules: Foreign.C.Error.Safe , System.Posix.IO.ByteString , System.Posix.IO.ByteString.Lazy , System.Posix.Types.Iovec -- We require base>=4.1 for Foreign.C.Error.throwErrnoIfMinus1Retry. -- -- We would require unix>=2.4 for System.Posix.IO.fdReadBuf/fdWriteBuf -- (and unix-2.4.0.0 requires base>=4.1 too), except we define -- them on our own for better backwards compatibility. -- -- Not sure what the real minbound is on bytestring... Build-Depends: base >= 4.1 && < 5 , bytestring >= 0.9.1.5 ---------------------------------------------------------------- ----------------------------------------------------------- fin. unix-bytestring-0.3.5.4/VERSION0000644000000000000000000000431412016530172014271 0ustar00000000000000000.3.5.4 (2012-08-23): - System.Posix.IO.ByteString: adjusted some imports for GHC 7.6 - Removed the custom Setup.hs, for compatibility with GHC 7.6 0.3.5.3 (2012-02-21): - Foreign.C.Error.Safe: changed (Num a) to (Eq a, Num a) for GHC 7.4 0.3.5 (2011-06-29): - System.Posix.IO.ByteString: added fdSeek, tryFdSeek. - Foreign.C.Error.Safe: added. 0.3.4.1 (2011-04-03): - LICENSE: corrected license for the fdReadBuf and fdWriteBuf functions 0.3.4 (2011-03-26): - System.Posix.IO.ByteString.Lazy: Fixed functions to check (<=0) instead of (==0) 0.3.3 (2011-03-26): - System.Posix.IO.ByteString: added tryFdReadBuf, tryFdReadvBuf, tryFdPreadBuf, tryFdWriteBuf, tryFdWritevBuf, tryFdPwriteBuf 0.3.2.1 (2011-03-20): - Changed the cabal category label to System - Uploaded to Hackage 0.3.2 (2011-03-17): - Removed the dependency on @unix@. 0.3.1 (2011-03-07): - System.Posix.IO.ByteString: added fdPreads - System.Posix.IO.ByteString.Lazy: added fdPread 0.3.0 (2011-03-07): - System.Posix.IO.ByteString: added fdReadvBuf, exposed fdWritevBuf - System.Posix.IO.ByteString: added fdReadBuf and fdWriteBuf for compatibility with older versions of the @unix@ package - System.Posix.IO.ByteString: added fdPread, fdPreadBuf - System.Posix.IO.ByteString: added fdPwrite, fdPwriteBuf 0.2.1 (2011-03-06): - Added a custom build in order to define __HADDOCK__ when appropriate. - System.Posix.IO.ByteString: added fdReads 0.2.0 (2011-03-05): - Corrected the specifications (writev etc is XPG4.2, not POSIX) - Added some extra #includes for legacy reasons - Changed stability to experimental. - Added new module System.Posix.Types.Iovec - System.Posix.IO.ByteString.Lazy: added fdWritev - System.Posix.IO.ByteString.Lazy: changed fdWrite to fdWrites - System.Posix.IO.ByteString: added fdWrites and fdWritev - Renamed package to unix-bytestring 0.1.0 (2011-02-27): - Moved Data.ByteString.Posix to System.Posix.IO.ByteString - Moved Data.ByteString.Lazy.Posix to System.Posix.IO.ByteString.Lazy 0.0.2 (2011-02-20): - Fixed stack overflow possibility in Lazy.fdWrite 0.0.1 (2010-11-10): - Added lazy variants 0.0.0 (2010-11-10): - Initial version forked from Posta-IPC unix-bytestring-0.3.5.4/src/0000755000000000000000000000000012016530172014006 5ustar0000000000000000unix-bytestring-0.3.5.4/src/Foreign/0000755000000000000000000000000012016530172015377 5ustar0000000000000000unix-bytestring-0.3.5.4/src/Foreign/C/0000755000000000000000000000000012016530172015561 5ustar0000000000000000unix-bytestring-0.3.5.4/src/Foreign/C/Error/0000755000000000000000000000000012016530172016652 5ustar0000000000000000unix-bytestring-0.3.5.4/src/Foreign/C/Error/Safe.hs0000644000000000000000000001027212016530172020066 0ustar0000000000000000 {-# OPTIONS_GHC -Wall -fwarn-tabs #-} ---------------------------------------------------------------- -- 2012.02.21 -- | -- Module : Foreign.C.Error.Safe -- Copyright : Copyright (c) 2010--2012 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 :: (Eq a, Num a) => IO a -> IO (Either C.Errno a) eitherErrnoIfMinus1 = eitherErrnoIf (-1 ==) eitherErrnoIfMinus1Retry :: (Eq a, Num a) => IO a -> IO (Either C.Errno a) eitherErrnoIfMinus1Retry = eitherErrnoIfRetry (-1 ==) eitherErrnoIfMinus1RetryMayBlock :: (Eq a, 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. unix-bytestring-0.3.5.4/src/System/0000755000000000000000000000000012016530172015272 5ustar0000000000000000unix-bytestring-0.3.5.4/src/System/Posix/0000755000000000000000000000000012016530172016374 5ustar0000000000000000unix-bytestring-0.3.5.4/src/System/Posix/IO/0000755000000000000000000000000012016530172016703 5ustar0000000000000000unix-bytestring-0.3.5.4/src/System/Posix/IO/ByteString.hsc0000644000000000000000000007360212016530172021504 0ustar0000000000000000{- /N.B./, There's a bug when trying to use Cabal-style MIN_VERSION_foo(1,2,3) macros in combination with hsc2hs. We don't need full hsc2hs support in this file, but if we use CPP instead we get a strange error on OSX 10.5.8 about "architecture not supported" (even though the headers work fine with hsc2hs). It turns out that we don't /need/ to combine Cabal-style macros and hsc2hs\/cpp since we can remove our dependency on the @unix@ package. But this issue is worth making a note of. -} -- GHC 7.6 changed the semantics of the FFI so that we must have -- the data constructors in scope in order to import functions using -- the given types. However, those data constructors[1] are not exported -- in earlier versions, so having @(..)@ will raise warnings on old -- systems. However, Cabal-style MIN_VERSION_foo(1,2,3) macros don't -- play nicely with hsc2hs; and we need hsc2hs in lieu of CPP for -- OS X. So we disable -Wall rather than trying to CPP this problem -- away. There doesn't appear to be a -fno-warn-foo for this -- particular issue. -- -- [1] CSsize(..), COff(..), CInt(..), CSize(..), CChar(..) {-# LANGUAGE ForeignFunctionInterface #-} {-# OPTIONS_GHC -fwarn-tabs #-} ---------------------------------------------------------------- -- 2012.08.23 -- | -- Module : System.Posix.IO.ByteString -- Copyright : Copyright (c) 2010--2012 wren ng thornton -- License : BSD -- Maintainer : wren@community.haskell.org -- Stability : experimental -- Portability : non-portable (POSIX.1, XPG4.2; hsc2hs, FFI) -- -- Provides a strict-'BS.ByteString' file-descriptor based I\/O -- API, designed loosely after the @String@ file-descriptor based -- I\/O API in "System.Posix.IO". The functions here wrap standard -- C implementations of the functions specified by the ISO\/IEC -- 9945-1:1990 (``POSIX.1'') and X\/Open Portability Guide Issue -- 4, Version 2 (``XPG4.2'') specifications. ---------------------------------------------------------------- module System.Posix.IO.ByteString ( -- * I\/O with file descriptors -- ** Reading -- *** The POSIX.1 @read(2)@ syscall fdRead , fdReadBuf , tryFdReadBuf , fdReads -- *** The XPG4.2 @readv(2)@ syscall -- , fdReadv , fdReadvBuf , tryFdReadvBuf -- *** The XPG4.2 @pread(2)@ syscall , fdPread , fdPreadBuf , tryFdPreadBuf , fdPreads -- ** Writing -- *** The POSIX.1 @write(2)@ syscall , fdWrite , fdWriteBuf , tryFdWriteBuf , fdWrites -- *** The XPG4.2 @writev(2)@ syscall , fdWritev , fdWritevBuf , tryFdWritevBuf -- *** The XPG4.2 @pwrite(2)@ syscall , 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) import qualified Data.ByteString as BS 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) -- For the functor instance of 'Either', aka 'right' for ArrowChoice(->) import Control.Arrow (ArrowChoice(..)) -- iovec, writev, and readv are in , but we must include -- and for legacy reasons. #include #include #include ---------------------------------------------------------------- -- | Throw an 'IOE.IOError' for EOF. ioErrorEOF :: String -> IO a ioErrorEOF fun = IOE.ioError (IOE.ioeSetErrorString (IOE.mkIOError IOE.eofErrorType fun Nothing Nothing) "EOF") ---------------------------------------------------------------- foreign import ccall safe "read" -- ssize_t read(int fildes, void *buf, size_t nbyte); c_safe_read :: CInt -> Ptr CChar -> CSize -> IO CSsize -- | Read data from an 'Fd' into memory. This is exactly equivalent -- to the POSIX.1 @read(2)@ system call, except that we return 0 -- bytes read if the @ByteCount@ argument is less than or equal to -- zero (instead of throwing an errno exception). /N.B./, this -- behavior is different from the version in @unix-2.4.2.0@ which -- only checks for equality to zero. If there are any errors, then -- they are thrown as 'IOE.IOError' exceptions. -- -- /Since: 0.3.0/ fdReadBuf :: Fd -> Ptr Word8 -- ^ Memory in which to put the data. -> ByteCount -- ^ How many bytes to try to read. -> IO ByteCount -- ^ How many bytes were actually read (zero for EOF). fdReadBuf fd buf nbytes | nbytes <= 0 = return 0 | otherwise = fmap fromIntegral $ C.throwErrnoIfMinus1Retry _fdReadBuf $ c_safe_read (fromIntegral fd) (castPtr buf) (fromIntegral nbytes) _fdReadBuf :: String _fdReadBuf = "System.Posix.IO.ByteString.fdReadBuf" {-# NOINLINE _fdReadBuf #-} -- | Read data from an 'Fd' into memory. This is a variation of -- 'fdReadBuf' which returns errors with an 'Either' instead of -- throwing exceptions. -- -- /Since: 0.3.3/ tryFdReadBuf :: Fd -> Ptr Word8 -- ^ Memory in which to put the data. -> ByteCount -- ^ How many bytes to try to read. -> IO (Either C.Errno ByteCount) -- ^ How many bytes were actually read (zero for EOF). tryFdReadBuf fd buf nbytes | nbytes <= 0 = return (Right 0) | otherwise = fmap (right fromIntegral) $ eitherErrnoIfMinus1Retry $ c_safe_read (fromIntegral fd) (castPtr buf) (fromIntegral nbytes) ---------------------------------------------------------------- -- | Read data from an 'Fd' and convert it to a 'BS.ByteString'. -- Throws an exception if this is an invalid descriptor, or EOF has -- been reached. This is essentially equivalent to 'fdReadBuf'; the -- differences are that we allocate a byte buffer for the @ByteString@, -- and that we detect EOF and throw an 'IOE.IOError'. fdRead :: Fd -> ByteCount -- ^ How many bytes to try to read. -> IO BS.ByteString -- ^ The bytes read. fdRead fd nbytes | nbytes <= 0 = return BS.empty | otherwise = BSI.createAndTrim (fromIntegral nbytes) $ \buf -> do rc <- fdReadBuf fd buf nbytes if 0 == rc then ioErrorEOF _fdRead else return (fromIntegral rc) _fdRead :: String _fdRead = "System.Posix.IO.ByteString.fdRead" {-# NOINLINE _fdRead #-} ---------------------------------------------------------------- -- | Read data from an 'Fd' and convert it to a 'BS.ByteString'. -- Throws an exception if this is an invalid descriptor, or EOF has -- been reached. -- -- This version takes a kind of stateful predicate for whether and -- how long to keep retrying. Assume the function is called as -- @fdReads f z0 fd n0@. We will attempt to read @n0@ bytes from -- @fd@. If we fall short, then we will call @f len z@ where @len@ -- is the total number of bytes read so far and @z@ is the current -- state (initially @z0@). If it returns @Nothing@ then we will -- give up and return the current buffer; otherwise we will retry -- with the new state, continuing from where we left off. -- -- For example, to define a function that tries up to @n@ times, -- we can use: -- -- > fdReadUptoNTimes :: Int -> Fd -> ByteCount -> IO ByteString -- > fdReadUptoNTimes n0 = fdReads retry n0 -- > where -- > retry _ 0 = Nothing -- > retry _ n = Just $! n-1 -- -- The benefit of doing this instead of the naive approach of calling -- 'fdRead' repeatedly is that we only need to allocate one byte -- buffer, and trim it once at the end--- whereas the naive approach -- would allocate a buffer, trim it to the number of bytes read, -- and then concatenate with the previous one (another allocation, -- plus copying everything over) for each time around the loop. -- -- /Since: 0.2.1/ fdReads :: (ByteCount -> a -> Maybe a) -- ^ A stateful predicate for retrying. -> a -- ^ An initial state for the predicate. -> Fd -> ByteCount -- ^ How many bytes to try to read. -> IO BS.ByteString -- ^ The bytes read. fdReads f z0 fd n0 | n0 <= 0 = return BS.empty | otherwise = BSI.createAndTrim (fromIntegral n0) (go z0 0 n0) where go _ len n buf | len `seq` n `seq` buf `seq` False = undefined go z len n buf = do rc <- fdReadBuf fd buf n let len' = len + rc case rc of _ | rc == 0 -> ioErrorEOF _fdReads | rc == n -> return (fromIntegral len') -- Finished. | otherwise -> case f len' z of Nothing -> return (fromIntegral len') -- Gave up. Just z' -> go z' len' (n - rc) (buf `plusPtr` fromIntegral rc) _fdReads :: String _fdReads = "System.Posix.IO.ByteString.fdReads" {-# NOINLINE _fdReads #-} ---------------------------------------------------------------- foreign import ccall safe "readv" -- ssize_t readv(int fildes, const struct iovec *iov, int iovcnt); c_safe_readv :: CInt -> Ptr CIovec -> CInt -> IO CSsize {- -- N.B., c_safe_readv will throw errno=EINVAL -- if iovcnt <= 0 || > 16, -- if one of the iov_len values in the iov array was negative, -- if the sum of the iov_len values in the iov array overflowed a 32-bit integer. fdReadvBufSafe :: Fd -> Ptr CIovec -> Int -> IO ByteCount fdReadvBufSafe fd = go 0 where go rc bufs len | len <= 0 = return rc | otherwise = do m <- checkIovecs bufs (min 16 len) case m of Nothing -> error Just (bufs', l, nbytes) -> do rc' <- fdReadvBuf fd bufs l if rc' == nbytes then go (rc+rc') bufs' (len-l) else return (rc+rc') checkIovecs :: Ptr CIovec -> Int -> IO (Maybe (Ptr CIovec, Int, ByteCount)) checkIovecs = go (0 :: Int32) 0 where go nbytes n p len | nbytes `seq` n `seq` p `seq` len `seq` False = undefined | len == 0 = return (Just (p, n, fromIntegral nbytes) | otherwise = do l <- iov_len <$> peek p if l < 0 then return Nothing else do let nbytes' = nbytes+l if nbytes' < 0 then return (Just (p, n, fromIntegral nbytes) else go nbytes' (n+1) (p++) (len-1) -} -- | Read data from an 'Fd' and scatter it into memory. This is -- exactly equivalent to the XPG4.2 @readv(2)@ system call, except -- that we return 0 bytes read if the @Int@ argument is less than -- or equal to zero (instead of throwing an 'C.eINVAL' exception). -- If there are any errors, then they are thrown as 'IOE.IOError' -- exceptions. -- -- TODO: better documentation. -- -- /Since: 0.3.0/ fdReadvBuf :: Fd -> Ptr CIovec -- ^ A C-style array of buffers to fill. -> Int -- ^ How many buffers there are. -> IO ByteCount -- ^ How many bytes were actually read (zero for EOF). fdReadvBuf fd bufs len | len <= 0 = return 0 | otherwise = fmap fromIntegral $ C.throwErrnoIfMinus1Retry _fdReadvBuf $ c_safe_readv (fromIntegral fd) bufs (fromIntegral len) _fdReadvBuf :: String _fdReadvBuf = "System.Posix.IO.ByteString.fdReadvBuf" {-# NOINLINE _fdReadvBuf #-} -- | Read data from an 'Fd' and scatter it into memory. This is a -- variation of 'fdReadvBuf' which returns errors with an 'Either' -- instead of throwing exceptions. -- -- /Since: 0.3.3/ tryFdReadvBuf :: Fd -> Ptr CIovec -- ^ A C-style array of buffers to fill. -> Int -- ^ How many buffers there are. -> IO (Either C.Errno ByteCount) -- ^ How many bytes were actually read (zero for EOF). tryFdReadvBuf fd bufs len | len <= 0 = return (Right 0) | otherwise = fmap (right fromIntegral) $ eitherErrnoIfMinus1Retry $ c_safe_readv (fromIntegral fd) bufs (fromIntegral len) -- TODO: What's a reasonable wrapper for fdReadvBuf to make it Haskellish? ---------------------------------------------------------------- foreign import ccall safe "pread" -- ssize_t pread(int fildes, void *buf, size_t nbyte, off_t offset); c_safe_pread :: CInt -> Ptr Word8 -> CSize -> COff -> IO CSsize -- | Read data from a specified position in the 'Fd' into memory, -- without altering the position stored in the @Fd@. This is exactly -- equivalent to the XPG4.2 @pread(2)@ system call, except that we -- return 0 bytes read if the @Int@ argument is less than or equal -- to zero (instead of throwing an errno exception). If there are -- any errors, then they are thrown as 'IOE.IOError' exceptions. -- -- /Since: 0.3.0/ fdPreadBuf :: Fd -> Ptr Word8 -- ^ Memory in which to put the data. -> ByteCount -- ^ How many bytes to try to read. -> FileOffset -- ^ Where to read the data from. -> IO ByteCount -- ^ How many bytes were actually read (zero for EOF). fdPreadBuf fd buf nbytes offset | nbytes <= 0 = return 0 | otherwise = fmap fromIntegral $ C.throwErrnoIfMinus1Retry _fdPreadBuf $ c_safe_pread (fromIntegral fd) buf (fromIntegral nbytes) (fromIntegral offset) _fdPreadBuf :: String _fdPreadBuf = "System.Posix.IO.ByteString.fdPreadBuf" {-# NOINLINE _fdPreadBuf #-} -- | Read data from a specified position in the 'Fd' into memory, -- without altering the position stored in the @Fd@. This is a -- variation of 'fdPreadBuf' which returns errors with an 'Either' -- instead of throwing exceptions. -- -- /Since: 0.3.3/ tryFdPreadBuf :: Fd -> Ptr Word8 -- ^ Memory in which to put the data. -> ByteCount -- ^ How many bytes to try to read. -> FileOffset -- ^ Where to read the data from. -> IO (Either C.Errno ByteCount) -- ^ How many bytes were actually read (zero for EOF). tryFdPreadBuf fd buf nbytes offset | nbytes <= 0 = return (Right 0) | otherwise = fmap (right fromIntegral) $ eitherErrnoIfMinus1Retry $ c_safe_pread (fromIntegral fd) buf (fromIntegral nbytes) (fromIntegral offset) ---------------------------------------------------------------- -- | Read data from a specified position in the 'Fd' and convert -- it to a 'BS.ByteString', without altering the position stored -- in the @Fd@. Throws an exception if this is an invalid descriptor, -- or EOF has been reached. This is essentially equivalent to -- 'fdPreadBuf'; the differences are that we allocate a byte buffer -- for the @ByteString@, and that we detect EOF and throw an -- 'IOE.IOError'. -- -- /Since: 0.3.0/ fdPread :: Fd -> ByteCount -- ^ How many bytes to try to read. -> FileOffset -- ^ Where to read the data from. -> IO BS.ByteString -- ^ The bytes read. fdPread fd nbytes offset | nbytes <= 0 = return BS.empty | otherwise = BSI.createAndTrim (fromIntegral nbytes) $ \buf -> do rc <- fdPreadBuf fd buf nbytes offset if 0 == rc then ioErrorEOF _fdPread else return (fromIntegral rc) _fdPread :: String _fdPread = "System.Posix.IO.ByteString.fdPread" {-# NOINLINE _fdPread #-} ---------------------------------------------------------------- -- | Read data from a specified position in the 'Fd' and convert -- it to a 'BS.ByteString', without altering the position stored -- in the @Fd@. Throws an exception if this is an invalid descriptor, -- or EOF has been reached. This is a 'fdPreadBuf' based version -- of 'fdReads'; see those functions for more details. -- -- /Since: 0.3.1/ fdPreads :: (ByteCount -> a -> Maybe a) -- ^ A stateful predicate for retrying. -> a -- ^ An initial state for the predicate. -> Fd -> ByteCount -- ^ How many bytes to try to read. -> FileOffset -- ^ Where to read the data from. -> IO BS.ByteString -- ^ The bytes read. fdPreads f z0 fd n0 offset | n0 <= 0 = return BS.empty | otherwise = BSI.createAndTrim (fromIntegral n0) (go z0 0 n0) where go _ len n buf | len `seq` n `seq` buf `seq` False = undefined go z len n buf = do rc <- fdPreadBuf fd buf n (offset + fromIntegral len) let len' = len + rc case rc of _ | rc == 0 -> ioErrorEOF _fdPreads | rc == n -> return (fromIntegral len') -- Finished. | otherwise -> case f len' z of Nothing -> return (fromIntegral len') -- Gave up. Just z' -> go z' len' (n - rc) (buf `plusPtr` fromIntegral rc) _fdPreads :: String _fdPreads = "System.Posix.IO.ByteString.fdPreads" {-# NOINLINE _fdPreads #-} ---------------------------------------------------------------- ---------------------------------------------------------------- foreign import ccall safe "write" -- ssize_t write(int fildes, const void *buf, size_t nbyte); c_safe_write :: CInt -> Ptr CChar -> CSize -> IO CSsize -- | Write data from memory to an 'Fd'. This is exactly equivalent -- to the POSIX.1 @write(2)@ system call, except that we return 0 -- bytes written if the @ByteCount@ argument is less than or equal -- to zero (instead of throwing an errno exception). /N.B./, this -- behavior is different from the version in @unix-2.4.2.0@ which -- doesn't check the byte count. If there are any errors, then they -- are thrown as 'IOE.IOError' exceptions. -- -- /Since: 0.3.0/ fdWriteBuf :: Fd -> Ptr Word8 -- ^ Memory containing the data to write. -> ByteCount -- ^ How many bytes to try to write. -> IO ByteCount -- ^ How many bytes were actually written. fdWriteBuf fd buf nbytes | nbytes <= 0 = return 0 | otherwise = fmap fromIntegral $ C.throwErrnoIfMinus1Retry _fdWriteBuf $ c_safe_write (fromIntegral fd) (castPtr buf) (fromIntegral nbytes) _fdWriteBuf :: String _fdWriteBuf = "System.Posix.IO.ByteString.fdWriteBuf" {-# NOINLINE _fdWriteBuf #-} -- | Write data from memory to an 'Fd'. This is a variation of -- 'fdWriteBuf' which returns errors with an 'Either' instead of -- throwing exceptions. -- -- /Since: 0.3.3/ tryFdWriteBuf :: Fd -> Ptr Word8 -- ^ Memory containing the data to write. -> ByteCount -- ^ How many bytes to try to write. -> IO (Either C.Errno ByteCount) -- ^ How many bytes were actually read (zero for EOF). tryFdWriteBuf fd buf nbytes | nbytes <= 0 = return (Right 0) | otherwise = fmap (right fromIntegral) $ eitherErrnoIfMinus1Retry $ c_safe_write (fromIntegral fd) (castPtr buf) (fromIntegral nbytes) ---------------------------------------------------------------- -- | Write a 'BS.ByteString' to an 'Fd'. The return value is the -- total number of bytes actually written. This is exactly equivalent -- to 'fdWriteBuf'; we just convert the @ByteString@ into its -- underlying @Ptr Word8@ and @ByteCount@ components for passing -- to 'fdWriteBuf'. fdWrite :: Fd -> BS.ByteString -- ^ The string to write. -> IO ByteCount -- ^ How many bytes were actually written. fdWrite fd s = -- N.B., BSU.unsafeUseAsCStringLen does zero copying. Use -- BS.useAsCStringLen if there's any chance fdWriteBuf might -- alter the buffer. BSU.unsafeUseAsCStringLen s $ \(buf,len) -> do fdWriteBuf fd (castPtr buf) (fromIntegral len) ---------------------------------------------------------------- -- | Write a sequence of 'BS.ByteString's to an 'Fd'. The return -- value is a triple of: the total number of bytes written, the -- number of bytes written from the first of the remaining strings, -- and the remaining (unwritten) strings. We return this triple -- instead of a pair adjusting the head of the remaining strings -- (i.e., removing the bytes already written) in case there is some -- semantic significance to the way the input is split into chunks. -- -- This version consumes the list lazily and will call 'fdWrite' -- once for each @ByteString@, thus making /O(n)/ system calls. -- This laziness allows the early parts of the list to be garbage -- collected and prevents needing to hold the whole list of -- @ByteString@s in memory at once. Compare against 'fdWritev'. fdWrites :: Fd -> [BS.ByteString] -- ^ The strings to write. -> IO (ByteCount, ByteCount, [BS.ByteString]) -- ^ The total number of bytes written, the number of bytes -- written from the first of the remaining strings, the -- remaining (unwritten) strings. fdWrites fd = go 0 where -- We want to do a left fold in order to avoid stack overflows, -- but we need to have an early exit for incomplete writes -- (which normally requires a right fold). Hence this recursion. go acc [] = return (acc, 0, []) go acc ccs@(c:cs) = do rc <- fdWrite fd c let acc' = acc+rc in acc' `seq` do if rc == fromIntegral (BS.length c) then go acc' cs else return (acc', rc, ccs) ---------------------------------------------------------------- foreign import ccall safe "writev" -- ssize_t writev(int fildes, const struct iovec *iov, int iovcnt); c_safe_writev :: CInt -> Ptr CIovec -> CInt -> IO CSsize {- -- N.B., c_safe_readv will throw errno=EINVAL -- if iovcnt is less than or equal to 0, or greater than UIO_MAXIOV. (BUG: I have no idea where UIO_MAXIOV is defined! The web says it's in , and some suggest using IOV_MAX or _XOPEN_IOV_MAX instead.) -- -- -- -- That last link says that glibc might transparently chop up larger values before sending to the kernel. -- if one of the iov_len values in the iov array is negative. -- if the sum of the iov_len values in the iov array overflows a 32-bit integer. -} -- | Write data from memory to an 'Fd'. This is exactly equivalent -- to the XPG4.2 @writev(2)@ system call, except that we return 0 -- bytes written if the @Int@ argument is less than or equal to -- zero (instead of throwing an 'C.eINVAL' exception). If there are -- any errors, then they are thrown as 'IOE.IOError' exceptions. -- -- TODO: better documentation. -- -- /Since: 0.3.0/ fdWritevBuf :: Fd -> Ptr CIovec -- ^ A C-style array of buffers to write. -> Int -- ^ How many buffers there are. -> IO ByteCount -- ^ How many bytes were actually written. fdWritevBuf fd bufs len | len <= 0 = return 0 | otherwise = fmap fromIntegral $ C.throwErrnoIfMinus1Retry _fdWritevBuf $ c_safe_writev (fromIntegral fd) bufs (fromIntegral len) _fdWritevBuf :: String _fdWritevBuf = "System.Posix.IO.ByteString.fdWritevBuf" {-# NOINLINE _fdWritevBuf #-} -- | Write data from memory to an 'Fd'. This is a variation of -- 'fdWritevBuf' which returns errors with an 'Either' instead of -- throwing exceptions. -- -- /Since: 0.3.3/ tryFdWritevBuf :: Fd -> Ptr CIovec -- ^ A C-style array of buffers to write. -> Int -- ^ How many buffers there are. -> IO (Either C.Errno ByteCount) -- ^ How many bytes were actually read (zero for EOF). tryFdWritevBuf fd bufs len | len <= 0 = return (Right 0) | otherwise = fmap (right fromIntegral) $ eitherErrnoIfMinus1Retry $ c_safe_writev (fromIntegral fd) bufs (fromIntegral len) ---------------------------------------------------------------- -- | Write a sequence of 'BS.ByteString's to an 'Fd'. The return -- value is the total number of bytes written. Unfortunately the -- @writev(2)@ system call does not provide enough information to -- return the triple that 'fdWrites' does. -- -- This version will force the spine of the list, converting each -- @ByteString@ into an @iovec@ (see 'CIovec'), and then call -- 'fdWritevBuf'. This means we only make one system call, which -- reduces the overhead of performing context switches. But it also -- means that we must store the whole list of @ByteString@s in -- memory at once, and that we must perform some allocation and -- conversion. Compare against 'fdWrites'. fdWritev :: Fd -> [BS.ByteString] -- ^ The strings to write. -> IO ByteCount -- ^ How many bytes were actually written. fdWritev fd cs = do rc <- FMA.withArrayLen (map unsafeByteString2CIovec cs) $ \len iovs -> fdWritevBuf fd iovs (fromIntegral len) -- BUG: is this enough to actually hold onto them? mapM_ touchByteString cs return rc ---------------------------------------------------------------- foreign import ccall safe "pwrite" -- ssize_t pwrite(int fildes, const void *buf, size_t nbyte, off_t offset); c_safe_pwrite :: CInt -> Ptr Word8 -> CSize -> COff -> IO CSsize -- | Write data from memory to a specified position in the 'Fd', -- but without altering the position stored in the @Fd@. This is -- exactly equivalent to the XPG4.2 @pwrite(2)@ system call, except -- that we return 0 bytes written if the @ByteCount@ argument is -- less than or equal to zero (instead of throwing an errno exception). -- If there are any errors, then they are thrown as 'IOE.IOError' -- exceptions. -- -- /Since: 0.3.0/ fdPwriteBuf :: Fd -> Ptr Word8 -- ^ Memory containing the data to write. -> ByteCount -- ^ How many bytes to try to write. -> FileOffset -- ^ Where to write the data to. -> IO ByteCount -- ^ How many bytes were actually written. fdPwriteBuf fd buf nbytes offset | nbytes <= 0 = return 0 | otherwise = fmap fromIntegral $ C.throwErrnoIfMinus1Retry _fdPwriteBuf $ c_safe_pwrite (fromIntegral fd) (castPtr buf) (fromIntegral nbytes) (fromIntegral offset) _fdPwriteBuf :: String _fdPwriteBuf = "System.Posix.IO.ByteString.fdPwriteBuf" {-# NOINLINE _fdPwriteBuf #-} -- | Write data from memory to a specified position in the 'Fd', -- but without altering the position stored in the @Fd@. This is a -- variation of 'fdPwriteBuf' which returns errors with an 'Either' -- instead of throwing exceptions. -- -- /Since: 0.3.3/ tryFdPwriteBuf :: Fd -> Ptr Word8 -- ^ Memory containing the data to write. -> ByteCount -- ^ How many bytes to try to write. -> FileOffset -- ^ Where to write the data to. -> IO (Either C.Errno ByteCount) -- ^ How many bytes were actually written. tryFdPwriteBuf fd buf nbytes offset | nbytes <= 0 = return (Right 0) | otherwise = fmap (right fromIntegral) $ eitherErrnoIfMinus1Retry $ c_safe_pwrite (fromIntegral fd) (castPtr buf) (fromIntegral nbytes) (fromIntegral offset) ---------------------------------------------------------------- -- | Write data from memory to a specified position in the 'Fd', -- but without altering the position stored in the @Fd@. This is -- exactly equivalent to 'fdPwriteBuf'; we just convert the -- @ByteString@ into its underlying @Ptr Word8@ and @ByteCount@ -- components for passing to 'fdPwriteBuf'. -- -- /Since: 0.3.0/ fdPwrite :: Fd -> BS.ByteString -- ^ The string to write. -> FileOffset -- ^ Where to write the data to. -> IO ByteCount -- ^ How many bytes were actually written. fdPwrite fd s offset = -- N.B., BSU.unsafeUseAsCStringLen does zero copying. Use -- BS.useAsCStringLen if there's any chance fdPwriteBuf might -- 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. unix-bytestring-0.3.5.4/src/System/Posix/IO/ByteString/0000755000000000000000000000000012016530172020775 5ustar0000000000000000unix-bytestring-0.3.5.4/src/System/Posix/IO/ByteString/Lazy.hs0000644000000000000000000001256412016530172022260 0ustar0000000000000000{-# OPTIONS_GHC -Wall -fwarn-tabs #-} ---------------------------------------------------------------- -- 2011.03.17 -- | -- Module : System.Posix.IO.ByteString.Lazy -- Copyright : Copyright (c) 2010--2012 wren ng thornton -- License : BSD -- Maintainer : wren@community.haskell.org -- Stability : experimental -- Portability : non-portable (requires POSIX.1, XPG4.2) -- -- Provides a lazy-'BL.ByteString' file-descriptor based I\/O -- API, designed loosely after the @String@ file-descriptor based -- I\/O API in "System.Posix.IO". The functions here wrap standard -- C implementations of the functions specified by the ISO\/IEC -- 9945-1:1990 (``POSIX.1'') and X\/Open Portability Guide Issue -- 4, Version 2 (``XPG4.2'') specifications. -- -- These functions are provided mainly as a convenience to avoid -- boilerplate code converting between lazy 'BL.ByteString' and -- strict @['BS.ByteString']@. It may be depricated in the future. ---------------------------------------------------------------- module System.Posix.IO.ByteString.Lazy ( -- * I\/O with file descriptors -- ** Reading fdRead , fdPread -- ** Writing , fdWrites , fdWritev ) where import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BSU import qualified System.Posix.IO.ByteString as PosixBS import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Internal as BLI import System.Posix.Types (Fd, ByteCount, FileOffset) ---------------------------------------------------------------- -- | Read data from an 'Fd' and convert it to a 'BL.ByteString'. -- Throws an exception if this is an invalid descriptor, or EOF has -- been reached. This is a thin wrapper around 'PosixBS.fdRead'. fdRead :: Fd -> ByteCount -- ^ How many bytes to try to read. -> IO BL.ByteString -- ^ The bytes read. fdRead fd nbytes | nbytes <= 0 = return BL.empty | otherwise = do s <- PosixBS.fdRead fd nbytes return (BLI.chunk s BL.empty) ---------------------------------------------------------------- -- | Read data from a specified position in the 'Fd' and convert -- it to a 'BS.ByteString', without altering the position stored -- in the @Fd@. Throws an exception if this is an invalid descriptor, -- or EOF has been reached. This is a thin wrapper around -- 'PosixBS.fdPread'. -- -- /Since: 0.3.1/ fdPread :: Fd -> ByteCount -- ^ How many bytes to try to read. -> FileOffset -- ^ Where to read the data from. -> IO BL.ByteString -- ^ The bytes read. fdPread fd nbytes offset | nbytes <= 0 = return BL.empty | otherwise = do s <- PosixBS.fdPread fd nbytes offset return (BLI.chunk s BL.empty) ---------------------------------------------------------------- -- | Write a 'BL.ByteString' to an 'Fd'. This function makes one -- @write(2)@ system call per chunk, as per 'PosixBS.fdWrites'. fdWrites :: Fd -> BL.ByteString -- ^ The string to write. -> IO (ByteCount, BL.ByteString) -- ^ How many bytes were actually written, and the remaining -- (unwritten) string. fdWrites fd = go 0 where -- We want to do a left fold in order to avoid stack overflows, -- but we need to have an early exit for incomplete writes -- (which normally requires a right fold). Hence this recursion. go acc BLI.Empty = return (acc, BL.empty) go acc (BLI.Chunk c cs) = do rc <- PosixBS.fdWrite fd c let acc' = acc+rc in acc' `seq` do let rcInt = fromIntegral rc in rcInt `seq` do if rcInt == BS.length c then go acc' cs else return (acc', BLI.Chunk (BSU.unsafeDrop rcInt c) cs) {- Using 'BSU.unsafeDrop' above is safe, assuming that 'System.Posix.IO.fdWriteBuf' never returns (rc < 0 || rc > BS.length c). If we are paranoid about that then we should do the following instead: go acc ccs = case ccs of BLI.Empty -> return (acc, ccs) BLI.Chunk c cs -> do rc <- PosixBS.fdWrite fd c let acc' = acc+rc in acc' `seq` do let rcInt = fromIntegral rc in rcInt `seq` do case BS.length c of len | rcInt == len -> go acc' cs | rcInt > len -> error _impossibleByteCount | rcInt < 0 -> error _negtiveByteCount | rcInt == 0 -> return (acc', ccs) -- trivial optimizing | otherwise -> return (acc', BLI.Chunk (BSU.unsafeDrop rcInt c) cs) _negtiveByteCount = "System.Posix.IO.fdWriteBuf: returned a negative byte count" _impossibleByteCount = "System.Posix.IO.fdWriteBuf: returned a byte count greater than the length it was given" -} ---------------------------------------------------------------- -- | Write a 'BL.ByteString' to an 'Fd'. This function makes a -- single @writev(2)@ system call, as per 'PosixBS.fdWritev'. fdWritev :: Fd -> BL.ByteString -- ^ The string to write. -> IO ByteCount -- ^ How many bytes were actually written. fdWritev fd s = PosixBS.fdWritev fd (BL.toChunks s) {-# INLINE fdWritev #-} -- Hopefully the intermediate list can be fused away... ---------------------------------------------------------------- ----------------------------------------------------------- fin. unix-bytestring-0.3.5.4/src/System/Posix/Types/0000755000000000000000000000000012016530172017500 5ustar0000000000000000unix-bytestring-0.3.5.4/src/System/Posix/Types/Iovec.hsc0000644000000000000000000001361412016530172021251 0ustar0000000000000000-- The -fno-warn-unused-imports flag is to avoid the need for a -- special Setup.hs in order to use __HADDOCK__ to conditionally -- import Foreign.C.String.CStringLen only for the sake of Haddock. -- We avoid the special Setup.hs because in GHC 7.6 the prelude no -- longer exports 'catch', and it's not entirely clear what sort -- of exceptions from 'removeFile' actually need handling. {-# LANGUAGE ForeignFunctionInterface #-} {-# OPTIONS_GHC -Wall -fwarn-tabs -fno-warn-unused-imports #-} ---------------------------------------------------------------- -- 2011.03.17 -- | -- Module : System.Posix.Types.Iovec -- Copyright : Copyright (c) 2010--2012 wren ng thornton -- License : BSD -- Maintainer : wren@community.haskell.org -- Stability : experimental -- Portability : non-portable (POSIX.1, XPG4.2; hsc2hs, FFI) -- -- Imports the C @struct iovec@ type and provides conversion between -- 'CIovec's and strict 'BS.ByteString's. ---------------------------------------------------------------- module System.Posix.Types.Iovec ( -- * The @struct iovec@ type CIovec(..) , unsafeByteString2CIovec , touchByteString , unsafeUseAsCIovec , useAsCIovec ) where import Data.Word (Word8) import qualified Data.ByteString as BS import qualified Data.ByteString.Internal as BSI import Foreign.Ptr (Ptr) import qualified Foreign.Ptr as FFI (castPtr, plusPtr) import qualified Foreign.ForeignPtr as FFP import Foreign.C.Types (CSize) import Foreign.Storable (Storable(..)) -- N.B., we need a Custom cabal build-type in order for this to -- work. -- #ifdef __HADDOCK__ import Foreign.C.String (CStringLen) -- #endif -- iovec, writev, and readv are in , but we must include -- and for legacy reasons. #include #include #include ---------------------------------------------------------------- -- | Haskell type representing the C @struct iovec@ type. This is -- exactly like @'CStringLen'@ except there's actually struct -- definition on the C side. data CIovec = CIovec { iov_base :: {-# UNPACK #-} !(Ptr Word8) -- char* or void* , iov_len :: {-# UNPACK #-} !CSize -- size_t } #let alignment t = \ "%lu", (unsigned long) offsetof(struct {char x__; t (y__); }, y__) instance Storable CIovec where alignment _ = #{alignment struct iovec} sizeOf _ = #{size struct iovec} peek ptr = do base <- #{peek struct iovec, iov_base} ptr len <- #{peek struct iovec, iov_len} ptr return (CIovec base len) poke ptr (CIovec base len) = do #{poke struct iovec, iov_base} ptr base #{poke struct iovec, iov_len} ptr len -- | /O(1) construction/ Convert a @ByteString@ into an @CIovec@. -- -- This function is /unsafe/ in two ways: -- -- * After calling this function the @CIovec@ shares the underlying -- byte buffer with the original @ByteString@. Thus, modifying the -- @CIovec@ either in C or using poke will cause the contents of -- the @ByteString@ to change, breaking referential transparency. -- Other @ByteStrings@ created by sharing (such as those produced -- via 'BS.take' or 'BS.drop') will also reflect these changes. -- -- * Also, even though the @CIovec@ shares the underlying byte -- buffer, it does so in a way that will not keep the original -- @ByteString@ alive with respect to garbage collection. Thus, the -- byte buffer could be collected out from under the @CIovec@. To -- prevent this, you must use 'touchByteString' after the last point -- where the @CIovec@ is needed. unsafeByteString2CIovec :: BS.ByteString -> CIovec unsafeByteString2CIovec (BSI.PS fptr offset len) = CIovec (FFP.unsafeForeignPtrToPtr fptr `FFI.plusPtr` offset) (fromIntegral len) {-# INLINE unsafeByteString2CIovec #-} -- | Keep the @ByteString@ alive. See 'unsafeByteString2CIovec'. touchByteString :: BS.ByteString -> IO () touchByteString (BSI.PS fptr _ _) = FFP.touchForeignPtr fptr {-# INLINE touchByteString #-} -- | /O(1) construction/ Use a @ByteString@ with a function requiring -- a @CIovec@. -- -- This function does zero copying, and merely unwraps a @ByteString@ -- to appear as an @CIovec@. It is /unsafe/ in the same way as -- 'unsafeByteString2CIovec'. unsafeUseAsCIovec :: BS.ByteString -> (CIovec -> IO a) -> IO a unsafeUseAsCIovec (BSI.PS fptr offset len) io = FFP.withForeignPtr fptr $ \ptr -> io (CIovec (ptr `FFI.plusPtr` offset) (fromIntegral len)) {-# INLINE unsafeUseAsCIovec #-} -- The above version saves a case match on @s@ vs using -- 'unsafeByteString2CIovec' and 'touchByteString' -- | /O(n) construction/ Use a @ByteString@ with a function requiring -- a @CIovec@. -- -- As with 'BS.useAsCString' and 'BS.useAsCStringLen', this function -- makes a copy of the original @ByteString@ via @memcpy(3)@. The -- copy will be freed automatically. See 'unsafeUseAsCIovec' for a -- zero-copying version. useAsCIovec :: BS.ByteString -> (CIovec -> IO a) -> IO a useAsCIovec s@(BSI.PS _ _ len) io = BS.useAsCString s $ \cstr -> io (CIovec (FFI.castPtr cstr) (fromIntegral len)) {-# INLINE useAsCIovec #-} {- This definition is essentially verbatim 'BS.useAsCStringLen'. We can save two 'FFI.castPtr' and one 'fromIntegral' if we instead do an essentially verbatim 'BS.useAsCString': useAsCIovec s@(BSI.PS fptr offset len) io = do let lenCSize = fromIntegral len FMA.allocaBytes (len+1) $ \buf -> FFP.withForeignPtr fptr $ \ptr -> do BSI.memcpy buf (ptr `FFI.plusPtr` offset) lenCSize pokeByteOff buf len (0 :: Word8) -- add null-terminator io (CIovec buf lenCSize) -} ---------------------------------------------------------------- ----------------------------------------------------------- fin.