Add writeFile and appendFile

This commit is contained in:
Julian Ospald 2018-04-06 17:22:22 +02:00
parent 9ac10a6a7d
commit 0ec2cf8ca5
4 changed files with 266 additions and 7 deletions

View File

@ -63,6 +63,9 @@ module HPath.IO
-- * File reading -- * File reading
, readFile , readFile
, readFileEOF , readFileEOF
-- * File writing
, writeFile
, appendFile
-- * File permissions -- * File permissions
, newFilePerms , newFilePerms
, newDirPerms , newDirPerms
@ -163,7 +166,7 @@ import GHC.IO.Exception
import HPath import HPath
import HPath.Internal import HPath.Internal
import HPath.IO.Errors import HPath.IO.Errors
import Prelude hiding (readFile, writeFile) import Prelude hiding (appendFile, readFile, writeFile)
import System.IO.Error import System.IO.Error
( (
catchIOError catchIOError
@ -931,6 +934,42 @@ readFileEOF p = withAbsPath p $ \fp ->
--------------------
--[ File Writing ]--
--------------------
-- |Write a given ByteString to a file, truncating the file beforehand.
-- The file must exist. Follows symlinks.
--
-- Throws:
--
-- - `InappropriateType` if file is not a regular file or a symlink
-- - `PermissionDenied` if we cannot read the file or the directory
-- containting it
-- - `NoSuchThing` if the file does not exist
writeFile :: Path Abs -> ByteString -> IO ()
writeFile p bs = withAbsPath p $ \fp ->
bracket (openFd fp SPI.WriteOnly [SPDF.oTrunc] Nothing) (SPI.closeFd) $ \fd ->
void $ SPB.fdWrite fd bs
-- |Append a given ByteString to a file.
-- The file must exist. Follows symlinks.
--
-- Throws:
--
-- - `InappropriateType` if file is not a regular file or a symlink
-- - `PermissionDenied` if we cannot read the file or the directory
-- containting it
-- - `NoSuchThing` if the file does not exist
appendFile :: Path Abs -> ByteString -> IO ()
appendFile p bs = withAbsPath p $ \fp ->
bracket (openFd fp SPI.WriteOnly [SPDF.oAppend] Nothing)
(SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs
----------------------- -----------------------
--[ File Permissions]-- --[ File Permissions]--

View File

@ -0,0 +1,109 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.AppendFileSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Process
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "AppendFileSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "fileWithContent"
createRegularFile' "fileWithoutContent"
createSymlink' "inputFileSymL" "fileWithContent"
createDir' "alreadyExistsD"
createRegularFile' "noPerms"
noPerms "noPerms"
createDir' "noPermsD"
createRegularFile' "noPermsD/inputFile"
noPerms "noPermsD"
writeFile' "fileWithContent" "BLKASL"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "fileWithContent"
deleteFile' "fileWithoutContent"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
normalFilePerms "noPerms"
deleteFile' "noPerms"
normalDirPerms "noPermsD"
deleteFile' "noPermsD/inputFile"
deleteDir' "noPermsD"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.appendFile" $ do
-- successes --
it "appendFile file with content, everything clear" $ do
appendFile' "fileWithContent" "blahfaselllll"
out <- readFile' "fileWithContent"
out `shouldBe` "BLKASLblahfaselllll"
it "appendFile file with content, everything clear" $ do
appendFile' "fileWithContent" "gagagaga"
out <- readFile' "fileWithContent"
out `shouldBe` "BLKASLblahfaselllllgagagaga"
it "appendFile file with content, everything clear" $ do
appendFile' "fileWithContent" ""
out <- readFile' "fileWithContent"
out `shouldBe` "BLKASLblahfaselllllgagagaga"
it "appendFile file without content, everything clear" $ do
appendFile' "fileWithoutContent" "blahfaselllll"
out <- readFile' "fileWithoutContent"
out `shouldBe` "blahfaselllll"
it "appendFile, everything clear" $ do
appendFile' "fileWithoutContent" "gagagaga"
out <- readFile' "fileWithoutContent"
out `shouldBe` "blahfaselllllgagagaga"
it "appendFile symlink, everything clear" $ do
appendFile' "inputFileSymL" "blahfaselllll"
out <- readFile' "inputFileSymL"
out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllll"
it "appendFile symlink, everything clear" $ do
appendFile' "inputFileSymL" "gagagaga"
out <- readFile' "inputFileSymL"
out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllllgagagaga"
-- posix failures --
it "appendFile to dir, inappropriate type" $ do
appendFile' "alreadyExistsD" ""
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
it "appendFile, no permissions to file" $ do
appendFile' "noPerms" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "appendFile, no permissions to file" $ do
appendFile' "noPermsD/inputFile" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "appendFile, file does not exist" $ do
appendFile' "gaga" ""
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

View File

@ -0,0 +1,109 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.WriteFileSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Process
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "WriteFileSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "fileWithContent"
createRegularFile' "fileWithoutContent"
createSymlink' "inputFileSymL" "fileWithContent"
createDir' "alreadyExistsD"
createRegularFile' "noPerms"
noPerms "noPerms"
createDir' "noPermsD"
createRegularFile' "noPermsD/inputFile"
noPerms "noPermsD"
writeFile' "fileWithContent" "BLKASL"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "fileWithContent"
deleteFile' "fileWithoutContent"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
normalFilePerms "noPerms"
deleteFile' "noPerms"
normalDirPerms "noPermsD"
deleteFile' "noPermsD/inputFile"
deleteDir' "noPermsD"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.writeFile" $ do
-- successes --
it "writeFile file with content, everything clear" $ do
writeFile' "fileWithContent" "blahfaselllll"
out <- readFile' "fileWithContent"
out `shouldBe` "blahfaselllll"
it "writeFile file with content, everything clear" $ do
writeFile' "fileWithContent" "gagagaga"
out <- readFile' "fileWithContent"
out `shouldBe` "gagagaga"
it "writeFile file with content, everything clear" $ do
writeFile' "fileWithContent" ""
out <- readFile' "fileWithContent"
out `shouldBe` ""
it "writeFile file without content, everything clear" $ do
writeFile' "fileWithoutContent" "blahfaselllll"
out <- readFile' "fileWithoutContent"
out `shouldBe` "blahfaselllll"
it "writeFile, everything clear" $ do
writeFile' "fileWithoutContent" "gagagaga"
out <- readFile' "fileWithoutContent"
out `shouldBe` "gagagaga"
it "writeFile symlink, everything clear" $ do
writeFile' "inputFileSymL" "blahfaselllll"
out <- readFile' "inputFileSymL"
out `shouldBe` "blahfaselllll"
it "writeFile symlink, everything clear" $ do
writeFile' "inputFileSymL" "gagagaga"
out <- readFile' "inputFileSymL"
out `shouldBe` "gagagaga"
-- posix failures --
it "writeFile to dir, inappropriate type" $ do
writeFile' "alreadyExistsD" ""
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
it "writeFile, no permissions to file" $ do
writeFile' "noPerms" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "writeFile, no permissions to file" $ do
writeFile' "noPermsD/inputFile" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "writeFile, file does not exist" $ do
writeFile' "gaga" ""
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

View File

@ -28,7 +28,7 @@ import Data.IORef
) )
import HPath.IO import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import Prelude hiding (readFile) import Prelude hiding (appendFile, readFile, writeFile)
import Data.Maybe import Data.Maybe
( (
fromJust fromJust
@ -284,11 +284,13 @@ canonicalizePath' p = withTmpDir p canonicalizePath
writeFile' :: ByteString -> ByteString -> IO () writeFile' :: ByteString -> ByteString -> IO ()
{-# NOINLINE writeFile' #-} {-# NOINLINE writeFile' #-}
writeFile' ip bs = writeFile' ip bs =
withTmpDir ip $ \p -> do withTmpDir ip $ \p -> writeFile p bs
fd <- SPI.openFd (P.fromAbs p) SPI.WriteOnly Nothing
SPI.defaultFileFlags
_ <- SPB.fdWrite fd bs appendFile' :: ByteString -> ByteString -> IO ()
SPI.closeFd fd {-# NOINLINE appendFile' #-}
appendFile' ip bs =
withTmpDir ip $ \p -> appendFile p bs
allDirectoryContents' :: ByteString -> IO [ByteString] allDirectoryContents' :: ByteString -> IO [ByteString]