{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE BangPatterns #-}

module System.File.OsPath (
  openBinaryFile
, withFile
, withBinaryFile
, withFile'
, withBinaryFile'
, readFile
, readFile'
, writeFile
, writeFile'
, appendFile
, appendFile'
, openFile
, openExistingFile
) where


import qualified System.File.Platform as P

import Prelude ((.), ($), String, IO, ioError, pure, either, const, flip, Maybe(..), fmap, (<$>), id, Bool(..), FilePath, (++), return, show, (>>=))
import GHC.IO (catchException)
import GHC.IO.Exception (IOException(..))
import GHC.IO.Handle (hClose_help)
import GHC.IO.Handle.Internals (debugIO)
import GHC.IO.Handle.Types (Handle__, Handle(..))
import Control.Concurrent.MVar
import Control.Monad (void, when)
import Control.DeepSeq (force)
import Control.Exception (SomeException, try, evaluate, mask, onException)
import System.IO (IOMode(..), hSetBinaryMode, hClose)
import System.IO.Unsafe (unsafePerformIO)
import System.OsPath as OSP
import System.OsString.Internal.Types

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

-- | Like 'openFile', but open the file in binary mode.
-- On Windows, reading a file in text mode (which is the default)
-- will translate CRLF to LF, and writing will translate LF to CRLF.
-- This is usually what you want with text files.  With binary files
-- this is undesirable; also, as usual under Microsoft operating systems,
-- text mode treats control-Z as EOF.  Binary mode turns off all special
-- treatment of end-of-line and end-of-file characters.
-- (See also 'System.IO.hSetBinaryMode'.)

-- On POSIX systems, 'openBinaryFile' is an /interruptible operation/ as
-- described in "Control.Exception".
openBinaryFile :: OsPath -> IOMode -> IO Handle
openBinaryFile :: OsPath -> IOMode -> IO Handle
openBinaryFile OsPath
osfp IOMode
iomode = [Char] -> OsPath -> IO Handle -> IO Handle
forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
"openBinaryFile" OsPath
osfp (IO Handle -> IO Handle) -> IO Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> Bool
-> Bool
-> (Handle -> IO Handle)
-> Bool
-> IO Handle
forall r.
OsPath
-> IOMode -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
withOpenFile' OsPath
osfp IOMode
iomode Bool
True Bool
False Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False


-- | Run an action on a file.
--
-- The 'Handle' is automatically closed afther the action.
withFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile :: forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile OsPath
osfp IOMode
iomode Handle -> IO r
act = ([Char] -> OsPath -> IO (Either IOError r) -> IO (Either IOError r)
forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
"withFile" OsPath
osfp
    (IO (Either IOError r) -> IO (Either IOError r))
-> IO (Either IOError r) -> IO (Either IOError r)
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> Bool
-> Bool
-> (Handle -> IO (Either IOError r))
-> Bool
-> IO (Either IOError r)
forall r.
OsPath
-> IOMode -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
withOpenFile' OsPath
osfp IOMode
iomode Bool
False Bool
False (IO r -> IO (Either IOError r)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO r -> IO (Either IOError r))
-> (Handle -> IO r) -> Handle -> IO (Either IOError r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO r
act) Bool
True)
  IO (Either IOError r) -> (Either IOError r -> IO r) -> IO r
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IOError -> IO r) -> (r -> IO r) -> Either IOError r -> IO r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOError -> IO r
forall a. IOError -> IO a
ioError r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

withBinaryFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile :: forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile OsPath
osfp IOMode
iomode Handle -> IO r
act = ([Char] -> OsPath -> IO (Either IOError r) -> IO (Either IOError r)
forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
"withBinaryFile" OsPath
osfp
    (IO (Either IOError r) -> IO (Either IOError r))
-> IO (Either IOError r) -> IO (Either IOError r)
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> Bool
-> Bool
-> (Handle -> IO (Either IOError r))
-> Bool
-> IO (Either IOError r)
forall r.
OsPath
-> IOMode -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
withOpenFile' OsPath
osfp IOMode
iomode Bool
True Bool
False (IO r -> IO (Either IOError r)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO r -> IO (Either IOError r))
-> (Handle -> IO r) -> Handle -> IO (Either IOError r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO r
act) Bool
True)
  IO (Either IOError r) -> (Either IOError r -> IO r) -> IO r
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IOError -> IO r) -> (r -> IO r) -> Either IOError r -> IO r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOError -> IO r
forall a. IOError -> IO a
ioError r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Run an action on a file.
--
-- The 'Handle' is not automatically closed to allow lazy IO. Use this
-- with caution.
withFile'
  :: OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile' :: forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile' OsPath
osfp IOMode
iomode Handle -> IO r
act = ([Char] -> OsPath -> IO (Either IOError r) -> IO (Either IOError r)
forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
"withFile'" OsPath
osfp
    (IO (Either IOError r) -> IO (Either IOError r))
-> IO (Either IOError r) -> IO (Either IOError r)
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> Bool
-> Bool
-> (Handle -> IO (Either IOError r))
-> Bool
-> IO (Either IOError r)
forall r.
OsPath
-> IOMode -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
withOpenFile' OsPath
osfp IOMode
iomode Bool
False Bool
False (IO r -> IO (Either IOError r)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO r -> IO (Either IOError r))
-> (Handle -> IO r) -> Handle -> IO (Either IOError r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO r
act) Bool
False)
  IO (Either IOError r) -> (Either IOError r -> IO r) -> IO r
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IOError -> IO r) -> (r -> IO r) -> Either IOError r -> IO r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOError -> IO r
forall a. IOError -> IO a
ioError r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

withBinaryFile'
  :: OsPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile' :: forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile' OsPath
osfp IOMode
iomode Handle -> IO r
act = ([Char] -> OsPath -> IO (Either IOError r) -> IO (Either IOError r)
forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
"withBinaryFile'" OsPath
osfp
    (IO (Either IOError r) -> IO (Either IOError r))
-> IO (Either IOError r) -> IO (Either IOError r)
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> Bool
-> Bool
-> (Handle -> IO (Either IOError r))
-> Bool
-> IO (Either IOError r)
forall r.
OsPath
-> IOMode -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
withOpenFile' OsPath
osfp IOMode
iomode Bool
True Bool
False (IO r -> IO (Either IOError r)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO r -> IO (Either IOError r))
-> (Handle -> IO r) -> Handle -> IO (Either IOError r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO r
act) Bool
False)
  IO (Either IOError r) -> (Either IOError r -> IO r) -> IO r
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IOError -> IO r) -> (r -> IO r) -> Either IOError r -> IO r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOError -> IO r
forall a. IOError -> IO a
ioError r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | The 'readFile' function reads a file and returns the contents of the file
-- as a 'ByteString'. The file is read lazily, on demand.
readFile :: OsPath -> IO BSL.ByteString
readFile :: OsPath -> IO ByteString
readFile OsPath
fp = OsPath -> IOMode -> (Handle -> IO ByteString) -> IO ByteString
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile' OsPath
fp IOMode
ReadMode Handle -> IO ByteString
BSL.hGetContents

-- | The 'readFile'' function reads a file and returns the contents of the file
-- as a 'ByteString'. The file is fully read before being returned.
readFile'
  :: OsPath -> IO BS.ByteString
readFile' :: OsPath -> IO ByteString
readFile' OsPath
fp = OsPath -> IOMode -> (Handle -> IO ByteString) -> IO ByteString
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile OsPath
fp IOMode
ReadMode Handle -> IO ByteString
BS.hGetContents

-- | The computation 'writeFile' @file str@ function writes the lazy 'ByteString' @str@,
-- to the file @file@.
writeFile :: OsPath -> BSL.ByteString -> IO ()
writeFile :: OsPath -> ByteString -> IO ()
writeFile OsPath
fp ByteString
contents = OsPath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile OsPath
fp IOMode
WriteMode (Handle -> ByteString -> IO ()
`BSL.hPut` ByteString
contents)

-- | The computation 'writeFile' @file str@ function writes the strict 'ByteString' @str@,
-- to the file @file@.
writeFile'
  :: OsPath -> BS.ByteString -> IO ()
writeFile' :: OsPath -> ByteString -> IO ()
writeFile' OsPath
fp ByteString
contents = OsPath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile OsPath
fp IOMode
WriteMode (Handle -> ByteString -> IO ()
`BS.hPut` ByteString
contents)

-- | The computation 'appendFile' @file str@ function appends the lazy 'ByteString' @str@,
-- to the file @file@.
appendFile :: OsPath -> BSL.ByteString -> IO ()
appendFile :: OsPath -> ByteString -> IO ()
appendFile OsPath
fp ByteString
contents = OsPath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile OsPath
fp IOMode
AppendMode (Handle -> ByteString -> IO ()
`BSL.hPut` ByteString
contents)

-- | The computation 'appendFile' @file str@ function appends the strict 'ByteString' @str@,
-- to the file @file@.
appendFile'
  :: OsPath -> BS.ByteString -> IO ()
appendFile' :: OsPath -> ByteString -> IO ()
appendFile' OsPath
fp ByteString
contents = OsPath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile OsPath
fp IOMode
AppendMode (Handle -> ByteString -> IO ()
`BS.hPut` ByteString
contents)

-- | Open a file and return the 'Handle'.
openFile :: OsPath -> IOMode -> IO Handle
openFile :: OsPath -> IOMode -> IO Handle
openFile OsPath
osfp IOMode
iomode = [Char] -> OsPath -> IO Handle -> IO Handle
forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
"openFile" OsPath
osfp (IO Handle -> IO Handle) -> IO Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> Bool
-> Bool
-> (Handle -> IO Handle)
-> Bool
-> IO Handle
forall r.
OsPath
-> IOMode -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
withOpenFile' OsPath
osfp IOMode
iomode Bool
False Bool
False Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False


-- | Open an existing file and return the 'Handle'.
openExistingFile :: OsPath -> IOMode -> IO Handle
openExistingFile :: OsPath -> IOMode -> IO Handle
openExistingFile OsPath
osfp IOMode
iomode = [Char] -> OsPath -> IO Handle -> IO Handle
forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
"openExistingFile" OsPath
osfp (IO Handle -> IO Handle) -> IO Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> Bool
-> Bool
-> (Handle -> IO Handle)
-> Bool
-> IO Handle
forall r.
OsPath
-> IOMode -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
withOpenFile' OsPath
osfp IOMode
iomode Bool
False Bool
True Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False


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

handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
handleFinalizer :: [Char] -> MVar Handle__ -> IO ()
handleFinalizer [Char]
_fp MVar Handle__
m = do
  Handle__
handle_ <- MVar Handle__ -> IO Handle__
forall a. MVar a -> IO a
takeMVar MVar Handle__
m
  (Handle__
handle_', Maybe SomeException
_) <- Handle__ -> IO (Handle__, Maybe SomeException)
hClose_help Handle__
handle_
  MVar Handle__ -> Handle__ -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Handle__
m Handle__
handle_'
  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

type HandleFinalizer = FilePath -> MVar Handle__ -> IO ()

-- | Add a finalizer to a 'Handle'. Specifically, the finalizer
-- will be added to the 'MVar' of a file handle or the write-side
-- 'MVar' of a duplex handle. See Handle Finalizers for details.
addHandleFinalizer :: Handle -> HandleFinalizer -> IO ()
addHandleFinalizer :: Handle -> ([Char] -> MVar Handle__ -> IO ()) -> IO ()
addHandleFinalizer Handle
hndl [Char] -> MVar Handle__ -> IO ()
finalizer = do
  [Char] -> IO ()
debugIO ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Registering finalizer: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
filepath
  IO (Weak (MVar Handle__)) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Weak (MVar Handle__)) -> IO ())
-> IO (Weak (MVar Handle__)) -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar Handle__ -> IO () -> IO (Weak (MVar Handle__))
forall a. MVar a -> IO () -> IO (Weak (MVar a))
mkWeakMVar MVar Handle__
mv ([Char] -> MVar Handle__ -> IO ()
finalizer [Char]
filepath MVar Handle__
mv)
  where
    !([Char]
filepath, !MVar Handle__
mv) = case Handle
hndl of
      FileHandle [Char]
fp MVar Handle__
m -> ([Char]
fp, MVar Handle__
m)
      DuplexHandle [Char]
fp MVar Handle__
_ MVar Handle__
write_m -> ([Char]
fp, MVar Handle__
write_m)

withOpenFile' :: OsPath -> IOMode -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
withOpenFile' :: forall r.
OsPath
-> IOMode -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
withOpenFile' (OsString PlatformString
fp) IOMode
iomode Bool
binary Bool
existing Handle -> IO r
action Bool
close_finally = ((forall a. IO a -> IO a) -> IO r) -> IO r
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO r) -> IO r)
-> ((forall a. IO a -> IO a) -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
  Handle
hndl <- if Bool
existing
          then PlatformString -> IOMode -> IO Handle
P.openExistingFile PlatformString
fp IOMode
iomode
          else PlatformString -> IOMode -> IO Handle
P.openFile PlatformString
fp IOMode
iomode
  Handle -> ([Char] -> MVar Handle__ -> IO ()) -> IO ()
addHandleFinalizer Handle
hndl [Char] -> MVar Handle__ -> IO ()
handleFinalizer
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
binary (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Bool -> IO ()
hSetBinaryMode Handle
hndl Bool
True
  r
r <- IO r -> IO r
forall a. IO a -> IO a
restore (Handle -> IO r
action Handle
hndl) IO r -> IO () -> IO r
forall a b. IO a -> IO b -> IO a
`onException` Handle -> IO ()
hClose Handle
hndl
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
close_finally (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
hndl
  r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r

addFilePathToIOError :: String -> OsPath -> IOException -> IOException
addFilePathToIOError :: [Char] -> OsPath -> IOError -> IOError
addFilePathToIOError [Char]
fun OsPath
fp IOError
ioe = IO IOError -> IOError
forall a. IO a -> a
unsafePerformIO (IO IOError -> IOError) -> IO IOError -> IOError
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 ((OsChar -> Char) -> [OsChar] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OsChar -> Char
OSP.toChar ([OsChar] -> [Char]) -> (OsPath -> [OsChar]) -> OsPath -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> [OsChar]
OSP.unpack (OsPath -> [Char]) -> OsPath -> [Char]
forall a b. (a -> b) -> a -> b
$ OsPath
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 (OsPath -> IO [Char]
OSP.decodeFS OsPath
fp)
  [Char]
fp'' <- [Char] -> IO [Char]
forall a. a -> IO a
evaluate ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. NFData a => a -> a
force [Char]
fp'
  IOError -> IO IOError
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IOError -> IO IOError) -> IOError -> IO IOError
forall a b. (a -> b) -> a -> b
$ IOError
ioe{ ioe_location :: [Char]
ioe_location = [Char]
fun, ioe_filename :: Maybe [Char]
ioe_filename = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
fp'' }

augmentError :: String -> OsPath -> IO a -> IO a
augmentError :: forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
str OsPath
osfp = (IO a -> (IOError -> IO a) -> IO a)
-> (IOError -> IO a) -> IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO a -> (IOError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catchException (IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IO a) -> (IOError -> IOError) -> IOError -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> OsPath -> IOError -> IOError
addFilePathToIOError [Char]
str OsPath
osfp)