module Memfd.Create where

import Foreign.C as C (CInt (..), CUInt (..))
import Foreign.C.String (CString, withCString)
import Memfd.CreateFlagsType (CreateFlags(..))
import Memfd.CreateOptionsFlags (createOptionsFlags)
import Memfd.CreateOptionsType (CreateOptions(..))
import Memfd.NameType (Name (..))
import System.IO (IO)
import System.Posix.Types (Fd (..))

{-| Creates an anonymous file

The file behaves like a regular file, and so can be modified, truncated,
memory-mapped, and so on. However, unlike a regular file, it lives in RAM and
has a volatile backing storage. Once all references to the file are dropped, it
is automatically released.
-}
create :: CreateOptions -> IO Fd
create :: CreateOptions -> IO Fd
create CreateOptions
x =
    forall a. String -> (CString -> IO a) -> IO a
withCString (Name -> String
nameString (CreateOptions -> Name
name CreateOptions
x)) \CString
name' ->
    CString -> CreateFlags -> IO Fd
c_create CString
name' (CreateOptions -> CreateFlags
createOptionsFlags CreateOptions
x)

foreign import ccall unsafe "memfd_create"
    c_create :: CString -> CreateFlags -> IO Fd