{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE NoImplicitPrelude #-}

module System.FilePath.FilePather.IO(
  readFile
, readFile'
, appendFile
, writeFile
, withFile
, openFile
, withBinaryFile
, openBinaryFile
, openTempFile
, openBinaryTempFile
, openTempFileWithDefaultPermissions
, openBinaryTempFileWithDefaultPermissions
) where

import Control.Exception ( Exception )
import Data.String ( String )
import System.FilePath(FilePath)
import System.FilePath.FilePather.ReadFilePath
    ( ReadFilePathT, tryReadFilePath )
import qualified System.IO as I
    ( appendFile,
      readFile,
      writeFile,
      openBinaryFile,
      openFile,
      openBinaryTempFile,
      openBinaryTempFileWithDefaultPermissions,
      openTempFile,
      openTempFileWithDefaultPermissions,
      readFile',
      withBinaryFile,
      withFile )
import System.IO(IO, IOMode, Handle)

readFile ::
  Exception e =>
  ReadFilePathT e IO String
readFile :: forall e. Exception e => ReadFilePathT e IO String
readFile =
  forall e a. Exception e => (String -> IO a) -> ReadFilePathT e IO a
tryReadFilePath String -> IO String
I.readFile
{-# INLINE readFile #-}

readFile' ::
  Exception e =>
  ReadFilePathT e IO String
readFile' :: forall e. Exception e => ReadFilePathT e IO String
readFile' =
  forall e a. Exception e => (String -> IO a) -> ReadFilePathT e IO a
tryReadFilePath String -> IO String
I.readFile'
{-# INLINE readFile' #-}

appendFile ::
  Exception e =>
  String
  -> ReadFilePathT e IO ()
appendFile :: forall e. Exception e => String -> ReadFilePathT e IO ()
appendFile String
s =
  forall e a. Exception e => (String -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (String -> String -> IO ()
`I.appendFile` String
s)
{-# INLINE appendFile #-}

writeFile ::
  Exception e =>
  String
  -> ReadFilePathT e IO ()
writeFile :: forall e. Exception e => String -> ReadFilePathT e IO ()
writeFile String
s =
  forall e a. Exception e => (String -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (String -> String -> IO ()
`I.writeFile` String
s)
{-# INLINE writeFile #-}

withFile ::
  Exception e =>
  IOMode
  -> (Handle -> IO r)
  -> ReadFilePathT e IO r
withFile :: forall e r.
Exception e =>
IOMode -> (Handle -> IO r) -> ReadFilePathT e IO r
withFile IOMode
mode Handle -> IO r
k =
  forall e a. Exception e => (String -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (\String
p -> forall r. String -> IOMode -> (Handle -> IO r) -> IO r
I.withFile String
p IOMode
mode Handle -> IO r
k)
{-# INLINE withFile #-}

openFile ::
  Exception e =>
  IOMode
  -> ReadFilePathT e IO Handle
openFile :: forall e. Exception e => IOMode -> ReadFilePathT e IO Handle
openFile IOMode
mode =
  forall e a. Exception e => (String -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (String -> IOMode -> IO Handle
`I.openFile` IOMode
mode)
{-# INLINE openFile #-}

withBinaryFile ::
  Exception e =>
  IOMode
  -> (Handle -> IO r)
  -> ReadFilePathT e IO r
withBinaryFile :: forall e r.
Exception e =>
IOMode -> (Handle -> IO r) -> ReadFilePathT e IO r
withBinaryFile IOMode
mode Handle -> IO r
k =
  forall e a. Exception e => (String -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (\String
p -> forall r. String -> IOMode -> (Handle -> IO r) -> IO r
I.withBinaryFile String
p IOMode
mode Handle -> IO r
k)
{-# INLINE withBinaryFile #-}

openBinaryFile ::
  Exception e =>
  IOMode
  -> ReadFilePathT e IO Handle
openBinaryFile :: forall e. Exception e => IOMode -> ReadFilePathT e IO Handle
openBinaryFile IOMode
mode =
  forall e a. Exception e => (String -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (String -> IOMode -> IO Handle
`I.openBinaryFile` IOMode
mode)
{-# INLINE openBinaryFile #-}

openTempFile ::
  Exception e =>
  String
  -> ReadFilePathT e IO (FilePath, Handle)
openTempFile :: forall e.
Exception e =>
String -> ReadFilePathT e IO (String, Handle)
openTempFile String
s =
  forall e a. Exception e => (String -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (String -> String -> IO (String, Handle)
`I.openTempFile` String
s)
{-# INLINE openTempFile #-}

openBinaryTempFile ::
  Exception e =>
  String
  -> ReadFilePathT e IO (FilePath, Handle)
openBinaryTempFile :: forall e.
Exception e =>
String -> ReadFilePathT e IO (String, Handle)
openBinaryTempFile String
s =
  forall e a. Exception e => (String -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (String -> String -> IO (String, Handle)
`I.openBinaryTempFile` String
s)
{-# INLINE openBinaryTempFile #-}

openTempFileWithDefaultPermissions ::
  Exception e =>
  String
  -> ReadFilePathT e IO (FilePath, Handle)
openTempFileWithDefaultPermissions :: forall e.
Exception e =>
String -> ReadFilePathT e IO (String, Handle)
openTempFileWithDefaultPermissions String
s =
  forall e a. Exception e => (String -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (String -> String -> IO (String, Handle)
`I.openTempFileWithDefaultPermissions` String
s)
{-# INLINE openTempFileWithDefaultPermissions #-}

openBinaryTempFileWithDefaultPermissions ::
  Exception e =>
  String
  -> ReadFilePathT e IO (FilePath, Handle)
openBinaryTempFileWithDefaultPermissions :: forall e.
Exception e =>
String -> ReadFilePathT e IO (String, Handle)
openBinaryTempFileWithDefaultPermissions String
s =
  forall e a. Exception e => (String -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (String -> String -> IO (String, Handle)
`I.openBinaryTempFileWithDefaultPermissions` String
s)
{-# INLINE openBinaryTempFileWithDefaultPermissions #-}