{-# 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),
      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 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 :: Bool
trunc = Bool
True, creat :: Maybe FileMode
creat = FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
0o666 }
  IOMode
AppendMode    -> OpenMode -> OpenFileFlags -> IO Fd
open OpenMode
WriteOnly OpenFileFlags
df { append :: Bool
append = Bool
True, creat :: Maybe FileMode
creat = FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
0o666 }
  IOMode
ReadWriteMode -> OpenMode -> OpenFileFlags -> IO Fd
open OpenMode
ReadWrite OpenFileFlags
df { creat :: Maybe FileMode
creat = FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
0o666 }
 where
  open :: OpenMode -> OpenFileFlags -> IO Fd
open = PosixPath -> OpenMode -> OpenFileFlags -> IO Fd
openFd PosixPath
fp
  df :: OpenFileFlags
df = OpenFileFlags
defaultFileFlags { noctty :: Bool
noctty = Bool
True, nonBlock :: Bool
nonBlock = Bool
True }

-- | Open an existing file and return the 'Handle'.
openExistingFile :: PosixPath -> IOMode -> IO Handle
openExistingFile :: PosixPath -> IOMode -> IO Handle
openExistingFile 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 :: Bool
trunc = Bool
True }
  IOMode
AppendMode    -> OpenMode -> OpenFileFlags -> IO Fd
open OpenMode
WriteOnly OpenFileFlags
df { append :: Bool
append = Bool
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
  df :: OpenFileFlags
df = OpenFileFlags
defaultFileFlags { noctty :: Bool
noctty = Bool
True, nonBlock :: Bool
nonBlock = Bool
True, creat :: Maybe FileMode
creat = Maybe FileMode
forall a. Maybe a
Nothing }

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
    [Char]
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)
    CInt
-> Maybe IODeviceType
-> Bool
-> [Char]
-> IOMode
-> Bool
-> IO Handle
fdToHandle' CInt
fd Maybe IODeviceType
forall a. Maybe a
Nothing Bool
False [Char]
fp' IOMode
iomode Bool
True