Split packages into hpath{,-io,-filepath}
This commit is contained in:
108
hpath-io/test/HPath/IO/AppendFileSpec.hs
Normal file
108
hpath-io/test/HPath/IO/AppendFileSpec.hs
Normal file
@@ -0,0 +1,108 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
|
||||
module HPath.IO.AppendFileSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
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)
|
||||
78
hpath-io/test/HPath/IO/CanonicalizePathSpec.hs
Normal file
78
hpath-io/test/HPath/IO/CanonicalizePathSpec.hs
Normal file
@@ -0,0 +1,78 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module HPath.IO.CanonicalizePathSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CanonicalizePathSpec"
|
||||
createTmpDir
|
||||
|
||||
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 = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ 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)
|
||||
|
||||
248
hpath-io/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs
Normal file
248
hpath-io/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs
Normal file
@@ -0,0 +1,248 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
|
||||
module HPath.IO.CopyDirRecursiveCollectFailuresSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import Data.List (sort)
|
||||
import HPath.IO
|
||||
import HPath.IO.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import System.Exit
|
||||
import System.Process
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CopyDirRecursiveCollectFailuresSpec"
|
||||
createTmpDir
|
||||
|
||||
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"
|
||||
|
||||
createDir' "inputDir1"
|
||||
createDir' "inputDir1/foo2"
|
||||
createDir' "inputDir1/foo2/foo3"
|
||||
createDir' "inputDir1/foo2/foo4"
|
||||
createRegularFile' "inputDir1/foo2/inputFile1"
|
||||
createRegularFile' "inputDir1/foo2/inputFile2"
|
||||
createRegularFile' "inputDir1/foo2/inputFile3"
|
||||
createRegularFile' "inputDir1/foo2/foo4/inputFile4"
|
||||
createRegularFile' "inputDir1/foo2/foo4/inputFile6"
|
||||
createRegularFile' "inputDir1/foo2/foo3/inputFile5"
|
||||
noPerms "inputDir1/foo2/foo3"
|
||||
|
||||
createDir' "outputDir1"
|
||||
createDir' "outputDir1/foo2"
|
||||
createDir' "outputDir1/foo2/foo4"
|
||||
createDir' "outputDir1/foo2/foo4/inputFile4"
|
||||
createRegularFile' "outputDir1/foo2/foo4/inputFile6"
|
||||
noPerms "outputDir1/foo2/foo4/inputFile4"
|
||||
noPerms "outputDir1/foo2/foo4"
|
||||
|
||||
noPerms "noPerms"
|
||||
noWritableDirPerms "noWritePerm"
|
||||
|
||||
|
||||
cleanupFiles :: IO ()
|
||||
cleanupFiles = do
|
||||
normalDirPerms "noPerms"
|
||||
normalDirPerms "noWritePerm"
|
||||
|
||||
normalDirPerms "inputDir1/foo2/foo3"
|
||||
deleteFile' "inputDir1/foo2/foo4/inputFile4"
|
||||
deleteFile' "inputDir1/foo2/foo4/inputFile6"
|
||||
deleteFile' "inputDir1/foo2/inputFile1"
|
||||
deleteFile' "inputDir1/foo2/inputFile2"
|
||||
deleteFile' "inputDir1/foo2/inputFile3"
|
||||
deleteFile' "inputDir1/foo2/foo3/inputFile5"
|
||||
deleteDir' "inputDir1/foo2/foo3"
|
||||
deleteDir' "inputDir1/foo2/foo4"
|
||||
deleteDir' "inputDir1/foo2"
|
||||
deleteDir' "inputDir1"
|
||||
|
||||
normalDirPerms "outputDir1/foo2/foo4"
|
||||
normalDirPerms "outputDir1/foo2/foo4/inputFile4"
|
||||
deleteFile' "outputDir1/foo2/foo4/inputFile6"
|
||||
deleteDir' "outputDir1/foo2/foo4/inputFile4"
|
||||
deleteDir' "outputDir1/foo2/foo4"
|
||||
deleteDir' "outputDir1/foo2"
|
||||
deleteDir' "outputDir1"
|
||||
|
||||
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 = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.copyDirRecursive" $ do
|
||||
|
||||
-- successes --
|
||||
it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do
|
||||
tmpDir' <- getRawTmpDir
|
||||
copyDirRecursive' "inputDir"
|
||||
"outputDir"
|
||||
Strict
|
||||
CollectFailures
|
||||
(system $ "diff -r --no-dereference "
|
||||
++ toString tmpDir' ++ "inputDir" ++ " "
|
||||
++ toString tmpDir' ++ "outputDir"
|
||||
++ " >/dev/null")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeDirIfExists "outputDir"
|
||||
|
||||
-- posix failures --
|
||||
it "copyDirRecursive (Strict, CollectFailures), source directory does not exist" $
|
||||
copyDirRecursive' "doesNotExist"
|
||||
"outputDir"
|
||||
Strict
|
||||
CollectFailures
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "copyDirRecursive (Strict, CollectFailures), cannot open source dir" $
|
||||
copyDirRecursive' "noPerms/inputDir"
|
||||
"foo"
|
||||
Strict
|
||||
CollectFailures
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
|
||||
-- custom failures
|
||||
it "copyDirRecursive (Overwrite, CollectFailures), various failures" $ do
|
||||
copyDirRecursive' "inputDir1/foo2"
|
||||
"outputDir1/foo2"
|
||||
Overwrite
|
||||
CollectFailures
|
||||
`shouldThrow`
|
||||
(\(RecursiveFailure ex@[_, _]) ->
|
||||
any (\(h, e) -> ioeGetErrorType e == InappropriateType
|
||||
&& isCopyFileFailed h) ex &&
|
||||
any (\(h, e) -> ioeGetErrorType e == PermissionDenied
|
||||
&& isReadContentsFailed h) ex)
|
||||
normalDirPerms "outputDir1/foo2/foo4"
|
||||
normalDirPerms "outputDir1/foo2/foo4/inputFile4"
|
||||
c <- allDirectoryContents' "outputDir1"
|
||||
tmpDir' <- getRawTmpDir
|
||||
let shouldC = (fmap (\x -> tmpDir' `BS.append` x)
|
||||
["outputDir1"
|
||||
,"outputDir1/foo2"
|
||||
,"outputDir1/foo2/inputFile1"
|
||||
,"outputDir1/foo2/inputFile2"
|
||||
,"outputDir1/foo2/inputFile3"
|
||||
,"outputDir1/foo2/foo4"
|
||||
,"outputDir1/foo2/foo4/inputFile6"
|
||||
,"outputDir1/foo2/foo4/inputFile4"])
|
||||
deleteFile' "outputDir1/foo2/inputFile1"
|
||||
deleteFile' "outputDir1/foo2/inputFile2"
|
||||
deleteFile' "outputDir1/foo2/inputFile3"
|
||||
sort c `shouldBe` sort shouldC
|
||||
|
||||
|
||||
it "copyDirRecursive (Strict, CollectFailures), no write permission on output dir" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"noWritePerm/foo"
|
||||
Strict
|
||||
CollectFailures
|
||||
`shouldThrow`
|
||||
(\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyDirRecursive (Strict, CollectFailures), cannot open output dir" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"noPerms/foo"
|
||||
Strict
|
||||
CollectFailures
|
||||
`shouldThrow`
|
||||
isRecursiveFailure
|
||||
|
||||
it "copyDirRecursive (Strict, CollectFailures), destination dir already exists" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"alreadyExistsD"
|
||||
Strict
|
||||
CollectFailures
|
||||
`shouldThrow`
|
||||
(\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "copyDirRecursive (Strict, CollectFailures), destination already exists and is a file" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"alreadyExists"
|
||||
Strict
|
||||
CollectFailures
|
||||
`shouldThrow`
|
||||
isRecursiveFailure
|
||||
|
||||
it "copyDirRecursive (Strict, CollectFailures), wrong input (regular file)" $
|
||||
copyDirRecursive' "wrongInput"
|
||||
"outputDir"
|
||||
Strict
|
||||
CollectFailures
|
||||
`shouldThrow`
|
||||
(\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "copyDirRecursive (Strict, CollectFailures), wrong input (symlink to directory)" $
|
||||
copyDirRecursive' "wrongInputSymL"
|
||||
"outputDir"
|
||||
Strict
|
||||
CollectFailures
|
||||
`shouldThrow`
|
||||
(\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
it "copyDirRecursive (Strict, CollectFailures), destination in source" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"inputDir/foo"
|
||||
Strict
|
||||
CollectFailures
|
||||
`shouldThrow`
|
||||
isDestinationInSource
|
||||
|
||||
it "copyDirRecursive (Strict, CollectFailures), destination and source same directory" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"inputDir"
|
||||
Strict
|
||||
CollectFailures
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
|
||||
|
||||
205
hpath-io/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs
Normal file
205
hpath-io/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs
Normal file
@@ -0,0 +1,205 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
|
||||
module HPath.IO.CopyDirRecursiveOverwriteSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HPath.IO
|
||||
import HPath.IO.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import System.Exit
|
||||
import System.Process
|
||||
import Utils
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CopyDirRecursiveOverwriteSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "alreadyExists"
|
||||
createRegularFile' "wrongInput"
|
||||
createSymlink' "wrongInputSymL" "inputDir/"
|
||||
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"
|
||||
|
||||
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 = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.copyDirRecursive" $ do
|
||||
|
||||
-- successes --
|
||||
it "copyDirRecursive (Overwrite, FailEarly), all fine" $ do
|
||||
copyDirRecursive' "inputDir"
|
||||
"outputDir"
|
||||
Overwrite
|
||||
FailEarly
|
||||
removeDirIfExists "outputDir"
|
||||
|
||||
it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do
|
||||
tmpDir' <- getRawTmpDir
|
||||
copyDirRecursive' "inputDir"
|
||||
"outputDir"
|
||||
Overwrite
|
||||
FailEarly
|
||||
(system $ "diff -r --no-dereference "
|
||||
++ toString tmpDir' ++ "inputDir" ++ " "
|
||||
++ toString tmpDir' ++ "outputDir"
|
||||
++ " >/dev/null")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeDirIfExists "outputDir"
|
||||
|
||||
it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do
|
||||
tmpDir' <- getRawTmpDir
|
||||
(system $ "diff -r --no-dereference "
|
||||
++ toString tmpDir' ++ "inputDir" ++ " "
|
||||
++ toString tmpDir' ++ "alreadyExistsD"
|
||||
++ " >/dev/null")
|
||||
`shouldReturn` (ExitFailure 1)
|
||||
copyDirRecursive' "inputDir"
|
||||
"alreadyExistsD"
|
||||
Overwrite
|
||||
FailEarly
|
||||
(system $ "diff -r --no-dereference "
|
||||
++ toString tmpDir' ++ "inputDir" ++ " "
|
||||
++ toString tmpDir' ++ "alreadyExistsD"
|
||||
++ " >/dev/null")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeDirIfExists "outputDir"
|
||||
|
||||
|
||||
-- posix failures --
|
||||
it "copyDirRecursive, source directory does not exist" $
|
||||
copyDirRecursive' "doesNotExist"
|
||||
"outputDir"
|
||||
Overwrite
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "copyDirRecursive, no write permission on output dir" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"noWritePerm/foo"
|
||||
Overwrite
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyDirRecursive, cannot open output dir" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"noPerms/foo"
|
||||
Overwrite
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyDirRecursive, cannot open source dir" $
|
||||
copyDirRecursive' "noPerms/inputDir"
|
||||
"foo"
|
||||
Overwrite
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyDirRecursive, destination already exists and is a file" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"alreadyExists"
|
||||
Overwrite
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "copyDirRecursive, wrong input (regular file)" $
|
||||
copyDirRecursive' "wrongInput"
|
||||
"outputDir"
|
||||
Overwrite
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "copyDirRecursive, wrong input (symlink to directory)" $
|
||||
copyDirRecursive' "wrongInputSymL"
|
||||
"outputDir"
|
||||
Overwrite
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
-- custom failures
|
||||
it "copyDirRecursive (Overwrite, FailEarly), destination in source" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"inputDir/foo"
|
||||
Overwrite
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
isDestinationInSource
|
||||
|
||||
it "copyDirRecursive (Overwrite, FailEarly), destination and source same directory" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"inputDir"
|
||||
Overwrite
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
181
hpath-io/test/HPath/IO/CopyDirRecursiveSpec.hs
Normal file
181
hpath-io/test/HPath/IO/CopyDirRecursiveSpec.hs
Normal file
@@ -0,0 +1,181 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
|
||||
module HPath.IO.CopyDirRecursiveSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HPath.IO
|
||||
import HPath.IO.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import System.Exit
|
||||
import System.Process
|
||||
import Utils
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CopyDirRecursiveSpec"
|
||||
createTmpDir
|
||||
|
||||
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 = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.copyDirRecursive" $ do
|
||||
|
||||
-- successes --
|
||||
it "copyDirRecursive (Strict, FailEarly), all fine" $ do
|
||||
copyDirRecursive' "inputDir"
|
||||
"outputDir"
|
||||
Strict
|
||||
FailEarly
|
||||
removeDirIfExists "outputDir"
|
||||
|
||||
it "copyDirRecursive (Strict, FailEarly), all fine and compare" $ do
|
||||
tmpDir' <- getRawTmpDir
|
||||
copyDirRecursive' "inputDir"
|
||||
"outputDir"
|
||||
Strict
|
||||
FailEarly
|
||||
(system $ "diff -r --no-dereference "
|
||||
++ toString tmpDir' ++ "inputDir" ++ " "
|
||||
++ toString tmpDir' ++ "outputDir"
|
||||
++ " >/dev/null")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeDirIfExists "outputDir"
|
||||
|
||||
-- posix failures --
|
||||
it "copyDirRecursive (Strict, FailEarly), source directory does not exist" $
|
||||
copyDirRecursive' "doesNotExist"
|
||||
"outputDir"
|
||||
Strict
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "copyDirRecursive (Strict, FailEarly), no write permission on output dir" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"noWritePerm/foo"
|
||||
Strict
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyDirRecursive (Strict, FailEarly), cannot open output dir" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"noPerms/foo"
|
||||
Strict
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyDirRecursive (Strict, FailEarly), cannot open source dir" $
|
||||
copyDirRecursive' "noPerms/inputDir"
|
||||
"foo"
|
||||
Strict
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyDirRecursive (Strict, FailEarly), destination dir already exists" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"alreadyExistsD"
|
||||
Strict
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "copyDirRecursive (Strict, FailEarly), destination already exists and is a file" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"alreadyExists"
|
||||
Strict
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "copyDirRecursive (Strict, FailEarly), wrong input (regular file)" $
|
||||
copyDirRecursive' "wrongInput"
|
||||
"outputDir"
|
||||
Strict
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "copyDirRecursive (Strict, FailEarly), wrong input (symlink to directory)" $
|
||||
copyDirRecursive' "wrongInputSymL"
|
||||
"outputDir"
|
||||
Strict
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
-- custom failures
|
||||
it "copyDirRecursive (Strict, FailEarly), destination in source" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"inputDir/foo"
|
||||
Strict
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
isDestinationInSource
|
||||
|
||||
it "copyDirRecursive (Strict, FailEarly), destination and source same directory" $
|
||||
copyDirRecursive' "inputDir"
|
||||
"inputDir"
|
||||
Strict
|
||||
FailEarly
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
|
||||
|
||||
148
hpath-io/test/HPath/IO/CopyFileOverwriteSpec.hs
Normal file
148
hpath-io/test/HPath/IO/CopyFileOverwriteSpec.hs
Normal file
@@ -0,0 +1,148 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module HPath.IO.CopyFileOverwriteSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HPath.IO
|
||||
import HPath.IO.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import System.Exit
|
||||
import System.Process
|
||||
import Utils
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CopyFileOverwriteSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
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"
|
||||
|
||||
|
||||
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 = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.copyFile" $ do
|
||||
|
||||
-- successes --
|
||||
it "copyFile (Overwrite), everything clear" $ do
|
||||
copyFile' "inputFile"
|
||||
"outputFile"
|
||||
Overwrite
|
||||
removeFileIfExists "outputFile"
|
||||
|
||||
it "copyFile (Overwrite), output file already exists, all clear" $ do
|
||||
tmpDir' <- getRawTmpDir
|
||||
copyFile' "alreadyExists" "alreadyExists.bak" Strict
|
||||
copyFile' "inputFile" "alreadyExists" Overwrite
|
||||
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "
|
||||
++ toString tmpDir' ++ "alreadyExists")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeFileIfExists "alreadyExists"
|
||||
copyFile' "alreadyExists.bak" "alreadyExists" Strict
|
||||
removeFileIfExists "alreadyExists.bak"
|
||||
|
||||
it "copyFile (Overwrite), and compare" $ do
|
||||
tmpDir' <- getRawTmpDir
|
||||
copyFile' "inputFile"
|
||||
"outputFile"
|
||||
Overwrite
|
||||
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "
|
||||
++ toString tmpDir' ++ "outputFile")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeFileIfExists "outputFile"
|
||||
|
||||
|
||||
-- posix failures --
|
||||
it "copyFile (Overwrite), input file does not exist" $
|
||||
copyFile' "noSuchFile"
|
||||
"outputFile"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "copyFile (Overwrite), no permission to write to output directory" $
|
||||
copyFile' "inputFile"
|
||||
"outputDirNoWrite/outputFile"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyFile (Overwrite), cannot open output directory" $
|
||||
copyFile' "inputFile"
|
||||
"noPerms/outputFile"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyFile (Overwrite), cannot open source directory" $
|
||||
copyFile' "noPerms/inputFile"
|
||||
"outputFile"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyFile (Overwrite), wrong input type (symlink)" $
|
||||
copyFile' "inputFileSymL"
|
||||
"outputFile"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
it "copyFile (Overwrite), wrong input type (directory)" $
|
||||
copyFile' "wrongInput"
|
||||
"outputFile"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "copyFile (Overwrite), output file already exists and is a dir" $
|
||||
copyFile' "inputFile"
|
||||
"alreadyExistsD"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
-- custom failures --
|
||||
it "copyFile (Overwrite), output and input are same file" $
|
||||
copyFile' "inputFile"
|
||||
"inputFile"
|
||||
Overwrite
|
||||
`shouldThrow` isSameFile
|
||||
143
hpath-io/test/HPath/IO/CopyFileSpec.hs
Normal file
143
hpath-io/test/HPath/IO/CopyFileSpec.hs
Normal file
@@ -0,0 +1,143 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
|
||||
module HPath.IO.CopyFileSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HPath.IO
|
||||
import HPath.IO.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import System.Exit
|
||||
import System.Process
|
||||
import Utils
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CopyFileSpec"
|
||||
createTmpDir
|
||||
|
||||
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"
|
||||
|
||||
|
||||
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 = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.copyFile" $ do
|
||||
|
||||
-- successes --
|
||||
it "copyFile (Strict), everything clear" $ do
|
||||
copyFile' "inputFile"
|
||||
"outputFile"
|
||||
Strict
|
||||
removeFileIfExists "outputFile"
|
||||
|
||||
it "copyFile (Strict), and compare" $ do
|
||||
tmpDir' <- getRawTmpDir
|
||||
copyFile' "inputFile"
|
||||
"outputFile"
|
||||
Strict
|
||||
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "
|
||||
++ toString tmpDir' ++ "outputFile")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeFileIfExists "outputFile"
|
||||
|
||||
-- posix failures --
|
||||
it "copyFile (Strict), input file does not exist" $
|
||||
copyFile' "noSuchFile"
|
||||
"outputFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "copyFile (Strict), no permission to write to output directory" $
|
||||
copyFile' "inputFile"
|
||||
"outputDirNoWrite/outputFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyFile (Strict), cannot open output directory" $
|
||||
copyFile' "inputFile"
|
||||
"noPerms/outputFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyFile (Strict), cannot open source directory" $
|
||||
copyFile' "noPerms/inputFile"
|
||||
"outputFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyFile (Strict), wrong input type (symlink)" $
|
||||
copyFile' "inputFileSymL"
|
||||
"outputFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
it "copyFile (Strict), wrong input type (directory)" $
|
||||
copyFile' "wrongInput"
|
||||
"outputFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "copyFile (Strict), output file already exists" $
|
||||
copyFile' "inputFile"
|
||||
"alreadyExists"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "copyFile (Strict), output file already exists and is a dir" $
|
||||
copyFile' "inputFile"
|
||||
"alreadyExistsD"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
-- custom failures --
|
||||
it "copyFile (Strict), output and input are same file" $
|
||||
copyFile' "inputFile"
|
||||
"inputFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
78
hpath-io/test/HPath/IO/CreateDirRecursiveSpec.hs
Normal file
78
hpath-io/test/HPath/IO/CreateDirRecursiveSpec.hs
Normal file
@@ -0,0 +1,78 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module HPath.IO.CreateDirRecursiveSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CreateDirRecursiveSpec"
|
||||
createTmpDir
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createDir' "alreadyExists"
|
||||
createRegularFile' "alreadyExistsF"
|
||||
createDir' "noPerms"
|
||||
createDir' "noWritePerms"
|
||||
noPerms "noPerms"
|
||||
noWritableDirPerms "noWritePerms"
|
||||
|
||||
cleanupFiles :: IO ()
|
||||
cleanupFiles = do
|
||||
normalDirPerms "noPerms"
|
||||
normalDirPerms "noWritePerms"
|
||||
deleteDir' "alreadyExists"
|
||||
deleteDir' "noPerms"
|
||||
deleteDir' "noWritePerms"
|
||||
deleteFile' "alreadyExistsF"
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.createDirRecursive" $ do
|
||||
|
||||
-- successes --
|
||||
it "createDirRecursive, all fine" $ do
|
||||
createDirRecursive' "newDir"
|
||||
deleteDir' "newDir"
|
||||
|
||||
it "createDirRecursive, parent directories do not exist" $ do
|
||||
createDirRecursive' "some/thing/dada"
|
||||
deleteDir' "some/thing/dada"
|
||||
deleteDir' "some/thing"
|
||||
deleteDir' "some"
|
||||
|
||||
it "createDirRecursive, destination directory already exists" $
|
||||
createDirRecursive' "alreadyExists"
|
||||
|
||||
-- posix failures --
|
||||
it "createDirRecursive, destination already exists and is a file" $
|
||||
createDirRecursive' "alreadyExistsF"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "createDirRecursive, can't write to output directory" $
|
||||
createDirRecursive' "noWritePerms/newDir"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "createDirRecursive, can't open output directory" $
|
||||
createDirRecursive' "noPerms/newDir"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
|
||||
|
||||
72
hpath-io/test/HPath/IO/CreateDirSpec.hs
Normal file
72
hpath-io/test/HPath/IO/CreateDirSpec.hs
Normal file
@@ -0,0 +1,72 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module HPath.IO.CreateDirSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CreateDirSpec"
|
||||
createTmpDir
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createDir' "alreadyExists"
|
||||
createDir' "noPerms"
|
||||
createDir' "noWritePerms"
|
||||
noPerms "noPerms"
|
||||
noWritableDirPerms "noWritePerms"
|
||||
|
||||
|
||||
|
||||
cleanupFiles :: IO ()
|
||||
cleanupFiles = do
|
||||
normalDirPerms "noPerms"
|
||||
normalDirPerms "noWritePerms"
|
||||
deleteDir' "alreadyExists"
|
||||
deleteDir' "noPerms"
|
||||
deleteDir' "noWritePerms"
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.createDir" $ do
|
||||
|
||||
-- successes --
|
||||
it "createDir, all fine" $ do
|
||||
createDir' "newDir"
|
||||
removeDirIfExists "newDir"
|
||||
|
||||
-- posix failures --
|
||||
it "createDir, parent directories do not exist" $
|
||||
createDir' "some/thing/dada"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "createDir, can't write to output directory" $
|
||||
createDir' "noWritePerms/newDir"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "createDir, can't open output directory" $
|
||||
createDir' "noPerms/newDir"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "createDir, destination directory already exists" $
|
||||
createDir' "alreadyExists"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
70
hpath-io/test/HPath/IO/CreateRegularFileSpec.hs
Normal file
70
hpath-io/test/HPath/IO/CreateRegularFileSpec.hs
Normal file
@@ -0,0 +1,70 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module HPath.IO.CreateRegularFileSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CreateRegularFileSpec"
|
||||
createTmpDir
|
||||
|
||||
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 = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.createRegularFile" $ do
|
||||
|
||||
-- successes --
|
||||
it "createRegularFile, all fine" $ do
|
||||
createRegularFile' "newDir"
|
||||
removeFileIfExists "newDir"
|
||||
|
||||
-- posix failures --
|
||||
it "createRegularFile, parent directories do not exist" $
|
||||
createRegularFile' "some/thing/dada"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "createRegularFile, can't write to destination directory" $
|
||||
createRegularFile' "noWritePerms/newDir"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "createRegularFile, can't write to destination directory" $
|
||||
createRegularFile' "noPerms/newDir"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "createRegularFile, destination file already exists" $
|
||||
createRegularFile' "alreadyExists"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
71
hpath-io/test/HPath/IO/CreateSymlinkSpec.hs
Normal file
71
hpath-io/test/HPath/IO/CreateSymlinkSpec.hs
Normal file
@@ -0,0 +1,71 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module HPath.IO.CreateSymlinkSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CreateSymlinkSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
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 = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.createSymlink" $ do
|
||||
|
||||
-- successes --
|
||||
it "createSymlink, all fine" $ do
|
||||
createSymlink' "newSymL" "alreadyExists/"
|
||||
removeFileIfExists "newSymL"
|
||||
|
||||
-- posix failures --
|
||||
it "createSymlink, parent directories do not exist" $
|
||||
createSymlink' "some/thing/dada" "lala"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
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)
|
||||
|
||||
116
hpath-io/test/HPath/IO/DeleteDirRecursiveSpec.hs
Normal file
116
hpath-io/test/HPath/IO/DeleteDirRecursiveSpec.hs
Normal file
@@ -0,0 +1,116 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module HPath.IO.DeleteDirRecursiveSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import System.Posix.Files.ByteString
|
||||
(
|
||||
getSymbolicLinkStatus
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "DeleteDirRecursiveSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "file"
|
||||
createDir' "dir"
|
||||
createRegularFile' "dir/.keep"
|
||||
createSymlink' "dirSym" "dir/"
|
||||
createDir' "noPerms"
|
||||
createRegularFile' "noPerms/.keep"
|
||||
createDir' "noWritable"
|
||||
createRegularFile' "noWritable/.keep"
|
||||
|
||||
|
||||
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 = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.deleteDirRecursive" $ do
|
||||
|
||||
-- successes --
|
||||
it "deleteDirRecursive, empty directory, all fine" $ do
|
||||
createDir' "testDir"
|
||||
deleteDirRecursive' "testDir"
|
||||
getSymbolicLinkStatus "testDir"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "deleteDirRecursive, empty directory with null permissions, all fine" $ do
|
||||
createDir' "noPerms/testDir"
|
||||
noPerms "noPerms/testDir"
|
||||
deleteDirRecursive' "noPerms/testDir"
|
||||
|
||||
it "deleteDirRecursive, non-empty directory, all fine" $ do
|
||||
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' "noPerms/foo"
|
||||
noPerms "noPerms"
|
||||
(deleteDirRecursive' "noPerms/foo")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
normalDirPerms "noPerms"
|
||||
deleteDir' "noPerms/foo"
|
||||
|
||||
it "deleteDirRecursive, can't write to parent directory" $ do
|
||||
createDir' "noWritable/foo"
|
||||
noWritableDirPerms "noWritable"
|
||||
(deleteDirRecursive' "noWritable/foo")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
normalDirPerms "noWritable"
|
||||
deleteDir' "noWritable/foo"
|
||||
|
||||
it "deleteDirRecursive, wrong file type (symlink to directory)" $
|
||||
deleteDirRecursive' "dirSym"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "deleteDirRecursive, wrong file type (regular file)" $
|
||||
deleteDirRecursive' "file"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "deleteDirRecursive, directory does not exist" $
|
||||
deleteDirRecursive' "doesNotExist"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
|
||||
114
hpath-io/test/HPath/IO/DeleteDirSpec.hs
Normal file
114
hpath-io/test/HPath/IO/DeleteDirSpec.hs
Normal file
@@ -0,0 +1,114 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module HPath.IO.DeleteDirSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import System.Posix.Files.ByteString
|
||||
(
|
||||
getSymbolicLinkStatus
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "DeleteDirSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "file"
|
||||
createDir' "dir"
|
||||
createRegularFile' "dir/.keep"
|
||||
createSymlink' "dirSym" "dir/"
|
||||
createDir' "noPerms"
|
||||
createRegularFile' "noPerms/.keep"
|
||||
createDir' "noWritable"
|
||||
createRegularFile' "noWritable/.keep"
|
||||
|
||||
|
||||
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 = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.deleteDir" $ do
|
||||
|
||||
-- successes --
|
||||
it "deleteDir, empty directory, all fine" $ do
|
||||
createDir' "testDir"
|
||||
deleteDir' "testDir"
|
||||
getSymbolicLinkStatus "testDir"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "deleteDir, directory with null permissions, all fine" $ do
|
||||
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' "dirSym"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "deleteDir, wrong file type (regular file)" $
|
||||
deleteDir' "file"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "deleteDir, directory does not exist" $
|
||||
deleteDir' "doesNotExist"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "deleteDir, directory not empty" $
|
||||
deleteDir' "dir"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == UnsatisfiedConstraints)
|
||||
|
||||
it "deleteDir, can't open parent directory" $ do
|
||||
createDir' "noPerms/foo"
|
||||
noPerms "noPerms"
|
||||
(deleteDir' "noPerms/foo")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
normalDirPerms "noPerms"
|
||||
deleteDir' "noPerms/foo"
|
||||
|
||||
it "deleteDir, can't write to parent directory, still fine" $ do
|
||||
createDir' "noWritable/foo"
|
||||
noWritableDirPerms "noWritable"
|
||||
(deleteDir' "noWritable/foo")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
normalDirPerms "noWritable"
|
||||
deleteDir' "noWritable/foo"
|
||||
|
||||
|
||||
|
||||
84
hpath-io/test/HPath/IO/DeleteFileSpec.hs
Normal file
84
hpath-io/test/HPath/IO/DeleteFileSpec.hs
Normal file
@@ -0,0 +1,84 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module HPath.IO.DeleteFileSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HPath.IO
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import System.Posix.Files.ByteString
|
||||
(
|
||||
getSymbolicLinkStatus
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "DeleteFileSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "foo"
|
||||
createSymlink' "syml" "foo"
|
||||
createDir' "dir"
|
||||
createDir' "noPerms"
|
||||
noPerms "noPerms"
|
||||
|
||||
|
||||
cleanupFiles :: IO ()
|
||||
cleanupFiles = do
|
||||
normalDirPerms "noPerms"
|
||||
deleteFile' "foo"
|
||||
deleteFile' "syml"
|
||||
deleteDir' "dir"
|
||||
deleteDir' "noPerms"
|
||||
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.deleteFile" $ do
|
||||
|
||||
-- successes --
|
||||
it "deleteFile, regular file, all fine" $ do
|
||||
createRegularFile' "testFile"
|
||||
deleteFile' "testFile"
|
||||
getSymbolicLinkStatus "testFile"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "deleteFile, symlink, all fine" $ do
|
||||
recreateSymlink' "syml"
|
||||
"testFile"
|
||||
Strict
|
||||
deleteFile' "testFile"
|
||||
getSymbolicLinkStatus "testFile"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
-- posix failures --
|
||||
it "deleteFile, wrong file type (directory)" $
|
||||
deleteFile' "dir"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "deleteFile, file does not exist" $
|
||||
deleteFile' "doesNotExist"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "deleteFile, can't read directory" $
|
||||
deleteFile' "noPerms/blah"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
100
hpath-io/test/HPath/IO/GetDirsFilesSpec.hs
Normal file
100
hpath-io/test/HPath/IO/GetDirsFilesSpec.hs
Normal file
@@ -0,0 +1,100 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module HPath.IO.GetDirsFilesSpec where
|
||||
|
||||
|
||||
import Data.List
|
||||
(
|
||||
sort
|
||||
)
|
||||
import qualified HPath as P
|
||||
import HPath.IO
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "GetDirsFilesSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "file"
|
||||
createRegularFile' "Lala"
|
||||
createRegularFile' ".hidden"
|
||||
createSymlink' "syml" "Lala"
|
||||
createDir' "dir"
|
||||
createSymlink' "dirsym" "dir"
|
||||
createDir' "noPerms"
|
||||
noPerms "noPerms"
|
||||
|
||||
|
||||
cleanupFiles :: IO ()
|
||||
cleanupFiles = do
|
||||
normalDirPerms "noPerms"
|
||||
deleteFile' "file"
|
||||
deleteFile' "Lala"
|
||||
deleteFile' ".hidden"
|
||||
deleteFile' "syml"
|
||||
deleteDir' "dir"
|
||||
deleteFile' "dirsym"
|
||||
deleteDir' "noPerms"
|
||||
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.getDirsFiles" $ do
|
||||
|
||||
-- successes --
|
||||
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' "nothingHere"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "getDirsFiles, wrong file type (file)" $
|
||||
getDirsFiles' "file"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "getDirsFiles, wrong file type (symlink to file)" $
|
||||
getDirsFiles' "syml"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
it "getDirsFiles, wrong file type (symlink to dir)" $
|
||||
getDirsFiles' "dirsym"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
it "getDirsFiles, can't open directory" $
|
||||
getDirsFiles' "noPerms"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
|
||||
|
||||
|
||||
88
hpath-io/test/HPath/IO/GetFileTypeSpec.hs
Normal file
88
hpath-io/test/HPath/IO/GetFileTypeSpec.hs
Normal file
@@ -0,0 +1,88 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module HPath.IO.GetFileTypeSpec where
|
||||
|
||||
|
||||
import HPath.IO
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "GetFileTypeSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "regularfile"
|
||||
createSymlink' "symlink" "regularfile"
|
||||
createSymlink' "brokenSymlink" "broken"
|
||||
createDir' "directory"
|
||||
createSymlink' "symlinkD" "directory"
|
||||
createDir' "noPerms"
|
||||
noPerms "noPerms"
|
||||
|
||||
|
||||
cleanupFiles :: IO ()
|
||||
cleanupFiles = do
|
||||
normalDirPerms "noPerms"
|
||||
deleteFile' "regularfile"
|
||||
deleteFile' "symlink"
|
||||
deleteFile' "brokenSymlink"
|
||||
deleteDir' "directory"
|
||||
deleteFile' "symlinkD"
|
||||
deleteDir' "noPerms"
|
||||
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.getFileType" $ do
|
||||
|
||||
-- successes --
|
||||
it "getFileType, regular file" $
|
||||
getFileType' "regularfile"
|
||||
`shouldReturn` RegularFile
|
||||
|
||||
it "getFileType, directory" $
|
||||
getFileType' "directory"
|
||||
`shouldReturn` Directory
|
||||
|
||||
it "getFileType, directory with null permissions" $
|
||||
getFileType' "noPerms"
|
||||
`shouldReturn` Directory
|
||||
|
||||
it "getFileType, symlink to file" $
|
||||
getFileType' "symlink"
|
||||
`shouldReturn` SymbolicLink
|
||||
|
||||
it "getFileType, symlink to directory" $
|
||||
getFileType' "symlinkD"
|
||||
`shouldReturn` SymbolicLink
|
||||
|
||||
it "getFileType, broken symlink" $
|
||||
getFileType' "brokenSymlink"
|
||||
`shouldReturn` SymbolicLink
|
||||
|
||||
-- posix failures --
|
||||
it "getFileType, file does not exist" $
|
||||
getFileType' "nothingHere"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "getFileType, can't open directory" $
|
||||
getFileType' "noPerms/forz"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
126
hpath-io/test/HPath/IO/MoveFileOverwriteSpec.hs
Normal file
126
hpath-io/test/HPath/IO/MoveFileOverwriteSpec.hs
Normal file
@@ -0,0 +1,126 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module HPath.IO.MoveFileOverwriteSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HPath.IO
|
||||
import HPath.IO.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "MoveFileOverwriteSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "myFile"
|
||||
createSymlink' "myFileL" "myFile"
|
||||
createDir' "alreadyExistsD"
|
||||
createDir' "dir"
|
||||
createDir' "noPerms"
|
||||
createDir' "noWritePerm"
|
||||
noPerms "noPerms"
|
||||
noWritableDirPerms "noWritePerm"
|
||||
writeFile' "myFile" "Blahfaselgagaga"
|
||||
|
||||
|
||||
cleanupFiles :: IO ()
|
||||
cleanupFiles = do
|
||||
normalDirPerms "noPerms"
|
||||
normalDirPerms "noWritePerm"
|
||||
deleteFile' "myFile"
|
||||
deleteFile' "myFileL"
|
||||
deleteDir' "alreadyExistsD"
|
||||
deleteDir' "dir"
|
||||
deleteDir' "noPerms"
|
||||
deleteDir' "noWritePerm"
|
||||
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.moveFile" $ do
|
||||
|
||||
-- successes --
|
||||
it "moveFile (Overwrite), all fine" $
|
||||
moveFile' "myFile"
|
||||
"movedFile"
|
||||
Overwrite
|
||||
|
||||
it "moveFile (Overwrite), all fine" $
|
||||
moveFile' "myFile"
|
||||
"dir/movedFile"
|
||||
Overwrite
|
||||
|
||||
it "moveFile (Overwrite), all fine on symlink" $
|
||||
moveFile' "myFileL"
|
||||
"movedFile"
|
||||
Overwrite
|
||||
|
||||
it "moveFile (Overwrite), all fine on directory" $
|
||||
moveFile' "dir"
|
||||
"movedFile"
|
||||
Overwrite
|
||||
|
||||
it "moveFile (Overwrite), destination file already exists" $
|
||||
moveFile' "myFile"
|
||||
"alreadyExists"
|
||||
Overwrite
|
||||
|
||||
-- posix failures --
|
||||
it "moveFile (Overwrite), source file does not exist" $
|
||||
moveFile' "fileDoesNotExist"
|
||||
"movedFile"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "moveFile (Overwrite), can't write to destination directory" $
|
||||
moveFile' "myFile"
|
||||
"noWritePerm/movedFile"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "moveFile (Overwrite), can't open destination directory" $
|
||||
moveFile' "myFile"
|
||||
"noPerms/movedFile"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "moveFile (Overwrite), can't open source directory" $
|
||||
moveFile' "noPerms/myFile"
|
||||
"movedFile"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
-- custom failures --
|
||||
|
||||
it "moveFile (Overwrite), move from file to dir" $
|
||||
moveFile' "myFile"
|
||||
"alreadyExistsD"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "moveFile (Overwrite), source and dest are same file" $
|
||||
moveFile' "myFile"
|
||||
"myFile"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
129
hpath-io/test/HPath/IO/MoveFileSpec.hs
Normal file
129
hpath-io/test/HPath/IO/MoveFileSpec.hs
Normal file
@@ -0,0 +1,129 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module HPath.IO.MoveFileSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HPath.IO
|
||||
import HPath.IO.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "MoveFileSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
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"
|
||||
|
||||
|
||||
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 = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.moveFile" $ do
|
||||
|
||||
-- successes --
|
||||
it "moveFile (Strict), all fine" $
|
||||
moveFile' "myFile"
|
||||
"movedFile"
|
||||
Strict
|
||||
|
||||
it "moveFile (Strict), all fine" $
|
||||
moveFile' "myFile"
|
||||
"dir/movedFile"
|
||||
Strict
|
||||
|
||||
it "moveFile (Strict), all fine on symlink" $
|
||||
moveFile' "myFileL"
|
||||
"movedFile"
|
||||
Strict
|
||||
|
||||
it "moveFile (Strict), all fine on directory" $
|
||||
moveFile' "dir"
|
||||
"movedFile"
|
||||
Strict
|
||||
|
||||
-- posix failures --
|
||||
it "moveFile (Strict), source file does not exist" $
|
||||
moveFile' "fileDoesNotExist"
|
||||
"movedFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "moveFile (Strict), can't write to destination directory" $
|
||||
moveFile' "myFile"
|
||||
"noWritePerm/movedFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "moveFile (Strict), can't open destination directory" $
|
||||
moveFile' "myFile"
|
||||
"noPerms/movedFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "moveFile (Strict), can't open source directory" $
|
||||
moveFile' "noPerms/myFile"
|
||||
"movedFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
-- custom failures --
|
||||
it "moveFile (Strict), destination file already exists" $
|
||||
moveFile' "myFile"
|
||||
"alreadyExists"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "moveFile (Strict), move from file to dir" $
|
||||
moveFile' "myFile"
|
||||
"alreadyExistsD"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "moveFile (Strict), source and dest are same file" $
|
||||
moveFile' "myFile"
|
||||
"myFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
85
hpath-io/test/HPath/IO/ReadFileEOFSpec.hs
Normal file
85
hpath-io/test/HPath/IO/ReadFileEOFSpec.hs
Normal file
@@ -0,0 +1,85 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
|
||||
module HPath.IO.ReadFileEOFSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "ReadFileEOFSpec"
|
||||
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" "Blahfaselgagaga"
|
||||
|
||||
|
||||
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.readFileEOF" $ do
|
||||
|
||||
-- successes --
|
||||
it "readFileEOF (Strict) file with content, everything clear" $ do
|
||||
out <- readFileEOF' "fileWithContent"
|
||||
out `shouldBe` "Blahfaselgagaga"
|
||||
|
||||
it "readFileEOF (Strict) symlink, everything clear" $ do
|
||||
out <- readFileEOF' "inputFileSymL"
|
||||
out `shouldBe` "Blahfaselgagaga"
|
||||
|
||||
it "readFileEOF (Strict) empty file, everything clear" $ do
|
||||
out <- readFileEOF' "fileWithoutContent"
|
||||
out `shouldBe` ""
|
||||
|
||||
|
||||
-- posix failures --
|
||||
it "readFileEOF (Strict) directory, wrong file type" $ do
|
||||
readFileEOF' "alreadyExistsD"
|
||||
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "readFileEOF (Strict) file, no permissions" $ do
|
||||
readFileEOF' "noPerms"
|
||||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "readFileEOF (Strict) file, no permissions on dir" $ do
|
||||
readFileEOF' "noPermsD/inputFile"
|
||||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "readFileEOF (Strict) file, no such file" $ do
|
||||
readFileEOF' "lalala"
|
||||
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)
|
||||
85
hpath-io/test/HPath/IO/ReadFileSpec.hs
Normal file
85
hpath-io/test/HPath/IO/ReadFileSpec.hs
Normal file
@@ -0,0 +1,85 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
|
||||
module HPath.IO.ReadFileSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "ReadFileSpec"
|
||||
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" "Blahfaselgagaga"
|
||||
|
||||
|
||||
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.readFile" $ do
|
||||
|
||||
-- successes --
|
||||
it "readFile (Strict) file with content, everything clear" $ do
|
||||
out <- readFile' "fileWithContent"
|
||||
out `shouldBe` "Blahfaselgagaga"
|
||||
|
||||
it "readFile (Strict) symlink, everything clear" $ do
|
||||
out <- readFile' "inputFileSymL"
|
||||
out `shouldBe` "Blahfaselgagaga"
|
||||
|
||||
it "readFile (Strict) empty file, everything clear" $ do
|
||||
out <- readFile' "fileWithoutContent"
|
||||
out `shouldBe` ""
|
||||
|
||||
|
||||
-- posix failures --
|
||||
it "readFile (Strict) directory, wrong file type" $ do
|
||||
readFile' "alreadyExistsD"
|
||||
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "readFile (Strict) file, no permissions" $ do
|
||||
readFile' "noPerms"
|
||||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "readFile (Strict) file, no permissions on dir" $ do
|
||||
readFile' "noPermsD/inputFile"
|
||||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "readFile (Strict) file, no such file" $ do
|
||||
readFile' "lalala"
|
||||
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)
|
||||
139
hpath-io/test/HPath/IO/RecreateSymlinkOverwriteSpec.hs
Normal file
139
hpath-io/test/HPath/IO/RecreateSymlinkOverwriteSpec.hs
Normal file
@@ -0,0 +1,139 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module HPath.IO.RecreateSymlinkOverwriteSpec where
|
||||
|
||||
|
||||
-- TODO: exception if destination exists but is not a file + `OverWrite` CopyMode
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HPath.IO
|
||||
import HPath.IO.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "RecreateSymlinkOverwriteSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "myFile"
|
||||
createSymlink' "myFileL" "myFile"
|
||||
createRegularFile' "alreadyExists"
|
||||
createDir' "alreadyExistsD"
|
||||
createDir' "dir"
|
||||
createDir' "noPerms"
|
||||
createDir' "noWritePerm"
|
||||
createDir' "alreadyExistsD2"
|
||||
createRegularFile' "alreadyExistsD2/lala"
|
||||
noPerms "noPerms"
|
||||
noWritableDirPerms "noWritePerm"
|
||||
writeFile' "myFile" "Blahfaselgagaga"
|
||||
|
||||
|
||||
cleanupFiles :: IO ()
|
||||
cleanupFiles = do
|
||||
normalDirPerms "noPerms"
|
||||
normalDirPerms "noWritePerm"
|
||||
deleteFile' "myFile"
|
||||
deleteFile' "myFileL"
|
||||
deleteFile' "alreadyExists"
|
||||
deleteFile' "alreadyExistsD2/lala"
|
||||
deleteDir' "alreadyExistsD"
|
||||
deleteDir' "alreadyExistsD2"
|
||||
deleteDir' "dir"
|
||||
deleteDir' "noPerms"
|
||||
deleteDir' "noWritePerm"
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.recreateSymlink" $ do
|
||||
|
||||
-- successes --
|
||||
it "recreateSymLink (Overwrite), all fine" $ do
|
||||
recreateSymlink' "myFileL"
|
||||
"movedFile"
|
||||
Overwrite
|
||||
removeFileIfExists "movedFile"
|
||||
|
||||
it "recreateSymLink (Overwrite), all fine" $ do
|
||||
recreateSymlink' "myFileL"
|
||||
"dir/movedFile"
|
||||
Overwrite
|
||||
removeFileIfExists "dir/movedFile"
|
||||
|
||||
it "recreateSymLink (Overwrite), destination file already exists" $
|
||||
recreateSymlink' "myFileL"
|
||||
"alreadyExists"
|
||||
Overwrite
|
||||
|
||||
it "recreateSymLink (Overwrite), destination already exists and is an empty dir" $ do
|
||||
recreateSymlink' "myFileL"
|
||||
"alreadyExistsD"
|
||||
Overwrite
|
||||
deleteFile' "alreadyExistsD"
|
||||
createDir' "alreadyExistsD"
|
||||
|
||||
-- posix failures --
|
||||
it "recreateSymLink (Overwrite), destination already exists and is a non-empty dir" $
|
||||
recreateSymlink' "myFileL"
|
||||
"alreadyExistsD2"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == UnsatisfiedConstraints)
|
||||
|
||||
it "recreateSymLink (Overwrite), wrong input type (file)" $
|
||||
recreateSymlink' "myFile"
|
||||
"movedFile"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
it "recreateSymLink (Overwrite), wrong input type (directory)" $
|
||||
recreateSymlink' "dir"
|
||||
"movedFile"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
it "recreateSymLink (Overwrite), can't write to destination directory" $
|
||||
recreateSymlink' "myFileL"
|
||||
"noWritePerm/movedFile"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "recreateSymLink (Overwrite), can't open destination directory" $
|
||||
recreateSymlink' "myFileL"
|
||||
"noPerms/movedFile"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "recreateSymLink (Overwrite), can't open source directory" $
|
||||
recreateSymlink' "noPerms/myFileL"
|
||||
"movedFile"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
-- custom failures --
|
||||
it "recreateSymLink (Overwrite), source and destination are the same file" $
|
||||
recreateSymlink' "myFileL"
|
||||
"myFileL"
|
||||
Overwrite
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
|
||||
130
hpath-io/test/HPath/IO/RecreateSymlinkSpec.hs
Normal file
130
hpath-io/test/HPath/IO/RecreateSymlinkSpec.hs
Normal file
@@ -0,0 +1,130 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module HPath.IO.RecreateSymlinkSpec where
|
||||
|
||||
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HPath.IO
|
||||
import HPath.IO.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "RecreateSymlinkSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
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"
|
||||
|
||||
|
||||
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 = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.recreateSymlink" $ do
|
||||
|
||||
-- successes --
|
||||
it "recreateSymLink (Strict), all fine" $ do
|
||||
recreateSymlink' "myFileL"
|
||||
"movedFile"
|
||||
Strict
|
||||
removeFileIfExists "movedFile"
|
||||
|
||||
it "recreateSymLink (Strict), all fine" $ do
|
||||
recreateSymlink' "myFileL"
|
||||
"dir/movedFile"
|
||||
Strict
|
||||
removeFileIfExists "dir/movedFile"
|
||||
|
||||
-- posix failures --
|
||||
it "recreateSymLink (Strict), wrong input type (file)" $
|
||||
recreateSymlink' "myFile"
|
||||
"movedFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
it "recreateSymLink (Strict), wrong input type (directory)" $
|
||||
recreateSymlink' "dir"
|
||||
"movedFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
it "recreateSymLink (Strict), can't write to destination directory" $
|
||||
recreateSymlink' "myFileL"
|
||||
"noWritePerm/movedFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "recreateSymLink (Strict), can't open destination directory" $
|
||||
recreateSymlink' "myFileL"
|
||||
"noPerms/movedFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "recreateSymLink (Strict), can't open source directory" $
|
||||
recreateSymlink' "noPerms/myFileL"
|
||||
"movedFile"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "recreateSymLink (Strict), destination file already exists" $
|
||||
recreateSymlink' "myFileL"
|
||||
"alreadyExists"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "recreateSymLink (Strict), destination already exists and is a dir" $
|
||||
recreateSymlink' "myFileL"
|
||||
"alreadyExistsD"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
-- custom failures --
|
||||
it "recreateSymLink (Strict), source and destination are the same file" $
|
||||
recreateSymlink' "myFileL"
|
||||
"myFileL"
|
||||
Strict
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
|
||||
117
hpath-io/test/HPath/IO/RenameFileSpec.hs
Normal file
117
hpath-io/test/HPath/IO/RenameFileSpec.hs
Normal file
@@ -0,0 +1,117 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module HPath.IO.RenameFileSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HPath.IO.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "RenameFileSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
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"
|
||||
|
||||
|
||||
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 = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
|
||||
describe "HPath.IO.renameFile" $ do
|
||||
|
||||
-- successes --
|
||||
it "renameFile, all fine" $
|
||||
renameFile' "myFile"
|
||||
"renamedFile"
|
||||
|
||||
it "renameFile, all fine" $
|
||||
renameFile' "myFile"
|
||||
"dir/renamedFile"
|
||||
|
||||
it "renameFile, all fine on symlink" $
|
||||
renameFile' "myFileL"
|
||||
"renamedFile"
|
||||
|
||||
it "renameFile, all fine on directory" $
|
||||
renameFile' "dir"
|
||||
"renamedFile"
|
||||
|
||||
-- posix failures --
|
||||
it "renameFile, source file does not exist" $
|
||||
renameFile' "fileDoesNotExist"
|
||||
"renamedFile"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "renameFile, can't write to output directory" $
|
||||
renameFile' "myFile"
|
||||
"noWritePerm/renamedFile"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "renameFile, can't open output directory" $
|
||||
renameFile' "myFile"
|
||||
"noPerms/renamedFile"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "renameFile, can't open source directory" $
|
||||
renameFile' "noPerms/myFile"
|
||||
"renamedFile"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
-- custom failures --
|
||||
it "renameFile, destination file already exists" $
|
||||
renameFile' "myFile"
|
||||
"alreadyExists"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "renameFile, move from file to dir" $
|
||||
renameFile' "myFile"
|
||||
"alreadyExistsD"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "renameFile, source and dest are same file" $
|
||||
renameFile' "myFile"
|
||||
"myFile"
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
|
||||
27
hpath-io/test/HPath/IO/ToAbsSpec.hs
Normal file
27
hpath-io/test/HPath/IO/ToAbsSpec.hs
Normal file
@@ -0,0 +1,27 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
|
||||
module HPath.IO.ToAbsSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HPath
|
||||
import HPath.IO
|
||||
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "HPath.IO.toAbs" $ do
|
||||
|
||||
-- successes --
|
||||
it "toAbs returns absolute paths unchanged" $ do
|
||||
p1 <- parseAbs "/a/b/c/d"
|
||||
to <- toAbs p1
|
||||
p1 `shouldBe` to
|
||||
|
||||
it "toAbs returns even existing absolute paths unchanged" $ do
|
||||
p1 <- parseAbs "/home"
|
||||
to <- toAbs p1
|
||||
p1 `shouldBe` to
|
||||
|
||||
|
||||
108
hpath-io/test/HPath/IO/WriteFileSpec.hs
Normal file
108
hpath-io/test/HPath/IO/WriteFileSpec.hs
Normal file
@@ -0,0 +1,108 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
|
||||
module HPath.IO.WriteFileSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
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)
|
||||
24
hpath-io/test/Main.hs
Normal file
24
hpath-io/test/Main.hs
Normal file
@@ -0,0 +1,24 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.IORef
|
||||
import Test.Hspec
|
||||
import Test.Hspec.Runner
|
||||
import Test.Hspec.Formatters
|
||||
import qualified Spec
|
||||
import Utils
|
||||
import System.Posix.Temp.ByteString (mkdtemp)
|
||||
|
||||
|
||||
-- TODO: chardev, blockdev, namedpipe, socket
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
tmpBase <- mkdtemp "/tmp/"
|
||||
writeIORef baseTmpDir (Just (tmpBase `BS.append` "/"))
|
||||
putStrLn $ ("Temporary test directory at: " <> show tmpBase)
|
||||
hspecWith
|
||||
defaultConfig { configFormatter = Just progress }
|
||||
$ afterAll_ deleteBaseTmpDir
|
||||
$ Spec.spec
|
||||
2
hpath-io/test/Spec.hs
Normal file
2
hpath-io/test/Spec.hs
Normal file
@@ -0,0 +1,2 @@
|
||||
-- file test/Spec.hs
|
||||
{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}
|
||||
290
hpath-io/test/Utils.hs
Normal file
290
hpath-io/test/Utils.hs
Normal file
@@ -0,0 +1,290 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
|
||||
|
||||
module Utils where
|
||||
|
||||
|
||||
import Control.Applicative
|
||||
(
|
||||
(<$>)
|
||||
)
|
||||
import Control.Monad
|
||||
(
|
||||
forM_
|
||||
, void
|
||||
)
|
||||
import Control.Monad.IfElse
|
||||
(
|
||||
whenM
|
||||
)
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.IORef
|
||||
(
|
||||
newIORef
|
||||
, readIORef
|
||||
, writeIORef
|
||||
, IORef
|
||||
)
|
||||
import HPath.IO
|
||||
import HPath.IO.Errors
|
||||
import Prelude hiding (appendFile, readFile, writeFile)
|
||||
import Data.Maybe
|
||||
(
|
||||
fromJust
|
||||
)
|
||||
import qualified HPath as P
|
||||
import System.IO.Unsafe
|
||||
(
|
||||
unsafePerformIO
|
||||
)
|
||||
import qualified System.Posix.Directory.Traversals as DT
|
||||
import Data.ByteString
|
||||
(
|
||||
ByteString
|
||||
)
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import System.Posix.Files.ByteString
|
||||
(
|
||||
groupExecuteMode
|
||||
, groupReadMode
|
||||
, nullFileMode
|
||||
, otherExecuteMode
|
||||
, otherReadMode
|
||||
, ownerExecuteMode
|
||||
, ownerReadMode
|
||||
, setFileMode
|
||||
, unionFileModes
|
||||
)
|
||||
|
||||
baseTmpDir :: IORef (Maybe ByteString)
|
||||
{-# NOINLINE baseTmpDir #-}
|
||||
baseTmpDir = unsafePerformIO (newIORef Nothing)
|
||||
|
||||
|
||||
tmpDir :: IORef (Maybe ByteString)
|
||||
{-# NOINLINE tmpDir #-}
|
||||
tmpDir = unsafePerformIO (newIORef Nothing)
|
||||
|
||||
|
||||
|
||||
-----------------
|
||||
--[ Utilities ]--
|
||||
-----------------
|
||||
|
||||
|
||||
setTmpDir :: ByteString -> IO ()
|
||||
{-# NOINLINE setTmpDir #-}
|
||||
setTmpDir bs = do
|
||||
tmp <- fromJust <$> readIORef baseTmpDir
|
||||
writeIORef tmpDir (Just (tmp `BS.append` bs))
|
||||
|
||||
|
||||
createTmpDir :: IO ()
|
||||
{-# NOINLINE createTmpDir #-}
|
||||
createTmpDir = do
|
||||
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)
|
||||
void $ createDir newDirPerms tmp
|
||||
|
||||
|
||||
deleteTmpDir :: IO ()
|
||||
{-# NOINLINE deleteTmpDir #-}
|
||||
deleteTmpDir = do
|
||||
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)
|
||||
void $ deleteDir tmp
|
||||
|
||||
|
||||
deleteBaseTmpDir :: IO ()
|
||||
{-# NOINLINE deleteBaseTmpDir #-}
|
||||
deleteBaseTmpDir = do
|
||||
tmp <- (fromJust <$> readIORef baseTmpDir) >>= P.parseAbs
|
||||
contents <- getDirsFiles tmp
|
||||
forM_ contents deleteDir
|
||||
void $ deleteDir tmp
|
||||
|
||||
|
||||
withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a
|
||||
{-# NOINLINE withRawTmpDir #-}
|
||||
withRawTmpDir f = do
|
||||
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)
|
||||
f tmp
|
||||
|
||||
|
||||
getRawTmpDir :: IO ByteString
|
||||
{-# NOINLINE getRawTmpDir #-}
|
||||
getRawTmpDir = withRawTmpDir (return . flip BS.append "/" . P.fromAbs)
|
||||
|
||||
|
||||
withTmpDir :: ByteString -> (P.Path P.Abs -> IO a) -> IO a
|
||||
{-# NOINLINE withTmpDir #-}
|
||||
withTmpDir ip f = do
|
||||
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)
|
||||
p <- (tmp P.</>) <$> P.parseRel ip
|
||||
f p
|
||||
|
||||
|
||||
withTmpDir' :: ByteString
|
||||
-> ByteString
|
||||
-> (P.Path P.Abs -> P.Path P.Abs -> IO a)
|
||||
-> IO a
|
||||
{-# NOINLINE withTmpDir' #-}
|
||||
withTmpDir' ip1 ip2 f = do
|
||||
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)
|
||||
p1 <- (tmp P.</>) <$> P.parseRel ip1
|
||||
p2 <- (tmp P.</>) <$> P.parseRel ip2
|
||||
f p1 p2
|
||||
|
||||
|
||||
removeFileIfExists :: ByteString -> IO ()
|
||||
{-# NOINLINE removeFileIfExists #-}
|
||||
removeFileIfExists bs =
|
||||
withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p)
|
||||
|
||||
|
||||
removeDirIfExists :: ByteString -> IO ()
|
||||
{-# NOINLINE removeDirIfExists #-}
|
||||
removeDirIfExists bs =
|
||||
withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p)
|
||||
|
||||
|
||||
copyFile' :: ByteString -> ByteString -> CopyMode -> IO ()
|
||||
{-# NOINLINE copyFile' #-}
|
||||
copyFile' inputFileP outputFileP cm =
|
||||
withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm)
|
||||
|
||||
|
||||
copyDirRecursive' :: ByteString -> ByteString
|
||||
-> CopyMode -> RecursiveErrorMode -> IO ()
|
||||
{-# NOINLINE copyDirRecursive' #-}
|
||||
copyDirRecursive' inputDirP outputDirP cm rm =
|
||||
withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm)
|
||||
|
||||
|
||||
createDir' :: ByteString -> IO ()
|
||||
{-# NOINLINE createDir' #-}
|
||||
createDir' dest = withTmpDir dest (createDir newDirPerms)
|
||||
|
||||
createDirRecursive' :: ByteString -> IO ()
|
||||
{-# NOINLINE createDirRecursive' #-}
|
||||
createDirRecursive' dest = withTmpDir dest (createDirRecursive newDirPerms)
|
||||
|
||||
createRegularFile' :: ByteString -> IO ()
|
||||
{-# NOINLINE createRegularFile' #-}
|
||||
createRegularFile' dest = withTmpDir dest (createRegularFile newFilePerms)
|
||||
|
||||
|
||||
createSymlink' :: ByteString -> ByteString -> IO ()
|
||||
{-# NOINLINE createSymlink' #-}
|
||||
createSymlink' dest sympoint = withTmpDir dest
|
||||
(\x -> createSymlink x sympoint)
|
||||
|
||||
|
||||
renameFile' :: ByteString -> ByteString -> IO ()
|
||||
{-# NOINLINE renameFile' #-}
|
||||
renameFile' inputFileP outputFileP =
|
||||
withTmpDir' inputFileP outputFileP $ \i o -> do
|
||||
renameFile i o
|
||||
renameFile o i
|
||||
|
||||
|
||||
moveFile' :: ByteString -> ByteString -> CopyMode -> IO ()
|
||||
{-# NOINLINE moveFile' #-}
|
||||
moveFile' inputFileP outputFileP cm =
|
||||
withTmpDir' inputFileP outputFileP $ \i o -> do
|
||||
moveFile i o cm
|
||||
moveFile o i Strict
|
||||
|
||||
|
||||
recreateSymlink' :: ByteString -> ByteString -> CopyMode -> IO ()
|
||||
{-# NOINLINE recreateSymlink' #-}
|
||||
recreateSymlink' inputFileP outputFileP cm =
|
||||
withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm)
|
||||
|
||||
|
||||
noWritableDirPerms :: ByteString -> IO ()
|
||||
{-# NOINLINE noWritableDirPerms #-}
|
||||
noWritableDirPerms path = withTmpDir path $ \p ->
|
||||
setFileMode (P.fromAbs p) perms
|
||||
where
|
||||
perms = ownerReadMode
|
||||
`unionFileModes` ownerExecuteMode
|
||||
`unionFileModes` groupReadMode
|
||||
`unionFileModes` groupExecuteMode
|
||||
`unionFileModes` otherReadMode
|
||||
`unionFileModes` otherExecuteMode
|
||||
|
||||
|
||||
noPerms :: ByteString -> IO ()
|
||||
{-# NOINLINE noPerms #-}
|
||||
noPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) nullFileMode
|
||||
|
||||
|
||||
normalDirPerms :: ByteString -> IO ()
|
||||
{-# NOINLINE normalDirPerms #-}
|
||||
normalDirPerms path =
|
||||
withTmpDir path $ \p -> setFileMode (P.fromAbs p) newDirPerms
|
||||
|
||||
|
||||
normalFilePerms :: ByteString -> IO ()
|
||||
{-# NOINLINE normalFilePerms #-}
|
||||
normalFilePerms path =
|
||||
withTmpDir path $ \p -> setFileMode (P.fromAbs p) newFilePerms
|
||||
|
||||
|
||||
getFileType' :: ByteString -> IO FileType
|
||||
{-# NOINLINE getFileType' #-}
|
||||
getFileType' path = withTmpDir path getFileType
|
||||
|
||||
|
||||
getDirsFiles' :: ByteString -> IO [P.Path P.Abs]
|
||||
{-# NOINLINE getDirsFiles' #-}
|
||||
getDirsFiles' path = withTmpDir path getDirsFiles
|
||||
|
||||
|
||||
deleteFile' :: ByteString -> IO ()
|
||||
{-# NOINLINE deleteFile' #-}
|
||||
deleteFile' p = withTmpDir p deleteFile
|
||||
|
||||
|
||||
deleteDir' :: ByteString -> IO ()
|
||||
{-# NOINLINE deleteDir' #-}
|
||||
deleteDir' p = withTmpDir p deleteDir
|
||||
|
||||
|
||||
deleteDirRecursive' :: ByteString -> IO ()
|
||||
{-# NOINLINE deleteDirRecursive' #-}
|
||||
deleteDirRecursive' p = withTmpDir p deleteDirRecursive
|
||||
|
||||
|
||||
canonicalizePath' :: ByteString -> IO (P.Path P.Abs)
|
||||
{-# NOINLINE canonicalizePath' #-}
|
||||
canonicalizePath' p = withTmpDir p canonicalizePath
|
||||
|
||||
|
||||
writeFile' :: ByteString -> ByteString -> IO ()
|
||||
{-# NOINLINE writeFile' #-}
|
||||
writeFile' ip bs =
|
||||
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]
|
||||
{-# NOINLINE allDirectoryContents' #-}
|
||||
allDirectoryContents' ip =
|
||||
withTmpDir ip $ \p -> DT.allDirectoryContents' (P.fromAbs p)
|
||||
|
||||
|
||||
readFile' :: ByteString -> IO ByteString
|
||||
{-# NOINLINE readFile' #-}
|
||||
readFile' p = withTmpDir p readFile
|
||||
|
||||
|
||||
readFileEOF' :: ByteString -> IO L.ByteString
|
||||
{-# NOINLINE readFileEOF' #-}
|
||||
readFileEOF' p = withTmpDir p readFileEOF
|
||||
|
||||
Reference in New Issue
Block a user