-- |
-- Module      : Foundation.Foreign.MemoryMap.Types
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : portable
--
module Foundation.Foreign.MemoryMap.Types
    ( FileMapping(..)
    , fileMappingToFinalPtr
    , FileMapReadF
    ) where

import GHC.Ptr
import Basement.FinalPtr
import Basement.Types.OffsetSize
import Basement.Compat.Base
import Foundation.VFS (FilePath)

-- | Contains all the information related to a file mapping,
-- including the size and the finalizer function.
data FileMapping = FileMapping
    { FileMapping -> Ptr Word8
fileMappingPtr   :: Ptr Word8
    , FileMapping -> FileSize
fileMappingSize  :: FileSize
    , FileMapping -> IO ()
fileMappingUnmap :: IO ()
    }

-- | From a file mapping, create a final ptr which will automatically
-- unmap memory when the pointer is garbage.
fileMappingToFinalPtr :: FileMapping -> IO (FinalPtr Word8)
fileMappingToFinalPtr :: FileMapping -> IO (FinalPtr Word8)
fileMappingToFinalPtr (FileMapping Ptr Word8
ptr FileSize
_ IO ()
finalizer) =
    Ptr Word8 -> (Ptr Word8 -> IO ()) -> IO (FinalPtr Word8)
forall (prim :: * -> *) a.
PrimMonad prim =>
Ptr a -> (Ptr a -> IO ()) -> prim (FinalPtr a)
toFinalPtr Ptr Word8
ptr (IO () -> Ptr Word8 -> IO ()
forall a b. a -> b -> a
const IO ()
finalizer)

type FileMapReadF = FilePath -> IO FileMapping