module Data.Iteratee.IO.Fd(
#if defined(USE_POSIX)
enumFd
,enumFdFollow
,enumFdRandom
,fileDriverFd
,fileDriverFollowFd
,fileDriverRandomFd
#endif
)
where
#if defined(USE_POSIX)
import Data.Iteratee.Base.StreamChunk (ReadableChunk (..))
import Data.Iteratee.Base
import Data.Iteratee.Binary()
import Data.Iteratee.IO.Base
import Control.Monad
import Control.Monad.IO.Class
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable
import System.IO (SeekMode(..))
import System.Posix hiding (FileOffset)
import GHC.Conc
enumFd :: forall s el m a.(ReadableChunk s el, MonadIO m) =>
Fd ->
EnumeratorGM s el m a
enumFd fd iter' =
liftIO (mallocForeignPtrBytes (fromIntegral buffer_size)) >>= loop iter'
where
buffer_size = fromIntegral $ 4096 mod 4096 (sizeOf (undefined :: el))
loop iter fp = do
s <- liftIO . withForeignPtr fp $ \p -> do
liftIO $ GHC.Conc.threadWaitRead fd
n <- myfdRead fd (castPtr p) buffer_size
case n of
Left _errno -> return $ Left "IO error"
Right 0 -> return $ Right Nothing
Right n' -> liftM (Right . Just) $ readFromPtr p (fromIntegral n')
checkres fp iter s
checkres fp iter = either (flip enumErr iter)
(maybe (return iter)
(check fp <=< runIter iter . Chunk))
check _p (Done x _) = return . return $ x
check p (Cont i Nothing) = loop i p
check _p (Cont _ (Just e)) = return $ throwErr e
enumFdFollow :: forall s el a.(ReadableChunk s el) =>
Fd ->
EnumeratorGM s el IO a
enumFdFollow fd iter' =
liftIO (mallocForeignPtrBytes (fromIntegral buffer_size)) >>= loop iter'
where
buffer_size = fromIntegral $ 4096 mod 4096 (sizeOf (undefined :: el))
loop iter fp = do
s <- readFollow iter fp
checkres fp iter s
readFollow iter fp = do
liftIO . withForeignPtr fp $ \p -> do
liftIO $ GHC.Conc.threadWaitRead fd
n <- myfdRead fd (castPtr p) buffer_size
case n of
Left _errno -> return $ Left "IO error"
Right 0 -> do liftIO $ threadDelay (250 * 1000)
readFollow iter fp
Right n' -> liftM (Right . Just) $ readFromPtr p (fromIntegral n')
checkres fp iter = either (flip enumErr iter)
(maybe (return iter)
(check fp <=< runIter iter . Chunk))
check _p (Done x _) = return . return $ x
check p (Cont i Nothing) = loop i p
check _p (Cont _ (Just e)) = return $ throwErr e
enumFdRandom :: forall s el m a.(ReadableChunk s el, MonadIO m) =>
Fd ->
EnumeratorGM s el m a
enumFdRandom fd iter' =
liftIO (mallocForeignPtrBytes (fromIntegral buffer_size)) >>= loop (0,0) iter'
where
buffer_size = fromIntegral $ 4096 mod 4096 (sizeOf (undefined :: el))
loop :: (FileOffset,Int) ->
IterateeG s el m a ->
ForeignPtr el ->
m (IterateeG s el m a)
loop (off,len) _iter _fp | off `seq` len `seq` False = undefined
loop (off,len) iter fp = do
s <- liftIO . withForeignPtr fp $ \p -> do
liftIO $ GHC.Conc.threadWaitRead fd
n <- myfdRead fd (castPtr p) buffer_size
case n of
Left _errno -> return $ Left "IO error"
Right 0 -> return $ Right Nothing
Right n' -> liftM
(Right . Just . (,) (off + fromIntegral len, fromIntegral n'))
(readFromPtr p (fromIntegral n'))
checkres fp iter s
seekTo pos@(off, len) off' iter fp
| off <= off' && off' < off + fromIntegral len =
do
let local_off = fromIntegral $ off' off
s <- liftIO $ withForeignPtr fp $ \p ->
readFromPtr (p `plusPtr` local_off) (len local_off)
igv <- runIter iter (Chunk s)
check pos fp igv
seekTo _pos off iter fp = do
off' <- liftIO $ myfdSeek fd AbsoluteSeek (fromIntegral off)
case off' of
Left _errno -> enumErr "IO error" iter
Right off'' -> loop (off'',0) iter fp
checkres fp iter = either
(flip enumErr iter)
(maybe (return iter) (uncurry $ runS fp iter))
runS fp iter o s = runIter iter (Chunk s) >>= check o fp
check _ _fp (Done x _) = return . return $ x
check o fp (Cont i Nothing) = loop o i fp
check o fp (Cont i (Just (Seek off))) = seekTo o off i fp
check _ _fp (Cont _ (Just e)) = return $ throwErr e
fileDriverFd :: (MonadIO m, ReadableChunk s el) =>
IterateeG s el m a ->
FilePath ->
m a
fileDriverFd iter filepath = do
fd <- liftIO $ openFd filepath ReadOnly Nothing defaultFileFlags
result <- enumFd fd iter >>= run
liftIO $ closeFd fd
return result
fileDriverFollowFd :: (ReadableChunk s el) =>
IterateeG s el IO a ->
(a -> IterateeG s el IO b) ->
FilePath ->
IO b
fileDriverFollowFd scanIter followIter filepath = do
fd <- liftIO $ openFd filepath ReadOnly Nothing defaultFileFlags
state <- enumFd fd scanIter >>= run
result <- enumFdFollow fd (followIter state) >>= run
liftIO $ closeFd fd
return result
fileDriverRandomFd :: (MonadIO m, ReadableChunk s el) =>
IterateeG s el m a ->
FilePath ->
m a
fileDriverRandomFd iter filepath = do
fd <- liftIO $ openFd filepath ReadOnly Nothing defaultFileFlags
result <- enumFdRandom fd iter >>= run
liftIO $ closeFd fd
return result
#endif