#include "inline.hs"
module Streamly.Internal.FileSystem.File
(
withFile
, readWithBufferOf
, read
, toBytes
, readChunksWithBufferOf
, readChunks
, toChunksWithBufferOf
, toChunks
, write
, writeWithBufferOf
, fromBytes
, fromBytesWithBufferOf
, writeArray
, 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.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))
import Streamly.Internal.Data.Array.Foreign.Type
(Array(..), defaultChunkSize, writeNUnsafe)
import Streamly.Internal.Data.Stream.Serial (SerialT)
import Streamly.Internal.Data.Stream.StreamK.Type (IsStream)
import Streamly.Internal.Data.SVar (MonadAsync)
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
import qualified Streamly.Data.Array.Foreign as A
{-# INLINE withFile #-}
withFile :: (IsStream t, MonadCatch m, MonadAsync m)
=> FilePath -> IOMode -> (Handle -> t m a) -> t m a
withFile :: FilePath -> IOMode -> (Handle -> t m a) -> t m a
withFile FilePath
file IOMode
mode = m Handle -> (Handle -> m ()) -> (Handle -> t m a) -> t m a
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 (IO Handle -> m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
openFile FilePath
file IOMode
mode) (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Handle -> IO ()) -> Handle -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
hClose)
{-# INLINABLE usingFile #-}
usingFile :: (MonadCatch m, MonadAsync m)
=> Unfold m Handle a -> Unfold m FilePath a
usingFile :: Unfold m Handle a -> Unfold m FilePath a
usingFile =
(FilePath -> m Handle)
-> (Handle -> m ()) -> Unfold m Handle a -> Unfold m FilePath a
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 -> IO Handle -> m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
openFile FilePath
file IOMode
ReadMode)
(IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Handle -> IO ()) -> Handle -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
hClose)
{-# INLINABLE usingFile2 #-}
usingFile2 :: (MonadCatch m, MonadAsync m)
=> Unfold m (x, Handle) a -> Unfold m (x, FilePath) a
usingFile2 :: Unfold m (x, Handle) a -> Unfold m (x, FilePath) a
usingFile2 = ((x, FilePath) -> m (x, Handle))
-> ((x, Handle) -> m ())
-> Unfold m (x, Handle) a
-> Unfold m (x, FilePath) a
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 (x, FilePath) -> m (x, Handle)
forall (m :: * -> *) a. MonadIO m => (a, FilePath) -> m (a, Handle)
before (x, Handle) -> m ()
forall (m :: * -> *) a. MonadIO m => (a, Handle) -> m ()
after
where
before :: (a, FilePath) -> m (a, Handle)
before (a
x, FilePath
file) = do
Handle
h <- IO Handle -> m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
openFile FilePath
file IOMode
ReadMode
(a, Handle) -> m (a, Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, Handle
h)
after :: (a, Handle) -> m ()
after (a
_, Handle
h) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
h
{-# INLINABLE writeArray #-}
writeArray :: Storable a => FilePath -> Array a -> IO ()
writeArray :: FilePath -> Array a -> IO ()
writeArray FilePath
file Array a
arr = FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
SIO.withFile FilePath
file IOMode
WriteMode (Handle -> Array a -> IO ()
forall a. Storable a => Handle -> Array a -> IO ()
`FH.writeArray` Array a
arr)
{-# INLINABLE appendArray #-}
appendArray :: Storable a => FilePath -> Array a -> IO ()
appendArray :: FilePath -> Array a -> IO ()
appendArray FilePath
file Array a
arr = FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
SIO.withFile FilePath
file IOMode
AppendMode (Handle -> Array a -> IO ()
forall a. Storable a => Handle -> Array a -> IO ()
`FH.writeArray` Array a
arr)
{-# INLINABLE toChunksWithBufferOf #-}
toChunksWithBufferOf :: (IsStream t, MonadCatch m, MonadAsync m)
=> Int -> FilePath -> t m (Array Word8)
toChunksWithBufferOf :: Int -> FilePath -> t m (Array Word8)
toChunksWithBufferOf Int
size FilePath
file =
FilePath
-> IOMode -> (Handle -> t m (Array Word8)) -> t m (Array Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, MonadCatch m, MonadAsync m) =>
FilePath -> IOMode -> (Handle -> t m a) -> t m a
withFile FilePath
file IOMode
ReadMode (Int -> Handle -> t m (Array Word8)
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 :: FilePath -> t m (Array Word8)
toChunks = Int -> FilePath -> t m (Array Word8)
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 :: Unfold m (Int, FilePath) (Array Word8)
readChunksWithBufferOf = Unfold m (Int, Handle) (Array Word8)
-> Unfold m (Int, FilePath) (Array Word8)
forall (m :: * -> *) x a.
(MonadCatch m, MonadAsync m) =>
Unfold m (x, Handle) a -> Unfold m (x, FilePath) a
usingFile2 Unfold m (Int, Handle) (Array Word8)
forall (m :: * -> *).
MonadIO m =>
Unfold m (Int, Handle) (Array Word8)
FH.readChunksWithBufferOf
{-# INLINE readChunks #-}
readChunks :: (MonadCatch m, MonadAsync m) => Unfold m FilePath (Array Word8)
readChunks :: Unfold m FilePath (Array Word8)
readChunks = Unfold m Handle (Array Word8) -> Unfold m FilePath (Array Word8)
forall (m :: * -> *) a.
(MonadCatch m, MonadAsync m) =>
Unfold m Handle a -> Unfold m FilePath a
usingFile Unfold m Handle (Array Word8)
forall (m :: * -> *). MonadIO m => Unfold m Handle (Array Word8)
FH.readChunks
{-# INLINE readWithBufferOf #-}
readWithBufferOf :: (MonadCatch m, MonadAsync m) => Unfold m (Int, FilePath) Word8
readWithBufferOf :: Unfold m (Int, FilePath) Word8
readWithBufferOf = Unfold m (Int, Handle) Word8 -> Unfold m (Int, FilePath) Word8
forall (m :: * -> *) x a.
(MonadCatch m, MonadAsync m) =>
Unfold m (x, Handle) a -> Unfold m (x, FilePath) a
usingFile2 Unfold m (Int, Handle) Word8
forall (m :: * -> *). MonadIO m => Unfold m (Int, Handle) Word8
FH.readWithBufferOf
{-# INLINE read #-}
read :: (MonadCatch m, MonadAsync m) => Unfold m FilePath Word8
read :: Unfold m FilePath Word8
read = Unfold m FilePath (Array Word8)
-> Unfold m (Array Word8) Word8 -> Unfold m FilePath Word8
forall (m :: * -> *) a b c.
Monad m =>
Unfold m a b -> Unfold m b c -> Unfold m a c
UF.many (Unfold m Handle (Array Word8) -> Unfold m FilePath (Array Word8)
forall (m :: * -> *) a.
(MonadCatch m, MonadAsync m) =>
Unfold m Handle a -> Unfold m FilePath a
usingFile Unfold m Handle (Array Word8)
forall (m :: * -> *). MonadIO m => Unfold m Handle (Array Word8)
FH.readChunks) Unfold m (Array Word8) Word8
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 :: FilePath -> t m Word8
toBytes FilePath
file = t m (Array Word8) -> t m Word8
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, MonadIO m, Storable a) =>
t m (Array a) -> t m a
AS.concat (t m (Array Word8) -> t m Word8) -> t m (Array Word8) -> t m Word8
forall a b. (a -> b) -> a -> b
$ FilePath
-> IOMode -> (Handle -> t m (Array Word8)) -> t m (Array Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, MonadCatch m, MonadAsync m) =>
FilePath -> IOMode -> (Handle -> t m a) -> t m a
withFile FilePath
file IOMode
ReadMode Handle -> t m (Array Word8)
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 :: IOMode -> FilePath -> SerialT m (Array a) -> m ()
fromChunksMode IOMode
mode FilePath
file SerialT m (Array a)
xs = SerialT m () -> m ()
forall (m :: * -> *) a. Monad m => SerialT m a -> m ()
S.drain (SerialT m () -> m ()) -> SerialT m () -> m ()
forall a b. (a -> b) -> a -> b
$
FilePath -> IOMode -> (Handle -> SerialT m ()) -> SerialT m ()
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 -> (Array a -> m ()) -> SerialT m (Array a) -> SerialT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, MonadAsync m) =>
(a -> m b) -> t m a -> t m b
S.mapM (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Array a -> IO ()) -> Array a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Array a -> IO ()
forall a. Storable a => Handle -> Array a -> IO ()
FH.writeArray Handle
h) SerialT m (Array a)
xs)
{-# INLINE fromChunks #-}
fromChunks :: (MonadAsync m, MonadCatch m, Storable a)
=> FilePath -> SerialT m (Array a) -> m ()
fromChunks :: FilePath -> SerialT m (Array a) -> m ()
fromChunks = IOMode -> FilePath -> SerialT m (Array a) -> m ()
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 :: Int -> FilePath -> SerialT m Word8 -> m ()
fromBytesWithBufferOf Int
n FilePath
file SerialT m Word8
xs = FilePath -> SerialT m (Array Word8) -> m ()
forall (m :: * -> *) a.
(MonadAsync m, MonadCatch m, Storable a) =>
FilePath -> SerialT m (Array a) -> m ()
fromChunks FilePath
file (SerialT m (Array Word8) -> m ())
-> SerialT m (Array Word8) -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> SerialT m Word8 -> SerialT m (Array Word8)
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 :: FilePath -> SerialT m Word8 -> m ()
fromBytes = Int -> FilePath -> SerialT m Word8 -> m ()
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 :: FilePath -> Fold m (Array a) ()
writeChunks FilePath
path = ((Fold m (Array a) (), Handle)
-> Array a -> m (Step (Fold m (Array a) (), Handle) ()))
-> m (Step (Fold m (Array a) (), Handle) ())
-> ((Fold m (Array a) (), Handle) -> m ())
-> Fold m (Array a) ()
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold (Fold m (Array a) (), Handle)
-> Array a -> m (Step (Fold m (Array a) (), Handle) ())
forall (m :: * -> *) a b b.
(MonadCatch m, MonadIO m) =>
(Fold m a b, Handle) -> a -> m (Step (Fold m a b, Handle) b)
step m (Step (Fold m (Array a) (), Handle) ())
forall b. m (Step (Fold m (Array a) (), Handle) b)
initial (Fold m (Array a) (), Handle) -> m ()
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 <- IO Handle -> m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IOMode -> IO Handle
openFile FilePath
path IOMode
WriteMode)
Fold m (Array a) ()
fld <- Fold m (Array a) () -> m (Fold m (Array a) ())
forall (m :: * -> *) a b. Monad m => Fold m a b -> m (Fold m a b)
FL.initialize (Handle -> Fold m (Array a) ()
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Handle -> Fold m (Array a) ()
FH.writeChunks Handle
h)
m (Fold m (Array a) ()) -> m () -> m (Fold m (Array a) ())
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`MC.onException` IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO ()
hClose Handle
h)
Step (Fold m (Array a) (), Handle) b
-> m (Step (Fold m (Array a) (), Handle) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Fold m (Array a) (), Handle) b
-> m (Step (Fold m (Array a) (), Handle) b))
-> Step (Fold m (Array a) (), Handle) b
-> m (Step (Fold m (Array a) (), Handle) b)
forall a b. (a -> b) -> a -> b
$ (Fold m (Array a) (), Handle)
-> Step (Fold m (Array a) (), Handle) 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 <- Fold m a b -> a -> m (Fold m a b)
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> a -> m (Fold m a b)
FL.runStep Fold m a b
fld a
x m (Fold m a b) -> m () -> m (Fold m a b)
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`MC.onException` IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO ()
hClose Handle
h)
Step (Fold m a b, Handle) b -> m (Step (Fold m a b, Handle) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Fold m a b, Handle) b -> m (Step (Fold m a b, Handle) b))
-> Step (Fold m a b, Handle) b -> m (Step (Fold m a b, Handle) b)
forall a b. (a -> b) -> a -> b
$ (Fold m a b, Handle) -> Step (Fold m a b, Handle) 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
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
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 -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
fb
{-# INLINE writeWithBufferOf #-}
writeWithBufferOf :: (MonadIO m, MonadCatch m)
=> Int -> FilePath -> Fold m Word8 ()
writeWithBufferOf :: Int -> FilePath -> Fold m Word8 ()
writeWithBufferOf Int
n FilePath
path =
Int
-> Fold m Word8 (Array Word8)
-> Fold m (Array Word8) ()
-> Fold m Word8 ()
forall (m :: * -> *) a b c.
Monad m =>
Int -> Fold m a b -> Fold m b c -> Fold m a c
FL.chunksOf Int
n (Int -> Fold m Word8 (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Fold m a (Array a)
writeNUnsafe Int
n) (FilePath -> Fold m (Array Word8) ()
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 :: FilePath -> Fold m Word8 ()
write = Int -> FilePath -> Fold m Word8 ()
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 :: FilePath -> SerialT m (Array a) -> m ()
appendChunks = IOMode -> FilePath -> SerialT m (Array a) -> m ()
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 :: Int -> FilePath -> SerialT m Word8 -> m ()
appendWithBufferOf Int
n FilePath
file SerialT m Word8
xs = FilePath -> SerialT m (Array Word8) -> m ()
forall (m :: * -> *) a.
(MonadAsync m, MonadCatch m, Storable a) =>
FilePath -> SerialT m (Array a) -> m ()
appendChunks FilePath
file (SerialT m (Array Word8) -> m ())
-> SerialT m (Array Word8) -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> SerialT m Word8 -> SerialT m (Array Word8)
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 :: FilePath -> SerialT m Word8 -> m ()
append = Int -> FilePath -> SerialT m Word8 -> m ()
forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
Int -> FilePath -> SerialT m Word8 -> m ()
appendWithBufferOf Int
defaultChunkSize