{-# LANGUAGE ForeignFunctionInterface, CPP #-}
module System.IO.MMap
(
Mode(..),
mmapFilePtr,
mmapWithFilePtr,
mmapFileForeignPtr,
mmapFileByteString,
munmapFilePtr,
mmapFileForeignPtrLazy,
mmapFileByteStringLazy
)
where
import System.IO ()
import Foreign.Ptr (Ptr,FunPtr,nullPtr,plusPtr,castPtr)
import Foreign.C.Types (CInt(..),CLLong(..),CSize(..))
import Foreign.C.String (CString,withCString)
import Foreign.ForeignPtr (ForeignPtr,withForeignPtr,finalizeForeignPtr,newForeignPtr,newForeignPtrEnv)
import Foreign.C.Error
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString.Internal as BS (fromForeignPtr)
import Data.Int (Int64)
import Control.Monad (when)
import qualified Control.Exception as E (bracketOnError, bracket, finally)
import qualified Data.ByteString as BS (ByteString)
import qualified Data.ByteString.Lazy as BSL (ByteString,fromChunks)
import Prelude hiding (length)
data Mode = ReadOnly
| ReadWrite
| WriteCopy
| ReadWriteEx
deriving (Mode -> Mode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq,Eq Mode
Mode -> Mode -> Bool
Mode -> Mode -> Ordering
Mode -> Mode -> Mode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmax :: Mode -> Mode -> Mode
>= :: Mode -> Mode -> Bool
$c>= :: Mode -> Mode -> Bool
> :: Mode -> Mode -> Bool
$c> :: Mode -> Mode -> Bool
<= :: Mode -> Mode -> Bool
$c<= :: Mode -> Mode -> Bool
< :: Mode -> Mode -> Bool
$c< :: Mode -> Mode -> Bool
compare :: Mode -> Mode -> Ordering
$ccompare :: Mode -> Mode -> Ordering
Ord,Int -> Mode
Mode -> Int
Mode -> [Mode]
Mode -> Mode
Mode -> Mode -> [Mode]
Mode -> Mode -> Mode -> [Mode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
$cenumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
enumFromTo :: Mode -> Mode -> [Mode]
$cenumFromTo :: Mode -> Mode -> [Mode]
enumFromThen :: Mode -> Mode -> [Mode]
$cenumFromThen :: Mode -> Mode -> [Mode]
enumFrom :: Mode -> [Mode]
$cenumFrom :: Mode -> [Mode]
fromEnum :: Mode -> Int
$cfromEnum :: Mode -> Int
toEnum :: Int -> Mode
$ctoEnum :: Int -> Mode
pred :: Mode -> Mode
$cpred :: Mode -> Mode
succ :: Mode -> Mode
$csucc :: Mode -> Mode
Enum,Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show,ReadPrec [Mode]
ReadPrec Mode
Int -> ReadS Mode
ReadS [Mode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Mode]
$creadListPrec :: ReadPrec [Mode]
readPrec :: ReadPrec Mode
$creadPrec :: ReadPrec Mode
readList :: ReadS [Mode]
$creadList :: ReadS [Mode]
readsPrec :: Int -> ReadS Mode
$creadsPrec :: Int -> ReadS Mode
Read)
sanitizeFileRegion :: (Integral a,Bounded a) => String -> ForeignPtr () -> Mode -> Maybe (Int64,a) -> IO (Int64,a)
sanitizeFileRegion :: forall a.
(Integral a, Bounded a) =>
String
-> ForeignPtr () -> Mode -> Maybe (Int64, a) -> IO (Int64, a)
sanitizeFileRegion String
filepath ForeignPtr ()
handle' Mode
ReadWriteEx (Just region :: (Int64, a)
region@(Int64
offset,a
length)) =
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
handle' forall a b. (a -> b) -> a -> b
$ \Ptr ()
handle -> do
CLLong
longsize <- Ptr () -> IO CLLong
c_system_io_file_size Ptr ()
handle
let needsize :: CLLong
needsize = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
offset forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
length)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CLLong
longsize forall a. Ord a => a -> a -> Bool
< CLLong
needsize)
((forall a. (Eq a, Num a) => String -> String -> IO a -> IO a
throwErrnoPathIfMinus1 String
"extend file size" String
filepath forall a b. (a -> b) -> a -> b
$
Ptr () -> CLLong -> IO CInt
c_system_io_extend_file_size Ptr ()
handle CLLong
needsize) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64, a)
region
sanitizeFileRegion String
_filepath ForeignPtr ()
_handle Mode
ReadWriteEx Maybe (Int64, a)
_
= forall a. HasCallStack => String -> a
error String
"sanitizeRegion given ReadWriteEx with no region, please check earlier for this"
sanitizeFileRegion String
filepath ForeignPtr ()
handle' Mode
mode Maybe (Int64, a)
region = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
handle' forall a b. (a -> b) -> a -> b
$ \Ptr ()
handle -> do
Int64
longsize <- Ptr () -> IO CLLong
c_system_io_file_size Ptr ()
handle forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CLLong
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral CLLong
x)
let Just (Int64
_,a
sizetype) = Maybe (Int64, a)
region
(Int64
offset,a
size) <- case Maybe (Int64, a)
region of
Just (Int64
offset,a
size) -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
sizeforall a. Ord a => a -> a -> Bool
<a
0) forall a b. (a -> b) -> a -> b
$
forall a. IOError -> IO a
ioError (String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
"mmap negative size reguested" Errno
eINVAL forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just String
filepath))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
offsetforall a. Ord a => a -> a -> Bool
<Int64
0) forall a b. (a -> b) -> a -> b
$
forall a. IOError -> IO a
ioError (String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
"mmap negative offset reguested" Errno
eINVAL forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just String
filepath))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Mode
modeforall a. Eq a => a -> a -> Bool
/=Mode
ReadWriteEx Bool -> Bool -> Bool
&& (Int64
longsizeforall a. Ord a => a -> a -> Bool
<Int64
offset Bool -> Bool -> Bool
|| Int64
longsizeforall a. Ord a => a -> a -> Bool
<(Int64
offset forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
size))) forall a b. (a -> b) -> a -> b
$
forall a. IOError -> IO a
ioError (String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
"mmap offset and size beyond end of file" Errno
eINVAL forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just String
filepath))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
offset,a
size)
Maybe (Int64, a)
Nothing -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
longsize forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound forall a. a -> a -> a
`asTypeOf` a
sizetype)) forall a b. (a -> b) -> a -> b
$
forall a. IOError -> IO a
ioError (String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
"mmap requested size is greater then maxBound" Errno
eINVAL forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just String
filepath))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
0,forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
longsize)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
offset,a
size)
checkModeRegion :: FilePath -> Mode -> Maybe a -> IO ()
checkModeRegion :: forall a. String -> Mode -> Maybe a -> IO ()
checkModeRegion String
filepath Mode
ReadWriteEx Maybe a
Nothing =
forall a. IOError -> IO a
ioError (String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
"mmap ReadWriteEx must have explicit region" Errno
eINVAL forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just String
filepath))
checkModeRegion String
_ Mode
_ Maybe a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
mmapFilePtr :: FilePath
-> Mode
-> Maybe (Int64,Int)
-> IO (Ptr a,Int,Int,Int)
mmapFilePtr :: forall a.
String -> Mode -> Maybe (Int64, Int) -> IO (Ptr a, Int, Int, Int)
mmapFilePtr String
filepath Mode
mode Maybe (Int64, Int)
offsetsize = do
forall a. String -> Mode -> Maybe a -> IO ()
checkModeRegion String
filepath Mode
mode Maybe (Int64, Int)
offsetsize
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (String -> Mode -> IO (ForeignPtr ())
mmapFileOpen String
filepath Mode
mode)
(forall a. ForeignPtr a -> IO ()
finalizeForeignPtr) forall {c} {b}. Num c => ForeignPtr () -> IO (Ptr b, Int, c, Int)
mmap
where
mmap :: ForeignPtr () -> IO (Ptr b, Int, c, Int)
mmap ForeignPtr ()
handle' = do
(Int64
offset,Int
size) <- forall a.
(Integral a, Bounded a) =>
String
-> ForeignPtr () -> Mode -> Maybe (Int64, a) -> IO (Int64, a)
sanitizeFileRegion String
filepath ForeignPtr ()
handle' Mode
mode Maybe (Int64, Int)
offsetsize
let align :: Int64
align = Int64
offset forall a. Integral a => a -> a -> a
`mod` forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c_system_io_granularity
let offsetraw :: Int64
offsetraw = Int64
offset forall a. Num a => a -> a -> a
- Int64
align
let sizeraw :: Int
sizeraw = Int
size forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
align
Ptr Any
ptr <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
handle' forall a b. (a -> b) -> a -> b
$ \Ptr ()
handle ->
forall a. Ptr () -> CInt -> CLLong -> CSize -> IO (Ptr a)
c_system_io_mmap_mmap Ptr ()
handle (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Mode
mode)
(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
offsetraw) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeraw)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Any
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) forall a b. (a -> b) -> a -> b
$
forall a. String -> String -> IO a
throwErrnoPath (String
"mmap of '" forall a. [a] -> [a] -> [a]
++ String
filepath forall a. [a] -> [a] -> [a]
++ String
"' failed") String
filepath
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. Ptr a -> Ptr b
castPtr Ptr Any
ptr,Int
sizeraw,forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
align,Int
size)
mmapWithFilePtr :: FilePath
-> Mode
-> Maybe (Int64,Int)
-> ((Ptr (),Int) -> IO a)
-> IO a
mmapWithFilePtr :: forall a.
String
-> Mode -> Maybe (Int64, Int) -> ((Ptr (), Int) -> IO a) -> IO a
mmapWithFilePtr String
filepath Mode
mode Maybe (Int64, Int)
offsetsize (Ptr (), Int) -> IO a
action = do
forall a. String -> Mode -> Maybe a -> IO ()
checkModeRegion String
filepath Mode
mode Maybe (Int64, Int)
offsetsize
(Ptr Any
ptr,Int
rawsize,Int
offset,Int
size) <- forall a.
String -> Mode -> Maybe (Int64, Int) -> IO (Ptr a, Int, Int, Int)
mmapFilePtr String
filepath Mode
mode Maybe (Int64, Int)
offsetsize
a
result <- (Ptr (), Int) -> IO a
action (Ptr Any
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset,Int
size) forall a b. IO a -> IO b -> IO a
`E.finally` forall a. Ptr a -> Int -> IO ()
munmapFilePtr Ptr Any
ptr Int
rawsize
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
mmapFileForeignPtr :: FilePath
-> Mode
-> Maybe (Int64,Int)
-> IO (ForeignPtr a,Int,Int)
mmapFileForeignPtr :: forall a.
String -> Mode -> Maybe (Int64, Int) -> IO (ForeignPtr a, Int, Int)
mmapFileForeignPtr String
filepath Mode
mode Maybe (Int64, Int)
range = do
forall a. String -> Mode -> Maybe a -> IO ()
checkModeRegion String
filepath Mode
mode Maybe (Int64, Int)
range
(Ptr a
rawptr,Int
rawsize,Int
offset,Int
size) <- forall a.
String -> Mode -> Maybe (Int64, Int) -> IO (Ptr a, Int, Int, Int)
mmapFilePtr String
filepath Mode
mode Maybe (Int64, Int)
range
let rawsizeptr :: Ptr a
rawsizeptr = forall a. Int -> Ptr a
castIntToPtr Int
rawsize
ForeignPtr a
foreignptr <- forall env a.
FinalizerEnvPtr env a -> Ptr env -> Ptr a -> IO (ForeignPtr a)
newForeignPtrEnv forall a. FunPtr (Ptr () -> Ptr a -> IO ())
c_system_io_mmap_munmap_funptr forall a. Ptr a
rawsizeptr Ptr a
rawptr
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr a
foreignptr,Int
offset,Int
size)
mmapFileByteString :: FilePath
-> Maybe (Int64,Int)
-> IO BS.ByteString
mmapFileByteString :: String -> Maybe (Int64, Int) -> IO ByteString
mmapFileByteString String
filepath Maybe (Int64, Int)
range = do
(ForeignPtr Word8
foreignptr,Int
offset,Int
size) <- forall a.
String -> Mode -> Maybe (Int64, Int) -> IO (ForeignPtr a, Int, Int)
mmapFileForeignPtr String
filepath Mode
ReadOnly Maybe (Int64, Int)
range
let bytestring :: ByteString
bytestring = ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr ForeignPtr Word8
foreignptr Int
offset Int
size
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bytestring
mmapFileForeignPtrLazy :: FilePath
-> Mode
-> Maybe (Int64,Int64)
-> IO [(ForeignPtr a,Int,Int)]
mmapFileForeignPtrLazy :: forall a.
String
-> Mode -> Maybe (Int64, Int64) -> IO [(ForeignPtr a, Int, Int)]
mmapFileForeignPtrLazy String
filepath Mode
mode Maybe (Int64, Int64)
offsetsize = do
forall a. String -> Mode -> Maybe a -> IO ()
checkModeRegion String
filepath Mode
mode Maybe (Int64, Int64)
offsetsize
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError (String -> Mode -> IO (ForeignPtr ())
mmapFileOpen String
filepath Mode
mode)
(forall a. ForeignPtr a -> IO ()
finalizeForeignPtr) forall {a}. ForeignPtr () -> IO [(ForeignPtr a, Int, Int)]
mmap
where
mmap :: ForeignPtr () -> IO [(ForeignPtr a, Int, Int)]
mmap ForeignPtr ()
handle = do
(Int64
offset,Int64
size) <- forall a.
(Integral a, Bounded a) =>
String
-> ForeignPtr () -> Mode -> Maybe (Int64, a) -> IO (Int64, a)
sanitizeFileRegion String
filepath ForeignPtr ()
handle Mode
mode Maybe (Int64, Int64)
offsetsize
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a.
String
-> Mode
-> ForeignPtr ()
-> (Int64, Int)
-> (ForeignPtr a, Int, Int)
mmapFileForeignPtrLazyChunk String
filepath Mode
mode ForeignPtr ()
handle) (Int64 -> Int64 -> [(Int64, Int)]
chunks Int64
offset Int64
size)
{-# NOINLINE mmapFileForeignPtrLazyChunk #-}
mmapFileForeignPtrLazyChunk :: FilePath
-> Mode
-> ForeignPtr ()
-> (Int64, Int)
-> (ForeignPtr a, Int, Int)
mmapFileForeignPtrLazyChunk :: forall a.
String
-> Mode
-> ForeignPtr ()
-> (Int64, Int)
-> (ForeignPtr a, Int, Int)
mmapFileForeignPtrLazyChunk String
filepath Mode
mode ForeignPtr ()
handle' (Int64
offset,Int
size) = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
handle' forall a b. (a -> b) -> a -> b
$ \Ptr ()
handle -> do
let align :: Int64
align = Int64
offset forall a. Integral a => a -> a -> a
`mod` forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c_system_io_granularity
offsetraw :: Int64
offsetraw = Int64
offset forall a. Num a => a -> a -> a
- Int64
align
sizeraw :: Int
sizeraw = Int
size forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
align
Ptr a
ptr <- forall a. Ptr () -> CInt -> CLLong -> CSize -> IO (Ptr a)
c_system_io_mmap_mmap Ptr ()
handle (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Mode
mode)
(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
offsetraw) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeraw)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr a
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) forall a b. (a -> b) -> a -> b
$
forall a. String -> String -> IO a
throwErrnoPath (String
"lazy mmap of '" forall a. [a] -> [a] -> [a]
++ String
filepath forall a. [a] -> [a] -> [a]
++
String
"' chunk(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int64
offset forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
size forall a. [a] -> [a] -> [a]
++String
") failed") String
filepath
let rawsizeptr :: Ptr a
rawsizeptr = forall a. Int -> Ptr a
castIntToPtr Int
sizeraw
ForeignPtr a
foreignptr <- forall env a.
FinalizerEnvPtr env a -> Ptr env -> Ptr a -> IO (ForeignPtr a)
newForeignPtrEnv forall a. FunPtr (Ptr () -> Ptr a -> IO ())
c_system_io_mmap_munmap_funptr forall a. Ptr a
rawsizeptr Ptr a
ptr
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr a
foreignptr,forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
offset,Int
size)
chunks :: Int64 -> Int64 -> [(Int64,Int)]
chunks :: Int64 -> Int64 -> [(Int64, Int)]
chunks Int64
_offset Int64
0 = []
chunks Int64
offset Int64
size | Int64
size forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
chunkSize = [(Int64
offset,forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
size)]
| Bool
otherwise = let offset2 :: Int64
offset2 = ((Int64
offset forall a. Num a => a -> a -> a
+ Int64
chunkSizeLong forall a. Num a => a -> a -> a
* Int64
2 forall a. Num a => a -> a -> a
- Int64
1) forall a. Integral a => a -> a -> a
`div` Int64
chunkSizeLong) forall a. Num a => a -> a -> a
* Int64
chunkSizeLong
size2 :: Int64
size2 = Int64
offset2 forall a. Num a => a -> a -> a
- Int64
offset
chunkSizeLong :: Int64
chunkSizeLong = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
chunkSize
in (Int64
offset,forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
size2) forall a. a -> [a] -> [a]
: Int64 -> Int64 -> [(Int64, Int)]
chunks Int64
offset2 (Int64
sizeforall a. Num a => a -> a -> a
-Int64
size2)
mmapFileByteStringLazy :: FilePath
-> Maybe (Int64,Int64)
-> IO BSL.ByteString
mmapFileByteStringLazy :: String -> Maybe (Int64, Int64) -> IO ByteString
mmapFileByteStringLazy String
filepath Maybe (Int64, Int64)
offsetsize = do
[(ForeignPtr Word8, Int, Int)]
list <- forall a.
String
-> Mode -> Maybe (Int64, Int64) -> IO [(ForeignPtr a, Int, Int)]
mmapFileForeignPtrLazy String
filepath Mode
ReadOnly Maybe (Int64, Int64)
offsetsize
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
BSL.fromChunks (forall a b. (a -> b) -> [a] -> [b]
map (ForeignPtr Word8, Int, Int) -> ByteString
turn [(ForeignPtr Word8, Int, Int)]
list))
where
turn :: (ForeignPtr Word8, Int, Int) -> ByteString
turn (ForeignPtr Word8
foreignptr,Int
offset,Int
size) = ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr ForeignPtr Word8
foreignptr Int
offset Int
size
munmapFilePtr :: Ptr a
-> Int
-> IO ()
munmapFilePtr :: forall a. Ptr a -> Int -> IO ()
munmapFilePtr Ptr a
ptr Int
rawsize = forall a. Ptr () -> Ptr a -> IO ()
c_system_io_mmap_munmap (forall a. Int -> Ptr a
castIntToPtr Int
rawsize) Ptr a
ptr
chunkSize :: Int
chunkSize :: Int
chunkSize = (Int
128forall a. Num a => a -> a -> a
*Int
1024 forall a. Integral a => a -> a -> a
`div` forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c_system_io_granularity) forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c_system_io_granularity
mmapFileOpen :: FilePath -> Mode -> IO (ForeignPtr ())
mmapFileOpen :: String -> Mode -> IO (ForeignPtr ())
mmapFileOpen String
filepath' Mode
mode = do
Ptr ()
ptr <- forall a. String -> (CString -> IO a) -> IO a
withCString String
filepath' forall a b. (a -> b) -> a -> b
$ \CString
filepath ->
CString -> CInt -> IO (Ptr ())
c_system_io_mmap_file_open CString
filepath (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Mode
mode)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr ()
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) forall a b. (a -> b) -> a -> b
$
forall a. String -> String -> IO a
throwErrnoPath (String
"opening of '" forall a. [a] -> [a] -> [a]
++ String
filepath' forall a. [a] -> [a] -> [a]
++ String
"' failed") String
filepath'
ForeignPtr ()
handle <- forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr () -> IO ())
c_system_io_mmap_file_close Ptr ()
ptr
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr ()
handle
castIntToPtr :: Int -> Ptr a
castIntToPtr :: forall a. Int -> Ptr a
castIntToPtr Int
int = forall a. Ptr a
nullPtr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
int
foreign import ccall unsafe "HsMmap.h system_io_mmap_file_open"
c_system_io_mmap_file_open :: CString
-> CInt
-> IO (Ptr ())
foreign import ccall unsafe "HsMmap.h &system_io_mmap_file_close"
c_system_io_mmap_file_close :: FunPtr(Ptr () -> IO ())
foreign import ccall unsafe "HsMmap.h system_io_mmap_mmap"
c_system_io_mmap_mmap :: Ptr ()
-> CInt
-> CLLong
-> CSize
-> IO (Ptr a)
foreign import ccall unsafe "HsMmap.h &system_io_mmap_munmap"
c_system_io_mmap_munmap_funptr :: FunPtr(Ptr () -> Ptr a -> IO ())
foreign import ccall unsafe "HsMmap.h system_io_mmap_munmap"
c_system_io_mmap_munmap :: Ptr () -> Ptr a -> IO ()
foreign import ccall unsafe "HsMmap.h system_io_mmap_file_size"
c_system_io_file_size :: Ptr () -> IO CLLong
foreign import ccall unsafe "HsMmap.h system_io_mmap_extend_file_size"
c_system_io_extend_file_size :: Ptr () -> CLLong -> IO CInt
foreign import ccall unsafe "HsMmap.h system_io_mmap_granularity"
c_system_io_granularity :: CInt