{-# LANGUAGE ForeignFunctionInterface, CPP #-}
-- |
-- Module      :  System.IO.MMap
-- Copyright   :  (c) Gracjan Polak 2009
-- License     :  BSD-style
--
-- Stability   :  experimental
-- Portability :  portable
--
-- This library provides a wrapper to mmap(2) or MapViewOfFile,
-- allowing files or devices to be lazily loaded into memory as strict
-- or lazy ByteStrings, ForeignPtrs or plain Ptrs, using the virtual
-- memory subsystem to do on-demand loading.  Modifications are also
-- supported.


module System.IO.MMap
(
     -- $mmap_intro

     -- * Mapping mode
     Mode(..),

     -- * Memory mapped files strict interface
     mmapFilePtr,
     mmapWithFilePtr,
     mmapFileForeignPtr,
     mmapFileByteString,

     munmapFilePtr,

     -- * Memory mapped files lazy interface
     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)

--import Debug.Trace

-- TODO:
--    - support native characters (Unicode) in FilePath
--    - support externally given HANDLEs and FDs
--    - support data commit
--    - support memory region resize

-- $mmap_intro
--
-- This module is an interface to @mmap(2)@ system call under POSIX
-- (Unix, Linux, Mac OS X) and @CreateFileMapping@, @MapViewOfFile@ under
-- Windows.
--
-- We can consider mmap as lazy IO pushed into the virtual memory
-- subsystem.
--
-- It is only safe to mmap a file if you know you are the sole
-- user. Otherwise referential transparency may be or may be not
-- compromised. Sadly semantics differ much between operating systems.
--
-- In case of IO errors all function use 'throwErrno' or 'throwErrnoPath'.
--
-- In case of 'ForeignPtr' or 'BS.ByteString' functions the storage
-- manager is used to free the mapped memory. When the garbage
-- collector notices there are no further references to the mapped
-- memory, a call to @munmap@ is made. It is not necessary to do this
-- yourself. In tight memory situations it may be profitable to use
-- 'System.Mem.performGC' or 'finalizeForeignPtr' to force an unmap
-- action. You can also use 'mmapWithFilePtr' that uses scope based
-- resource allocation.
--
-- To free resources returned as Ptr use 'munmapFilePtr'.
--
-- For modes 'ReadOnly', 'ReadWrite' and 'WriteCopy' file must exist
-- before mapping it into memory. It also needs to have correct
-- permissions for reading and/or writing (depending on mode). In
-- 'ReadWriteEx' the file will be created with default permissions if
-- it does not exist.
--
-- If mode is 'ReadWrite', 'ReadWriteEx' or 'WriteCopy' the returned
-- memory region may be written to with 'Foreign.Storable.poke' and
-- friends. In 'WriteCopy' mode changes will not be written to disk.
-- It is an error to modify mapped memory in 'ReadOnly' mode. If is
-- undefined if and how changes from external changes affect your
-- mmapped regions, they may reflect in your memory or may not and
-- this note applies equally to all modes.
--
-- Range specified may be 'Nothing', in this case whole file will be
-- mapped. Otherwise range should be 'Just (offset,size)' where
-- offsets is the beginning byte of file region to map and size tells
-- mapping length. There are no alignment requirements. Returned Ptr or
-- ForeignPtr will be aligned to page size boundary and you'll be
-- given offset to your data. Both @offset@ and @size@ must be
-- nonnegative.  Sum @offset + size@ should not be greater than file
-- length, except in 'ReadWriteEx' mode when file will be extended to
-- cover whole range. We do allow @size@ to be 0 and we do mmap files
-- of 0 length. If your offset is 0 you are guaranteed to receive page
-- aligned pointer back. You are required to give explicit range in
-- case of 'ReadWriteEx' even if the file exists.
--
-- File extension in 'ReadWriteEx' mode seems to use sparse files
-- whenever supported by oprating system and therefore returns
-- immediatelly as postpones real block allocation for later.
--
-- For more details about mmap and its consequences see:
--
-- * <http://opengroup.org/onlinepubs/009695399/functions/mmap.html>
--
-- * <http://www.gnu.org/software/libc/manual/html_node/Memory_002dmapped-I_002fO.html>
--
-- * <http://msdn2.microsoft.com/en-us/library/aa366781(VS.85).aspx>
--
-- Questions and Answers
--
-- * Q: What happens if somebody writes to my mmapped file? A:
-- Undefined. System is free to not synchronize write system call and
-- mmap so nothing is sure. So this might be reflected in your memory
-- or not.  This applies even in 'WriteCopy' mode.
--
-- * Q: What happens if I map 'ReadWrite' and change memory? A: After
-- some time in will be written to disk. It is unspecified when this
-- happens.
--
-- * Q: What if somebody removes my file? A: Undefined. File with
-- mmapped region is treated by system as open file. Removing such
-- file works the same way as removing open file and different systems
-- have different ideas what to do in such case.
--
-- * Q: Why can't I open my file for writting after mmaping it? A:
-- File needs to be unmapped first. Either make sure you don't
-- reference memory mapped regions and force garbage collection (this
-- is hard to do) or better yet use mmaping with explicit memory
-- management.
--
-- * Q: Can I map region after end of file? A: You need to use
-- 'ReadWriteEx' mode.
--


-- | Mode of mapping. Four cases are supported.
data Mode = ReadOnly     -- ^ file is mapped read-only, file must
                         -- exist
          | ReadWrite    -- ^ file is mapped read-write, file must
                         -- exist
          | WriteCopy    -- ^ file is mapped read-write, but changes
                         -- aren't propagated to disk, file must exist
          | ReadWriteEx  -- ^ file is mapped read-write, if file does
                         -- not exist it will be created with default
                         -- permissions, region parameter specifies
                         -- size, if file size is lower it will be
                         -- extended with zeros
    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 ()

-- | The 'mmapFilePtr' function maps a file or device into memory,
-- returning a tuple @(ptr,rawsize,offset,size)@ where:
--
-- * @ptr@ is pointer to mmapped region
--
-- * @rawsize@ is length (in bytes) of mapped data, rawsize might be
-- greater than size because of alignment
--
-- * @offset@ tell where your data lives: @plusPtr ptr offset@
--
-- * @size@ your data length (in bytes)
--
-- If 'mmapFilePtr' fails for some reason, a 'throwErrno' is used.
--
-- Use @munmapFilePtr ptr rawsize@ to unmap memory.
--
-- Memory mapped files will behave as if they were read lazily
-- pages from the file will be loaded into memory on demand.
--

mmapFilePtr :: FilePath                     -- ^ name of file to mmap
            -> Mode                         -- ^ access mode
            -> Maybe (Int64,Int)            -- ^ range to map, maps whole file if Nothing
            -> IO (Ptr a,Int,Int,Int)       -- ^ (ptr,rawsize,offset,size)
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)

-- | Memory map region of file using autounmap semantics. See
-- 'mmapFilePtr' for description of parameters.  The @action@ will be
-- executed with tuple @(ptr,size)@ as single argument. This is the
-- pointer to mapped data already adjusted and size of requested
-- region. Return value is that of action.
mmapWithFilePtr :: FilePath                        -- ^ name of file to mmap
                -> Mode                            -- ^ access mode
                -> Maybe (Int64,Int)               -- ^ range to map, maps whole file if Nothing
                -> ((Ptr (),Int) -> IO a)          -- ^ action to run
                -> IO a                            -- ^ result of action
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

-- | Maps region of file and returns it as 'ForeignPtr'. See 'mmapFilePtr' for details.
mmapFileForeignPtr :: FilePath                     -- ^ name of file to map
                   -> Mode                         -- ^ access mode
                   -> Maybe (Int64,Int)            -- ^ range to map, maps whole file if Nothing
                   -> IO (ForeignPtr a,Int,Int)    -- ^ foreign pointer to beginning of raw region,
                                                   -- offset to your data and size of your data
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)

-- | Maps region of file and returns it as 'BS.ByteString'.  File is
-- mapped in in 'ReadOnly' mode. See 'mmapFilePtr' for details.
mmapFileByteString :: FilePath                     -- ^ name of file to map
                   -> Maybe (Int64,Int)            -- ^ range to map, maps whole file if Nothing
                   -> IO BS.ByteString             -- ^ bytestring with file contents
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

-- | The 'mmapFileForeignPtrLazy' function maps a file or device into
-- memory, returning a list of tuples with the same meaning as in
-- function 'mmapFileForeignPtr'.
--
-- Chunks are really mapped into memory at the first inspection of a
-- chunk. They are kept in memory while they are referenced, garbage
-- collector takes care of the later.
--
mmapFileForeignPtrLazy :: FilePath                    -- ^ name of file to mmap
                       -> Mode                        -- ^ access mode
                       -> Maybe (Int64,Int64)         -- ^ range to map, maps whole file if Nothing
                       -> IO [(ForeignPtr a,Int,Int)] -- ^ (ptr,offset,size)
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)

-- | Maps region of file and returns it as 'BSL.ByteString'. File is
-- mapped in in 'ReadOnly' mode. See 'mmapFileForeignPtrLazy' for
-- details.
mmapFileByteStringLazy :: FilePath                     -- ^ name of file to map
                       -> Maybe (Int64,Int64)          -- ^ range to map, maps whole file if Nothing
                       -> IO BSL.ByteString            -- ^ bytestring with file content
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

-- | Unmaps memory region. As parameters use values marked as ptr and
-- rawsize in description of 'mmapFilePtr'.
munmapFilePtr :: Ptr a  -- ^ pointer
              -> Int    -- ^ rawsize
              -> 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

--castPtrToInt :: Ptr a -> Int
--castPtrToInt ptr = ptr `minusPtr` nullPtr

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


-- | Should open file given as CString in mode given as CInt
foreign import ccall unsafe "HsMmap.h system_io_mmap_file_open"
    c_system_io_mmap_file_open :: CString       -- ^ file path, system encoding
                               -> CInt          -- ^ mode as 0, 1, 2, fromEnum
                               -> IO (Ptr ())   -- ^ file handle returned, nullPtr on error (and errno set)
-- | Used in finalizers, to close handle
foreign import ccall unsafe "HsMmap.h &system_io_mmap_file_close"
    c_system_io_mmap_file_close :: FunPtr(Ptr () -> IO ())

-- | Mmemory maps file from handle, using mode, starting offset and size
foreign import ccall unsafe "HsMmap.h system_io_mmap_mmap"
    c_system_io_mmap_mmap :: Ptr ()     -- ^ handle from c_system_io_mmap_file_open
                          -> CInt       -- ^ mode
                          -> CLLong     -- ^ starting offset, must be nonegative
                          -> CSize      -- ^ length, must be greater than zero
                          -> IO (Ptr a) -- ^ starting pointer to byte data, nullPtr on error (plus errno set)
-- | Used in finalizers
foreign import ccall unsafe "HsMmap.h &system_io_mmap_munmap"
    c_system_io_mmap_munmap_funptr :: FunPtr(Ptr () -> Ptr a -> IO ())
-- | Unmap region of memory. Size must be the same as returned by
-- mmap. If size is zero, does nothing (treats pointer as invalid)
foreign import ccall unsafe "HsMmap.h system_io_mmap_munmap"
    c_system_io_mmap_munmap :: Ptr () -> Ptr a -> IO ()
-- | Get file size in system specific manner
foreign import ccall unsafe "HsMmap.h system_io_mmap_file_size"
    c_system_io_file_size :: Ptr () -> IO CLLong
-- | Set file size in system specific manner. It is guaranteed to be called
-- only with new size being at least current size.
foreign import ccall unsafe "HsMmap.h system_io_mmap_extend_file_size"
    c_system_io_extend_file_size :: Ptr () -> CLLong -> IO CInt
-- | Memory mapping granularity.
foreign import ccall unsafe "HsMmap.h system_io_mmap_granularity"
    c_system_io_granularity :: CInt