From 0ec2cf8ca51c51b4129192945b055ad020448b77 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 6 Apr 2018 17:22:22 +0200 Subject: [PATCH] Add writeFile and appendFile --- src/HPath/IO.hs | 41 +++++++++++- test/HPath/IO/AppendFileSpec.hs | 109 ++++++++++++++++++++++++++++++++ test/HPath/IO/WriteFileSpec.hs | 109 ++++++++++++++++++++++++++++++++ test/Utils.hs | 14 ++-- 4 files changed, 266 insertions(+), 7 deletions(-) create mode 100644 test/HPath/IO/AppendFileSpec.hs create mode 100644 test/HPath/IO/WriteFileSpec.hs diff --git a/src/HPath/IO.hs b/src/HPath/IO.hs index 65b4f4e..429e939 100644 --- a/src/HPath/IO.hs +++ b/src/HPath/IO.hs @@ -63,6 +63,9 @@ module HPath.IO -- * File reading , readFile , readFileEOF + -- * File writing + , writeFile + , appendFile -- * File permissions , newFilePerms , newDirPerms @@ -163,7 +166,7 @@ import GHC.IO.Exception import HPath import HPath.Internal import HPath.IO.Errors -import Prelude hiding (readFile, writeFile) +import Prelude hiding (appendFile, readFile, writeFile) import System.IO.Error ( 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]-- diff --git a/test/HPath/IO/AppendFileSpec.hs b/test/HPath/IO/AppendFileSpec.hs new file mode 100644 index 0000000..c1c5b79 --- /dev/null +++ b/test/HPath/IO/AppendFileSpec.hs @@ -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) diff --git a/test/HPath/IO/WriteFileSpec.hs b/test/HPath/IO/WriteFileSpec.hs new file mode 100644 index 0000000..0bbbbdb --- /dev/null +++ b/test/HPath/IO/WriteFileSpec.hs @@ -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) diff --git a/test/Utils.hs b/test/Utils.hs index 5216c16..63845b7 100644 --- a/test/Utils.hs +++ b/test/Utils.hs @@ -28,7 +28,7 @@ import Data.IORef ) import HPath.IO import HPath.IO.Errors -import Prelude hiding (readFile) +import Prelude hiding (appendFile, readFile, writeFile) import Data.Maybe ( fromJust @@ -284,11 +284,13 @@ canonicalizePath' p = withTmpDir p canonicalizePath writeFile' :: ByteString -> ByteString -> IO () {-# NOINLINE writeFile' #-} writeFile' ip bs = - withTmpDir ip $ \p -> do - fd <- SPI.openFd (P.fromAbs p) SPI.WriteOnly Nothing - SPI.defaultFileFlags - _ <- SPB.fdWrite fd bs - SPI.closeFd fd + withTmpDir ip $ \p -> writeFile p bs + + +appendFile' :: ByteString -> ByteString -> IO () +{-# NOINLINE appendFile' #-} +appendFile' ip bs = + withTmpDir ip $ \p -> appendFile p bs allDirectoryContents' :: ByteString -> IO [ByteString]