-- |
-- Module      :  System.Posix.FD
-- Copyright   :  © 2016 Julian Ospald
-- License     :  BSD3
--
-- Maintainer  :  Julian Ospald <hasufell@posteo.de>
-- Stability   :  experimental
-- Portability :  portable
--
-- Provides an alternative for `System.Posix.IO.ByteString.openFd`
-- which gives us more control on what status flags to pass to the
-- low-level @open(2)@ call, in contrast to the unix package.


{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

{-# OPTIONS_GHC -Wall #-}


module System.Posix.FD (
    openFd
) where


import Foreign.C.String
import Foreign.C.Types
import System.Posix.Directory.Foreign
import qualified System.Posix as Posix
import System.Posix.ByteString.FilePath


foreign import ccall unsafe "open"
   c_open :: CString -> CInt -> Posix.CMode -> IO CInt


open_  :: CString
       -> Posix.OpenMode
       -> [Flags]
       -> Maybe Posix.FileMode
       -> IO Posix.Fd
open_ :: CString -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
open_ str :: CString
str how :: OpenMode
how optional_flags :: [Flags]
optional_flags maybe_mode :: Maybe FileMode
maybe_mode = do
    CInt
fd <- CString -> CInt -> FileMode -> IO CInt
c_open CString
str CInt
all_flags FileMode
mode_w
    Fd -> IO Fd
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Fd
Posix.Fd CInt
fd)
  where
    all_flags :: CInt
all_flags  = [Flags] -> CInt
unionFlags ([Flags] -> CInt) -> [Flags] -> CInt
forall a b. (a -> b) -> a -> b
$ [Flags]
optional_flags [Flags] -> [Flags] -> [Flags]
forall a. [a] -> [a] -> [a]
++ [Flags
open_mode] [Flags] -> [Flags] -> [Flags]
forall a. [a] -> [a] -> [a]
++ [Flags]
creat


    (creat :: [Flags]
creat, mode_w :: FileMode
mode_w) = case Maybe FileMode
maybe_mode of
                        Nothing -> ([],0)
                        Just x :: FileMode
x  -> ([Flags
oCreat], FileMode
x)

    open_mode :: Flags
open_mode = case OpenMode
how of
                   Posix.ReadOnly  -> Flags
oRdonly
                   Posix.WriteOnly -> Flags
oWronly
                   Posix.ReadWrite -> Flags
oRdwr


-- |Open and optionally create this file. See 'System.Posix.Files'
-- for information on how to use the 'FileMode' type.
--
-- Note that passing @Just x@ as the 4th argument triggers the
-- `oCreat` status flag, which must be set when you pass in `oExcl`
-- to the status flags. Also see the manpage for @open(2)@.
openFd :: RawFilePath
       -> Posix.OpenMode
       -> [Flags]               -- ^ status flags of @open(2)@
       -> Maybe Posix.FileMode  -- ^ @Just x@ => creates the file with the given modes, Nothing => the file must exist.
       -> IO Posix.Fd
openFd :: RawFilePath -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
openFd name :: RawFilePath
name how :: OpenMode
how optional_flags :: [Flags]
optional_flags maybe_mode :: Maybe FileMode
maybe_mode =
   RawFilePath -> (CString -> IO Fd) -> IO Fd
forall a. RawFilePath -> (CString -> IO a) -> IO a
withFilePath RawFilePath
name ((CString -> IO Fd) -> IO Fd) -> (CString -> IO Fd) -> IO Fd
forall a b. (a -> b) -> a -> b
$ \str :: CString
str ->
     String -> RawFilePath -> IO Fd -> IO Fd
forall a. (Eq a, Num a) => String -> RawFilePath -> IO a -> IO a
throwErrnoPathIfMinus1Retry "openFd" RawFilePath
name (IO Fd -> IO Fd) -> IO Fd -> IO Fd
forall a b. (a -> b) -> a -> b
$
       CString -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
open_ CString
str OpenMode
how [Flags]
optional_flags Maybe FileMode
maybe_mode