{-# LANGUAGE TypeApplications #-}

module System.File.Platform where

import Control.Exception (try, onException, SomeException)
import GHC.IO.Handle.FD (fdToHandle')
import System.IO (IOMode(..), Handle)
import System.Posix.Types (Fd(..))
import System.Posix.IO.PosixString
    ( defaultFileFlags,
      openFd,
      closeFd,
      OpenFileFlags(noctty, nonBlock, creat, append, trunc, cloexec),
      OpenMode(ReadWrite, ReadOnly, WriteOnly) )
import System.OsPath.Posix ( PosixPath )
import qualified System.OsPath.Posix as PS

-- | Open a file and return the 'Handle'.
openFile :: PosixPath -> IOMode -> IO Handle
openFile :: PosixPath -> IOMode -> IO Handle
openFile = OpenFileFlags -> PosixPath -> IOMode -> IO Handle
openFile_ OpenFileFlags
defaultFileFlags'

openFile_ :: OpenFileFlags -> PosixPath -> IOMode -> IO Handle
openFile_ :: OpenFileFlags -> PosixPath -> IOMode -> IO Handle
openFile_ OpenFileFlags
df PosixPath
fp IOMode
iomode = IOMode -> PosixPath -> Fd -> IO Handle
fdToHandle_ IOMode
iomode PosixPath
fp (Fd -> IO Handle) -> IO Fd -> IO Handle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case IOMode
iomode of
  IOMode
ReadMode      -> OpenMode -> OpenFileFlags -> IO Fd
open OpenMode
ReadOnly  OpenFileFlags
df
  IOMode
WriteMode     -> OpenMode -> OpenFileFlags -> IO Fd
open OpenMode
WriteOnly OpenFileFlags
df { trunc = True, creat = Just 0o666 }
  IOMode
AppendMode    -> OpenMode -> OpenFileFlags -> IO Fd
open OpenMode
WriteOnly OpenFileFlags
df { append = True, creat = Just 0o666 }
  IOMode
ReadWriteMode -> OpenMode -> OpenFileFlags -> IO Fd
open OpenMode
ReadWrite OpenFileFlags
df { creat = Just 0o666 }
 where
  open :: OpenMode -> OpenFileFlags -> IO Fd
open = PosixPath -> OpenMode -> OpenFileFlags -> IO Fd
openFd PosixPath
fp

-- | Open an existing file and return the 'Handle'.
openExistingFile :: PosixPath -> IOMode -> IO Handle
openExistingFile :: PosixPath -> IOMode -> IO Handle
openExistingFile = OpenFileFlags -> PosixPath -> IOMode -> IO Handle
openExistingFile_ OpenFileFlags
defaultExistingFileFlags

openExistingFile_ :: OpenFileFlags -> PosixPath -> IOMode -> IO Handle
openExistingFile_ :: OpenFileFlags -> PosixPath -> IOMode -> IO Handle
openExistingFile_ OpenFileFlags
df PosixPath
fp IOMode
iomode = IOMode -> PosixPath -> Fd -> IO Handle
fdToHandle_ IOMode
iomode PosixPath
fp (Fd -> IO Handle) -> IO Fd -> IO Handle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case IOMode
iomode of
  IOMode
ReadMode      -> OpenMode -> OpenFileFlags -> IO Fd
open OpenMode
ReadOnly  OpenFileFlags
df
  IOMode
WriteMode     -> OpenMode -> OpenFileFlags -> IO Fd
open OpenMode
WriteOnly OpenFileFlags
df { trunc = True }
  IOMode
AppendMode    -> OpenMode -> OpenFileFlags -> IO Fd
open OpenMode
WriteOnly OpenFileFlags
df { append = True }
  IOMode
ReadWriteMode -> OpenMode -> OpenFileFlags -> IO Fd
open OpenMode
ReadWrite OpenFileFlags
df
 where
  open :: OpenMode -> OpenFileFlags -> IO Fd
open = PosixPath -> OpenMode -> OpenFileFlags -> IO Fd
openFd PosixPath
fp

fdToHandle_ :: IOMode -> PosixPath -> Fd -> IO Handle
fdToHandle_ :: IOMode -> PosixPath -> Fd -> IO Handle
fdToHandle_ IOMode
iomode PosixPath
fp (Fd CInt
fd) = (IO Handle -> IO () -> IO Handle
forall a b. IO a -> IO b -> IO a
`onException` Fd -> IO ()
closeFd (CInt -> Fd
Fd CInt
fd)) (IO Handle -> IO Handle) -> IO Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ do
    fp'  <- (SomeException -> [Char])
-> ([Char] -> [Char]) -> Either SomeException [Char] -> [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> SomeException -> [Char]
forall a b. a -> b -> a
const ((PosixChar -> Char) -> [PosixChar] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PosixChar -> Char
PS.toChar ([PosixChar] -> [Char])
-> (PosixPath -> [PosixChar]) -> PosixPath -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixPath -> [PosixChar]
PS.unpack (PosixPath -> [Char]) -> PosixPath -> [Char]
forall a b. (a -> b) -> a -> b
$ PosixPath
fp)) [Char] -> [Char]
forall a. a -> a
id (Either SomeException [Char] -> [Char])
-> IO (Either SomeException [Char]) -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a. Exception e => IO a -> IO (Either e a)
try @SomeException (PosixPath -> IO [Char]
PS.decodeFS PosixPath
fp)
    fdToHandle' fd Nothing False fp' iomode True

openFileWithCloseOnExec :: PosixPath -> IOMode -> IO Handle
openFileWithCloseOnExec :: PosixPath -> IOMode -> IO Handle
openFileWithCloseOnExec = OpenFileFlags -> PosixPath -> IOMode -> IO Handle
openFile_ OpenFileFlags
defaultFileFlags' { cloexec = True }

openExistingFileWithCloseOnExec :: PosixPath -> IOMode -> IO Handle
openExistingFileWithCloseOnExec :: PosixPath -> IOMode -> IO Handle
openExistingFileWithCloseOnExec = OpenFileFlags -> PosixPath -> IOMode -> IO Handle
openExistingFile_ OpenFileFlags
defaultExistingFileFlags { cloexec = True }

defaultFileFlags' :: OpenFileFlags
defaultFileFlags' :: OpenFileFlags
defaultFileFlags' = OpenFileFlags
defaultFileFlags { noctty = True, nonBlock = True }

defaultExistingFileFlags :: OpenFileFlags
defaultExistingFileFlags :: OpenFileFlags
defaultExistingFileFlags = OpenFileFlags
defaultFileFlags { noctty = True, nonBlock = True, creat = Nothing }