{-# LINE 1 "Bio/Util/MMap.hsc" #-}
module Bio.Util.MMap ( mmapFile, createMmapFile ) where

import BasePrelude
import Foreign.C.Error      ( getErrno, errnoToIOError )
import Foreign.C.Types
import System.Posix.Files   ( fileSize, getFdStatus, setFdSize )
import System.Posix.IO      ( openFd, closeFd, defaultFileFlags, OpenMode(ReadOnly,ReadWrite) )
import System.Posix.Types   ( Fd(..), COff(..) )



-- | Maps a whole file into memory, returns the size in bytes and a
-- 'ForeignPtr' to the contents.
mmapFile :: FilePath -> IO (Int, ForeignPtr a)
mmapFile :: FilePath -> IO (Int, ForeignPtr a)
mmapFile fp :: FilePath
fp =
    IO Fd
-> (Fd -> IO ())
-> (Fd -> IO (Int, ForeignPtr a))
-> IO (Int, ForeignPtr a)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
openFd FilePath
fp OpenMode
ReadOnly Maybe FileMode
forall a. Maybe a
Nothing OpenFileFlags
defaultFileFlags) Fd -> IO ()
closeFd ((Fd -> IO (Int, ForeignPtr a)) -> IO (Int, ForeignPtr a))
-> (Fd -> IO (Int, ForeignPtr a)) -> IO (Int, ForeignPtr a)
forall a b. (a -> b) -> a -> b
$ \fd :: Fd
fd -> do
        FileOffset
size <- FileStatus -> FileOffset
fileSize (FileStatus -> FileOffset) -> IO FileStatus -> IO FileOffset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fd -> IO FileStatus
getFdStatus Fd
fd
        if FileOffset
size FileOffset -> FileOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
            then (,) 0 (ForeignPtr a -> (Int, ForeignPtr a))
-> IO (ForeignPtr a) -> IO (Int, ForeignPtr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO (ForeignPtr a)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr a
forall a. Ptr a
nullPtr
            else do
                Ptr a
ptr <- Ptr a -> CSize -> CInt -> CInt -> Fd -> FileOffset -> IO (Ptr a)
forall a.
Ptr a -> CSize -> CInt -> CInt -> Fd -> FileOffset -> IO (Ptr a)
mmap Ptr a
forall a. Ptr a
nullPtr (FileOffset -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral FileOffset
size) (1) (1) Fd
fd 0
{-# LINE 22 "Bio/Util/MMap.hsc" #-}
                if Ptr a -> IntPtr
forall a. Ptr a -> IntPtr
ptrToIntPtr Ptr a
ptr IntPtr -> IntPtr -> Bool
forall a. Eq a => a -> a -> Bool
== 18446744073709551615
{-# LINE 23 "Bio/Util/MMap.hsc" #-}
                    then do Errno
errno <- IO Errno
getErrno
                            IOError -> IO (Int, ForeignPtr a)
forall a. IOError -> IO a
ioError (IOError -> IO (Int, ForeignPtr a))
-> IOError -> IO (Int, ForeignPtr a)
forall a b. (a -> b) -> a -> b
$ FilePath -> Errno -> Maybe Handle -> Maybe FilePath -> IOError
errnoToIOError "mmapFile" Errno
errno Maybe Handle
forall a. Maybe a
Nothing (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fp)
                    else (,) (FileOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FileOffset
size) (ForeignPtr a -> (Int, ForeignPtr a))
-> IO (ForeignPtr a) -> IO (Int, ForeignPtr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 ())
my_munmap (IntPtr -> Ptr ()
forall a. IntPtr -> Ptr a
intPtrToPtr (IntPtr -> Ptr ()) -> IntPtr -> Ptr ()
forall a b. (a -> b) -> a -> b
$ FileOffset -> IntPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral FileOffset
size) Ptr a
ptr

-- | Creates a new file of a desired initial size, maps it into memory,
-- and calls a function to fill it.  That function returns a pointer to
-- the first unused byte in the file, and it is truncated accordingly.
createMmapFile :: FilePath -> CSize -> (Ptr a -> IO (Ptr a, b)) -> IO b
createMmapFile :: FilePath -> CSize -> (Ptr a -> IO (Ptr a, b)) -> IO b
createMmapFile fp :: FilePath
fp sz :: CSize
sz k :: Ptr a -> IO (Ptr a, b)
k =
    IO Fd -> (Fd -> IO ()) -> (Fd -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
openFd FilePath
fp OpenMode
ReadWrite (FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just 0x1b6) OpenFileFlags
defaultFileFlags) Fd -> IO ()
closeFd ((Fd -> IO b) -> IO b) -> (Fd -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \fd :: Fd
fd -> do
        Fd -> FileOffset -> IO ()
setFdSize Fd
fd (CSize -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
sz)
        IO (Ptr a) -> (Ptr a -> IO ()) -> (Ptr a -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Ptr a -> CSize -> CInt -> CInt -> Fd -> FileOffset -> IO (Ptr a)
forall a.
Ptr a -> CSize -> CInt -> CInt -> Fd -> FileOffset -> IO (Ptr a)
mmap Ptr a
forall a. Ptr a
nullPtr CSize
sz (3) (1) Fd
fd 0)
{-# LINE 35 "Bio/Util/MMap.hsc" #-}
                ((Ptr a -> CSize -> IO ()) -> CSize -> Ptr a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr a -> CSize -> IO ()
forall a. Ptr a -> CSize -> IO ()
munmap CSize
sz) ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr a
p -> do
            (p' :: Ptr a
p',r :: b
r) <- Ptr a -> IO (Ptr a, b)
k Ptr a
p
            Fd -> FileOffset -> IO ()
setFdSize Fd
fd (Int -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> FileOffset) -> Int -> FileOffset
forall a b. (a -> b) -> a -> b
$ Ptr a -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr a
p' Ptr a
p)
            b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r

foreign import ccall unsafe "&my_munmap"        my_munmap :: FunPtr (Ptr () -> Ptr a -> IO ())
foreign import ccall unsafe "sys/mman.h mmap"   mmap      :: Ptr a -> CSize -> CInt -> CInt -> Fd -> COff -> IO (Ptr a)
foreign import ccall unsafe "sys/mman.h munmap" munmap    :: Ptr a -> CSize -> IO ()