module Streamly.Internal.FileSystem.Posix.File
    (
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
      OpenFlags (..)
    , OpenMode (..)
    , defaultOpenFlags
    , openFileWith
    , openFile

    , openFdAtWith
    , openFdAt
    , openFd
    , closeFd

    -- Re-exported
    , Fd
#endif
    ) where

#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)

-------------------------------------------------------------------------------
-- Imports
-------------------------------------------------------------------------------

import Data.Bits ((.|.))
import Foreign.C.Error (throwErrnoIfMinus1_)
import Foreign.C.String (CString)
import Foreign.C.Types (CInt(..))
import Streamly.Internal.FileSystem.PosixPath (PosixPath)
import System.IO (IOMode(..), Handle)
import GHC.IO.Handle.FD (fdToHandle)
import System.Posix.Types (Fd(..), CMode(..), FileMode)
import Streamly.Internal.FileSystem.Posix.Errno (throwErrnoPathIfMinus1Retry)

import qualified Streamly.Internal.Data.Array as Array
import qualified Streamly.Internal.FileSystem.PosixPath as Path
-- import qualified GHC.IO.FD as FD

-------------------------------------------------------------------------------
-- Flags
-------------------------------------------------------------------------------

-- XXX use oRDONLY, oWRONLY etc?
data OpenMode =
      ReadOnly -- ^ O_RDONLY
    | WriteOnly -- ^ O_WRONLY
    | ReadWrite -- ^ O_RDWR
    deriving (ReadPrec [OpenMode]
ReadPrec OpenMode
Int -> ReadS OpenMode
ReadS [OpenMode]
(Int -> ReadS OpenMode)
-> ReadS [OpenMode]
-> ReadPrec OpenMode
-> ReadPrec [OpenMode]
-> Read OpenMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OpenMode
readsPrec :: Int -> ReadS OpenMode
$creadList :: ReadS [OpenMode]
readList :: ReadS [OpenMode]
$creadPrec :: ReadPrec OpenMode
readPrec :: ReadPrec OpenMode
$creadListPrec :: ReadPrec [OpenMode]
readListPrec :: ReadPrec [OpenMode]
Read, Int -> OpenMode -> ShowS
[OpenMode] -> ShowS
OpenMode -> String
(Int -> OpenMode -> ShowS)
-> (OpenMode -> String) -> ([OpenMode] -> ShowS) -> Show OpenMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenMode -> ShowS
showsPrec :: Int -> OpenMode -> ShowS
$cshow :: OpenMode -> String
show :: OpenMode -> String
$cshowList :: [OpenMode] -> ShowS
showList :: [OpenMode] -> ShowS
Show, OpenMode -> OpenMode -> Bool
(OpenMode -> OpenMode -> Bool)
-> (OpenMode -> OpenMode -> Bool) -> Eq OpenMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenMode -> OpenMode -> Bool
== :: OpenMode -> OpenMode -> Bool
$c/= :: OpenMode -> OpenMode -> Bool
/= :: OpenMode -> OpenMode -> Bool
Eq, Eq OpenMode
Eq OpenMode
-> (OpenMode -> OpenMode -> Ordering)
-> (OpenMode -> OpenMode -> Bool)
-> (OpenMode -> OpenMode -> Bool)
-> (OpenMode -> OpenMode -> Bool)
-> (OpenMode -> OpenMode -> Bool)
-> (OpenMode -> OpenMode -> OpenMode)
-> (OpenMode -> OpenMode -> OpenMode)
-> Ord OpenMode
OpenMode -> OpenMode -> Bool
OpenMode -> OpenMode -> Ordering
OpenMode -> OpenMode -> OpenMode
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
$ccompare :: OpenMode -> OpenMode -> Ordering
compare :: OpenMode -> OpenMode -> Ordering
$c< :: OpenMode -> OpenMode -> Bool
< :: OpenMode -> OpenMode -> Bool
$c<= :: OpenMode -> OpenMode -> Bool
<= :: OpenMode -> OpenMode -> Bool
$c> :: OpenMode -> OpenMode -> Bool
> :: OpenMode -> OpenMode -> Bool
$c>= :: OpenMode -> OpenMode -> Bool
>= :: OpenMode -> OpenMode -> Bool
$cmax :: OpenMode -> OpenMode -> OpenMode
max :: OpenMode -> OpenMode -> OpenMode
$cmin :: OpenMode -> OpenMode -> OpenMode
min :: OpenMode -> OpenMode -> OpenMode
Ord)

-- XXX use oAPPEND, oEXCL, oNOCTTY etc?
data OpenFlags =
 OpenFlags {
    OpenFlags -> Bool
append    :: Bool,           -- ^ O_APPEND
    OpenFlags -> Bool
exclusive :: Bool,           -- ^ O_EXCL, Result is undefined if 'creat' is 'Nothing'.
    OpenFlags -> Bool
noctty    :: Bool,           -- ^ O_NOCTTY
    OpenFlags -> Bool
nonBlock  :: Bool,           -- ^ O_NONBLOCK
    OpenFlags -> Bool
trunc     :: Bool,           -- ^ O_TRUNC
    OpenFlags -> Bool
nofollow  :: Bool,           -- ^ O_NOFOLLOW
    OpenFlags -> Maybe FileMode
creat     :: Maybe FileMode, -- ^ O_CREAT
    OpenFlags -> Bool
cloexec   :: Bool,           -- ^ O_CLOEXEC
    OpenFlags -> Bool
directory :: Bool,           -- ^ O_DIRECTORY
    OpenFlags -> Bool
sync      :: Bool            -- ^ O_SYNC
 }
 deriving (ReadPrec [OpenFlags]
ReadPrec OpenFlags
Int -> ReadS OpenFlags
ReadS [OpenFlags]
(Int -> ReadS OpenFlags)
-> ReadS [OpenFlags]
-> ReadPrec OpenFlags
-> ReadPrec [OpenFlags]
-> Read OpenFlags
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OpenFlags
readsPrec :: Int -> ReadS OpenFlags
$creadList :: ReadS [OpenFlags]
readList :: ReadS [OpenFlags]
$creadPrec :: ReadPrec OpenFlags
readPrec :: ReadPrec OpenFlags
$creadListPrec :: ReadPrec [OpenFlags]
readListPrec :: ReadPrec [OpenFlags]
Read, Int -> OpenFlags -> ShowS
[OpenFlags] -> ShowS
OpenFlags -> String
(Int -> OpenFlags -> ShowS)
-> (OpenFlags -> String)
-> ([OpenFlags] -> ShowS)
-> Show OpenFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenFlags -> ShowS
showsPrec :: Int -> OpenFlags -> ShowS
$cshow :: OpenFlags -> String
show :: OpenFlags -> String
$cshowList :: [OpenFlags] -> ShowS
showList :: [OpenFlags] -> ShowS
Show, OpenFlags -> OpenFlags -> Bool
(OpenFlags -> OpenFlags -> Bool)
-> (OpenFlags -> OpenFlags -> Bool) -> Eq OpenFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenFlags -> OpenFlags -> Bool
== :: OpenFlags -> OpenFlags -> Bool
$c/= :: OpenFlags -> OpenFlags -> Bool
/= :: OpenFlags -> OpenFlags -> Bool
Eq, Eq OpenFlags
Eq OpenFlags
-> (OpenFlags -> OpenFlags -> Ordering)
-> (OpenFlags -> OpenFlags -> Bool)
-> (OpenFlags -> OpenFlags -> Bool)
-> (OpenFlags -> OpenFlags -> Bool)
-> (OpenFlags -> OpenFlags -> Bool)
-> (OpenFlags -> OpenFlags -> OpenFlags)
-> (OpenFlags -> OpenFlags -> OpenFlags)
-> Ord OpenFlags
OpenFlags -> OpenFlags -> Bool
OpenFlags -> OpenFlags -> Ordering
OpenFlags -> OpenFlags -> OpenFlags
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
$ccompare :: OpenFlags -> OpenFlags -> Ordering
compare :: OpenFlags -> OpenFlags -> Ordering
$c< :: OpenFlags -> OpenFlags -> Bool
< :: OpenFlags -> OpenFlags -> Bool
$c<= :: OpenFlags -> OpenFlags -> Bool
<= :: OpenFlags -> OpenFlags -> Bool
$c> :: OpenFlags -> OpenFlags -> Bool
> :: OpenFlags -> OpenFlags -> Bool
$c>= :: OpenFlags -> OpenFlags -> Bool
>= :: OpenFlags -> OpenFlags -> Bool
$cmax :: OpenFlags -> OpenFlags -> OpenFlags
max :: OpenFlags -> OpenFlags -> OpenFlags
$cmin :: OpenFlags -> OpenFlags -> OpenFlags
min :: OpenFlags -> OpenFlags -> OpenFlags
Ord)

-- | Default values for the 'OpenFlags'.
--
defaultOpenFlags :: OpenFlags
defaultOpenFlags :: OpenFlags
defaultOpenFlags =
    OpenFlags
    { append :: Bool
append    = Bool
False
    , exclusive :: Bool
exclusive = Bool
False
    , noctty :: Bool
noctty    = Bool
True -- XXX ?
    , nonBlock :: Bool
nonBlock  = Bool
True -- XXX ?
    , trunc :: Bool
trunc     = Bool
False
    , nofollow :: Bool
nofollow  = Bool
False
    , creat :: Maybe FileMode
creat     = Maybe FileMode
forall a. Maybe a
Nothing
    , cloexec :: Bool
cloexec   = Bool
False
    , directory :: Bool
directory = Bool
False
    , sync :: Bool
sync      = Bool
False
    }

foreign import capi unsafe "fcntl.h openat"
   c_openat :: CInt -> CString -> CInt -> CMode -> IO CInt

-- | Open and optionally create a file relative to an optional
-- directory file descriptor.
-- {-# INLINE openFdAtWith_ #-}
openFdAtWith_ ::
       OpenFlags -- ^ Append, exclusive, etc.
    -> Maybe Fd -- ^ Optional directory file descriptor
    -> CString -- ^ Pathname to open
    -> OpenMode -- ^ Read-only, read-write or write-only
    -> IO Fd
openFdAtWith_ :: OpenFlags -> Maybe Fd -> CString -> OpenMode -> IO Fd
openFdAtWith_ OpenFlags{Bool
Maybe FileMode
append :: OpenFlags -> Bool
exclusive :: OpenFlags -> Bool
creat :: OpenFlags -> Maybe FileMode
noctty :: OpenFlags -> Bool
nonBlock :: OpenFlags -> Bool
trunc :: OpenFlags -> Bool
nofollow :: OpenFlags -> Bool
cloexec :: OpenFlags -> Bool
directory :: OpenFlags -> Bool
sync :: OpenFlags -> Bool
append :: Bool
exclusive :: Bool
noctty :: Bool
nonBlock :: Bool
trunc :: Bool
nofollow :: Bool
creat :: Maybe FileMode
cloexec :: Bool
directory :: Bool
sync :: Bool
..} Maybe Fd
fdMay CString
path OpenMode
how =
    CInt -> Fd
Fd (CInt -> Fd) -> IO CInt -> IO Fd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CString -> CInt -> FileMode -> IO CInt
c_openat CInt
c_fd CString
path CInt
all_flags FileMode
mode_w

    where

    c_fd :: CInt
c_fd = CInt -> (Fd -> CInt) -> Maybe Fd -> CInt
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-CInt
100) (\ (Fd CInt
fd) -> CInt
fd) Maybe Fd
fdMay

    flags :: CInt
flags =
       (if Bool
append       then CInt
1024    else CInt
0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
       (if Bool
exclusive    then CInt
128     else CInt
0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
       (if Bool
noctty       then CInt
256     else CInt
0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
       (if Bool
nonBlock     then CInt
2048    else CInt
0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
       (if Bool
trunc        then CInt
512     else CInt
0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
       (if Bool
nofollow     then CInt
131072  else CInt
0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
       (if Bool
cloexec      then CInt
524288  else CInt
0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
       (if Bool
directory    then CInt
65536   else CInt
0) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
       (if Bool
sync         then CInt
1052672 else CInt
0)

    open_mode :: CInt
open_mode =
        case OpenMode
how of
            OpenMode
ReadOnly  -> CInt
0
            OpenMode
WriteOnly -> CInt
1
            OpenMode
ReadWrite -> CInt
2

    (CInt
creat_f, FileMode
mode_w) =
        case Maybe FileMode
creat of
            Maybe FileMode
Nothing -> (CInt
0, FileMode
0)
            Just FileMode
x  -> (CInt
64, FileMode
x)

    all_flags :: CInt
all_flags = CInt
creat_f CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
flags CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
open_mode

withFilePath :: PosixPath -> (CString -> IO a) -> IO a
withFilePath :: forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
p = Array Word8 -> (CString -> IO a) -> IO a
forall a b. Array a -> (CString -> IO b) -> IO b
Array.asCStringUnsafe (PosixPath -> Array Word8
forall a. IsPath PosixPath a => a -> Array Word8
Path.toChunk PosixPath
p)

-- | Open a file relative to an optional directory file descriptor.
--
-- {-# INLINE openFdAtWith #-}
openFdAtWith ::
       OpenFlags -- ^ Append, exclusive, truncate, etc.
    -> Maybe Fd -- ^ Optional directory file descriptor
    -> PosixPath -- ^ Pathname to open
    -> OpenMode -- ^ Read-only, read-write or write-only
    -> IO Fd
openFdAtWith :: OpenFlags -> Maybe Fd -> PosixPath -> OpenMode -> IO Fd
openFdAtWith OpenFlags
flags Maybe Fd
fdMay PosixPath
name OpenMode
how =
   PosixPath -> (CString -> IO Fd) -> IO Fd
forall a. PosixPath -> (CString -> IO a) -> IO a
withFilePath PosixPath
name ((CString -> IO Fd) -> IO Fd) -> (CString -> IO Fd) -> IO Fd
forall a b. (a -> b) -> a -> b
$ \CString
str -> do
     String -> PosixPath -> IO Fd -> IO Fd
forall a. (Eq a, Num a) => String -> PosixPath -> IO a -> IO a
throwErrnoPathIfMinus1Retry String
"openFdAt" PosixPath
name
        (IO Fd -> IO Fd) -> IO Fd -> IO Fd
forall a b. (a -> b) -> a -> b
$ OpenFlags -> Maybe Fd -> CString -> OpenMode -> IO Fd
openFdAtWith_ OpenFlags
flags Maybe Fd
fdMay CString
str OpenMode
how

{-# INLINE openFdAt #-}
openFdAt :: Maybe Fd -> PosixPath -> OpenMode -> IO Fd
openFdAt :: Maybe Fd -> PosixPath -> OpenMode -> IO Fd
openFdAt = OpenFlags -> Maybe Fd -> PosixPath -> OpenMode -> IO Fd
openFdAtWith OpenFlags
defaultOpenFlags

{-# INLINE openFd #-}
openFd :: PosixPath -> OpenMode -> IO Fd
openFd :: PosixPath -> OpenMode -> IO Fd
openFd = Maybe Fd -> PosixPath -> OpenMode -> IO Fd
openFdAt Maybe Fd
forall a. Maybe a
Nothing

openFileWith :: OpenFlags -> PosixPath -> IOMode -> IO Handle
openFileWith :: OpenFlags -> PosixPath -> IOMode -> IO Handle
openFileWith OpenFlags
df PosixPath
fp IOMode
iomode = do
    Fd
r <-
        case IOMode
iomode of
            IOMode
ReadMode -> OpenMode -> OpenFlags -> IO Fd
open OpenMode
ReadOnly  OpenFlags
df
            IOMode
WriteMode -> OpenMode -> OpenFlags -> IO Fd
open OpenMode
WriteOnly OpenFlags
df {trunc :: Bool
trunc = Bool
True, creat :: Maybe FileMode
creat = FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
0o666}
            IOMode
AppendMode -> OpenMode -> OpenFlags -> IO Fd
open OpenMode
WriteOnly OpenFlags
df {append :: Bool
append = Bool
True, creat :: Maybe FileMode
creat = FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
0o666}
            IOMode
ReadWriteMode -> OpenMode -> OpenFlags -> IO Fd
open OpenMode
ReadWrite OpenFlags
df {creat :: Maybe FileMode
creat = FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
0o666}
    -- XXX Note we did not use mkFD here, are we locking the file?
    CInt -> IO Handle
fdToHandle (CInt -> IO Handle) -> CInt -> IO Handle
forall a b. (a -> b) -> a -> b
$ Fd -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
r

    where

    open :: OpenMode -> OpenFlags -> IO Fd
open OpenMode
mode OpenFlags
flags = OpenFlags -> Maybe Fd -> PosixPath -> OpenMode -> IO Fd
openFdAtWith OpenFlags
flags Maybe Fd
forall a. Maybe a
Nothing PosixPath
fp OpenMode
mode

openFile :: PosixPath -> IOMode -> IO Handle
openFile :: PosixPath -> IOMode -> IO Handle
openFile = OpenFlags -> PosixPath -> IOMode -> IO Handle
openFileWith OpenFlags
defaultOpenFlags

foreign import ccall unsafe "unistd.h close"
   c_close :: CInt -> IO CInt

closeFd :: Fd -> IO ()
closeFd :: Fd -> IO ()
closeFd (Fd CInt
fd) = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ (String
"closeFd " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
fd) (CInt -> IO CInt
c_close CInt
fd)

#endif