module System.File.PlatformPath.Internal (
    openBinaryFile
  , withFile
  , withBinaryFile
  , withFile'
  , withBinaryFile'
  , readFile
  , readFile'
  , writeFile
  , writeFile'
  , appendFile
  , appendFile'
  , openFile
  , openExistingFile
  , openFileWithCloseOnExec
  , openExistingFileWithCloseOnExec
  , OsPath.handleFinalizer
  , OsPath.HandleFinalizer
  , OsPath.addHandleFinalizer
  , withOpenFile'
  , addFilePathToIOError
  , augmentError
) where


import System.IO (IOMode(..), Handle)
import System.OsPath.Types
import GHC.IO.Exception (IOException(..))

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL

import qualified System.File.OsPath.Internal as OsPath
import System.OsString.Internal.Types

import Data.Coerce (coerce)
import Prelude hiding (readFile, writeFile, appendFile)

-- | Like `OsPath.openBinaryFile`, but takes a `PlatformPath` instead of an `OsPath`.
openBinaryFile :: PlatformPath -> IOMode -> IO Handle
openBinaryFile :: PosixString -> IOMode -> IO Handle
openBinaryFile = OsString -> IOMode -> IO Handle
OsPath.openBinaryFile (OsString -> IOMode -> IO Handle)
-> (PosixString -> OsString) -> PosixString -> IOMode -> IO Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce

-- | Like `OsPath.withFile`, but takes a `PlatformPath` instead of an `OsPath`.
withFile :: PlatformPath -> IOMode -> (Handle -> IO r) -> IO r
withFile :: forall r. PosixString -> IOMode -> (Handle -> IO r) -> IO r
withFile = OsString -> IOMode -> (Handle -> IO r) -> IO r
forall r. OsString -> IOMode -> (Handle -> IO r) -> IO r
OsPath.withFile (OsString -> IOMode -> (Handle -> IO r) -> IO r)
-> (PosixString -> OsString)
-> PosixString
-> IOMode
-> (Handle -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce

-- | Like `OsPath.withBinaryFile`, but takes a `PlatformPath` instead of an `OsPath`.
withBinaryFile :: PlatformPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile :: forall r. PosixString -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile = OsString -> IOMode -> (Handle -> IO r) -> IO r
forall r. OsString -> IOMode -> (Handle -> IO r) -> IO r
OsPath.withBinaryFile (OsString -> IOMode -> (Handle -> IO r) -> IO r)
-> (PosixString -> OsString)
-> PosixString
-> IOMode
-> (Handle -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce

-- | Like `OsPath.withFile'`, but takes a `PlatformPath` instead of an `OsPath`.
withFile' :: PlatformPath -> IOMode -> (Handle -> IO r) -> IO r
withFile' :: forall r. PosixString -> IOMode -> (Handle -> IO r) -> IO r
withFile' = OsString -> IOMode -> (Handle -> IO r) -> IO r
forall r. OsString -> IOMode -> (Handle -> IO r) -> IO r
OsPath.withFile' (OsString -> IOMode -> (Handle -> IO r) -> IO r)
-> (PosixString -> OsString)
-> PosixString
-> IOMode
-> (Handle -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce

-- | Like `OsPath.withBinaryFile'`, but takes a `PlatformPath` instead of an `OsPath`.
withBinaryFile' :: PlatformPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile' :: forall r. PosixString -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile' = OsString -> IOMode -> (Handle -> IO r) -> IO r
forall r. OsString -> IOMode -> (Handle -> IO r) -> IO r
OsPath.withBinaryFile' (OsString -> IOMode -> (Handle -> IO r) -> IO r)
-> (PosixString -> OsString)
-> PosixString
-> IOMode
-> (Handle -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce

-- | Like `OsPath.readFile`, but takes a `PlatformPath` instead of an `OsPath`.
readFile :: PlatformPath -> IO BSL.ByteString
readFile :: PosixString -> IO ByteString
readFile = OsString -> IO ByteString
OsPath.readFile (OsString -> IO ByteString)
-> (PosixString -> OsString) -> PosixString -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce

-- | Like `OsPath.readFile'`, but takes a `PlatformPath` instead of an `OsPath`.
readFile' :: PlatformPath -> IO BS.ByteString
readFile' :: PosixString -> IO ByteString
readFile' = OsString -> IO ByteString
OsPath.readFile' (OsString -> IO ByteString)
-> (PosixString -> OsString) -> PosixString -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce

-- | Like `OsPath.writeFile`, but takes a `PlatformPath` instead of an `OsPath`.
writeFile :: PlatformPath -> BSL.ByteString -> IO ()
writeFile :: PosixString -> ByteString -> IO ()
writeFile = OsString -> ByteString -> IO ()
OsPath.writeFile (OsString -> ByteString -> IO ())
-> (PosixString -> OsString) -> PosixString -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce

-- | Like `OsPath.writeFile'`, but takes a `PlatformPath` instead of an `OsPath`.
writeFile' :: PlatformPath -> BS.ByteString -> IO ()
writeFile' :: PosixString -> ByteString -> IO ()
writeFile' = OsString -> ByteString -> IO ()
OsPath.writeFile' (OsString -> ByteString -> IO ())
-> (PosixString -> OsString) -> PosixString -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce

-- | Like `OsPath.appendFile`, but takes a `PlatformPath` instead of an `OsPath`.
appendFile :: PlatformPath -> BSL.ByteString -> IO ()
appendFile :: PosixString -> ByteString -> IO ()
appendFile = OsString -> ByteString -> IO ()
OsPath.appendFile (OsString -> ByteString -> IO ())
-> (PosixString -> OsString) -> PosixString -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce

-- | Like `OsPath.appendFile'`, but takes a `PlatformPath` instead of an `OsPath`.
appendFile' :: PlatformPath -> BS.ByteString -> IO ()
appendFile' :: PosixString -> ByteString -> IO ()
appendFile' = OsString -> ByteString -> IO ()
OsPath.appendFile' (OsString -> ByteString -> IO ())
-> (PosixString -> OsString) -> PosixString -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce

-- | Like `OsPath.openFile`, but takes a `PlatformPath` instead of an `OsPath`.
openFile :: PlatformPath -> IOMode -> IO Handle
openFile :: PosixString -> IOMode -> IO Handle
openFile = OsString -> IOMode -> IO Handle
OsPath.openFile (OsString -> IOMode -> IO Handle)
-> (PosixString -> OsString) -> PosixString -> IOMode -> IO Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce

-- | Like `OsPath.openExistingFile`, but takes a `PlatformPath` instead of an `OsPath`.
openExistingFile :: PlatformPath -> IOMode -> IO Handle
openExistingFile :: PosixString -> IOMode -> IO Handle
openExistingFile = OsString -> IOMode -> IO Handle
OsPath.openExistingFile (OsString -> IOMode -> IO Handle)
-> (PosixString -> OsString) -> PosixString -> IOMode -> IO Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce

-- | Open a file and return the 'Handle'.
--
-- Sets @O_CLOEXEC@ on posix.
--
-- @since 0.1.2
openFileWithCloseOnExec :: PlatformPath -> IOMode -> IO Handle
openFileWithCloseOnExec :: PosixString -> IOMode -> IO Handle
openFileWithCloseOnExec = OsString -> IOMode -> IO Handle
OsPath.openFileWithCloseOnExec (OsString -> IOMode -> IO Handle)
-> (PosixString -> OsString) -> PosixString -> IOMode -> IO Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce

-- | Open an existing file and return the 'Handle'.
--
-- Sets @O_CLOEXEC@ on posix.
--
-- @since 0.1.2
openExistingFileWithCloseOnExec :: PlatformPath -> IOMode -> IO Handle
openExistingFileWithCloseOnExec :: PosixString -> IOMode -> IO Handle
openExistingFileWithCloseOnExec = OsString -> IOMode -> IO Handle
OsPath.openExistingFileWithCloseOnExec (OsString -> IOMode -> IO Handle)
-> (PosixString -> OsString) -> PosixString -> IOMode -> IO Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce

-- ---------------------------------------------------------------------------
-- Internals

withOpenFile' :: PlatformPath -> IOMode -> Bool -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
withOpenFile' :: forall r.
PosixString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' = OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
forall r.
OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
OsPath.withOpenFile' (OsString
 -> IOMode
 -> Bool
 -> Bool
 -> Bool
 -> (Handle -> IO r)
 -> Bool
 -> IO r)
-> (PosixString -> OsString)
-> PosixString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce

addFilePathToIOError :: String -> PlatformPath -> IOException -> IOException
addFilePathToIOError :: [Char] -> PosixString -> IOException -> IOException
addFilePathToIOError = ([Char] -> OsString -> IOException -> IOException)
-> [Char] -> PosixString -> IOException -> IOException
forall a b. Coercible a b => a -> b
coerce [Char] -> OsString -> IOException -> IOException
OsPath.addFilePathToIOError

augmentError :: String -> PlatformPath -> IO a -> IO a
augmentError :: forall a. [Char] -> PosixString -> IO a -> IO a
augmentError [Char]
fp = [Char] -> OsString -> IO a -> IO a
forall a. [Char] -> OsString -> IO a -> IO a
OsPath.augmentError [Char]
fp (OsString -> IO a -> IO a)
-> (PosixString -> OsString) -> PosixString -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> OsString
forall a b. Coercible a b => a -> b
coerce