module Data.Iteratee.IO.OffsetFd (
enumFdRandomOBS
, enumFileRandomOBS
, fileDriverRandomFdOBS
, fileDriverRandomOBS
) where
import Control.Arrow (second)
import qualified Data.ByteString as B
import Data.ByteString (ByteString)
import Data.Iteratee.Iteratee
import Data.Iteratee.Binary()
import Data.Offset (Offset(..))
import Control.Concurrent (yield)
import Control.Exception
import Control.Monad
import Control.Monad.CatchIO as CIO
import Control.Monad.IO.Class
import Foreign.Ptr
import Foreign.Marshal.Alloc
import System.IO (SeekMode(..))
import System.Posix hiding (FileOffset)
import Foreign.C
myfdRead :: Fd -> Ptr CChar -> ByteCount -> IO (Either Errno ByteCount)
myfdRead (Fd fd) ptr n = do
n' <- cRead fd ptr n
if n' == 1 then liftM Left getErrno
else return . Right . fromIntegral $ n'
foreign import ccall unsafe "unistd.h read" cRead
:: CInt -> Ptr CChar -> CSize -> IO CInt
myfdSeek:: Fd -> SeekMode -> FileOffset -> IO (Either Errno FileOffset)
myfdSeek (Fd fd) mode off = do
n' <- cLSeek fd off (mode2Int mode)
if n' == 1 then liftM Left getErrno
else return . Right $ n'
where mode2Int :: SeekMode -> CInt
mode2Int AbsoluteSeek = 0
mode2Int RelativeSeek = 1
mode2Int SeekFromEnd = 2
foreign import ccall unsafe "unistd.h lseek" cLSeek
:: CInt -> FileOffset -> CInt -> IO FileOffset
defaultBufSize :: Int
defaultBufSize = 1024
makefdCallback ::
(MonadIO m) =>
Ptr el
-> ByteCount
-> Fd
-> st
-> m (Either SomeException ((Bool, st), B.ByteString))
makefdCallback p bufsize fd st = do
n <- liftIO $ myfdRead fd (castPtr p) bufsize
case n of
Left _ -> return $ Left (error "myfdRead failed")
Right 0 -> liftIO yield >> return (Right ((False, st), empty))
Right n' -> liftM (\s -> Right ((True, st), s)) $
readFromPtr p (fromIntegral n')
where
readFromPtr buf l = liftIO $ B.packCStringLen (castPtr buf, l)
makefdCallbackOBS ::
(MonadIO m) =>
Ptr el
-> ByteCount
-> Fd
-> st
-> m (Either SomeException ((Bool, st), Offset ByteString))
makefdCallbackOBS p bufsize fd st = do
o <- liftIO $ myfdSeek fd RelativeSeek 0
case o of
Left _ -> return $ Left (error "myfdSeek failed")
Right o' -> liftM (fmap (second (Offset o'))) (makefdCallback p bufsize fd st)
enumFdCatchOBS
:: forall e m a.(IException e, MonadCatchIO m)
=> Int
-> Fd
-> (e -> m (Maybe EnumException))
-> Enumerator (Offset ByteString) m a
enumFdCatchOBS bs fd handler iter =
let bufsize = bs
in CIO.bracket (liftIO $ mallocBytes bufsize)
(liftIO . free)
(\p -> enumFromCallbackCatch (makefdCallbackOBS p (fromIntegral bufsize) fd) handler () iter)
enumFdRandomOBS
:: forall m a.(MonadCatchIO m) =>
Int
-> Fd
-> Enumerator (Offset ByteString) m a
enumFdRandomOBS bs fd iter = enumFdCatchOBS bs fd handler iter
where
handler (SeekException off) =
liftM (either
(const . Just $ enStrExc "Error seeking within file descriptor")
(const Nothing))
. liftIO . myfdSeek fd AbsoluteSeek $ fromIntegral off
fileDriverOBS
:: (MonadCatchIO m) =>
(Int -> Fd -> Enumerator (Offset ByteString) m a)
-> Int
-> Iteratee (Offset ByteString) m a
-> FilePath
-> m a
fileDriverOBS enumf bufsize iter filepath = CIO.bracket
(liftIO $ openFd filepath ReadOnly Nothing defaultFileFlags)
(liftIO . closeFd)
(run <=< flip (enumf bufsize) iter)
fileDriverRandomFdOBS
:: (MonadCatchIO m) =>
Int
-> Iteratee (Offset ByteString) m a
-> FilePath
-> m a
fileDriverRandomFdOBS = fileDriverOBS enumFdRandomOBS
enumFile'OBS :: (MonadCatchIO m) =>
(Int -> Fd -> Enumerator (Offset ByteString) m a)
-> Int
-> FilePath
-> Enumerator (Offset ByteString) m a
enumFile'OBS enumf bufsize filepath iter = CIO.bracket
(liftIO $ openFd filepath ReadOnly Nothing defaultFileFlags)
(liftIO . closeFd)
(flip (enumf bufsize) iter)
enumFileRandomOBS ::
(MonadCatchIO m)
=> Int
-> FilePath
-> Enumerator (Offset ByteString) m a
enumFileRandomOBS = enumFile'OBS enumFdRandomOBS
fileDriverRandomOBS
:: (MonadCatchIO m) =>
Iteratee (Offset ByteString) m a
-> FilePath
-> m a
fileDriverRandomOBS = fileDriverRandomFdOBS defaultBufSize