{-# LANGUAGE CPP              #-}
{-# LANGUAGE TupleSections    #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE PackageImports   #-}

module System.File.Platform where

import Data.Either (fromRight)
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, exclusive),
      OpenMode(ReadWrite, ReadOnly, WriteOnly) )
import System.OsPath.Posix ( PosixPath, PosixString, (</>) )
import qualified System.OsPath.Posix as PS
import Data.IORef (IORef, newIORef)
import System.Posix (CMode)
import System.IO (utf8, latin1)
import System.IO.Unsafe (unsafePerformIO)
import System.Posix.Internals (c_getpid)
import GHC.IORef (atomicModifyIORef'_)
import Foreign.C (getErrno, eEXIST, errnoToIOError)

#if MIN_VERSION_filepath(1, 5, 0)
import "os-string" System.OsString.Internal.Types (PosixString(..), PosixChar(..))
import qualified "os-string" System.OsString.Data.ByteString.Short as BC
#else
import Data.Coerce (coerce)
import "filepath" System.OsString.Internal.Types (PosixString(..), PosixChar(..))
import qualified "filepath" System.OsPath.Data.ByteString.Short as BC
#endif
import System.CPUTime (cpuTimePrecision, getCPUTime)
import Text.Printf (printf)

-- | 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'  <- [Char] -> Either SomeException [Char] -> [Char]
forall b a. b -> Either a b -> b
fromRight ((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) (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 }

findTempName :: (PosixString, PosixString)
             -> String
             -> PosixPath
             -> CMode
             -> IO (PosixPath, Handle)
findTempName :: (PosixPath, PosixPath)
-> [Char] -> PosixPath -> FileMode -> IO (PosixPath, Handle)
findTempName (PosixPath
prefix, PosixPath
suffix) [Char]
loc PosixPath
tmp_dir FileMode
mode = IO (PosixPath, Handle)
go
 where
  go :: IO (PosixPath, Handle)
go = do
    rs <- IO PosixPath
rand_string
    let filename = PosixPath
prefix PosixPath -> PosixPath -> PosixPath
forall a. Semigroup a => a -> a -> a
<> PosixPath
rs PosixPath -> PosixPath -> PosixPath
forall a. Semigroup a => a -> a -> a
<> PosixPath
suffix
        filepath = PosixPath
tmp_dir PosixPath -> PosixPath -> PosixPath
</> PosixPath
filename
    fd <- openTempFile_ filepath mode
    if fd < 0
    then do
      errno <- getErrno
      case errno of
          Errno
_ | Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eEXIST -> IO (PosixPath, Handle)
go
          Errno
_ -> do
            let tmp_dir' :: [Char]
tmp_dir' = PosixPath -> [Char]
lenientDecode PosixPath
tmp_dir
            IOError -> IO (PosixPath, Handle)
forall a. HasCallStack => IOError -> IO a
ioError ([Char] -> Errno -> Maybe Handle -> Maybe [Char] -> IOError
errnoToIOError [Char]
loc Errno
errno Maybe Handle
forall a. Maybe a
Nothing ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
tmp_dir'))
    else fmap (filepath,) $ fdToHandle_ ReadWriteMode filepath fd

  openTempFile_ :: PosixPath -> CMode -> IO Fd
  openTempFile_ :: PosixPath -> FileMode -> IO Fd
openTempFile_ PosixPath
fp FileMode
cmode = PosixPath -> OpenMode -> OpenFileFlags -> IO Fd
openFd PosixPath
fp OpenMode
ReadWrite OpenFileFlags
defaultFileFlags' { creat = Just cmode, nonBlock = True, noctty = True, exclusive = True }

tempCounter :: IORef Int
tempCounter :: IORef Int
tempCounter = IO (IORef Int) -> IORef Int
forall a. IO a -> a
unsafePerformIO (IO (IORef Int) -> IORef Int) -> IO (IORef Int) -> IORef Int
forall a b. (a -> b) -> a -> b
$ Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
{-# NOINLINE tempCounter #-}

-- build large digit-alike number
rand_string :: IO PosixString
rand_string :: IO PosixPath
rand_string = do
  r1 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Int (CPid -> Int) -> IO CPid -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CPid
c_getpid
  (r2, _) <- atomicModifyIORef'_ tempCounter (+1)
  r3 <- (`quot` cpuTimePrecision) <$> getCPUTime
  return $ PS.pack $ fmap (PS.unsafeFromChar) (printf "%x-%x-%x" r1 r2 r3)

lenientDecode :: PosixString -> String
lenientDecode :: PosixPath -> [Char]
lenientDecode PosixPath
ps = let utf8' :: Either EncodingException [Char]
utf8' = TextEncoding -> PosixPath -> Either EncodingException [Char]
PS.decodeWith TextEncoding
utf8 PosixPath
ps
                       latin1' :: Either EncodingException [Char]
latin1' = TextEncoding -> PosixPath -> Either EncodingException [Char]
PS.decodeWith TextEncoding
latin1 PosixPath
ps
                   in case (Either EncodingException [Char]
utf8', Either EncodingException [Char]
latin1') of
                        (Right [Char]
s, ~Either EncodingException [Char]
_) -> [Char]
s
                        (Either EncodingException [Char]
_, Right [Char]
s) -> [Char]
s
                        (Left EncodingException
_, Left EncodingException
_) -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"lenientDecode: failed to decode"

#if !MIN_VERSION_filepath(1, 5, 0)

any_ :: (PosixChar -> Bool) -> PosixString -> Bool
any_ = coerce BC.any

#endif