hpath 0.7.1 → 0.7.2
raw patch · 23 files changed
+946/−475 lines, 23 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ HPath.IO: createSymlink :: Path Abs -> ByteString -> IO ()
Files
- CHANGELOG +3/−0
- README.md +2/−0
- hpath.cabal +8/−5
- src/HPath/IO.hs +16/−0
- test/HPath/IO/CanonicalizePathSpec.hs +75/−0
- test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs +95/−36
- test/HPath/IO/CopyDirRecursiveSpec.hs +73/−35
- test/HPath/IO/CopyFileOverwriteSpec.hs +59/−39
- test/HPath/IO/CopyFileSpec.hs +53/−33
- test/HPath/IO/CreateDirSpec.hs +21/−12
- test/HPath/IO/CreateRegularFileSpec.hs +21/−12
- test/HPath/IO/CreateSymlinkSpec.hs +63/−0
- test/HPath/IO/DeleteDirRecursiveSpec.hs +50/−36
- test/HPath/IO/DeleteDirSpec.hs +44/−30
- test/HPath/IO/DeleteFileSpec.hs +26/−17
- test/HPath/IO/GetDirsFilesSpec.hs +39/−23
- test/HPath/IO/GetFileTypeSpec.hs +28/−15
- test/HPath/IO/MoveFileOverwriteSpec.hs +45/−29
- test/HPath/IO/MoveFileSpec.hs +47/−29
- test/HPath/IO/RecreateSymlinkSpec.hs +46/−29
- test/HPath/IO/RenameFileSpec.hs +46/−29
- test/Main.hs +5/−35
- test/Utils.hs +81/−31
CHANGELOG view
@@ -1,3 +1,6 @@+0.7.2:+ * fix tests, so they work with the sdist tarball too+ * added the following function to HPath.IO: createSymlink 0.7.1: * various cleanups and documentation improvements * added the following functions to System.Posix.FilePath: splitSearchPath, getSearchPath, stripExtension, makeRelative, makeValid
README.md view
@@ -28,6 +28,8 @@ * safe filepath manipulation, never using String as filepath, but ByteString * still allowing sufficient control to interact with the underlying low-level calls +Note: this library was written for __posix__ systems and it will probably not support other systems.+ ## Differences to 'path' * doesn't attempt to fake IO-related information into the path, so whether a path points to a file or directory is up to your IO-code to decide...
hpath.cabal view
@@ -1,5 +1,5 @@ name: hpath-version: 0.7.1+version: 0.7.2 synopsis: Support for well-typed paths description: Support for well-typed paths, utilizing ByteString under the hood. license: GPL-2@@ -73,22 +73,24 @@ Hs-Source-Dirs: test Main-Is: Main.hs other-modules:- Spec- HPath.IO.CopyDirRecursiveSpec+ HPath.IO.CanonicalizePathSpec HPath.IO.CopyDirRecursiveOverwriteSpec- HPath.IO.CopyFileSpec+ HPath.IO.CopyDirRecursiveSpec HPath.IO.CopyFileOverwriteSpec+ HPath.IO.CopyFileSpec HPath.IO.CreateDirSpec HPath.IO.CreateRegularFileSpec+ HPath.IO.CreateSymlinkSpec HPath.IO.DeleteDirRecursiveSpec HPath.IO.DeleteDirSpec HPath.IO.DeleteFileSpec HPath.IO.GetDirsFilesSpec HPath.IO.GetFileTypeSpec- HPath.IO.MoveFileSpec HPath.IO.MoveFileOverwriteSpec+ HPath.IO.MoveFileSpec HPath.IO.RecreateSymlinkSpec HPath.IO.RenameFileSpec+ Spec Utils GHC-Options: -Wall Build-Depends: base@@ -98,6 +100,7 @@ , hspec >= 1.3 , process , unix+ , unix-bytestring , utf8-string benchmark bench.hs
src/HPath/IO.hs view
@@ -56,6 +56,7 @@ -- * File creation , createRegularFile , createDir+ , createSymlink -- * File renaming/moving , renameFile , moveFile@@ -315,6 +316,7 @@ RegularFile -> copyFileOverwrite f newdest _ -> return () + -- |Recreate a symlink. -- -- Throws:@@ -625,6 +627,20 @@ createDir :: Path Abs -> IO () createDir dest = createDirectory (fromAbs dest) newDirPerms ++-- |Create a symlink.+--+-- Throws:+--+-- - `PermissionDenied` if output directory cannot be written to+-- - `AlreadyExists` if destination file already exists+--+-- Note: calls `symlink`+createSymlink :: Path Abs -- ^ destination file+ -> ByteString -- ^ path the symlink points to+ -> IO ()+createSymlink dest sympoint+ = createSymbolicLink sympoint (fromAbs dest)
+ test/HPath/IO/CanonicalizePathSpec.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.CanonicalizePathSpec where+++import Test.Hspec+import System.IO.Error+ (+ ioeGetErrorType+ )+import GHC.IO.Exception+ (+ IOErrorType(..)+ )+import Utils+import qualified Data.ByteString as BS+import Data.ByteString.UTF8 (toString)+++++setupFiles :: IO ()+setupFiles = do+ createRegularFile' "file"+ createDir' "dir"+ createSymlink' "dirSym" "dir/"+ createSymlink' "brokenSym" "nothing"+ createSymlink' "fileSym" "file"++cleanupFiles :: IO ()+cleanupFiles = do+ deleteFile' "file"+ deleteDir' "dir"+ deleteFile' "dirSym"+ deleteFile' "brokenSym"+ deleteFile' "fileSym"+++spec :: Spec+spec = before_ setupFiles $ after_ cleanupFiles $+ describe "HPath.IO.canonicalizePath" $ do++ -- successes --+ it "canonicalizePath, all fine" $ do+ path <- withTmpDir "file" return+ canonicalizePath' "file"+ `shouldReturn` path++ it "canonicalizePath, all fine" $ do+ path <- withTmpDir "dir" return+ canonicalizePath' "dir"+ `shouldReturn` path++ it "canonicalizePath, all fine" $ do+ path <- withTmpDir "file" return+ canonicalizePath' "fileSym"+ `shouldReturn` path++ it "canonicalizePath, all fine" $ do+ path <- withTmpDir "dir" return+ canonicalizePath' "dirSym"+ `shouldReturn` path+++ -- posix failures --+ it "canonicalizePath, broken symlink" $+ canonicalizePath' "brokenSym"+ `shouldThrow`+ (\e -> ioeGetErrorType e == NoSuchThing)++ it "canonicalizePath, file does not exist" $+ canonicalizePath' "nothingBlah"+ `shouldThrow`+ (\e -> ioeGetErrorType e == NoSuchThing)+
test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} + module HPath.IO.CopyDirRecursiveOverwriteSpec where @@ -20,91 +21,149 @@ import Data.ByteString.UTF8 (toString) -ba :: BS.ByteString -> BS.ByteString -> BS.ByteString-ba = BS.append -specDir :: BS.ByteString-specDir = "test/HPath/IO/copyDirRecursiveOverwriteSpec/"+setupFiles :: IO ()+setupFiles = do+ createRegularFile' "alreadyExists"+ createRegularFile' "wrongInput"+ createSymlink' "wrongInputSymL" "inputDir/"+ createDir' "noPerms"+ createDir' "noWritePerm" -specDir' :: String-specDir' = toString specDir+ createDir' "inputDir"+ createDir' "inputDir/bar"+ createDir' "inputDir/foo"+ createRegularFile' "inputDir/foo/inputFile1"+ createRegularFile' "inputDir/inputFile2"+ createRegularFile' "inputDir/bar/inputFile3"+ writeFile' "inputDir/foo/inputFile1" "SDAADSdsada"+ writeFile' "inputDir/inputFile2" "Blahfaselgagaga"+ writeFile' "inputDir/bar/inputFile3"+ "fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4" + createDir' "alreadyExistsD"+ createDir' "alreadyExistsD/bar"+ createDir' "alreadyExistsD/foo"+ createRegularFile' "alreadyExistsD/foo/inputFile1"+ createRegularFile' "alreadyExistsD/inputFile2"+ createRegularFile' "alreadyExistsD/bar/inputFile3"+ writeFile' "alreadyExistsD/foo/inputFile1" "DAAsada"+ writeFile' "alreadyExistsD/inputFile2" "ahfaagaga"+ writeFile' "alreadyExistsD/bar/inputFile3"+ "f3223sasdasdaasdasdasasd4" + noPerms "noPerms"+ noWritableDirPerms "noWritePerm"+++cleanupFiles :: IO ()+cleanupFiles = do+ normalDirPerms "noPerms"+ normalDirPerms "noWritePerm"+ deleteFile' "alreadyExists"+ deleteFile' "wrongInput"+ deleteFile' "wrongInputSymL"+ deleteDir' "noPerms"+ deleteDir' "noWritePerm"+ deleteFile' "inputDir/foo/inputFile1"+ deleteFile' "inputDir/inputFile2"+ deleteFile' "inputDir/bar/inputFile3"+ deleteDir' "inputDir/foo"+ deleteDir' "inputDir/bar"+ deleteDir' "inputDir"+ deleteFile' "alreadyExistsD/foo/inputFile1"+ deleteFile' "alreadyExistsD/inputFile2"+ deleteFile' "alreadyExistsD/bar/inputFile3"+ deleteDir' "alreadyExistsD/foo"+ deleteDir' "alreadyExistsD/bar"+ deleteDir' "alreadyExistsD"+++ spec :: Spec-spec =+spec = before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.copyDirRecursiveOverwrite" $ do -- successes -- it "copyDirRecursiveOverwrite, all fine" $ do- copyDirRecursiveOverwrite' (specDir `ba` "inputDir")- (specDir `ba` "outputDir")- removeDirIfExists $ specDir `ba` "outputDir"+ copyDirRecursiveOverwrite' "inputDir"+ "outputDir"+ removeDirIfExists "outputDir" it "copyDirRecursiveOverwrite, all fine and compare" $ do- copyDirRecursiveOverwrite' (specDir `ba` "inputDir")- (specDir `ba` "outputDir")+ copyDirRecursiveOverwrite' "inputDir"+ "outputDir" (system $ "diff -r --no-dereference "- ++ specDir' ++ "inputDir" ++ " "- ++ specDir' ++ "outputDir")+ ++ toString tmpDir ++ "inputDir" ++ " "+ ++ toString tmpDir ++ "outputDir") `shouldReturn` ExitSuccess- removeDirIfExists $ specDir `ba` "outputDir"+ removeDirIfExists "outputDir" - it "copyDirRecursiveOverwrite, destination dir already exists" $- copyDirRecursiveOverwrite' (specDir `ba` "inputDir")- (specDir `ba` "alreadyExistsD")+ it "copyDirRecursiveOverwrite, destination dir already exists" $ do+ (system $ "diff -r --no-dereference "+ ++ toString tmpDir ++ "inputDir" ++ " "+ ++ toString tmpDir ++ "alreadyExistsD")+ `shouldReturn` (ExitFailure 1)+ copyDirRecursiveOverwrite' "inputDir"+ "alreadyExistsD"+ (system $ "diff -r --no-dereference "+ ++ toString tmpDir ++ "inputDir" ++ " "+ ++ toString tmpDir ++ "alreadyExistsD")+ `shouldReturn` ExitSuccess+ removeDirIfExists "outputDir" -- posix failures -- it "copyDirRecursiveOverwrite, source directory does not exist" $- copyDirRecursiveOverwrite' (specDir `ba` "doesNotExist")- (specDir `ba` "outputDir")+ copyDirRecursiveOverwrite' "doesNotExist"+ "outputDir" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "copyDirRecursiveOverwrite, no write permission on output dir" $- copyDirRecursiveOverwrite' (specDir `ba` "inputDir")- (specDir `ba` "noWritePerm/foo")+ copyDirRecursiveOverwrite' "inputDir"+ "noWritePerm/foo" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyDirRecursiveOverwrite, cannot open output dir" $- copyDirRecursiveOverwrite' (specDir `ba` "inputDir")- (specDir `ba` "noPerms/foo")+ copyDirRecursiveOverwrite' "inputDir"+ "noPerms/foo" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyDirRecursiveOverwrite, cannot open source dir" $- copyDirRecursiveOverwrite' (specDir `ba` "noPerms/inputDir")- (specDir `ba` "foo")+ copyDirRecursiveOverwrite' "noPerms/inputDir"+ "foo" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyDirRecursiveOverwrite, destination already exists and is a file" $- copyDirRecursiveOverwrite' (specDir `ba` "inputDir")- (specDir `ba` "alreadyExists")+ copyDirRecursiveOverwrite' "inputDir"+ "alreadyExists" `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) it "copyDirRecursiveOverwrite, wrong input (regular file)" $- copyDirRecursiveOverwrite' (specDir `ba` "wrongInput")- (specDir `ba` "outputDir")+ copyDirRecursiveOverwrite' "wrongInput"+ "outputDir" `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) it "copyDirRecursiveOverwrite, wrong input (symlink to directory)" $- copyDirRecursiveOverwrite' (specDir `ba` "wrongInputSymL")- (specDir `ba` "outputDir")+ copyDirRecursiveOverwrite' "wrongInputSymL"+ "outputDir" `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) -- custom failures it "copyDirRecursiveOverwrite, destination in source" $- copyDirRecursiveOverwrite' (specDir `ba` "inputDir")- (specDir `ba` "inputDir/foo")+ copyDirRecursiveOverwrite' "inputDir"+ "inputDir/foo" `shouldThrow` isDestinationInSource it "copyDirRecursiveOverwrite, destination and source same directory" $- copyDirRecursiveOverwrite' (specDir `ba` "inputDir")- (specDir `ba` "inputDir")+ copyDirRecursiveOverwrite' "inputDir"+ "inputDir" `shouldThrow` isSameFile
test/HPath/IO/CopyDirRecursiveSpec.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} + module HPath.IO.CopyDirRecursiveSpec where @@ -20,93 +21,130 @@ import Data.ByteString.UTF8 (toString) -ba :: BS.ByteString -> BS.ByteString -> BS.ByteString-ba = BS.append -specDir :: BS.ByteString-specDir = "test/HPath/IO/copyDirRecursiveSpec/" -specDir' :: String-specDir' = toString specDir +setupFiles :: IO ()+setupFiles = do+ createRegularFile' "alreadyExists"+ createRegularFile' "wrongInput"+ createSymlink' "wrongInputSymL" "inputDir/"+ createDir' "alreadyExistsD"+ createDir' "noPerms"+ createDir' "noWritePerm" + createDir' "inputDir"+ createDir' "inputDir/bar"+ createDir' "inputDir/foo"+ createRegularFile' "inputDir/foo/inputFile1"+ createRegularFile' "inputDir/inputFile2"+ createRegularFile' "inputDir/bar/inputFile3"+ writeFile' "inputDir/foo/inputFile1" "SDAADSdsada"+ writeFile' "inputDir/inputFile2" "Blahfaselgagaga"+ writeFile' "inputDir/bar/inputFile3"+ "fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4"++ noPerms "noPerms"+ noWritableDirPerms "noWritePerm"+++cleanupFiles :: IO ()+cleanupFiles = do+ normalDirPerms "noPerms"+ normalDirPerms "noWritePerm"+ deleteFile' "alreadyExists"+ deleteFile' "wrongInput"+ deleteFile' "wrongInputSymL"+ deleteDir' "alreadyExistsD"+ deleteDir' "noPerms"+ deleteDir' "noWritePerm"+ deleteFile' "inputDir/foo/inputFile1"+ deleteFile' "inputDir/inputFile2"+ deleteFile' "inputDir/bar/inputFile3"+ deleteDir' "inputDir/foo"+ deleteDir' "inputDir/bar"+ deleteDir' "inputDir"++++ spec :: Spec-spec =+spec = before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.copyDirRecursive" $ do -- successes -- it "copyDirRecursive, all fine" $ do- copyDirRecursive' (specDir `ba` "inputDir")- (specDir `ba` "outputDir")- removeDirIfExists (specDir `ba` "outputDir")+ copyDirRecursive' "inputDir"+ "outputDir"+ removeDirIfExists "outputDir" it "copyDirRecursive, all fine and compare" $ do- copyDirRecursive' (specDir `ba` "inputDir")- (specDir `ba` "outputDir")+ copyDirRecursive' "inputDir"+ "outputDir" (system $ "diff -r --no-dereference "- ++ specDir' ++ "inputDir" ++ " "- ++ specDir' ++ "outputDir")+ ++ toString tmpDir ++ "inputDir" ++ " "+ ++ toString tmpDir ++ "outputDir") `shouldReturn` ExitSuccess- removeDirIfExists (specDir `ba` "outputDir")+ removeDirIfExists "outputDir" -- posix failures -- it "copyDirRecursive, source directory does not exist" $- copyDirRecursive' (specDir `ba` "doesNotExist")- (specDir `ba` "outputDir")+ copyDirRecursive' "doesNotExist"+ "outputDir" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "copyDirRecursive, no write permission on output dir" $- copyDirRecursive' (specDir `ba` "inputDir")- (specDir `ba` "noWritePerm/foo")+ copyDirRecursive' "inputDir"+ "noWritePerm/foo" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyDirRecursive, cannot open output dir" $- copyDirRecursive' (specDir `ba` "inputDir")- (specDir `ba` "noPerms/foo")+ copyDirRecursive' "inputDir"+ "noPerms/foo" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyDirRecursive, cannot open source dir" $- copyDirRecursive' (specDir `ba` "noPerms/inputDir")- (specDir `ba` "foo")+ copyDirRecursive' "noPerms/inputDir"+ "foo" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyDirRecursive, destination dir already exists" $- copyDirRecursive' (specDir `ba` "inputDir")- (specDir `ba` "alreadyExistsD")+ copyDirRecursive' "inputDir"+ "alreadyExistsD" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) it "copyDirRecursive, destination already exists and is a file" $- copyDirRecursive' (specDir `ba` "inputDir")- (specDir `ba` "alreadyExists")+ copyDirRecursive' "inputDir"+ "alreadyExists" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) it "copyDirRecursive, wrong input (regular file)" $- copyDirRecursive' (specDir `ba` "wrongInput")- (specDir `ba` "outputDir")+ copyDirRecursive' "wrongInput"+ "outputDir" `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) it "copyDirRecursive, wrong input (symlink to directory)" $- copyDirRecursive' (specDir `ba` "wrongInputSymL")- (specDir `ba` "outputDir")+ copyDirRecursive' "wrongInputSymL"+ "outputDir" `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) -- custom failures it "copyDirRecursive, destination in source" $- copyDirRecursive' (specDir `ba` "inputDir")- (specDir `ba` "inputDir/foo")+ copyDirRecursive' "inputDir"+ "inputDir/foo" `shouldThrow` isDestinationInSource it "copyDirRecursive, destination and source same directory" $- copyDirRecursive' (specDir `ba` "inputDir")- (specDir `ba` "inputDir")+ copyDirRecursive' "inputDir"+ "inputDir" `shouldThrow` isSameFile
test/HPath/IO/CopyFileOverwriteSpec.hs view
@@ -20,90 +20,110 @@ import Data.ByteString.UTF8 (toString) -ba :: BS.ByteString -> BS.ByteString -> BS.ByteString-ba = BS.append+setupFiles :: IO ()+setupFiles = do+ createRegularFile' "inputFile"+ createRegularFile' "alreadyExists"+ createSymlink' "inputFileSymL" "inputFile"+ createDir' "alreadyExistsD"+ createDir' "noPerms"+ createRegularFile' "noPerms/inputFile"+ createDir' "outputDirNoWrite"+ createDir' "wrongInput"+ noPerms "noPerms"+ noWritableDirPerms "outputDirNoWrite"+ writeFile' "inputFile" "Blahfaselgagaga"+ writeFile' "alreadyExists" "dsaldsalkaklsdlkasksdadasl" -specDir :: BS.ByteString-specDir = "test/HPath/IO/copyFileOverwriteSpec/" -specDir' :: String-specDir' = toString specDir+cleanupFiles :: IO ()+cleanupFiles = do+ normalDirPerms "noPerms"+ normalDirPerms "outputDirNoWrite"+ deleteFile' "noPerms/inputFile"+ deleteFile' "inputFile"+ deleteFile' "alreadyExists"+ deleteFile' "inputFileSymL"+ deleteDir' "alreadyExistsD"+ deleteDir' "noPerms"+ deleteDir' "outputDirNoWrite"+ deleteDir' "wrongInput" spec :: Spec-spec =+spec = before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.copyFileOverwrite" $ do -- successes -- it "copyFileOverwrite, everything clear" $ do- copyFileOverwrite' (specDir `ba` "inputFile")- (specDir `ba` "outputFile")- removeFileIfExists (specDir `ba` "outputFile")+ copyFileOverwrite' "inputFile"+ "outputFile"+ removeFileIfExists "outputFile" it "copyFileOverwrite, output file already exists, all clear" $ do- copyFile' (specDir `ba` "alreadyExists") (specDir `ba` "alreadyExists.bak")- copyFileOverwrite' (specDir `ba` "inputFile")- (specDir `ba` "alreadyExists")- (system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "- ++ specDir' ++ "alreadyExists")+ copyFile' "alreadyExists" "alreadyExists.bak"+ copyFileOverwrite' "inputFile"+ "alreadyExists"+ (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " "+ ++ toString tmpDir ++ "alreadyExists") `shouldReturn` ExitSuccess- removeFileIfExists (specDir `ba` "alreadyExists")- copyFile' (specDir `ba` "alreadyExists.bak") (specDir `ba` "alreadyExists")- removeFileIfExists (specDir `ba` "alreadyExists.bak")+ removeFileIfExists "alreadyExists"+ copyFile' "alreadyExists.bak" "alreadyExists"+ removeFileIfExists "alreadyExists.bak" it "copyFileOverwrite, and compare" $ do- copyFileOverwrite' (specDir `ba` "inputFile")- (specDir `ba` "outputFile")- (system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "- ++ specDir' ++ "outputFile")+ copyFileOverwrite' "inputFile"+ "outputFile"+ (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " "+ ++ toString tmpDir ++ "outputFile") `shouldReturn` ExitSuccess- removeFileIfExists (specDir `ba` "outputFile")+ removeFileIfExists "outputFile" -- posix failures -- it "copyFileOverwrite, input file does not exist" $- copyFileOverwrite' (specDir `ba` "noSuchFile")- (specDir `ba` "outputFile")+ copyFileOverwrite' "noSuchFile"+ "outputFile" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "copyFileOverwrite, no permission to write to output directory" $- copyFileOverwrite' (specDir `ba` "inputFile")- (specDir `ba` "outputDirNoWrite/outputFile")+ copyFileOverwrite' "inputFile"+ "outputDirNoWrite/outputFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyFileOverwrite, cannot open output directory" $- copyFileOverwrite' (specDir `ba` "inputFile")- (specDir `ba` "noPerms/outputFile")+ copyFileOverwrite' "inputFile"+ "noPerms/outputFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyFileOverwrite, cannot open source directory" $- copyFileOverwrite' (specDir `ba` "noPerms/inputFile")- (specDir `ba` "outputFile")+ copyFileOverwrite' "noPerms/inputFile"+ "outputFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyFileOverwrite, wrong input type (symlink)" $- copyFileOverwrite' (specDir `ba` "inputFileSymL")- (specDir `ba` "outputFile")+ copyFileOverwrite' "inputFileSymL"+ "outputFile" `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) it "copyFileOverwrite, wrong input type (directory)" $- copyFileOverwrite' (specDir `ba` "wrongInput")- (specDir `ba` "outputFile")+ copyFileOverwrite' "wrongInput"+ "outputFile" `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) it "copyFileOverwrite, output file already exists and is a dir" $- copyFileOverwrite' (specDir `ba` "inputFile")- (specDir `ba` "alreadyExistsD")+ copyFileOverwrite' "inputFile"+ "alreadyExistsD" `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) -- custom failures -- it "copyFileOverwrite, output and input are same file" $- copyFileOverwrite' (specDir `ba` "inputFile")- (specDir `ba` "inputFile")+ copyFileOverwrite' "inputFile"+ "inputFile" `shouldThrow` isSameFile
test/HPath/IO/CopyFileSpec.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} + module HPath.IO.CopyFileSpec where @@ -20,86 +21,105 @@ import Data.ByteString.UTF8 (toString) -ba :: BS.ByteString -> BS.ByteString -> BS.ByteString-ba = BS.append+setupFiles :: IO ()+setupFiles = do+ createRegularFile' "inputFile"+ createRegularFile' "alreadyExists"+ createSymlink' "inputFileSymL" "inputFile"+ createDir' "alreadyExistsD"+ createDir' "noPerms"+ createRegularFile' "noPerms/inputFile"+ createDir' "outputDirNoWrite"+ createDir' "wrongInput"+ noPerms "noPerms"+ noWritableDirPerms "outputDirNoWrite"+ writeFile' "inputFile" "Blahfaselgagaga" -specDir :: BS.ByteString-specDir = "test/HPath/IO/copyFileSpec/" -specDir' :: String-specDir' = toString specDir+cleanupFiles :: IO ()+cleanupFiles = do+ normalDirPerms "noPerms"+ normalDirPerms "outputDirNoWrite"+ deleteFile' "noPerms/inputFile"+ deleteFile' "inputFile"+ deleteFile' "alreadyExists"+ deleteFile' "inputFileSymL"+ deleteDir' "alreadyExistsD"+ deleteDir' "noPerms"+ deleteDir' "outputDirNoWrite"+ deleteDir' "wrongInput" spec :: Spec-spec =+spec = before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.copyFile" $ do -- successes -- it "copyFile, everything clear" $ do- copyFile' (specDir `ba` "inputFile")- (specDir `ba` "outputFile")- removeFileIfExists (specDir `ba` "outputFile")+ copyFile' "inputFile"+ "outputFile"+ removeFileIfExists "outputFile" it "copyFile, and compare" $ do- copyFile' (specDir `ba` "inputFile")- (specDir `ba` "outputFile")- (system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "- ++ specDir' ++ "outputFile")+ copyFile' "inputFile"+ "outputFile"+ (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " "+ ++ toString tmpDir ++ "outputFile") `shouldReturn` ExitSuccess- removeFileIfExists (specDir `ba` "outputFile")+ removeFileIfExists "outputFile" -- posix failures -- it "copyFile, input file does not exist" $- copyFile' (specDir `ba` "noSuchFile")- (specDir `ba` "outputFile")+ copyFile' "noSuchFile"+ "outputFile" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "copyFile, no permission to write to output directory" $- copyFile' (specDir `ba` "inputFile")- (specDir `ba` "outputDirNoWrite/outputFile")+ copyFile' "inputFile"+ "outputDirNoWrite/outputFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyFile, cannot open output directory" $- copyFile' (specDir `ba` "inputFile")- (specDir `ba` "noPerms/outputFile")+ copyFile' "inputFile"+ "noPerms/outputFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyFile, cannot open source directory" $- copyFile' (specDir `ba` "noPerms/inputFile")- (specDir `ba` "outputFile")+ copyFile' "noPerms/inputFile"+ "outputFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "copyFile, wrong input type (symlink)" $- copyFile' (specDir `ba` "inputFileSymL")- (specDir `ba` "outputFile")+ copyFile' "inputFileSymL"+ "outputFile" `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) it "copyFile, wrong input type (directory)" $- copyFile' (specDir `ba` "wrongInput")- (specDir `ba` "outputFile")+ copyFile' "wrongInput"+ "outputFile" `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) it "copyFile, output file already exists" $- copyFile' (specDir `ba` "inputFile")- (specDir `ba` "alreadyExists")+ copyFile' "inputFile"+ "alreadyExists" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) it "copyFile, output file already exists and is a dir" $- copyFile' (specDir `ba` "inputFile")- (specDir `ba` "alreadyExistsD")+ copyFile' "inputFile"+ "alreadyExistsD" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) -- custom failures -- it "copyFile, output and input are same file" $- copyFile' (specDir `ba` "inputFile")- (specDir `ba` "inputFile")+ copyFile' "inputFile"+ "inputFile" `shouldThrow` isSameFile
test/HPath/IO/CreateDirSpec.hs view
@@ -17,38 +17,47 @@ import Data.ByteString.UTF8 (toString) -ba :: BS.ByteString -> BS.ByteString -> BS.ByteString-ba = BS.append+setupFiles :: IO ()+setupFiles = do+ createDir' "alreadyExists"+ createDir' "noPerms"+ createDir' "noWritePerms"+ noPerms "noPerms"+ noWritableDirPerms "noWritePerms" -specDir :: BS.ByteString-specDir = "test/HPath/IO/createDirSpec/" -specDir' :: String-specDir' = toString specDir +cleanupFiles :: IO ()+cleanupFiles = do+ normalDirPerms "noPerms"+ normalDirPerms "noWritePerms"+ deleteDir' "alreadyExists"+ deleteDir' "noPerms"+ deleteDir' "noWritePerms" + spec :: Spec-spec =+spec = before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.createDir" $ do -- successes -- it "createDir, all fine" $ do- createDir' (specDir `ba` "newDir")- removeDirIfExists (specDir `ba` "newDir")+ createDir' "newDir"+ removeDirIfExists "newDir" -- posix failures -- it "createDir, can't write to output directory" $- createDir' (specDir `ba` "noWritePerms/newDir")+ createDir' "noWritePerms/newDir" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "createDir, can't open output directory" $- createDir' (specDir `ba` "noPerms/newDir")+ createDir' "noPerms/newDir" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "createDir, destination directory already exists" $- createDir' (specDir `ba` "alreadyExists")+ createDir' "alreadyExists" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists)
test/HPath/IO/CreateRegularFileSpec.hs view
@@ -17,38 +17,47 @@ import Data.ByteString.UTF8 (toString) -ba :: BS.ByteString -> BS.ByteString -> BS.ByteString-ba = BS.append+setupFiles :: IO ()+setupFiles = do+ createRegularFile' "alreadyExists"+ createDir' "noPerms"+ createDir' "noWritePerms"+ noPerms "noPerms"+ noWritableDirPerms "noWritePerms" -specDir :: BS.ByteString-specDir = "test/HPath/IO/createRegularFileSpec/" -specDir' :: String-specDir' = toString specDir +cleanupFiles :: IO ()+cleanupFiles = do+ normalDirPerms "noPerms"+ normalDirPerms "noWritePerms"+ deleteFile' "alreadyExists"+ deleteDir' "noPerms"+ deleteDir' "noWritePerms" + spec :: Spec-spec =+spec = before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.createRegularFile" $ do -- successes -- it "createRegularFile, all fine" $ do- createRegularFile' (specDir `ba` "newDir")- removeFileIfExists (specDir `ba` "newDir")+ createRegularFile' "newDir"+ removeFileIfExists "newDir" -- posix failures -- it "createRegularFile, can't write to destination directory" $- createRegularFile' (specDir `ba` "noWritePerms/newDir")+ createRegularFile' "noWritePerms/newDir" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "createRegularFile, can't write to destination directory" $- createRegularFile' (specDir `ba` "noPerms/newDir")+ createRegularFile' "noPerms/newDir" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "createRegularFile, destination file already exists" $- createRegularFile' (specDir `ba` "alreadyExists")+ createRegularFile' "alreadyExists" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists)
+ test/HPath/IO/CreateSymlinkSpec.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.CreateSymlinkSpec where+++import Test.Hspec+import HPath.IO.Errors+import System.IO.Error+ (+ ioeGetErrorType+ )+import GHC.IO.Exception+ (+ IOErrorType(..)+ )+import Utils+import qualified Data.ByteString as BS+import Data.ByteString.UTF8 (toString)+++setupFiles :: IO ()+setupFiles = do+ createRegularFile' "alreadyExists"+ createDir' "noPerms"+ createDir' "noWritePerms"+ noPerms "noPerms"+ noWritableDirPerms "noWritePerms"+++cleanupFiles :: IO ()+cleanupFiles = do+ normalDirPerms "noPerms"+ normalDirPerms "noWritePerms"+ deleteFile' "alreadyExists"+ deleteDir' "noPerms"+ deleteDir' "noWritePerms"+++spec :: Spec+spec = before_ setupFiles $ after_ cleanupFiles $+ describe "HPath.IO.createSymlink" $ do++ -- successes --+ it "createSymlink, all fine" $ do+ createSymlink' "newSymL" "alreadyExists/"+ removeFileIfExists "newSymL"++ -- posix failures --+ it "createSymlink, can't write to destination directory" $+ createSymlink' "noWritePerms/newDir" "lala"+ `shouldThrow`+ (\e -> ioeGetErrorType e == PermissionDenied)++ it "createSymlink, can't write to destination directory" $+ createSymlink' "noPerms/newDir" "lala"+ `shouldThrow`+ (\e -> ioeGetErrorType e == PermissionDenied)++ it "createSymlink, destination file already exists" $+ createSymlink' "alreadyExists" "lala"+ `shouldThrow`+ (\e -> ioeGetErrorType e == AlreadyExists)+
test/HPath/IO/DeleteDirRecursiveSpec.hs view
@@ -21,76 +21,90 @@ import Data.ByteString.UTF8 (toString) -ba :: BS.ByteString -> BS.ByteString -> BS.ByteString-ba = BS.append+setupFiles :: IO ()+setupFiles = do+ createRegularFile' "file"+ createDir' "dir"+ createRegularFile' "dir/.keep"+ createSymlink' "dirSym" "dir/"+ createDir' "noPerms"+ createRegularFile' "noPerms/.keep"+ createDir' "noWritable"+ createRegularFile' "noWritable/.keep" -specDir :: BS.ByteString-specDir = "test/HPath/IO/deleteDirRecursiveSpec/" -specDir' :: String-specDir' = toString specDir+cleanupFiles :: IO ()+cleanupFiles = do+ deleteFile' "file"+ deleteFile' "dir/.keep"+ deleteDir' "dir"+ deleteFile' "dirSym"+ deleteFile' "noPerms/.keep"+ deleteDir' "noPerms"+ deleteFile' "noWritable/.keep"+ deleteDir' "noWritable" spec :: Spec-spec =+spec = before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.deleteDirRecursive" $ do -- successes -- it "deleteDirRecursive, empty directory, all fine" $ do- createDir' (specDir `ba` "testDir")- deleteDirRecursive' (specDir `ba` "testDir")- getSymbolicLinkStatus (specDir `ba` "testDir")+ createDir' "testDir"+ deleteDirRecursive' "testDir"+ getSymbolicLinkStatus "testDir" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "deleteDirRecursive, empty directory with null permissions, all fine" $ do- createDir' (specDir `ba` "noPerms/testDir")- noPerms (specDir `ba` "noPerms/testDir")- deleteDirRecursive' (specDir `ba` "noPerms/testDir")+ createDir' "noPerms/testDir"+ noPerms "noPerms/testDir"+ deleteDirRecursive' "noPerms/testDir" it "deleteDirRecursive, non-empty directory, all fine" $ do- createDir' (specDir `ba` "nonEmpty")- createDir' (specDir `ba` "nonEmpty/dir1")- createDir' (specDir `ba` "nonEmpty/dir2")- createDir' (specDir `ba` "nonEmpty/dir2/dir3")- createRegularFile' (specDir `ba` "nonEmpty/file1")- createRegularFile' (specDir `ba` "nonEmpty/dir1/file2")- deleteDirRecursive' (specDir `ba` "nonEmpty")- getSymbolicLinkStatus (specDir `ba` "nonEmpty")+ createDir' "nonEmpty"+ createDir' "nonEmpty/dir1"+ createDir' "nonEmpty/dir2"+ createDir' "nonEmpty/dir2/dir3"+ createRegularFile' "nonEmpty/file1"+ createRegularFile' "nonEmpty/dir1/file2"+ deleteDirRecursive' "nonEmpty"+ getSymbolicLinkStatus "nonEmpty" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) -- posix failures -- it "deleteDirRecursive, can't open parent directory" $ do- createDir' (specDir `ba` "noPerms/foo")- noPerms (specDir `ba` "noPerms")- (deleteDirRecursive' (specDir `ba` "noPerms/foo")+ createDir' "noPerms/foo"+ noPerms "noPerms"+ (deleteDirRecursive' "noPerms/foo") `shouldThrow`- (\e -> ioeGetErrorType e == PermissionDenied))- >> normalDirPerms (specDir `ba` "noPerms")- >> deleteDir' (specDir `ba` "noPerms/foo")+ (\e -> ioeGetErrorType e == PermissionDenied)+ normalDirPerms "noPerms"+ deleteDir' "noPerms/foo" it "deleteDirRecursive, can't write to parent directory" $ do- createDir' (specDir `ba` "noWritable/foo")- noWritableDirPerms (specDir `ba` "noWritable")- (deleteDirRecursive' (specDir `ba` "noWritable/foo")+ createDir' "noWritable/foo"+ noWritableDirPerms "noWritable"+ (deleteDirRecursive' "noWritable/foo") `shouldThrow`- (\e -> ioeGetErrorType e == PermissionDenied))- normalDirPerms (specDir `ba` "noWritable")- deleteDir' (specDir `ba` "noWritable/foo")+ (\e -> ioeGetErrorType e == PermissionDenied)+ normalDirPerms "noWritable"+ deleteDir' "noWritable/foo" it "deleteDirRecursive, wrong file type (symlink to directory)" $- deleteDirRecursive' (specDir `ba` "dirSym")+ deleteDirRecursive' "dirSym" `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) it "deleteDirRecursive, wrong file type (regular file)" $- deleteDirRecursive' (specDir `ba` "file")+ deleteDirRecursive' "file" `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) it "deleteDirRecursive, directory does not exist" $- deleteDirRecursive' (specDir `ba` "doesNotExist")+ deleteDirRecursive' "doesNotExist" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)
test/HPath/IO/DeleteDirSpec.hs view
@@ -21,74 +21,88 @@ import Data.ByteString.UTF8 (toString) -ba :: BS.ByteString -> BS.ByteString -> BS.ByteString-ba = BS.append+setupFiles :: IO ()+setupFiles = do+ createRegularFile' "file"+ createDir' "dir"+ createRegularFile' "dir/.keep"+ createSymlink' "dirSym" "dir/"+ createDir' "noPerms"+ createRegularFile' "noPerms/.keep"+ createDir' "noWritable"+ createRegularFile' "noWritable/.keep" -specDir :: BS.ByteString-specDir = "test/HPath/IO/deleteDirSpec/" -specDir' :: String-specDir' = toString specDir+cleanupFiles :: IO ()+cleanupFiles = do+ deleteFile' "file"+ deleteFile' "dir/.keep"+ deleteDir' "dir"+ deleteFile' "dirSym"+ deleteFile' "noPerms/.keep"+ deleteDir' "noPerms"+ deleteFile' "noWritable/.keep"+ deleteDir' "noWritable" spec :: Spec-spec =+spec = before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.deleteDir" $ do -- successes -- it "deleteDir, empty directory, all fine" $ do- createDir' (specDir `ba` "testDir")- deleteDir' (specDir `ba` "testDir")- getSymbolicLinkStatus (specDir `ba` "testDir")+ createDir' "testDir"+ deleteDir' "testDir"+ getSymbolicLinkStatus "testDir" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "deleteDir, directory with null permissions, all fine" $ do- createDir' (specDir `ba` "noPerms/testDir")- noPerms (specDir `ba` "noPerms/testDir")- deleteDir' (specDir `ba` "noPerms/testDir")- getSymbolicLinkStatus (specDir `ba` "testDir")+ createDir' "noPerms/testDir"+ noPerms "noPerms/testDir"+ deleteDir' "noPerms/testDir"+ getSymbolicLinkStatus "testDir" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) -- posix failures -- it "deleteDir, wrong file type (symlink to directory)" $- deleteDir' (specDir `ba` "dirSym")+ deleteDir' "dirSym" `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) it "deleteDir, wrong file type (regular file)" $- deleteDir' (specDir `ba` "file")+ deleteDir' "file" `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) it "deleteDir, directory does not exist" $- deleteDir' (specDir `ba` "doesNotExist")+ deleteDir' "doesNotExist" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "deleteDir, directory not empty" $- deleteDir' (specDir `ba` "dir")+ deleteDir' "dir" `shouldThrow` (\e -> ioeGetErrorType e == UnsatisfiedConstraints) it "deleteDir, can't open parent directory" $ do- createDir' (specDir `ba` "noPerms/foo")- noPerms (specDir `ba` "noPerms")- (deleteDir' (specDir `ba` "noPerms/foo")+ createDir' "noPerms/foo"+ noPerms "noPerms"+ (deleteDir' "noPerms/foo") `shouldThrow`- (\e -> ioeGetErrorType e == PermissionDenied))- >> normalDirPerms (specDir `ba` "noPerms")- >> deleteDir' (specDir `ba` "noPerms/foo")+ (\e -> ioeGetErrorType e == PermissionDenied)+ normalDirPerms "noPerms"+ deleteDir' "noPerms/foo" it "deleteDir, can't write to parent directory, still fine" $ do- createDir' (specDir `ba` "noWritable/foo")- noWritableDirPerms (specDir `ba` "noWritable")- (deleteDir' (specDir `ba` "noWritable/foo")+ createDir' "noWritable/foo"+ noWritableDirPerms "noWritable"+ (deleteDir' "noWritable/foo") `shouldThrow`- (\e -> ioeGetErrorType e == PermissionDenied))- normalDirPerms (specDir `ba` "noWritable")- deleteDir' (specDir `ba` "noWritable/foo")+ (\e -> ioeGetErrorType e == PermissionDenied)+ normalDirPerms "noWritable"+ deleteDir' "noWritable/foo"
test/HPath/IO/DeleteFileSpec.hs view
@@ -21,49 +21,58 @@ import Data.ByteString.UTF8 (toString) -ba :: BS.ByteString -> BS.ByteString -> BS.ByteString-ba = BS.append+setupFiles :: IO ()+setupFiles = do+ createRegularFile' "foo"+ createSymlink' "syml" "foo"+ createDir' "dir"+ createDir' "noPerms"+ noPerms "noPerms" -specDir :: BS.ByteString-specDir = "test/HPath/IO/deleteFileSpec/" -specDir' :: String-specDir' = toString specDir+cleanupFiles :: IO ()+cleanupFiles = do+ normalDirPerms "noPerms"+ deleteFile' "foo"+ deleteFile' "syml"+ deleteDir' "dir"+ deleteDir' "noPerms" + spec :: Spec-spec =+spec = before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.deleteFile" $ do -- successes -- it "deleteFile, regular file, all fine" $ do- createRegularFile' (specDir `ba` "testFile")- deleteFile' (specDir `ba` "testFile")- getSymbolicLinkStatus (specDir `ba` "testFile")+ createRegularFile' "testFile"+ deleteFile' "testFile"+ getSymbolicLinkStatus "testFile" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "deleteFile, symlink, all fine" $ do- recreateSymlink' (specDir `ba` "syml")- (specDir `ba` "testFile")- deleteFile' (specDir `ba` "testFile")- getSymbolicLinkStatus (specDir `ba` "testFile")+ recreateSymlink' "syml"+ "testFile"+ deleteFile' "testFile"+ getSymbolicLinkStatus "testFile" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) -- posix failures -- it "deleteFile, wrong file type (directory)" $- deleteFile' (specDir `ba` "dir")+ deleteFile' "dir" `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) it "deleteFile, file does not exist" $- deleteFile' (specDir `ba` "doesNotExist")+ deleteFile' "doesNotExist" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "deleteFile, can't read directory" $- deleteFile' (specDir `ba` "noPerms/blah")+ deleteFile' "noPerms/blah" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
test/HPath/IO/GetDirsFilesSpec.hs view
@@ -16,6 +16,7 @@ fromJust ) import qualified HPath as P+import HPath.IO import Test.Hspec import System.IO.Error (@@ -34,56 +35,71 @@ import Data.ByteString.UTF8 (toString) -ba :: BS.ByteString -> BS.ByteString -> BS.ByteString-ba = BS.append+setupFiles :: IO ()+setupFiles = do+ createRegularFile' "file"+ createRegularFile' "Lala"+ createRegularFile' ".hidden"+ createSymlink' "syml" "Lala"+ createDir' "dir"+ createSymlink' "dirsym" "dir"+ createDir' "noPerms"+ noPerms "noPerms" -specDir :: BS.ByteString-specDir = "test/HPath/IO/getDirsFilesSpec/" -specDir' :: String-specDir' = toString specDir+cleanupFiles :: IO ()+cleanupFiles = do+ normalDirPerms "noPerms"+ deleteFile' "file"+ deleteFile' "Lala"+ deleteFile' ".hidden"+ deleteFile' "syml"+ deleteDir' "dir"+ deleteFile' "dirsym"+ deleteDir' "noPerms" + spec :: Spec-spec =+spec = before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.getDirsFiles" $ do -- successes --- it "getDirsFiles, all fine" $ do- pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs- expectedFiles <- mapM P.parseRel [(specDir `ba ` ".hidden")- ,(specDir `ba ` "Lala")- ,(specDir `ba ` "dir")- ,(specDir `ba ` "dirsym")- ,(specDir `ba ` "file")- ,(specDir `ba ` "noPerms")- ,(specDir `ba ` "syml")]- (fmap sort $ getDirsFiles' specDir)- `shouldReturn` fmap (pwd P.</>) expectedFiles+ it "getDirsFiles, all fine" $+ withRawTmpDir $ \p -> do+ expectedFiles <- mapM P.parseRel [".hidden"+ ,"Lala"+ ,"dir"+ ,"dirsym"+ ,"file"+ ,"noPerms"+ ,"syml"]+ (fmap sort $ getDirsFiles p)+ `shouldReturn` fmap (p P.</>) expectedFiles -- posix failures -- it "getDirsFiles, nonexistent directory" $- getDirsFiles' (specDir `ba ` "nothingHere")+ getDirsFiles' "nothingHere" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "getDirsFiles, wrong file type (file)" $- getDirsFiles' (specDir `ba ` "file")+ getDirsFiles' "file" `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) it "getDirsFiles, wrong file type (symlink to file)" $- getDirsFiles' (specDir `ba ` "syml")+ getDirsFiles' "syml" `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) it "getDirsFiles, wrong file type (symlink to dir)" $- getDirsFiles' (specDir `ba ` "dirsym")+ getDirsFiles' "dirsym" `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) it "getDirsFiles, can't open directory" $- getDirsFiles' (specDir `ba ` "noPerms")+ getDirsFiles' "noPerms" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
test/HPath/IO/GetFileTypeSpec.hs view
@@ -18,53 +18,66 @@ import Data.ByteString.UTF8 (toString) -ba :: BS.ByteString -> BS.ByteString -> BS.ByteString-ba = BS.append+setupFiles :: IO ()+setupFiles = do+ createRegularFile' "regularfile"+ createSymlink' "symlink" "regularfile"+ createSymlink' "brokenSymlink" "broken"+ createDir' "directory"+ createSymlink' "symlinkD" "directory"+ createDir' "noPerms"+ noPerms "noPerms" -specDir :: BS.ByteString-specDir = "test/HPath/IO/getFileTypeSpec/" -specDir' :: String-specDir' = toString specDir+cleanupFiles :: IO ()+cleanupFiles = do+ normalDirPerms "noPerms"+ deleteFile' "regularfile"+ deleteFile' "symlink"+ deleteFile' "brokenSymlink"+ deleteDir' "directory"+ deleteFile' "symlinkD"+ deleteDir' "noPerms" + spec :: Spec-spec =+spec = before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.getFileType" $ do -- successes -- it "getFileType, regular file" $- getFileType' (specDir `ba` "regularfile")+ getFileType' "regularfile" `shouldReturn` RegularFile it "getFileType, directory" $- getFileType' (specDir `ba` "directory")+ getFileType' "directory" `shouldReturn` Directory it "getFileType, directory with null permissions" $- getFileType' (specDir `ba` "noPerms")+ getFileType' "noPerms" `shouldReturn` Directory it "getFileType, symlink to file" $- getFileType' (specDir `ba` "symlink")+ getFileType' "symlink" `shouldReturn` SymbolicLink it "getFileType, symlink to directory" $- getFileType' (specDir `ba` "symlinkD")+ getFileType' "symlinkD" `shouldReturn` SymbolicLink it "getFileType, broken symlink" $- getFileType' (specDir `ba` "brokenSymlink")+ getFileType' "brokenSymlink" `shouldReturn` SymbolicLink -- posix failures -- it "getFileType, file does not exist" $- getFileType' (specDir `ba` "nothingHere")+ getFileType' "nothingHere" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "getFileType, can't open directory" $- getFileType' (specDir `ba` "noPerms/forz")+ getFileType' "noPerms/forz" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
test/HPath/IO/MoveFileOverwriteSpec.hs view
@@ -18,76 +18,92 @@ import Data.ByteString.UTF8 (toString) -ba :: BS.ByteString -> BS.ByteString -> BS.ByteString-ba = BS.append+setupFiles :: IO ()+setupFiles = do+ createRegularFile' "myFile"+ createSymlink' "myFileL" "myFile"+ createDir' "alreadyExistsD"+ createDir' "dir"+ createDir' "noPerms"+ createDir' "noWritePerm"+ noPerms "noPerms"+ noWritableDirPerms "noWritePerm"+ writeFile' "myFile" "Blahfaselgagaga" -specDir :: BS.ByteString-specDir = "test/HPath/IO/moveFileOverwriteSpec/" -specDir' :: String-specDir' = toString specDir+cleanupFiles :: IO ()+cleanupFiles = do+ normalDirPerms "noPerms"+ normalDirPerms "noWritePerm"+ deleteFile' "myFile"+ deleteFile' "myFileL"+ deleteDir' "alreadyExistsD"+ deleteDir' "dir"+ deleteDir' "noPerms"+ deleteDir' "noWritePerm" + spec :: Spec-spec =+spec = before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.moveFileOverwrite" $ do -- successes -- it "moveFileOverwrite, all fine" $- moveFileOverwrite' (specDir `ba` "myFile")- (specDir `ba` "movedFile")+ moveFileOverwrite' "myFile"+ "movedFile" it "moveFileOverwrite, all fine" $- moveFileOverwrite' (specDir `ba` "myFile")- (specDir `ba` "dir/movedFile")+ moveFileOverwrite' "myFile"+ "dir/movedFile" it "moveFileOverwrite, all fine on symlink" $- moveFileOverwrite' (specDir `ba` "myFileL")- (specDir `ba` "movedFile")+ moveFileOverwrite' "myFileL"+ "movedFile" it "moveFileOverwrite, all fine on directory" $- moveFileOverwrite' (specDir `ba` "dir")- (specDir `ba` "movedFile")+ moveFileOverwrite' "dir"+ "movedFile" it "moveFileOverwrite, destination file already exists" $- moveFileOverwrite' (specDir `ba` "myFile")- (specDir `ba` "alreadyExists")+ moveFileOverwrite' "myFile"+ "alreadyExists" -- posix failures -- it "moveFileOverwrite, source file does not exist" $- moveFileOverwrite' (specDir `ba` "fileDoesNotExist")- (specDir `ba` "movedFile")+ moveFileOverwrite' "fileDoesNotExist"+ "movedFile" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "moveFileOverwrite, can't write to destination directory" $- moveFileOverwrite' (specDir `ba` "myFile")- (specDir `ba` "noWritePerm/movedFile")+ moveFileOverwrite' "myFile"+ "noWritePerm/movedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "moveFileOverwrite, can't open destination directory" $- moveFileOverwrite' (specDir `ba` "myFile")- (specDir `ba` "noPerms/movedFile")+ moveFileOverwrite' "myFile"+ "noPerms/movedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "moveFileOverwrite, can't open source directory" $- moveFileOverwrite' (specDir `ba` "noPerms/myFile")- (specDir `ba` "movedFile")+ moveFileOverwrite' "noPerms/myFile"+ "movedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) -- custom failures -- it "moveFileOverwrite, move from file to dir" $- moveFileOverwrite' (specDir `ba` "myFile")- (specDir `ba` "alreadyExistsD")+ moveFileOverwrite' "myFile"+ "alreadyExistsD" `shouldThrow` isDirDoesExist it "moveFileOverwrite, source and dest are same file" $- moveFileOverwrite' (specDir `ba` "myFile")- (specDir `ba` "myFile")+ moveFileOverwrite' "myFile"+ "myFile" `shouldThrow` isSameFile
test/HPath/IO/MoveFileSpec.hs view
@@ -18,78 +18,96 @@ import Data.ByteString.UTF8 (toString) -ba :: BS.ByteString -> BS.ByteString -> BS.ByteString-ba = BS.append+setupFiles :: IO ()+setupFiles = do+ createRegularFile' "myFile"+ createSymlink' "myFileL" "myFile"+ createRegularFile' "alreadyExists"+ createDir' "alreadyExistsD"+ createDir' "dir"+ createDir' "noPerms"+ createDir' "noWritePerm"+ noPerms "noPerms"+ noWritableDirPerms "noWritePerm"+ writeFile' "myFile" "Blahfaselgagaga" -specDir :: BS.ByteString-specDir = "test/HPath/IO/moveFileSpec/" -specDir' :: String-specDir' = toString specDir+cleanupFiles :: IO ()+cleanupFiles = do+ normalDirPerms "noPerms"+ normalDirPerms "noWritePerm"+ deleteFile' "myFile"+ deleteFile' "myFileL"+ deleteFile' "alreadyExists"+ deleteDir' "alreadyExistsD"+ deleteDir' "dir"+ deleteDir' "noPerms"+ deleteDir' "noWritePerm" + spec :: Spec-spec =+spec = before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.moveFile" $ do -- successes -- it "moveFile, all fine" $- moveFile' (specDir `ba` "myFile")- (specDir `ba` "movedFile")+ moveFile' "myFile"+ "movedFile" it "moveFile, all fine" $- moveFile' (specDir `ba` "myFile")- (specDir `ba` "dir/movedFile")+ moveFile' "myFile"+ "dir/movedFile" it "moveFile, all fine on symlink" $- moveFile' (specDir `ba` "myFileL")- (specDir `ba` "movedFile")+ moveFile' "myFileL"+ "movedFile" it "moveFile, all fine on directory" $- moveFile' (specDir `ba` "dir")- (specDir `ba` "movedFile")+ moveFile' "dir"+ "movedFile" -- posix failures -- it "moveFile, source file does not exist" $- moveFile' (specDir `ba` "fileDoesNotExist")- (specDir `ba` "movedFile")+ moveFile' "fileDoesNotExist"+ "movedFile" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "moveFile, can't write to destination directory" $- moveFile' (specDir `ba` "myFile")- (specDir `ba` "noWritePerm/movedFile")+ moveFile' "myFile"+ "noWritePerm/movedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "moveFile, can't open destination directory" $- moveFile' (specDir `ba` "myFile")- (specDir `ba` "noPerms/movedFile")+ moveFile' "myFile"+ "noPerms/movedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "moveFile, can't open source directory" $- moveFile' (specDir `ba` "noPerms/myFile")- (specDir `ba` "movedFile")+ moveFile' "noPerms/myFile"+ "movedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) -- custom failures -- it "moveFile, destination file already exists" $- moveFile' (specDir `ba` "myFile")- (specDir `ba` "alreadyExists")+ moveFile' "myFile"+ "alreadyExists" `shouldThrow` isFileDoesExist it "moveFile, move from file to dir" $- moveFile' (specDir `ba` "myFile")- (specDir `ba` "alreadyExistsD")+ moveFile' "myFile"+ "alreadyExistsD" `shouldThrow` isDirDoesExist it "moveFile, source and dest are same file" $- moveFile' (specDir `ba` "myFile")- (specDir `ba` "myFile")+ moveFile' "myFile"+ "myFile" `shouldThrow` isSameFile
test/HPath/IO/RecreateSymlinkSpec.hs view
@@ -18,78 +18,95 @@ import Data.ByteString.UTF8 (toString) -ba :: BS.ByteString -> BS.ByteString -> BS.ByteString-ba = BS.append+setupFiles :: IO ()+setupFiles = do+ createRegularFile' "myFile"+ createSymlink' "myFileL" "myFile"+ createRegularFile' "alreadyExists"+ createDir' "alreadyExistsD"+ createDir' "dir"+ createDir' "noPerms"+ createDir' "noWritePerm"+ noPerms "noPerms"+ noWritableDirPerms "noWritePerm"+ writeFile' "myFile" "Blahfaselgagaga" -specDir :: BS.ByteString-specDir = "test/HPath/IO/recreateSymlinkSpec/" -specDir' :: String-specDir' = toString specDir+cleanupFiles :: IO ()+cleanupFiles = do+ normalDirPerms "noPerms"+ normalDirPerms "noWritePerm"+ deleteFile' "myFile"+ deleteFile' "myFileL"+ deleteFile' "alreadyExists"+ deleteDir' "alreadyExistsD"+ deleteDir' "dir"+ deleteDir' "noPerms"+ deleteDir' "noWritePerm" spec :: Spec-spec =+spec = before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.recreateSymlink" $ do -- successes -- it "recreateSymLink, all fine" $ do- recreateSymlink' (specDir `ba` "myFileL")- (specDir `ba` "movedFile")- removeFileIfExists (specDir `ba` "movedFile")+ recreateSymlink' "myFileL"+ "movedFile"+ removeFileIfExists "movedFile" it "recreateSymLink, all fine" $ do- recreateSymlink' (specDir `ba` "myFileL")- (specDir `ba` "dir/movedFile")- removeFileIfExists (specDir `ba` "dir/movedFile")+ recreateSymlink' "myFileL"+ "dir/movedFile"+ removeFileIfExists "dir/movedFile" -- posix failures -- it "recreateSymLink, wrong input type (file)" $- recreateSymlink' (specDir `ba` "myFile")- (specDir `ba` "movedFile")+ recreateSymlink' "myFile"+ "movedFile" `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) it "recreateSymLink, wrong input type (directory)" $- recreateSymlink' (specDir `ba` "dir")- (specDir `ba` "movedFile")+ recreateSymlink' "dir"+ "movedFile" `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) it "recreateSymLink, can't write to destination directory" $- recreateSymlink' (specDir `ba` "myFileL")- (specDir `ba` "noWritePerm/movedFile")+ recreateSymlink' "myFileL"+ "noWritePerm/movedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "recreateSymLink, can't open destination directory" $- recreateSymlink' (specDir `ba` "myFileL")- (specDir `ba` "noPerms/movedFile")+ recreateSymlink' "myFileL"+ "noPerms/movedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "recreateSymLink, can't open source directory" $- recreateSymlink' (specDir `ba` "noPerms/myFileL")- (specDir `ba` "movedFile")+ recreateSymlink' "noPerms/myFileL"+ "movedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "recreateSymLink, destination file already exists" $- recreateSymlink' (specDir `ba` "myFileL")- (specDir `ba` "alreadyExists")+ recreateSymlink' "myFileL"+ "alreadyExists" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) it "recreateSymLink, destination already exists and is a dir" $- recreateSymlink' (specDir `ba` "myFileL")- (specDir `ba` "alreadyExistsD")+ recreateSymlink' "myFileL"+ "alreadyExistsD" `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) -- custom failures -- it "recreateSymLink, source and destination are the same file" $- recreateSymlink' (specDir `ba` "myFileL")- (specDir `ba` "myFileL")+ recreateSymlink' "myFileL"+ "myFileL" `shouldThrow` isSameFile
test/HPath/IO/RenameFileSpec.hs view
@@ -18,78 +18,95 @@ import Data.ByteString.UTF8 (toString) -ba :: BS.ByteString -> BS.ByteString -> BS.ByteString-ba = BS.append+setupFiles :: IO ()+setupFiles = do+ createRegularFile' "myFile"+ createSymlink' "myFileL" "myFile"+ createRegularFile' "alreadyExists"+ createDir' "alreadyExistsD"+ createDir' "dir"+ createDir' "noPerms"+ createDir' "noWritePerm"+ noPerms "noPerms"+ noWritableDirPerms "noWritePerm"+ writeFile' "myFile" "Blahfaselgagaga" -specDir :: BS.ByteString-specDir = "test/HPath/IO/renameFileSpec/" -specDir' :: String-specDir' = toString specDir+cleanupFiles :: IO ()+cleanupFiles = do+ normalDirPerms "noPerms"+ normalDirPerms "noWritePerm"+ deleteFile' "myFile"+ deleteFile' "myFileL"+ deleteFile' "alreadyExists"+ deleteDir' "alreadyExistsD"+ deleteDir' "dir"+ deleteDir' "noPerms"+ deleteDir' "noWritePerm" spec :: Spec-spec =+spec = before_ setupFiles $ after_ cleanupFiles $ describe "HPath.IO.renameFile" $ do -- successes -- it "renameFile, all fine" $- renameFile' (specDir `ba` "myFile")- (specDir `ba` "renamedFile")+ renameFile' "myFile"+ "renamedFile" it "renameFile, all fine" $- renameFile' (specDir `ba` "myFile")- (specDir `ba` "dir/renamedFile")+ renameFile' "myFile"+ "dir/renamedFile" it "renameFile, all fine on symlink" $- renameFile' (specDir `ba` "myFileL")- (specDir `ba` "renamedFile")+ renameFile' "myFileL"+ "renamedFile" it "renameFile, all fine on directory" $- renameFile' (specDir `ba` "dir")- (specDir `ba` "renamedFile")+ renameFile' "dir"+ "renamedFile" -- posix failures -- it "renameFile, source file does not exist" $- renameFile' (specDir `ba` "fileDoesNotExist")- (specDir `ba` "renamedFile")+ renameFile' "fileDoesNotExist"+ "renamedFile" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "renameFile, can't write to output directory" $- renameFile' (specDir `ba` "myFile")- (specDir `ba` "noWritePerm/renamedFile")+ renameFile' "myFile"+ "noWritePerm/renamedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "renameFile, can't open output directory" $- renameFile' (specDir `ba` "myFile")- (specDir `ba` "noPerms/renamedFile")+ renameFile' "myFile"+ "noPerms/renamedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "renameFile, can't open source directory" $- renameFile' (specDir `ba` "noPerms/myFile")- (specDir `ba` "renamedFile")+ renameFile' "noPerms/myFile"+ "renamedFile" `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) -- custom failures -- it "renameFile, destination file already exists" $- renameFile' (specDir `ba` "myFile")- (specDir `ba` "alreadyExists")+ renameFile' "myFile"+ "alreadyExists" `shouldThrow` isFileDoesExist it "renameFile, move from file to dir" $- renameFile' (specDir `ba` "myFile")- (specDir `ba` "alreadyExistsD")+ renameFile' "myFile"+ "alreadyExistsD" `shouldThrow` isDirDoesExist it "renameFile, source and dest are same file" $- renameFile' (specDir `ba` "myFile")- (specDir `ba` "myFile")+ renameFile' "myFile"+ "myFile" `shouldThrow` isSameFile
test/Main.hs view
@@ -14,40 +14,10 @@ main = hspecWith defaultConfig { configFormatter = Just progress }- $ before_ fixPermissions- $ after_ revertPermissions- $ Spec.spec >> Spec.spec+ $ before_ up+ $ after_ down+ $ Spec.spec where- noWriteDirs = ["test/HPath/IO/copyFileSpec/outputDirNoWrite"- ,"test/HPath/IO/copyFileOverwriteSpec/outputDirNoWrite"- ,"test/HPath/IO/copyDirRecursiveSpec/noWritePerm"- ,"test/HPath/IO/copyDirRecursiveOverwriteSpec/noWritePerm"- ,"test/HPath/IO/createDirSpec/noWritePerms"- ,"test/HPath/IO/createRegularFileSpec/noWritePerms"- ,"test/HPath/IO/renameFileSpec/noWritePerm"- ,"test/HPath/IO/moveFileSpec/noWritePerm"- ,"test/HPath/IO/moveFileOverwriteSpec/noWritePerm"- ,"test/HPath/IO/recreateSymlinkSpec/noWritePerm"- ]- noPermsDirs = ["test/HPath/IO/copyFileSpec/noPerms"- ,"test/HPath/IO/copyFileOverwriteSpec/noPerms"- ,"test/HPath/IO/copyDirRecursiveSpec/noPerms"- ,"test/HPath/IO/copyDirRecursiveOverwriteSpec/noPerms"- ,"test/HPath/IO/createDirSpec/noPerms"- ,"test/HPath/IO/createRegularFileSpec/noPerms"- ,"test/HPath/IO/renameFileSpec/noPerms"- ,"test/HPath/IO/moveFileSpec/noPerms"- ,"test/HPath/IO/moveFileOverwriteSpec/noPerms"- ,"test/HPath/IO/recreateSymlinkSpec/noPerms"- ,"test/HPath/IO/getFileTypeSpec/noPerms"- ,"test/HPath/IO/getDirsFilesSpec/noPerms"- ,"test/HPath/IO/deleteFileSpec/noPerms"- ]- fixPermissions = do- sequence_ $ fmap noWritableDirPerms noWriteDirs- sequence_ $ fmap noPerms noPermsDirs- revertPermissions = do- sequence_ $ fmap normalDirPerms noWriteDirs- sequence_ $ fmap normalDirPerms noPermsDirs-+ up = createTmpDir+ down = deleteTmpDir
test/Utils.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-} + module Utils where @@ -7,6 +9,10 @@ ( (<$>) )+import Control.Monad+ (+ void+ ) import HPath.IO import HPath.IO.Errors import HPath.IO.Utils@@ -36,97 +42,133 @@ , unionFileModes ) +import qualified "unix" System.Posix.IO.ByteString as SPI+import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB ++tmpDir :: ByteString+tmpDir = "test/HPath/IO/tmp/"+++ ----------------- --[ Utilities ]-- ----------------- -withPwd :: ByteString -> (P.Path P.Abs -> IO a) -> IO a-withPwd ip f = do+createTmpDir :: IO ()+createTmpDir = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs- p <- (pwd P.</>) <$> P.parseRel ip+ tmp <- P.parseRel tmpDir+ void $ createDir (pwd P.</> tmp)+++deleteTmpDir :: IO ()+deleteTmpDir = do+ pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs+ tmp <- P.parseRel tmpDir+ void $ deleteDir (pwd P.</> tmp)+++withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a+withRawTmpDir f = do+ pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs+ tmp <- P.parseRel tmpDir+ f (pwd P.</> tmp)+++withTmpDir :: ByteString -> (P.Path P.Abs -> IO a) -> IO a+withTmpDir ip f = do+ pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs+ tmp <- P.parseRel tmpDir+ p <- (pwd P.</> tmp P.</>) <$> P.parseRel ip f p -withPwd' :: ByteString- -> ByteString- -> (P.Path P.Abs -> P.Path P.Abs -> IO a)- -> IO a-withPwd' ip1 ip2 f = do+withTmpDir' :: ByteString+ -> ByteString+ -> (P.Path P.Abs -> P.Path P.Abs -> IO a)+ -> IO a+withTmpDir' ip1 ip2 f = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs- p1 <- (pwd P.</>) <$> P.parseRel ip1- p2 <- (pwd P.</>) <$> P.parseRel ip2+ tmp <- P.parseRel tmpDir+ p1 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip1+ p2 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip2 f p1 p2 removeFileIfExists :: ByteString -> IO () removeFileIfExists bs =- withPwd bs $ \p -> whenM (doesFileExist p) (deleteFile p)+ withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p) removeDirIfExists :: ByteString -> IO () removeDirIfExists bs =- withPwd bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p)+ withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p) copyFile' :: ByteString -> ByteString -> IO () copyFile' inputFileP outputFileP =- withPwd' inputFileP outputFileP copyFile+ withTmpDir' inputFileP outputFileP copyFile copyFileOverwrite' :: ByteString -> ByteString -> IO () copyFileOverwrite' inputFileP outputFileP =- withPwd' inputFileP outputFileP copyFileOverwrite+ withTmpDir' inputFileP outputFileP copyFileOverwrite copyDirRecursive' :: ByteString -> ByteString -> IO () copyDirRecursive' inputDirP outputDirP =- withPwd' inputDirP outputDirP copyDirRecursive+ withTmpDir' inputDirP outputDirP copyDirRecursive copyDirRecursiveOverwrite' :: ByteString -> ByteString -> IO () copyDirRecursiveOverwrite' inputDirP outputDirP =- withPwd' inputDirP outputDirP copyDirRecursiveOverwrite+ withTmpDir' inputDirP outputDirP copyDirRecursiveOverwrite createDir' :: ByteString -> IO ()-createDir' dest = withPwd dest createDir+createDir' dest = withTmpDir dest createDir createRegularFile' :: ByteString -> IO ()-createRegularFile' dest = withPwd dest createRegularFile+createRegularFile' dest = withTmpDir dest createRegularFile +createSymlink' :: ByteString -> ByteString -> IO ()+createSymlink' dest sympoint = withTmpDir dest+ (\x -> createSymlink x sympoint)++ renameFile' :: ByteString -> ByteString -> IO () renameFile' inputFileP outputFileP =- withPwd' inputFileP outputFileP $ \i o -> do+ withTmpDir' inputFileP outputFileP $ \i o -> do renameFile i o renameFile o i moveFile' :: ByteString -> ByteString -> IO () moveFile' inputFileP outputFileP =- withPwd' inputFileP outputFileP $ \i o -> do+ withTmpDir' inputFileP outputFileP $ \i o -> do moveFile i o moveFile o i moveFileOverwrite' :: ByteString -> ByteString -> IO () moveFileOverwrite' inputFileP outputFileP =- withPwd' inputFileP outputFileP $ \i o -> do+ withTmpDir' inputFileP outputFileP $ \i o -> do moveFileOverwrite i o moveFile o i recreateSymlink' :: ByteString -> ByteString -> IO () recreateSymlink' inputFileP outputFileP =- withPwd' inputFileP outputFileP recreateSymlink+ withTmpDir' inputFileP outputFileP recreateSymlink noWritableDirPerms :: ByteString -> IO ()-noWritableDirPerms path = withPwd path $ \p ->+noWritableDirPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) perms where perms = ownerReadMode@@ -138,34 +180,42 @@ noPerms :: ByteString -> IO ()-noPerms path = withPwd path $ \p -> setFileMode (P.fromAbs p) nullFileMode+noPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) nullFileMode normalDirPerms :: ByteString -> IO () normalDirPerms path =- withPwd path $ \p -> setFileMode (P.fromAbs p) newDirPerms+ withTmpDir path $ \p -> setFileMode (P.fromAbs p) newDirPerms getFileType' :: ByteString -> IO FileType-getFileType' path = withPwd path getFileType+getFileType' path = withTmpDir path getFileType getDirsFiles' :: ByteString -> IO [P.Path P.Abs]-getDirsFiles' path = withPwd path getDirsFiles+getDirsFiles' path = withTmpDir path getDirsFiles deleteFile' :: ByteString -> IO ()-deleteFile' p = withPwd p deleteFile+deleteFile' p = withTmpDir p deleteFile deleteDir' :: ByteString -> IO ()-deleteDir' p = withPwd p deleteDir+deleteDir' p = withTmpDir p deleteDir deleteDirRecursive' :: ByteString -> IO ()-deleteDirRecursive' p = withPwd p deleteDirRecursive+deleteDirRecursive' p = withTmpDir p deleteDirRecursive canonicalizePath' :: ByteString -> IO (P.Path P.Abs)-canonicalizePath' p = withPwd p canonicalizePath+canonicalizePath' p = withTmpDir p canonicalizePath ++writeFile' :: ByteString -> ByteString -> IO ()+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