-- |
-- Module      : Data.ByteString.RawFilePath
-- Copyright   : (c) XT 2016
-- License     : Apache 2.0
--
-- Maintainer  : e@xtendo.org
-- Stability   : stable
-- Portability : POSIX
--
-- A drop-in replacement of @Data.ByteString@ from the @bytestring@ package
-- that provides file I/O functions with 'RawFilePath' instead of 'FilePath'.
module Data.ByteString.RawFilePath (
  module Data.ByteString,
  RawFilePath,
  readFile,
  writeFile,
  appendFile,
  withFile,
) where

-- base modules

import Control.Exception (bracket)
-- extra modules

import Data.ByteString hiding (appendFile, readFile, writeFile)
import System.IO (Handle, IOMode (..), hClose)
import System.Posix.ByteString
import Prelude hiding (appendFile, readFile, writeFile)


-- | Read an entire file at the 'RawFilePath' strictly into a 'ByteString'.
readFile :: RawFilePath -> IO ByteString
readFile :: RawFilePath -> IO RawFilePath
readFile RawFilePath
path = RawFilePath
-> IOMode -> (Handle -> IO RawFilePath) -> IO RawFilePath
forall r. RawFilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile RawFilePath
path IOMode
ReadMode Handle -> IO RawFilePath
hGetContents


-- | Write a 'ByteString' to a file at the 'RawFilePath'.
writeFile :: RawFilePath -> ByteString -> IO ()
writeFile :: RawFilePath -> RawFilePath -> IO ()
writeFile RawFilePath
path RawFilePath
content = RawFilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. RawFilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile RawFilePath
path IOMode
WriteMode (Handle -> RawFilePath -> IO ()
`hPut` RawFilePath
content)


-- | Append a 'ByteString' to a file at the 'RawFilePath'.
appendFile :: RawFilePath -> ByteString -> IO ()
appendFile :: RawFilePath -> RawFilePath -> IO ()
appendFile RawFilePath
path RawFilePath
content = RawFilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. RawFilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile RawFilePath
path IOMode
AppendMode (Handle -> RawFilePath -> IO ()
`hPut` RawFilePath
content)


-- | Acquire a file handle and perform an I/O action. The file will be closed
-- on exit or when this I/O action throws an exception.
withFile :: RawFilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile :: forall r. RawFilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile RawFilePath
path IOMode
ioMode = IO Handle -> (Handle -> IO ()) -> (Handle -> IO r) -> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (IO Fd
open IO Fd -> (Fd -> IO Handle) -> IO Handle
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO Handle
fdToHandle) Handle -> IO ()
hClose
 where
#if MIN_VERSION_unix(2,8,0)
    open :: IO Fd
open = case IOMode
ioMode of
        IOMode
ReadMode -> RawFilePath -> OpenMode -> OpenFileFlags -> IO Fd
openFd RawFilePath
path OpenMode
ReadOnly (OpenFileFlags -> IO Fd) -> OpenFileFlags -> IO Fd
forall a b. (a -> b) -> a -> b
$ Maybe FileMode -> OpenFileFlags
defaultFlags Maybe FileMode
forall a. Maybe a
Nothing
        IOMode
WriteMode -> RawFilePath -> FileMode -> IO Fd
createFile RawFilePath
path FileMode
stdFileMode
        IOMode
AppendMode -> RawFilePath -> OpenMode -> OpenFileFlags -> IO Fd
openFd RawFilePath
path OpenMode
WriteOnly (OpenFileFlags -> IO Fd) -> OpenFileFlags -> IO Fd
forall a b. (a -> b) -> a -> b
$ Maybe FileMode -> OpenFileFlags
appendFlags (Maybe FileMode -> OpenFileFlags)
-> Maybe FileMode -> OpenFileFlags
forall a b. (a -> b) -> a -> b
$ FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
stdFileMode
        IOMode
ReadWriteMode -> RawFilePath -> OpenMode -> OpenFileFlags -> IO Fd
openFd RawFilePath
path OpenMode
ReadWrite (OpenFileFlags -> IO Fd) -> OpenFileFlags -> IO Fd
forall a b. (a -> b) -> a -> b
$ Maybe FileMode -> OpenFileFlags
defaultFlags (Maybe FileMode -> OpenFileFlags)
-> Maybe FileMode -> OpenFileFlags
forall a b. (a -> b) -> a -> b
$ FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
stdFileMode
    defaultFlags :: Maybe FileMode -> OpenFileFlags
defaultFlags Maybe FileMode
creat = OpenFileFlags
        { append :: Bool
System.Posix.ByteString.append = Bool
False
        , creat :: Maybe FileMode
creat = Maybe FileMode
creat
        , exclusive :: Bool
exclusive = Bool
False
        , noctty :: Bool
noctty = Bool
True
        , nonBlock :: Bool
nonBlock = Bool
False
        , trunc :: Bool
trunc = Bool
False
        , nofollow :: Bool
nofollow = Bool
False
        , cloexec :: Bool
cloexec = Bool
False
        , directory :: Bool
directory = Bool
False
        , sync :: Bool
sync = Bool
False
        }
    appendFlags :: Maybe FileMode -> OpenFileFlags
appendFlags Maybe FileMode
creat = (Maybe FileMode -> OpenFileFlags
defaultFlags Maybe FileMode
creat) { System.Posix.ByteString.append = True }
#else
    open = case ioMode of
        ReadMode -> openFd path ReadOnly Nothing defaultFlags
        WriteMode -> createFile path stdFileMode
        AppendMode -> openFd path WriteOnly (Just stdFileMode) appendFlags
        ReadWriteMode -> openFd path ReadWrite (Just stdFileMode) defaultFlags
    defaultFlags = OpenFileFlags
        { System.Posix.ByteString.append = False
        , exclusive = False
        , noctty = True
        , nonBlock = False
        , trunc = False
        }
    appendFlags = defaultFlags { System.Posix.ByteString.append = True }
#endif