#include "inline.hs"
module Streamly.Internal.FileSystem.File
(
withFile
, readWithBufferOf
, read
, toBytes
, readChunksWithBufferOf
, readChunksFromToWith
, readChunks
, toChunksWithBufferOf
, toChunks
, write
, writeWithBufferOf
, fromBytes
, fromBytesWithBufferOf
, putChunk
, writeChunks
, fromChunks
, append
, appendWithBufferOf
, appendArray
, appendChunks
)
where
import Control.Monad.Catch (MonadCatch)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Word (Word8)
import Foreign.Storable (Storable(..))
import System.IO (Handle, openFile, IOMode(..), hClose)
import Prelude hiding (read)
import qualified Control.Monad.Catch as MC
import qualified System.IO as SIO
import Streamly.Internal.Control.Concurrent (MonadAsync)
import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))
import Streamly.Internal.Data.Array.Foreign.Type (Array(..), writeNUnsafe)
import Streamly.Internal.Data.Stream.Serial (SerialT)
import Streamly.Internal.Data.Stream.IsStream.Type (IsStream)
import Streamly.Internal.System.IO (defaultChunkSize)
import qualified Streamly.Internal.Data.Array.Foreign as A
import qualified Streamly.Internal.Data.Fold.Type as FL
import qualified Streamly.Internal.Data.Unfold as UF
import qualified Streamly.Internal.FileSystem.Handle as FH
import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS
import qualified Streamly.Internal.Data.Stream.IsStream as S
{-# INLINE withFile #-}
withFile :: (IsStream t, MonadCatch m, MonadAsync m)
=> FilePath -> IOMode -> (Handle -> t m a) -> t m a
withFile :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, MonadCatch m, MonadAsync m) =>
FilePath -> IOMode -> (Handle -> t m a) -> t m a
withFile FilePath
file IOMode
mode = forall (t :: (* -> *) -> * -> *) (m :: * -> *) b c a.
(IsStream t, MonadAsync m, MonadCatch m) =>
m b -> (b -> m c) -> (b -> t m a) -> t m a
S.bracket (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
openFile FilePath
file IOMode
mode) (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
hClose)
{-# INLINE usingFile #-}
usingFile :: (MonadCatch m, MonadAsync m)
=> Unfold m Handle a -> Unfold m FilePath a
usingFile :: forall (m :: * -> *) a.
(MonadCatch m, MonadAsync m) =>
Unfold m Handle a -> Unfold m FilePath a
usingFile =
forall (m :: * -> *) a c d b.
(MonadAsync m, MonadCatch m) =>
(a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b
UF.bracket (\FilePath
file -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
openFile FilePath
file IOMode
ReadMode)
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
hClose)
{-# INLINE usingFile2 #-}
usingFile2 :: (MonadCatch m, MonadAsync m)
=> Unfold m (x, Handle) a -> Unfold m (x, FilePath) a
usingFile2 :: forall (m :: * -> *) x a.
(MonadCatch m, MonadAsync m) =>
Unfold m (x, Handle) a -> Unfold m (x, FilePath) a
usingFile2 = forall (m :: * -> *) a c d b.
(MonadAsync m, MonadCatch m) =>
(a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b
UF.bracket forall {m :: * -> *} {a}.
MonadIO m =>
(a, FilePath) -> m (a, Handle)
before forall {m :: * -> *} {a}. MonadIO m => (a, Handle) -> m ()
after
where
before :: (a, FilePath) -> m (a, Handle)
before (a
x, FilePath
file) = do
Handle
h <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
openFile FilePath
file IOMode
ReadMode
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, Handle
h)
after :: (a, Handle) -> m ()
after (a
_, Handle
h) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
h
{-# INLINE usingFile3 #-}
usingFile3 :: (MonadCatch m, MonadAsync m)
=> Unfold m (x, y, z, Handle) a -> Unfold m (x, y, z, FilePath) a
usingFile3 :: forall (m :: * -> *) x y z a.
(MonadCatch m, MonadAsync m) =>
Unfold m (x, y, z, Handle) a -> Unfold m (x, y, z, FilePath) a
usingFile3 = forall (m :: * -> *) a c d b.
(MonadAsync m, MonadCatch m) =>
(a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b
UF.bracket forall {m :: * -> *} {a} {b} {c}.
MonadIO m =>
(a, b, c, FilePath) -> m (a, b, c, Handle)
before forall {m :: * -> *} {a} {b} {c}.
MonadIO m =>
(a, b, c, Handle) -> m ()
after
where
before :: (a, b, c, FilePath) -> m (a, b, c, Handle)
before (a
x, b
y, c
z, FilePath
file) = do
Handle
h <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
openFile FilePath
file IOMode
ReadMode
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, b
y, c
z, Handle
h)
after :: (a, b, c, Handle) -> m ()
after (a
_, b
_, c
_, Handle
h) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
h
{-# INLINABLE putChunk #-}
putChunk :: Storable a => FilePath -> Array a -> IO ()
putChunk :: forall a. Storable a => FilePath -> Array a -> IO ()
putChunk FilePath
file Array a
arr = forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
SIO.withFile FilePath
file IOMode
WriteMode (forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Handle -> Array a -> m ()
`FH.putChunk` Array a
arr)
{-# INLINABLE appendArray #-}
appendArray :: Storable a => FilePath -> Array a -> IO ()
appendArray :: forall a. Storable a => FilePath -> Array a -> IO ()
appendArray FilePath
file Array a
arr = forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
SIO.withFile FilePath
file IOMode
AppendMode (forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Handle -> Array a -> m ()
`FH.putChunk` Array a
arr)
{-# INLINE toChunksWithBufferOf #-}
toChunksWithBufferOf :: (IsStream t, MonadCatch m, MonadAsync m)
=> Int -> FilePath -> t m (Array Word8)
toChunksWithBufferOf :: forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadCatch m, MonadAsync m) =>
Int -> FilePath -> t m (Array Word8)
toChunksWithBufferOf Int
size FilePath
file =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, MonadCatch m, MonadAsync m) =>
FilePath -> IOMode -> (Handle -> t m a) -> t m a
withFile FilePath
file IOMode
ReadMode (forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadIO m) =>
Int -> Handle -> t m (Array Word8)
FH.toChunksWithBufferOf Int
size)
{-# INLINE toChunks #-}
toChunks :: (IsStream t, MonadCatch m, MonadAsync m)
=> FilePath -> t m (Array Word8)
toChunks :: forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadCatch m, MonadAsync m) =>
FilePath -> t m (Array Word8)
toChunks = forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadCatch m, MonadAsync m) =>
Int -> FilePath -> t m (Array Word8)
toChunksWithBufferOf Int
defaultChunkSize
{-# INLINE readChunksWithBufferOf #-}
readChunksWithBufferOf :: (MonadCatch m, MonadAsync m)
=> Unfold m (Int, FilePath) (Array Word8)
readChunksWithBufferOf :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
Unfold m (Int, FilePath) (Array Word8)
readChunksWithBufferOf = forall (m :: * -> *) x a.
(MonadCatch m, MonadAsync m) =>
Unfold m (x, Handle) a -> Unfold m (x, FilePath) a
usingFile2 forall (m :: * -> *).
MonadIO m =>
Unfold m (Int, Handle) (Array Word8)
FH.readChunksWithBufferOf
{-# INLINE readChunksFromToWith #-}
readChunksFromToWith :: (MonadCatch m, MonadAsync m) =>
Unfold m (Int, Int, Int, FilePath) (Array Word8)
readChunksFromToWith :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
Unfold m (Int, Int, Int, FilePath) (Array Word8)
readChunksFromToWith = forall (m :: * -> *) x y z a.
(MonadCatch m, MonadAsync m) =>
Unfold m (x, y, z, Handle) a -> Unfold m (x, y, z, FilePath) a
usingFile3 forall (m :: * -> *).
MonadIO m =>
Unfold m (Int, Int, Int, Handle) (Array Word8)
FH.readChunksFromToWith
{-# INLINE readChunks #-}
readChunks :: (MonadCatch m, MonadAsync m) => Unfold m FilePath (Array Word8)
readChunks :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
Unfold m FilePath (Array Word8)
readChunks = forall (m :: * -> *) a.
(MonadCatch m, MonadAsync m) =>
Unfold m Handle a -> Unfold m FilePath a
usingFile forall (m :: * -> *). MonadIO m => Unfold m Handle (Array Word8)
FH.readChunks
{-# INLINE readWithBufferOf #-}
readWithBufferOf :: (MonadCatch m, MonadAsync m) => Unfold m (Int, FilePath) Word8
readWithBufferOf :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
Unfold m (Int, FilePath) Word8
readWithBufferOf = forall (m :: * -> *) x a.
(MonadCatch m, MonadAsync m) =>
Unfold m (x, Handle) a -> Unfold m (x, FilePath) a
usingFile2 forall (m :: * -> *). MonadIO m => Unfold m (Int, Handle) Word8
FH.readWithBufferOf
{-# INLINE read #-}
read :: (MonadCatch m, MonadAsync m) => Unfold m FilePath Word8
read :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
Unfold m FilePath Word8
read = forall (m :: * -> *) a b c.
Monad m =>
Unfold m a b -> Unfold m b c -> Unfold m a c
UF.many (forall (m :: * -> *) a.
(MonadCatch m, MonadAsync m) =>
Unfold m Handle a -> Unfold m FilePath a
usingFile forall (m :: * -> *). MonadIO m => Unfold m Handle (Array Word8)
FH.readChunks) forall (m :: * -> *) a.
(Monad m, Storable a) =>
Unfold m (Array a) a
A.read
{-# INLINE toBytes #-}
toBytes :: (IsStream t, MonadCatch m, MonadAsync m) => FilePath -> t m Word8
toBytes :: forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadCatch m, MonadAsync m) =>
FilePath -> t m Word8
toBytes FilePath
file = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m, Storable a) =>
t m (Array a) -> t m a
AS.concat forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, MonadCatch m, MonadAsync m) =>
FilePath -> IOMode -> (Handle -> t m a) -> t m a
withFile FilePath
file IOMode
ReadMode forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(IsStream t, MonadIO m) =>
Handle -> t m (Array Word8)
FH.toChunks
{-# INLINE fromChunksMode #-}
fromChunksMode :: (MonadAsync m, MonadCatch m, Storable a)
=> IOMode -> FilePath -> SerialT m (Array a) -> m ()
fromChunksMode :: forall (m :: * -> *) a.
(MonadAsync m, MonadCatch m, Storable a) =>
IOMode -> FilePath -> SerialT m (Array a) -> m ()
fromChunksMode IOMode
mode FilePath
file SerialT m (Array a)
xs = forall (m :: * -> *) a. Monad m => SerialT m a -> m ()
S.drain forall a b. (a -> b) -> a -> b
$
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, MonadCatch m, MonadAsync m) =>
FilePath -> IOMode -> (Handle -> t m a) -> t m a
withFile FilePath
file IOMode
mode (\Handle
h -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, MonadAsync m) =>
(a -> m b) -> t m a -> t m b
S.mapM (forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Handle -> Array a -> m ()
FH.putChunk Handle
h) SerialT m (Array a)
xs)
{-# INLINE fromChunks #-}
fromChunks :: (MonadAsync m, MonadCatch m, Storable a)
=> FilePath -> SerialT m (Array a) -> m ()
fromChunks :: forall (m :: * -> *) a.
(MonadAsync m, MonadCatch m, Storable a) =>
FilePath -> SerialT m (Array a) -> m ()
fromChunks = forall (m :: * -> *) a.
(MonadAsync m, MonadCatch m, Storable a) =>
IOMode -> FilePath -> SerialT m (Array a) -> m ()
fromChunksMode IOMode
WriteMode
{-# INLINE fromBytesWithBufferOf #-}
fromBytesWithBufferOf :: (MonadAsync m, MonadCatch m)
=> Int -> FilePath -> SerialT m Word8 -> m ()
fromBytesWithBufferOf :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
Int -> FilePath -> SerialT m Word8 -> m ()
fromBytesWithBufferOf Int
n FilePath
file SerialT m Word8
xs = forall (m :: * -> *) a.
(MonadAsync m, MonadCatch m, Storable a) =>
FilePath -> SerialT m (Array a) -> m ()
fromChunks FilePath
file forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, MonadIO m, Storable a) =>
Int -> t m a -> t m (Array a)
AS.arraysOf Int
n SerialT m Word8
xs
{-# INLINE fromBytes #-}
fromBytes :: (MonadAsync m, MonadCatch m) => FilePath -> SerialT m Word8 -> m ()
fromBytes :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> SerialT m Word8 -> m ()
fromBytes = forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
Int -> FilePath -> SerialT m Word8 -> m ()
fromBytesWithBufferOf Int
defaultChunkSize
{-# INLINE writeChunks #-}
writeChunks :: (MonadIO m, MonadCatch m, Storable a)
=> FilePath -> Fold m (Array a) ()
writeChunks :: forall (m :: * -> *) a.
(MonadIO m, MonadCatch m, Storable a) =>
FilePath -> Fold m (Array a) ()
writeChunks FilePath
path = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *} {a} {b} {b}.
(MonadCatch m, MonadIO m) =>
(Fold m a b, Handle) -> a -> m (Step (Fold m a b, Handle) b)
step forall {b}. m (Step (Fold m (Array a) (), Handle) b)
initial forall {m :: * -> *} {a} {b}.
MonadIO m =>
(Fold m a b, Handle) -> m b
extract
where
initial :: m (Step (Fold m (Array a) (), Handle) b)
initial = do
Handle
h <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IOMode -> IO Handle
openFile FilePath
path IOMode
WriteMode)
Fold m (Array a) ()
fld <- forall (m :: * -> *) a b. Monad m => Fold m a b -> m (Fold m a b)
FL.initialize (forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Handle -> Fold m (Array a) ()
FH.writeChunks Handle
h)
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`MC.onException` forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO ()
hClose Handle
h)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
FL.Partial (Fold m (Array a) ()
fld, Handle
h)
step :: (Fold m a b, Handle) -> a -> m (Step (Fold m a b, Handle) b)
step (Fold m a b
fld, Handle
h) a
x = do
Fold m a b
r <- forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> a -> m (Fold m a b)
FL.snoc Fold m a b
fld a
x forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`MC.onException` forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO ()
hClose Handle
h)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
FL.Partial (Fold m a b
r, Handle
h)
extract :: (Fold m a b, Handle) -> m b
extract (Fold s -> a -> m (Step s b)
_ m (Step s b)
initial1 s -> m b
extract1, Handle
h) = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
h
Step s b
res <- m (Step s b)
initial1
case Step s b
res of
FL.Partial s
fs -> s -> m b
extract1 s
fs
FL.Done b
fb -> forall (m :: * -> *) a. Monad m => a -> m a
return b
fb
{-# INLINE writeWithBufferOf #-}
writeWithBufferOf :: (MonadIO m, MonadCatch m)
=> Int -> FilePath -> Fold m Word8 ()
writeWithBufferOf :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Int -> FilePath -> Fold m Word8 ()
writeWithBufferOf Int
n FilePath
path =
forall (m :: * -> *) a b c.
Monad m =>
Int -> Fold m a b -> Fold m b c -> Fold m a c
FL.chunksOf Int
n (forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Fold m a (Array a)
writeNUnsafe Int
n) (forall (m :: * -> *) a.
(MonadIO m, MonadCatch m, Storable a) =>
FilePath -> Fold m (Array a) ()
writeChunks FilePath
path)
{-# INLINE write #-}
write :: (MonadIO m, MonadCatch m) => FilePath -> Fold m Word8 ()
write :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> Fold m Word8 ()
write = forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Int -> FilePath -> Fold m Word8 ()
writeWithBufferOf Int
defaultChunkSize
{-# INLINE appendChunks #-}
appendChunks :: (MonadAsync m, MonadCatch m, Storable a)
=> FilePath -> SerialT m (Array a) -> m ()
appendChunks :: forall (m :: * -> *) a.
(MonadAsync m, MonadCatch m, Storable a) =>
FilePath -> SerialT m (Array a) -> m ()
appendChunks = forall (m :: * -> *) a.
(MonadAsync m, MonadCatch m, Storable a) =>
IOMode -> FilePath -> SerialT m (Array a) -> m ()
fromChunksMode IOMode
AppendMode
{-# INLINE appendWithBufferOf #-}
appendWithBufferOf :: (MonadAsync m, MonadCatch m)
=> Int -> FilePath -> SerialT m Word8 -> m ()
appendWithBufferOf :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
Int -> FilePath -> SerialT m Word8 -> m ()
appendWithBufferOf Int
n FilePath
file SerialT m Word8
xs = forall (m :: * -> *) a.
(MonadAsync m, MonadCatch m, Storable a) =>
FilePath -> SerialT m (Array a) -> m ()
appendChunks FilePath
file forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, MonadIO m, Storable a) =>
Int -> t m a -> t m (Array a)
AS.arraysOf Int
n SerialT m Word8
xs
{-# INLINE append #-}
append :: (MonadAsync m, MonadCatch m) => FilePath -> SerialT m Word8 -> m ()
append :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
FilePath -> SerialT m Word8 -> m ()
append = forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
Int -> FilePath -> SerialT m Word8 -> m ()
appendWithBufferOf Int
defaultChunkSize