Add writeFile and appendFile

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]--

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)

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)

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]