{-# 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 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 :: PosixString -> IOMode -> IO Handle
openFile = OpenFileFlags -> PosixString -> IOMode -> IO Handle
openFile_ OpenFileFlags
defaultFileFlags'

openFile_ :: OpenFileFlags -> PosixPath -> IOMode -> IO Handle
openFile_ :: OpenFileFlags -> PosixString -> IOMode -> IO Handle
openFile_ OpenFileFlags
df PosixString
fp IOMode
iomode = IOMode -> PosixString -> Fd -> IO Handle
fdToHandle_ IOMode
iomode PosixString
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 = PosixString -> OpenMode -> OpenFileFlags -> IO Fd
openFd PosixString
fp

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

openExistingFile_ :: OpenFileFlags -> PosixPath -> IOMode -> IO Handle
openExistingFile_ :: OpenFileFlags -> PosixString -> IOMode -> IO Handle
openExistingFile_ OpenFileFlags
df PosixString
fp IOMode
iomode = IOMode -> PosixString -> Fd -> IO Handle
fdToHandle_ IOMode
iomode PosixString
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 = PosixString -> OpenMode -> OpenFileFlags -> IO Fd
openFd PosixString
fp

fdToHandle_ :: IOMode -> PosixPath -> Fd -> IO Handle
fdToHandle_ :: IOMode -> PosixString -> Fd -> IO Handle
fdToHandle_ IOMode
iomode PosixString
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'  <- [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])
-> (PosixString -> [PosixChar]) -> PosixString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> [PosixChar]
PS.unpack (PosixString -> [Char]) -> PosixString -> [Char]
forall a b. (a -> b) -> a -> b
$ PosixString
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 (PosixString -> IO [Char]
PS.decodeFS PosixString
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

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

openExistingFileWithCloseOnExec :: PosixPath -> IOMode -> IO Handle
openExistingFileWithCloseOnExec :: PosixString -> IOMode -> IO Handle
openExistingFileWithCloseOnExec = OpenFileFlags -> PosixString -> 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 :: (PosixString, PosixString)
-> [Char] -> PosixString -> FileMode -> IO (PosixString, Handle)
findTempName (PosixString
prefix, PosixString
suffix) [Char]
loc PosixString
tmp_dir FileMode
mode = IO (PosixString, Handle)
go
 where
  go :: IO (PosixString, Handle)
go = do
    PosixString
rs <- IO PosixString
rand_string
    let filename :: PosixString
filename = PosixString
prefix PosixString -> PosixString -> PosixString
forall a. Semigroup a => a -> a -> a
<> PosixString
rs PosixString -> PosixString -> PosixString
forall a. Semigroup a => a -> a -> a
<> PosixString
suffix
        filepath :: PosixString
filepath = PosixString
tmp_dir PosixString -> PosixString -> PosixString
</> PosixString
filename
    Fd
fd <- PosixString -> FileMode -> IO Fd
openTempFile_ PosixString
filepath FileMode
mode
    if Fd
fd Fd -> Fd -> Bool
forall a. Ord a => a -> a -> Bool
< Fd
0
    then do
      Errno
errno <- IO Errno
getErrno
      case Errno
errno of
          Errno
_ | Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eEXIST -> IO (PosixString, Handle)
go
          Errno
_ -> do
            let tmp_dir' :: [Char]
tmp_dir' = PosixString -> [Char]
lenientDecode PosixString
tmp_dir
            IOError -> IO (PosixString, Handle)
forall a. 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 (Handle -> (PosixString, Handle))
-> IO Handle -> IO (PosixString, Handle)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PosixString
filepath,) (IO Handle -> IO (PosixString, Handle))
-> IO Handle -> IO (PosixString, Handle)
forall a b. (a -> b) -> a -> b
$ IOMode -> PosixString -> Fd -> IO Handle
fdToHandle_ IOMode
ReadWriteMode PosixString
filepath Fd
fd

  openTempFile_ :: PosixPath -> CMode -> IO Fd
  openTempFile_ :: PosixString -> FileMode -> IO Fd
openTempFile_ PosixString
fp FileMode
cmode = PosixString -> OpenMode -> OpenFileFlags -> IO Fd
openFd PosixString
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 PosixString
rand_string = do
  Int
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
  (Int
r2, Int
_) <- IORef Int -> (Int -> Int) -> IO (Int, Int)
forall a. IORef a -> (a -> a) -> IO (a, a)
atomicModifyIORef'_ IORef Int
tempCounter (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  Integer
r3 <- (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
cpuTimePrecision) (Integer -> Integer) -> IO Integer -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Integer
getCPUTime
  PosixString -> IO PosixString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PosixString -> IO PosixString) -> PosixString -> IO PosixString
forall a b. (a -> b) -> a -> b
$ [PosixChar] -> PosixString
PS.pack ([PosixChar] -> PosixString) -> [PosixChar] -> PosixString
forall a b. (a -> b) -> a -> b
$ (Char -> PosixChar) -> [Char] -> [PosixChar]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> PosixChar
PS.unsafeFromChar) ([Char] -> Int -> Int -> Integer -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%x-%x-%x" Int
r1 Int
r2 Integer
r3)

lenientDecode :: PosixString -> String
lenientDecode :: PosixString -> [Char]
lenientDecode PosixString
ps = let utf8' :: Either EncodingException [Char]
utf8' = TextEncoding -> PosixString -> Either EncodingException [Char]
PS.decodeWith TextEncoding
utf8 PosixString
ps
                       latin1' :: Either EncodingException [Char]
latin1' = TextEncoding -> PosixString -> Either EncodingException [Char]
PS.decodeWith TextEncoding
latin1 PosixString
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_ :: (PosixChar -> Bool) -> PosixString -> Bool
any_ = ((Word8 -> Bool) -> ShortByteString -> Bool)
-> (PosixChar -> Bool) -> PosixString -> Bool
forall a b. Coercible a b => a -> b
coerce (Word8 -> Bool) -> ShortByteString -> Bool
BC.any

#endif