{-# LANGUAGE CPP #-}
#include "inline.hs"
module Streamly.Internal.FileSystem.Handle
(
getChunk
, getChunkOf
, putChunk
, read
, readWith
, readChunksWith
, readChunks
, reader
, readerWith
, chunkReader
, chunkReaderWith
, write
, writeWith
, writeChunks
, writeChunksWith
, writeMaybesWith
, writer
, writerWith
, chunkWriter
, putBytes
, putBytesWith
, putChunksWith
, putChunks
, chunkReaderFromToWith
, readChunksWithBufferOf
, readWithBufferOf
, writeChunksWithBufferOf
, writeWithBufferOf
)
where
import Control.Exception (assert)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Function ((&))
import Data.Maybe (isNothing, fromJust)
import Data.Word (Word8)
import Streamly.Internal.Data.Unbox (Unbox)
import System.IO (Handle, SeekMode(..), hGetBufSome, hPutBuf, hSeek)
import Prelude hiding (read)
import Streamly.Internal.Data.Fold (Fold)
import Streamly.Internal.Data.Refold.Type (Refold(..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))
import Streamly.Internal.Data.Array.Type
(Array(..), pinnedWriteNUnsafe, unsafeFreezeWithShrink, byteLength)
import Streamly.Internal.Data.Stream.Type (Stream)
import Streamly.Internal.Data.Array.Stream (lpackArraysChunksOf)
import Streamly.Internal.System.IO (defaultChunkSize)
import qualified Streamly.Data.Fold as FL
import qualified Streamly.Data.Array as A
import qualified Streamly.Internal.Data.Array.Type as A
import qualified Streamly.Internal.Data.Array.Stream as AS
import qualified Streamly.Internal.Data.MutArray.Type as MArray
import qualified Streamly.Internal.Data.Refold.Type as Refold
import qualified Streamly.Internal.Data.Fold.Type as FL(refoldMany)
import qualified Streamly.Internal.Data.Stream as S
import qualified Streamly.Internal.Data.Stream as D
(Stream(..), Step(..))
import qualified Streamly.Internal.Data.Unfold as UF
import qualified Streamly.Internal.Data.StreamK.Type as K (mkStream)
#include "DocTestFileSystemHandle.hs"
{-# INLINABLE getChunk #-}
getChunk :: MonadIO m => Int -> Handle -> m (Array Word8)
getChunk :: forall (m :: * -> *). MonadIO m => Int -> Handle -> m (Array Word8)
getChunk Int
size Handle
h = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
MutArray Any
arr <- forall (m :: * -> *) a. MonadIO m => Int -> m (MutArray a)
MArray.pinnedNewBytes Int
size
forall (m :: * -> *) a b.
MonadIO m =>
MutArray a -> (Ptr a -> m b) -> m b
MArray.asPtrUnsafe MutArray Any
arr forall a b. (a -> b) -> a -> b
$ \Ptr Any
p -> do
Int
n <- forall a. Handle -> Ptr a -> Int -> IO Int
hGetBufSome Handle
h Ptr Any
p Int
size
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall a. Unbox a => MutArray a -> Array a
unsafeFreezeWithShrink forall a b. (a -> b) -> a -> b
$
MutArray Any
arr { arrEnd :: Int
MArray.arrEnd = Int
n, arrBound :: Int
MArray.arrBound = Int
size }
{-# INLINABLE getChunkOf #-}
getChunkOf :: Int -> Handle -> IO (Array Word8)
getChunkOf :: Int -> Handle -> IO (Array Word8)
getChunkOf = forall a. HasCallStack => a
undefined
{-# INLINE _getChunksWith #-}
_getChunksWith :: MonadIO m => Int -> Handle -> Stream m (Array Word8)
_getChunksWith :: forall (m :: * -> *).
MonadIO m =>
Int -> Handle -> Stream m (Array Word8)
_getChunksWith Int
size Handle
h = forall (m :: * -> *) a. Applicative m => StreamK m a -> Stream m a
S.fromStreamK StreamK m (Array Word8)
go
where
go :: StreamK m (Array Word8)
go = forall (m :: * -> *) a.
(forall r.
State StreamK m a
-> (a -> StreamK m a -> m r) -> (a -> m r) -> m r -> m r)
-> StreamK m a
K.mkStream forall a b. (a -> b) -> a -> b
$ \State StreamK m (Array Word8)
_ Array Word8 -> StreamK m (Array Word8) -> m r
yld Array Word8 -> m r
_ m r
stp -> do
Array Word8
arr <- forall (m :: * -> *). MonadIO m => Int -> Handle -> m (Array Word8)
getChunk Int
size Handle
h
if forall a. Array a -> Int
byteLength Array Word8
arr forall a. Eq a => a -> a -> Bool
== Int
0
then m r
stp
else Array Word8 -> StreamK m (Array Word8) -> m r
yld Array Word8
arr StreamK m (Array Word8)
go
{-# INLINE_NORMAL readChunksWith #-}
readChunksWith :: MonadIO m => Int -> Handle -> Stream m (Array Word8)
readChunksWith :: forall (m :: * -> *).
MonadIO m =>
Int -> Handle -> Stream m (Array Word8)
readChunksWith Int
size Handle
h = forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream forall {m :: * -> *} {p} {p}.
MonadIO m =>
p -> p -> m (Step () (Array Word8))
step ()
where
{-# INLINE_LATE step #-}
step :: p -> p -> m (Step () (Array Word8))
step p
_ p
_ = do
Array Word8
arr <- forall (m :: * -> *). MonadIO m => Int -> Handle -> m (Array Word8)
getChunk Int
size Handle
h
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case forall a. Array a -> Int
byteLength Array Word8
arr of
Int
0 -> forall s a. Step s a
D.Stop
Int
_ -> forall s a. a -> s -> Step s a
D.Yield Array Word8
arr ()
{-# INLINE_NORMAL chunkReaderWith #-}
chunkReaderWith :: MonadIO m => Unfold m (Int, Handle) (Array Word8)
chunkReaderWith :: forall (m :: * -> *).
MonadIO m =>
Unfold m (Int, Handle) (Array Word8)
chunkReaderWith =
forall a c (m :: * -> *) b.
(a -> c) -> Unfold m c b -> Unfold m a b
UF.lmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *). MonadIO m => Int -> Handle -> m (Array Word8)
getChunk) forall (m :: * -> *) a. Applicative m => Unfold m (m a) a
UF.repeatM
forall a b. a -> (a -> b) -> b
& forall (m :: * -> *) b a.
Monad m =>
(b -> Bool) -> Unfold m a b -> Unfold m a b
UF.takeWhile ((forall a. Eq a => a -> a -> Bool
/= Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Array a -> Int
byteLength)
{-# DEPRECATED readChunksWithBufferOf "Please use chunkReaderWith instead." #-}
{-# INLINE_NORMAL readChunksWithBufferOf #-}
readChunksWithBufferOf :: MonadIO m => Unfold m (Int, Handle) (Array Word8)
readChunksWithBufferOf :: forall (m :: * -> *).
MonadIO m =>
Unfold m (Int, Handle) (Array Word8)
readChunksWithBufferOf = forall (m :: * -> *).
MonadIO m =>
Unfold m (Int, Handle) (Array Word8)
chunkReaderWith
{-# INLINE_NORMAL chunkReaderFromToWith #-}
chunkReaderFromToWith :: MonadIO m =>
Unfold m (Int, Int, Int, Handle) (Array Word8)
chunkReaderFromToWith :: forall (m :: * -> *).
MonadIO m =>
Unfold m (Int, Int, Int, Handle) (Array Word8)
chunkReaderFromToWith = forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold forall {m :: * -> *}.
MonadIO m =>
(Int, Int, Handle) -> m (Step (Int, Int, Handle) (Array Word8))
step forall {m :: * -> *} {a} {b}.
(MonadIO m, Integral a) =>
(a, a, b, Handle) -> m (a, b, Handle)
inject
where
inject :: (a, a, b, Handle) -> m (a, b, Handle)
inject (a
from, a
to, b
bufSize, Handle
h) = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
from
forall (m :: * -> *) a. Monad m => a -> m a
return (a
to forall a. Num a => a -> a -> a
- a
from forall a. Num a => a -> a -> a
+ a
1, b
bufSize, Handle
h)
{-# INLINE_LATE step #-}
step :: (Int, Int, Handle) -> m (Step (Int, Int, Handle) (Array Word8))
step (Int
remaining, Int
bufSize, Handle
h) =
if Int
remaining forall a. Ord a => a -> a -> Bool
<= Int
0
then forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Step s a
D.Stop
else do
Array Word8
arr <- forall (m :: * -> *). MonadIO m => Int -> Handle -> m (Array Word8)
getChunk (forall a. Ord a => a -> a -> a
min Int
bufSize Int
remaining) Handle
h
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case forall a. Array a -> Int
byteLength Array Word8
arr of
Int
0 -> forall s a. Step s a
D.Stop
Int
len ->
forall a. HasCallStack => Bool -> a -> a
assert (Int
len forall a. Ord a => a -> a -> Bool
<= Int
remaining)
forall a b. (a -> b) -> a -> b
$ forall s a. a -> s -> Step s a
D.Yield Array Word8
arr (Int
remaining forall a. Num a => a -> a -> a
- Int
len, Int
bufSize, Handle
h)
{-# INLINE readChunks #-}
readChunks :: MonadIO m => Handle -> Stream m (Array Word8)
readChunks :: forall (m :: * -> *). MonadIO m => Handle -> Stream m (Array Word8)
readChunks = forall (m :: * -> *).
MonadIO m =>
Int -> Handle -> Stream m (Array Word8)
readChunksWith Int
defaultChunkSize
{-# INLINE chunkReader #-}
chunkReader :: MonadIO m => Unfold m Handle (Array Word8)
chunkReader :: forall (m :: * -> *). MonadIO m => Unfold m Handle (Array Word8)
chunkReader = forall a (m :: * -> *) b c. a -> Unfold m (a, b) c -> Unfold m b c
UF.first Int
defaultChunkSize forall (m :: * -> *).
MonadIO m =>
Unfold m (Int, Handle) (Array Word8)
chunkReaderWith
{-# INLINE readerWith #-}
readerWith :: MonadIO m => Unfold m (Int, Handle) Word8
readerWith :: forall (m :: * -> *). MonadIO m => Unfold m (Int, Handle) Word8
readerWith = forall (m :: * -> *) b c a.
Monad m =>
Unfold m b c -> Unfold m a b -> Unfold m a c
UF.many forall (m :: * -> *) a. (Monad m, Unbox a) => Unfold m (Array a) a
A.reader forall (m :: * -> *).
MonadIO m =>
Unfold m (Int, Handle) (Array Word8)
chunkReaderWith
{-# DEPRECATED readWithBufferOf "Please use 'readerWith' instead." #-}
{-# INLINE readWithBufferOf #-}
readWithBufferOf :: MonadIO m => Unfold m (Int, Handle) Word8
readWithBufferOf :: forall (m :: * -> *). MonadIO m => Unfold m (Int, Handle) Word8
readWithBufferOf = forall (m :: * -> *). MonadIO m => Unfold m (Int, Handle) Word8
readerWith
{-# INLINE concatChunks #-}
concatChunks :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a
concatChunks :: forall (m :: * -> *) a.
(Monad m, Unbox a) =>
Stream m (Array a) -> Stream m a
concatChunks = forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
S.unfoldMany forall (m :: * -> *) a. (Monad m, Unbox a) => Unfold m (Array a) a
A.reader
{-# INLINE readWith #-}
readWith :: MonadIO m => Int -> Handle -> Stream m Word8
readWith :: forall (m :: * -> *). MonadIO m => Int -> Handle -> Stream m Word8
readWith Int
size Handle
h = forall (m :: * -> *) a.
(Monad m, Unbox a) =>
Stream m (Array a) -> Stream m a
concatChunks forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
Int -> Handle -> Stream m (Array Word8)
readChunksWith Int
size Handle
h
{-# INLINE reader #-}
reader :: MonadIO m => Unfold m Handle Word8
reader :: forall (m :: * -> *). MonadIO m => Unfold m Handle Word8
reader = forall (m :: * -> *) b c a.
Monad m =>
Unfold m b c -> Unfold m a b -> Unfold m a c
UF.many forall (m :: * -> *) a. (Monad m, Unbox a) => Unfold m (Array a) a
A.reader forall (m :: * -> *). MonadIO m => Unfold m Handle (Array Word8)
chunkReader
{-# INLINE read #-}
read :: MonadIO m => Handle -> Stream m Word8
read :: forall (m :: * -> *). MonadIO m => Handle -> Stream m Word8
read = forall (m :: * -> *) a.
(Monad m, Unbox a) =>
Stream m (Array a) -> Stream m a
concatChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => Handle -> Stream m (Array Word8)
readChunks
{-# INLINABLE putChunk #-}
putChunk :: MonadIO m => Handle -> Array a -> m ()
putChunk :: forall (m :: * -> *) a. MonadIO m => Handle -> Array a -> m ()
putChunk Handle
_ Array a
arr | forall a. Array a -> Int
byteLength Array a
arr forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
putChunk Handle
h Array a
arr = forall (m :: * -> *) a b.
MonadIO m =>
Array a -> (Ptr a -> m b) -> m b
A.asPtrUnsafe Array a
arr forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
h Ptr a
ptr Int
aLen
where
aLen :: Int
aLen = forall a. Array a -> Int
A.byteLength Array a
arr
{-# INLINE putChunks #-}
putChunks :: MonadIO m => Handle -> Stream m (Array a) -> m ()
putChunks :: forall (m :: * -> *) a.
MonadIO m =>
Handle -> Stream m (Array a) -> m ()
putChunks Handle
h = forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
S.fold (forall (m :: * -> *) a b. Monad m => (a -> m b) -> Fold m a ()
FL.drainMapM (forall (m :: * -> *) a. MonadIO m => Handle -> Array a -> m ()
putChunk Handle
h))
{-# INLINE putChunksWith #-}
putChunksWith :: (MonadIO m, Unbox a)
=> Int -> Handle -> Stream m (Array a) -> m ()
putChunksWith :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Handle -> Stream m (Array a) -> m ()
putChunksWith Int
n Handle
h Stream m (Array a)
xs = forall (m :: * -> *) a.
MonadIO m =>
Handle -> Stream m (Array a) -> m ()
putChunks Handle
h forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Stream m (Array a) -> Stream m (Array a)
AS.compact Int
n Stream m (Array a)
xs
{-# INLINE putBytesWith #-}
putBytesWith :: MonadIO m => Int -> Handle -> Stream m Word8 -> m ()
putBytesWith :: forall (m :: * -> *).
MonadIO m =>
Int -> Handle -> Stream m Word8 -> m ()
putBytesWith Int
n Handle
h Stream m Word8
m = forall (m :: * -> *) a.
MonadIO m =>
Handle -> Stream m (Array a) -> m ()
putChunks Handle
h forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Stream m a -> Stream m (Array a)
A.pinnedChunksOf Int
n Stream m Word8
m
{-# INLINE putBytes #-}
putBytes :: MonadIO m => Handle -> Stream m Word8 -> m ()
putBytes :: forall (m :: * -> *). MonadIO m => Handle -> Stream m Word8 -> m ()
putBytes = forall (m :: * -> *).
MonadIO m =>
Int -> Handle -> Stream m Word8 -> m ()
putBytesWith Int
defaultChunkSize
{-# INLINE writeChunks #-}
writeChunks :: MonadIO m => Handle -> Fold m (Array a) ()
writeChunks :: forall (m :: * -> *) a. MonadIO m => Handle -> Fold m (Array a) ()
writeChunks Handle
h = forall (m :: * -> *) a b. Monad m => (a -> m b) -> Fold m a ()
FL.drainMapM (forall (m :: * -> *) a. MonadIO m => Handle -> Array a -> m ()
putChunk Handle
h)
{-# INLINE chunkWriter #-}
chunkWriter :: MonadIO m => Refold m Handle (Array a) ()
chunkWriter :: forall (m :: * -> *) a. MonadIO m => Refold m Handle (Array a) ()
chunkWriter = forall (m :: * -> *) c a b.
Monad m =>
(c -> a -> m b) -> Refold m c a ()
Refold.drainBy forall (m :: * -> *) a. MonadIO m => Handle -> Array a -> m ()
putChunk
{-# INLINE writeChunksWith #-}
writeChunksWith :: (MonadIO m, Unbox a)
=> Int -> Handle -> Fold m (Array a) ()
writeChunksWith :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Handle -> Fold m (Array a) ()
writeChunksWith Int
n Handle
h = forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m (Array a) () -> Fold m (Array a) ()
lpackArraysChunksOf Int
n (forall (m :: * -> *) a. MonadIO m => Handle -> Fold m (Array a) ()
writeChunks Handle
h)
{-# DEPRECATED writeChunksWithBufferOf "Please use writeChunksWith instead." #-}
{-# INLINE writeChunksWithBufferOf #-}
writeChunksWithBufferOf :: (MonadIO m, Unbox a)
=> Int -> Handle -> Fold m (Array a) ()
writeChunksWithBufferOf :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Handle -> Fold m (Array a) ()
writeChunksWithBufferOf = forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Handle -> Fold m (Array a) ()
writeChunksWith
{-# INLINE writeWith #-}
writeWith :: MonadIO m => Int -> Handle -> Fold m Word8 ()
writeWith :: forall (m :: * -> *). MonadIO m => Int -> Handle -> Fold m Word8 ()
writeWith Int
n Handle
h = forall (m :: * -> *) a b c.
Monad m =>
Int -> Fold m a b -> Fold m b c -> Fold m a c
FL.groupsOf Int
n (forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (Array a)
pinnedWriteNUnsafe Int
n) (forall (m :: * -> *) a. MonadIO m => Handle -> Fold m (Array a) ()
writeChunks Handle
h)
{-# DEPRECATED writeWithBufferOf "Please use writeWith instead." #-}
{-# INLINE writeWithBufferOf #-}
writeWithBufferOf :: MonadIO m => Int -> Handle -> Fold m Word8 ()
writeWithBufferOf :: forall (m :: * -> *). MonadIO m => Int -> Handle -> Fold m Word8 ()
writeWithBufferOf = forall (m :: * -> *). MonadIO m => Int -> Handle -> Fold m Word8 ()
writeWith
{-# INLINE writeMaybesWith #-}
writeMaybesWith :: (MonadIO m )
=> Int -> Handle -> Fold m (Maybe Word8) ()
writeMaybesWith :: forall (m :: * -> *).
MonadIO m =>
Int -> Handle -> Fold m (Maybe Word8) ()
writeMaybesWith Int
n Handle
h =
let writeNJusts :: Fold m (Maybe Word8) (Array Word8)
writeNJusts = forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
FL.lmap forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (Array a)
A.pinnedWriteN Int
n
writeOnNothing :: Fold m (Maybe Word8) (Array Word8)
writeOnNothing = forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Fold m a b
FL.takeEndBy_ forall a. Maybe a -> Bool
isNothing Fold m (Maybe Word8) (Array Word8)
writeNJusts
in forall (m :: * -> *) a b c.
Monad m =>
Fold m a b -> Fold m b c -> Fold m a c
FL.many Fold m (Maybe Word8) (Array Word8)
writeOnNothing (forall (m :: * -> *) a. MonadIO m => Handle -> Fold m (Array a) ()
writeChunks Handle
h)
{-# INLINE writerWith #-}
writerWith :: MonadIO m => Int -> Refold m Handle Word8 ()
writerWith :: forall (m :: * -> *). MonadIO m => Int -> Refold m Handle Word8 ()
writerWith Int
n =
forall (m :: * -> *) a b x c.
Monad m =>
Fold m a b -> Refold m x b c -> Refold m x a c
FL.refoldMany (forall (m :: * -> *) a b.
Monad m =>
Int -> Fold m a b -> Fold m a b
FL.take Int
n forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (Array a)
pinnedWriteNUnsafe Int
n) forall (m :: * -> *) a. MonadIO m => Refold m Handle (Array a) ()
chunkWriter
{-# INLINE write #-}
write :: MonadIO m => Handle -> Fold m Word8 ()
write :: forall (m :: * -> *). MonadIO m => Handle -> Fold m Word8 ()
write = forall (m :: * -> *). MonadIO m => Int -> Handle -> Fold m Word8 ()
writeWith Int
defaultChunkSize
{-# INLINE writer #-}
writer :: MonadIO m => Refold m Handle Word8 ()
writer :: forall (m :: * -> *). MonadIO m => Refold m Handle Word8 ()
writer = forall (m :: * -> *). MonadIO m => Int -> Refold m Handle Word8 ()
writerWith Int
defaultChunkSize