{-# 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
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
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
Eq Mode
-> (Mode -> Mode -> Ordering)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Mode)
-> (Mode -> Mode -> Mode)
-> Ord 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]
(Mode -> Mode)
-> (Mode -> Mode)
-> (Int -> Mode)
-> (Mode -> Int)
-> (Mode -> [Mode])
-> (Mode -> Mode -> [Mode])
-> (Mode -> Mode -> [Mode])
-> (Mode -> Mode -> Mode -> [Mode])
-> Enum 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
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
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]
(Int -> ReadS Mode)
-> ReadS [Mode] -> ReadPrec Mode -> ReadPrec [Mode] -> Read 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)) =
ForeignPtr () -> (Ptr () -> IO (Int64, a)) -> IO (Int64, a)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
handle' ((Ptr () -> IO (Int64, a)) -> IO (Int64, a))
-> (Ptr () -> IO (Int64, a)) -> IO (Int64, a)
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 = Int64 -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
offset Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
length)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CLLong
longsize CLLong -> CLLong -> Bool
forall a. Ord a => a -> a -> Bool
< CLLong
needsize)
((String -> String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> String -> IO a -> IO a
throwErrnoPathIfMinus1 String
"extend file size" String
filepath (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
Ptr () -> CLLong -> IO CInt
c_system_io_extend_file_size Ptr ()
handle CLLong
needsize) IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
(Int64, a) -> IO (Int64, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64, a)
region
sanitizeFileRegion String
_filepath ForeignPtr ()
_handle Mode
ReadWriteEx Maybe (Int64, a)
_
= String -> IO (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 = ForeignPtr () -> (Ptr () -> IO (Int64, a)) -> IO (Int64, a)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
handle' ((Ptr () -> IO (Int64, a)) -> IO (Int64, a))
-> (Ptr () -> IO (Int64, a)) -> IO (Int64, a)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
handle -> do
Int64
longsize <- Ptr () -> IO CLLong
c_system_io_file_size Ptr ()
handle IO CLLong -> (CLLong -> IO Int64) -> IO Int64
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CLLong
x -> Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> Int64
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
sizea -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOError -> IO ()
forall a. IOError -> IO a
ioError (String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
"mmap negative size reguested" Errno
eINVAL Maybe Handle
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
filepath))
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
offsetInt64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<Int64
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOError -> IO ()
forall a. IOError -> IO a
ioError (String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
"mmap negative offset reguested" Errno
eINVAL Maybe Handle
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
filepath))
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Mode
modeMode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
/=Mode
ReadWriteEx Bool -> Bool -> Bool
&& (Int64
longsizeInt64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<Int64
offset Bool -> Bool -> Bool
|| Int64
longsizeInt64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<(Int64
offset Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
size))) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOError -> IO ()
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 Maybe Handle
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
filepath))
(Int64, a) -> IO (Int64, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
offset,a
size)
Maybe (Int64, a)
Nothing -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
longsize Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
sizetype)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOError -> IO ()
forall a. IOError -> IO a
ioError (String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
"mmap requested size is greater then maxBound" Errno
eINVAL Maybe Handle
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
filepath))
(Int64, a) -> IO (Int64, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
0,Int64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
longsize)
(Int64, a) -> IO (Int64, a)
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 =
IOError -> IO ()
forall a. IOError -> IO a
ioError (String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
"mmap ReadWriteEx must have explicit region" Errno
eINVAL Maybe Handle
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
filepath))
checkModeRegion String
_ Mode
_ Maybe a
_ = () -> IO ()
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
String -> Mode -> Maybe (Int64, Int) -> IO ()
forall a. String -> Mode -> Maybe a -> IO ()
checkModeRegion String
filepath Mode
mode Maybe (Int64, Int)
offsetsize
IO (ForeignPtr ())
-> (ForeignPtr () -> IO ())
-> (ForeignPtr () -> IO (Ptr a, Int, Int, Int))
-> IO (Ptr a, Int, Int, Int)
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)
(ForeignPtr () -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr) ForeignPtr () -> IO (Ptr a, Int, Int, Int)
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) <- String
-> ForeignPtr () -> Mode -> Maybe (Int64, Int) -> IO (Int64, Int)
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 Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` CInt -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c_system_io_granularity
let offsetraw :: Int64
offsetraw = Int64
offset Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
align
let sizeraw :: Int
sizeraw = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
align
Ptr Any
ptr <- ForeignPtr () -> (Ptr () -> IO (Ptr Any)) -> IO (Ptr Any)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
handle' ((Ptr () -> IO (Ptr Any)) -> IO (Ptr Any))
-> (Ptr () -> IO (Ptr Any)) -> IO (Ptr Any)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
handle ->
Ptr () -> CInt -> CLLong -> CSize -> IO (Ptr Any)
forall a. Ptr () -> CInt -> CLLong -> CSize -> IO (Ptr a)
c_system_io_mmap_mmap Ptr ()
handle (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Mode -> Int
forall a. Enum a => a -> Int
fromEnum Mode
mode)
(Int64 -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
offsetraw) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeraw)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Any
ptr Ptr Any -> Ptr Any -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Any
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> String -> IO ()
forall a. String -> String -> IO a
throwErrnoPath (String
"mmap of '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filepath String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' failed") String
filepath
(Ptr b, Int, c, Int) -> IO (Ptr b, Int, c, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
ptr,Int
sizeraw,Int64 -> c
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
String -> Mode -> Maybe (Int64, Int) -> IO ()
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) <- String -> Mode -> Maybe (Int64, Int) -> IO (Ptr Any, Int, Int, Int)
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 Ptr Any -> Int -> Ptr ()
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset,Int
size) IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`E.finally` Ptr Any -> Int -> IO ()
forall a. Ptr a -> Int -> IO ()
munmapFilePtr Ptr Any
ptr Int
rawsize
a -> IO a
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
String -> Mode -> Maybe (Int64, Int) -> IO ()
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) <- String -> Mode -> Maybe (Int64, Int) -> IO (Ptr a, Int, Int, Int)
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 = Int -> Ptr a
forall a. Int -> Ptr a
castIntToPtr Int
rawsize
ForeignPtr a
foreignptr <- FinalizerEnvPtr () a -> Ptr () -> Ptr a -> IO (ForeignPtr a)
forall env a.
FinalizerEnvPtr env a -> Ptr env -> Ptr a -> IO (ForeignPtr a)
newForeignPtrEnv FinalizerEnvPtr () a
forall a. FunPtr (Ptr () -> Ptr a -> IO ())
c_system_io_mmap_munmap_funptr Ptr ()
forall a. Ptr a
rawsizeptr Ptr a
rawptr
(ForeignPtr a, Int, Int) -> IO (ForeignPtr a, Int, Int)
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) <- String
-> Mode -> Maybe (Int64, Int) -> IO (ForeignPtr Word8, Int, Int)
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
ByteString -> IO ByteString
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
String -> Mode -> Maybe (Int64, Int64) -> IO ()
forall a. String -> Mode -> Maybe a -> IO ()
checkModeRegion String
filepath Mode
mode Maybe (Int64, Int64)
offsetsize
IO (ForeignPtr ())
-> (ForeignPtr () -> IO ())
-> (ForeignPtr () -> IO [(ForeignPtr a, Int, Int)])
-> IO [(ForeignPtr a, Int, Int)]
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)
(ForeignPtr () -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr) ForeignPtr () -> IO [(ForeignPtr a, Int, Int)]
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) <- String
-> ForeignPtr ()
-> Mode
-> Maybe (Int64, Int64)
-> IO (Int64, Int64)
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
[(ForeignPtr a, Int, Int)] -> IO [(ForeignPtr a, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ForeignPtr a, Int, Int)] -> IO [(ForeignPtr a, Int, Int)])
-> [(ForeignPtr a, Int, Int)] -> IO [(ForeignPtr a, Int, Int)]
forall a b. (a -> b) -> a -> b
$ ((Int64, Int) -> (ForeignPtr a, Int, Int))
-> [(Int64, Int)] -> [(ForeignPtr a, Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (String
-> Mode
-> ForeignPtr ()
-> (Int64, Int)
-> (ForeignPtr a, Int, Int)
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) = IO (ForeignPtr a, Int, Int) -> (ForeignPtr a, Int, Int)
forall a. IO a -> a
unsafePerformIO (IO (ForeignPtr a, Int, Int) -> (ForeignPtr a, Int, Int))
-> IO (ForeignPtr a, Int, Int) -> (ForeignPtr a, Int, Int)
forall a b. (a -> b) -> a -> b
$
ForeignPtr ()
-> (Ptr () -> IO (ForeignPtr a, Int, Int))
-> IO (ForeignPtr a, Int, Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
handle' ((Ptr () -> IO (ForeignPtr a, Int, Int))
-> IO (ForeignPtr a, Int, Int))
-> (Ptr () -> IO (ForeignPtr a, Int, Int))
-> IO (ForeignPtr a, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
handle -> do
let align :: Int64
align = Int64
offset Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` CInt -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c_system_io_granularity
offsetraw :: Int64
offsetraw = Int64
offset Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
align
sizeraw :: Int
sizeraw = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
align
Ptr a
ptr <- Ptr () -> CInt -> CLLong -> CSize -> IO (Ptr a)
forall a. Ptr () -> CInt -> CLLong -> CSize -> IO (Ptr a)
c_system_io_mmap_mmap Ptr ()
handle (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Mode -> Int
forall a. Enum a => a -> Int
fromEnum Mode
mode)
(Int64 -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
offsetraw) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeraw)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> String -> IO ()
forall a. String -> String -> IO a
throwErrnoPath (String
"lazy mmap of '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filepath String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"' chunk(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show Int64
offset String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
size String -> ShowS
forall a. [a] -> [a] -> [a]
++String
") failed") String
filepath
let rawsizeptr :: Ptr a
rawsizeptr = Int -> Ptr a
forall a. Int -> Ptr a
castIntToPtr Int
sizeraw
ForeignPtr a
foreignptr <- FinalizerEnvPtr () a -> Ptr () -> Ptr a -> IO (ForeignPtr a)
forall env a.
FinalizerEnvPtr env a -> Ptr env -> Ptr a -> IO (ForeignPtr a)
newForeignPtrEnv FinalizerEnvPtr () a
forall a. FunPtr (Ptr () -> Ptr a -> IO ())
c_system_io_mmap_munmap_funptr Ptr ()
forall a. Ptr a
rawsizeptr Ptr a
ptr
(ForeignPtr a, Int, Int) -> IO (ForeignPtr a, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr a
foreignptr,Int64 -> Int
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 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
chunkSize = [(Int64
offset,Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
size)]
| Bool
otherwise = let offset2 :: Int64
offset2 = ((Int64
offset Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
chunkSizeLong Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
chunkSizeLong) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
chunkSizeLong
size2 :: Int64
size2 = Int64
offset2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
offset
chunkSizeLong :: Int64
chunkSizeLong = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
chunkSize
in (Int64
offset,Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
size2) (Int64, Int) -> [(Int64, Int)] -> [(Int64, Int)]
forall a. a -> [a] -> [a]
: Int64 -> Int64 -> [(Int64, Int)]
chunks Int64
offset2 (Int64
sizeInt64 -> Int64 -> Int64
forall 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 <- String
-> Mode
-> Maybe (Int64, Int64)
-> IO [(ForeignPtr Word8, Int, Int)]
forall a.
String
-> Mode -> Maybe (Int64, Int64) -> IO [(ForeignPtr a, Int, Int)]
mmapFileForeignPtrLazy String
filepath Mode
ReadOnly Maybe (Int64, Int64)
offsetsize
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
BSL.fromChunks (((ForeignPtr Word8, Int, Int) -> ByteString)
-> [(ForeignPtr Word8, Int, Int)] -> [ByteString]
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 = Ptr () -> Ptr a -> IO ()
forall a. Ptr () -> Ptr a -> IO ()
c_system_io_mmap_munmap (Int -> Ptr ()
forall a. Int -> Ptr a
castIntToPtr Int
rawsize) Ptr a
ptr
chunkSize :: Int
chunkSize :: Int
chunkSize = (Int
128Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
1024 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c_system_io_granularity) Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
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 <- String -> (CString -> IO (Ptr ())) -> IO (Ptr ())
forall a. String -> (CString -> IO a) -> IO a
withCString String
filepath' ((CString -> IO (Ptr ())) -> IO (Ptr ()))
-> (CString -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \CString
filepath ->
CString -> CInt -> IO (Ptr ())
c_system_io_mmap_file_open CString
filepath (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Mode -> Int
forall a. Enum a => a -> Int
fromEnum Mode
mode)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr ()
ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> String -> IO ()
forall a. String -> String -> IO a
throwErrnoPath (String
"opening of '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filepath' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' failed") String
filepath'
ForeignPtr ()
handle <- FinalizerPtr () -> Ptr () -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
c_system_io_mmap_file_close Ptr ()
ptr
ForeignPtr () -> IO (ForeignPtr ())
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr ()
handle
castIntToPtr :: Int -> Ptr a
castIntToPtr :: forall a. Int -> Ptr a
castIntToPtr Int
int = Ptr Any
forall a. Ptr a
nullPtr Ptr Any -> Int -> Ptr a
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