TESTS: general refactoring
This commit is contained in:
parent
37773383af
commit
e56c345156
14
hsfm.cabal
14
hsfm.cabal
@ -118,6 +118,20 @@ Test-Suite spec
|
|||||||
Default-Language: Haskell2010
|
Default-Language: Haskell2010
|
||||||
Hs-Source-Dirs: test
|
Hs-Source-Dirs: test
|
||||||
Main-Is: Spec.hs
|
Main-Is: Spec.hs
|
||||||
|
other-modules:
|
||||||
|
CopyDirRecursiveSpec
|
||||||
|
CopyFileSpec
|
||||||
|
CreateDirSpec
|
||||||
|
CreateRegularFileSpec
|
||||||
|
DeleteDirRecursiveSpec
|
||||||
|
DeleteDirSpec
|
||||||
|
DeleteFileSpec
|
||||||
|
GetDirsFilesSpec
|
||||||
|
GetFileTypeSpec
|
||||||
|
MoveFileSpec
|
||||||
|
RecreateSymlinkSpec
|
||||||
|
RenameFileSpec
|
||||||
|
Utils
|
||||||
GHC-Options: -Wall
|
GHC-Options: -Wall
|
||||||
Build-Depends: base
|
Build-Depends: base
|
||||||
, HUnit
|
, HUnit
|
||||||
|
102
test/CopyDirRecursiveSpec.hs
Normal file
102
test/CopyDirRecursiveSpec.hs
Normal file
@ -0,0 +1,102 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module CopyDirRecursiveSpec where
|
||||||
|
|
||||||
|
|
||||||
|
import Test.Hspec
|
||||||
|
import HSFM.FileSystem.Errors
|
||||||
|
import System.IO.Error
|
||||||
|
(
|
||||||
|
ioeGetErrorType
|
||||||
|
)
|
||||||
|
import GHC.IO.Exception
|
||||||
|
(
|
||||||
|
IOErrorType(..)
|
||||||
|
)
|
||||||
|
import System.Exit
|
||||||
|
import System.Process
|
||||||
|
import Utils
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
copyDirRecursiveSpec :: Spec
|
||||||
|
copyDirRecursiveSpec =
|
||||||
|
describe "HSFM.FileSystem.FileOperations.copyDirRecursive" $ do
|
||||||
|
|
||||||
|
-- successes --
|
||||||
|
it "copyDirRecursive, all fine" $ do
|
||||||
|
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
|
||||||
|
"test/copyDirRecursiveSpec/outputDir"
|
||||||
|
removeDirIfExists "test/copyDirRecursiveSpec/outputDir"
|
||||||
|
|
||||||
|
it "copyDirRecursive, all fine and compare" $ do
|
||||||
|
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
|
||||||
|
"test/copyDirRecursiveSpec/outputDir"
|
||||||
|
(system $ "diff -r --no-dereference "
|
||||||
|
++ "test/copyDirRecursiveSpec/inputDir" ++ " "
|
||||||
|
++ "test/copyDirRecursiveSpec/outputDir")
|
||||||
|
`shouldReturn` ExitSuccess
|
||||||
|
removeDirIfExists "test/copyDirRecursiveSpec/outputDir"
|
||||||
|
|
||||||
|
-- posix failures --
|
||||||
|
it "copyDirRecursive, source directory does not exist" $
|
||||||
|
copyDirRecursive' "test/copyDirRecursiveSpec/doesNotExist"
|
||||||
|
"test/copyDirRecursiveSpec/outputDir"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||||
|
|
||||||
|
it "copyDirRecursive, no write permission on output dir" $
|
||||||
|
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
|
||||||
|
"test/copyDirRecursiveSpec/noWritePerm/foo"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "copyDirRecursive, cannot open output dir" $
|
||||||
|
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
|
||||||
|
"test/copyDirRecursiveSpec/noPerms/foo"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "copyDirRecursive, cannot open source dir" $
|
||||||
|
copyDirRecursive' "test/copyDirRecursiveSpec/noPerms/inputDir"
|
||||||
|
"test/copyDirRecursiveSpec/foo"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "copyDirRecursive, destination dir already exists" $
|
||||||
|
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
|
||||||
|
"test/copyDirRecursiveSpec/alreadyExistsD"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||||
|
|
||||||
|
it "copyDirRecursive, destination already exists and is a file" $
|
||||||
|
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
|
||||||
|
"test/copyDirRecursiveSpec/alreadyExists"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||||
|
|
||||||
|
it "copyDirRecursive, destination and source same directory" $
|
||||||
|
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
|
||||||
|
"test/copyDirRecursiveSpec/inputDir"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||||
|
|
||||||
|
it "copyDirRecursive, wrong input (regular file)" $
|
||||||
|
copyDirRecursive' "test/copyDirRecursiveSpec/wrongInput"
|
||||||
|
"test/copyDirRecursiveSpec/outputDir"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == InappropriateType)
|
||||||
|
|
||||||
|
it "copyDirRecursive, wrong input (symlink to directory)" $
|
||||||
|
copyDirRecursive' "test/copyDirRecursiveSpec/wrongInputSymL"
|
||||||
|
"test/copyDirRecursiveSpec/outputDir"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||||
|
|
||||||
|
-- custom failures
|
||||||
|
it "copyDirRecursive, destination in source" $
|
||||||
|
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
|
||||||
|
"test/copyDirRecursiveSpec/inputDir/foo"
|
||||||
|
`shouldThrow`
|
||||||
|
isDestinationInSource
|
||||||
|
|
93
test/CopyFileSpec.hs
Normal file
93
test/CopyFileSpec.hs
Normal file
@ -0,0 +1,93 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module CopyFileSpec where
|
||||||
|
|
||||||
|
|
||||||
|
import Test.Hspec
|
||||||
|
import System.IO.Error
|
||||||
|
(
|
||||||
|
ioeGetErrorType
|
||||||
|
)
|
||||||
|
import GHC.IO.Exception
|
||||||
|
(
|
||||||
|
IOErrorType(..)
|
||||||
|
)
|
||||||
|
import System.Exit
|
||||||
|
import System.Process
|
||||||
|
import Utils
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
copyFileSpec :: Spec
|
||||||
|
copyFileSpec =
|
||||||
|
describe "HSFM.FileSystem.FileOperations.copyFile" $ do
|
||||||
|
|
||||||
|
-- successes --
|
||||||
|
it "copyFile, everything clear" $ do
|
||||||
|
copyFile' "test/copyFileSpec/inputFile"
|
||||||
|
"test/copyFileSpec/outputFile"
|
||||||
|
removeFileIfExists "test/copyFileSpec/outputFile"
|
||||||
|
|
||||||
|
it "copyFile, and compare" $ do
|
||||||
|
copyFile' "test/copyFileSpec/inputFile"
|
||||||
|
"test/copyFileSpec/outputFile"
|
||||||
|
(system $ "cmp -s " ++ "test/copyFileSpec/inputFile" ++ " "
|
||||||
|
++ "test/copyFileSpec/outputFile")
|
||||||
|
`shouldReturn` ExitSuccess
|
||||||
|
removeFileIfExists "test/copyFileSpec/outputFile"
|
||||||
|
|
||||||
|
-- posix failures --
|
||||||
|
it "copyFile, input file does not exist" $
|
||||||
|
copyFile' "test/copyFileSpec/noSuchFile"
|
||||||
|
"test/copyFileSpec/outputFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||||
|
|
||||||
|
it "copyFile, no permission to write to output directory" $
|
||||||
|
copyFile' "test/copyFileSpec/inputFile"
|
||||||
|
"test/copyFileSpec/outputDirNoWrite/outputFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "copyFile, cannot open output directory" $
|
||||||
|
copyFile' "test/copyFileSpec/inputFile"
|
||||||
|
"test/copyFileSpec/noPerms/outputFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "copyFile, cannot open source directory" $
|
||||||
|
copyFile' "test/copyFileSpec/noPerms/inputFile"
|
||||||
|
"test/copyFileSpec/outputFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "copyFile, wrong input type (symlink)" $
|
||||||
|
copyFile' "test/copyFileSpec/inputFileSymL"
|
||||||
|
"test/copyFileSpec/outputFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||||
|
|
||||||
|
it "copyFile, wrong input type (directory)" $
|
||||||
|
copyFile' "test/copyFileSpec/wrongInput"
|
||||||
|
"test/copyFileSpec/outputFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == InappropriateType)
|
||||||
|
|
||||||
|
it "copyFile, output and input are same file" $
|
||||||
|
copyFile' "test/copyFileSpec/inputFile"
|
||||||
|
"test/copyFileSpec/inputFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||||
|
|
||||||
|
it "copyFile, output file already exists" $
|
||||||
|
copyFile' "test/copyFileSpec/inputFile"
|
||||||
|
"test/copyFileSpec/alreadyExists"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||||
|
|
||||||
|
it "copyFile, output file already exists and is a dir" $
|
||||||
|
copyFile' "test/copyFileSpec/inputFile"
|
||||||
|
"test/copyFileSpec/alreadyExistsD"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||||
|
|
43
test/CreateDirSpec.hs
Normal file
43
test/CreateDirSpec.hs
Normal file
@ -0,0 +1,43 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module CreateDirSpec where
|
||||||
|
|
||||||
|
|
||||||
|
import Test.Hspec
|
||||||
|
import System.IO.Error
|
||||||
|
(
|
||||||
|
ioeGetErrorType
|
||||||
|
)
|
||||||
|
import GHC.IO.Exception
|
||||||
|
(
|
||||||
|
IOErrorType(..)
|
||||||
|
)
|
||||||
|
import Utils
|
||||||
|
|
||||||
|
|
||||||
|
createDirSpec :: Spec
|
||||||
|
createDirSpec =
|
||||||
|
describe "HSFM.FileSystem.FileOperations.createDir" $ do
|
||||||
|
|
||||||
|
-- successes --
|
||||||
|
it "createDir, all fine" $ do
|
||||||
|
createDir' "test/createDirSpec/newDir"
|
||||||
|
removeDirIfExists "test/createDirSpec/newDir"
|
||||||
|
|
||||||
|
-- posix failures --
|
||||||
|
it "createDir, can't write to output directory" $
|
||||||
|
createDir' "test/createDirSpec/noWritePerms/newDir"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "createDir, can't open output directory" $
|
||||||
|
createDir' "test/createDirSpec/noPerms/newDir"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "createDir, destination directory already exists" $
|
||||||
|
createDir' "test/createDirSpec/alreadyExists"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||||
|
|
||||||
|
|
42
test/CreateRegularFileSpec.hs
Normal file
42
test/CreateRegularFileSpec.hs
Normal file
@ -0,0 +1,42 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module CreateRegularFileSpec where
|
||||||
|
|
||||||
|
|
||||||
|
import Test.Hspec
|
||||||
|
import System.IO.Error
|
||||||
|
(
|
||||||
|
ioeGetErrorType
|
||||||
|
)
|
||||||
|
import GHC.IO.Exception
|
||||||
|
(
|
||||||
|
IOErrorType(..)
|
||||||
|
)
|
||||||
|
import Utils
|
||||||
|
|
||||||
|
|
||||||
|
createRegularFileSpec :: Spec
|
||||||
|
createRegularFileSpec =
|
||||||
|
describe "HSFM.FileSystem.FileOperations.createRegularFile" $ do
|
||||||
|
|
||||||
|
-- successes --
|
||||||
|
it "createRegularFile, all fine" $ do
|
||||||
|
createRegularFile' "test/createRegularFileSpec/newDir"
|
||||||
|
removeFileIfExists "test/createRegularFileSpec/newDir"
|
||||||
|
|
||||||
|
-- posix failures --
|
||||||
|
it "createRegularFile, can't write to destination directory" $
|
||||||
|
createRegularFile' "test/createRegularFileSpec/noWritePerms/newDir"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "createRegularFile, can't write to destination directory" $
|
||||||
|
createRegularFile' "test/createRegularFileSpec/noPerms/newDir"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "createRegularFile, destination file already exists" $
|
||||||
|
createRegularFile' "test/createRegularFileSpec/alreadyExists"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||||
|
|
85
test/DeleteDirRecursiveSpec.hs
Normal file
85
test/DeleteDirRecursiveSpec.hs
Normal file
@ -0,0 +1,85 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module DeleteDirRecursiveSpec where
|
||||||
|
|
||||||
|
|
||||||
|
import Test.Hspec
|
||||||
|
import System.IO.Error
|
||||||
|
(
|
||||||
|
ioeGetErrorType
|
||||||
|
)
|
||||||
|
import System.Posix.Files.ByteString
|
||||||
|
(
|
||||||
|
getSymbolicLinkStatus
|
||||||
|
)
|
||||||
|
import GHC.IO.Exception
|
||||||
|
(
|
||||||
|
IOErrorType(..)
|
||||||
|
)
|
||||||
|
import Utils
|
||||||
|
|
||||||
|
|
||||||
|
deleteDirRecursiveSpec :: Spec
|
||||||
|
deleteDirRecursiveSpec =
|
||||||
|
describe "HSFM.FileSystem.FileOperations.deleteDirRecursive" $ do
|
||||||
|
|
||||||
|
-- successes --
|
||||||
|
it "deleteDirRecursive, empty directory, all fine" $ do
|
||||||
|
createDir' "test/deleteDirRecursiveSpec/testDir"
|
||||||
|
deleteDirRecursive' "test/deleteDirRecursiveSpec/testDir"
|
||||||
|
getSymbolicLinkStatus "test/deleteDirRecursiveSpec/testDir"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||||
|
|
||||||
|
it "deleteDirRecursive, empty directory with null permissions, all fine" $ do
|
||||||
|
createDir' "test/deleteDirRecursiveSpec/noPerms/testDir"
|
||||||
|
noPerms "test/deleteDirRecursiveSpec/noPerms/testDir"
|
||||||
|
deleteDirRecursive' "test/deleteDirRecursiveSpec/noPerms/testDir"
|
||||||
|
|
||||||
|
it "deleteDirRecursive, non-empty directory, all fine" $ do
|
||||||
|
createDir' "test/deleteDirRecursiveSpec/nonEmpty"
|
||||||
|
createDir' "test/deleteDirRecursiveSpec/nonEmpty/dir1"
|
||||||
|
createDir' "test/deleteDirRecursiveSpec/nonEmpty/dir2"
|
||||||
|
createDir' "test/deleteDirRecursiveSpec/nonEmpty/dir2/dir3"
|
||||||
|
createRegularFile' "test/deleteDirRecursiveSpec/nonEmpty/file1"
|
||||||
|
createRegularFile' "test/deleteDirRecursiveSpec/nonEmpty/dir1/file2"
|
||||||
|
deleteDirRecursive' "test/deleteDirRecursiveSpec/nonEmpty"
|
||||||
|
getSymbolicLinkStatus "test/deleteDirRecursiveSpec/nonEmpty"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||||
|
|
||||||
|
-- posix failures --
|
||||||
|
it "deleteDirRecursive, can't open parent directory" $ do
|
||||||
|
createDir' "test/deleteDirRecursiveSpec/noPerms/foo"
|
||||||
|
noPerms "test/deleteDirRecursiveSpec/noPerms"
|
||||||
|
(deleteDirRecursive' "test/deleteDirRecursiveSpec/noPerms/foo"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied))
|
||||||
|
>> normalDirPerms "test/deleteDirRecursiveSpec/noPerms"
|
||||||
|
>> deleteDir' "test/deleteDirRecursiveSpec/noPerms/foo"
|
||||||
|
|
||||||
|
it "deleteDirRecursive, can't write to parent directory" $ do
|
||||||
|
createDir' "test/deleteDirRecursiveSpec/noWritable/foo"
|
||||||
|
noWritableDirPerms "test/deleteDirRecursiveSpec/noWritable"
|
||||||
|
(deleteDirRecursive' "test/deleteDirRecursiveSpec/noWritable/foo"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied))
|
||||||
|
normalDirPerms "test/deleteDirRecursiveSpec/noWritable"
|
||||||
|
deleteDir' "test/deleteDirRecursiveSpec/noWritable/foo"
|
||||||
|
|
||||||
|
it "deleteDirRecursive, wrong file type (symlink to directory)" $
|
||||||
|
deleteDirRecursive' "test/deleteDirRecursiveSpec/dirSym"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == InappropriateType)
|
||||||
|
|
||||||
|
it "deleteDirRecursive, wrong file type (regular file)" $
|
||||||
|
deleteDirRecursive' "test/deleteDirRecursiveSpec/file"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == InappropriateType)
|
||||||
|
|
||||||
|
it "deleteDirRecursive, directory does not exist" $
|
||||||
|
deleteDirRecursive' "test/deleteDirRecursiveSpec/doesNotExist"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||||
|
|
||||||
|
|
82
test/DeleteDirSpec.hs
Normal file
82
test/DeleteDirSpec.hs
Normal file
@ -0,0 +1,82 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module DeleteDirSpec where
|
||||||
|
|
||||||
|
|
||||||
|
import Test.Hspec
|
||||||
|
import System.IO.Error
|
||||||
|
(
|
||||||
|
ioeGetErrorType
|
||||||
|
)
|
||||||
|
import System.Posix.Files.ByteString
|
||||||
|
(
|
||||||
|
getSymbolicLinkStatus
|
||||||
|
)
|
||||||
|
import GHC.IO.Exception
|
||||||
|
(
|
||||||
|
IOErrorType(..)
|
||||||
|
)
|
||||||
|
import Utils
|
||||||
|
|
||||||
|
|
||||||
|
deleteDirSpec :: Spec
|
||||||
|
deleteDirSpec =
|
||||||
|
describe "HSFM.FileSystem.FileOperations.deleteDir" $ do
|
||||||
|
|
||||||
|
-- successes --
|
||||||
|
it "deleteDir, empty directory, all fine" $ do
|
||||||
|
createDir' "test/deleteDirSpec/testDir"
|
||||||
|
deleteDir' "test/deleteDirSpec/testDir"
|
||||||
|
getSymbolicLinkStatus "test/deleteDirSpec/testDir"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||||
|
|
||||||
|
it "deleteDir, directory with null permissions, all fine" $ do
|
||||||
|
createDir' "test/deleteDirSpec/noPerms/testDir"
|
||||||
|
noPerms "test/deleteDirSpec/noPerms/testDir"
|
||||||
|
deleteDir' "test/deleteDirSpec/noPerms/testDir"
|
||||||
|
getSymbolicLinkStatus "test/deleteDirSpec/testDir"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||||
|
|
||||||
|
-- posix failures --
|
||||||
|
it "deleteDir, wrong file type (symlink to directory)" $
|
||||||
|
deleteDir' "test/deleteDirSpec/dirSym"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == InappropriateType)
|
||||||
|
|
||||||
|
it "deleteDir, wrong file type (regular file)" $
|
||||||
|
deleteDir' "test/deleteDirSpec/file"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == InappropriateType)
|
||||||
|
|
||||||
|
it "deleteDir, directory does not exist" $
|
||||||
|
deleteDir' "test/deleteDirSpec/doesNotExist"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||||
|
|
||||||
|
it "deleteDir, directory not empty" $
|
||||||
|
deleteDir' "test/deleteDirSpec/dir"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == UnsatisfiedConstraints)
|
||||||
|
|
||||||
|
it "deleteDir, can't open parent directory" $ do
|
||||||
|
createDir' "test/deleteDirSpec/noPerms/foo"
|
||||||
|
noPerms "test/deleteDirSpec/noPerms"
|
||||||
|
(deleteDir' "test/deleteDirSpec/noPerms/foo"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied))
|
||||||
|
>> normalDirPerms "test/deleteDirSpec/noPerms"
|
||||||
|
>> deleteDir' "test/deleteDirSpec/noPerms/foo"
|
||||||
|
|
||||||
|
it "deleteDir, can't write to parent directory, still fine" $ do
|
||||||
|
createDir' "test/deleteDirSpec/noWritable/foo"
|
||||||
|
noWritableDirPerms "test/deleteDirSpec/noWritable"
|
||||||
|
(deleteDir' "test/deleteDirSpec/noWritable/foo"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied))
|
||||||
|
normalDirPerms "test/deleteDirSpec/noWritable"
|
||||||
|
deleteDir' "test/deleteDirSpec/noWritable/foo"
|
||||||
|
|
||||||
|
|
||||||
|
|
57
test/DeleteFileSpec.hs
Normal file
57
test/DeleteFileSpec.hs
Normal file
@ -0,0 +1,57 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module DeleteFileSpec where
|
||||||
|
|
||||||
|
|
||||||
|
import Test.Hspec
|
||||||
|
import System.IO.Error
|
||||||
|
(
|
||||||
|
ioeGetErrorType
|
||||||
|
)
|
||||||
|
import System.Posix.Files.ByteString
|
||||||
|
(
|
||||||
|
getSymbolicLinkStatus
|
||||||
|
)
|
||||||
|
import GHC.IO.Exception
|
||||||
|
(
|
||||||
|
IOErrorType(..)
|
||||||
|
)
|
||||||
|
import Utils
|
||||||
|
|
||||||
|
|
||||||
|
deleteFileSpec :: Spec
|
||||||
|
deleteFileSpec =
|
||||||
|
describe "HSFM.FileSystem.FileOperations.deleteFile" $ do
|
||||||
|
|
||||||
|
-- successes --
|
||||||
|
it "deleteFile, regular file, all fine" $ do
|
||||||
|
createRegularFile' "test/deleteFileSpec/testFile"
|
||||||
|
deleteFile' "test/deleteFileSpec/testFile"
|
||||||
|
getSymbolicLinkStatus "test/deleteFileSpec/testFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||||
|
|
||||||
|
it "deleteFile, symlink, all fine" $ do
|
||||||
|
recreateSymlink' "test/deleteFileSpec/syml"
|
||||||
|
"test/deleteFileSpec/testFile"
|
||||||
|
deleteFile' "test/deleteFileSpec/testFile"
|
||||||
|
getSymbolicLinkStatus "test/deleteFileSpec/testFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||||
|
|
||||||
|
-- posix failures --
|
||||||
|
it "deleteFile, wrong file type (directory)" $
|
||||||
|
deleteFile' "test/deleteFileSpec/dir"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == InappropriateType)
|
||||||
|
|
||||||
|
it "deleteFile, file does not exist" $
|
||||||
|
deleteFile' "test/deleteFileSpec/doesNotExist"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||||
|
|
||||||
|
it "deleteFile, can't read directory" $
|
||||||
|
deleteFile' "test/deleteFileSpec/noPerms/blah"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
77
test/GetDirsFilesSpec.hs
Normal file
77
test/GetDirsFilesSpec.hs
Normal file
@ -0,0 +1,77 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module GetDirsFilesSpec where
|
||||||
|
|
||||||
|
|
||||||
|
import Data.List
|
||||||
|
(
|
||||||
|
sort
|
||||||
|
)
|
||||||
|
import Data.Maybe
|
||||||
|
(
|
||||||
|
fromJust
|
||||||
|
)
|
||||||
|
import qualified HPath as P
|
||||||
|
import Test.Hspec
|
||||||
|
import System.IO.Error
|
||||||
|
(
|
||||||
|
ioeGetErrorType
|
||||||
|
)
|
||||||
|
import System.Posix.Env.ByteString
|
||||||
|
(
|
||||||
|
getEnv
|
||||||
|
)
|
||||||
|
import GHC.IO.Exception
|
||||||
|
(
|
||||||
|
IOErrorType(..)
|
||||||
|
)
|
||||||
|
import Utils
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
getDirsFilesSpec :: Spec
|
||||||
|
getDirsFilesSpec =
|
||||||
|
describe "HSFM.FileSystem.FileOperations.getDirsFiles" $ do
|
||||||
|
|
||||||
|
-- successes --
|
||||||
|
it "getDirsFiles, all fine" $ do
|
||||||
|
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
|
||||||
|
expectedFiles <- mapM P.parseRel ["test/getDirsFilesSpec/.hidden"
|
||||||
|
,"test/getDirsFilesSpec/Lala"
|
||||||
|
,"test/getDirsFilesSpec/dir"
|
||||||
|
,"test/getDirsFilesSpec/dirsym"
|
||||||
|
,"test/getDirsFilesSpec/file"
|
||||||
|
,"test/getDirsFilesSpec/noPerms"
|
||||||
|
,"test/getDirsFilesSpec/syml"]
|
||||||
|
(fmap sort $ getDirsFiles' "test/getDirsFilesSpec")
|
||||||
|
`shouldReturn` fmap (pwd P.</>) expectedFiles
|
||||||
|
|
||||||
|
-- posix failures --
|
||||||
|
it "getDirsFiles, nonexistent directory" $
|
||||||
|
getDirsFiles' "test/getDirsFilesSpec/nothingHere"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||||
|
|
||||||
|
it "getDirsFiles, wrong file type (file)" $
|
||||||
|
getDirsFiles' "test/getDirsFilesSpec/file"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == InappropriateType)
|
||||||
|
|
||||||
|
it "getDirsFiles, wrong file type (symlink to file)" $
|
||||||
|
getDirsFiles' "test/getDirsFilesSpec/syml"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||||
|
|
||||||
|
it "getDirsFiles, wrong file type (symlink to dir)" $
|
||||||
|
getDirsFiles' "test/getDirsFilesSpec/dirsym"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||||
|
|
||||||
|
it "getDirsFiles, can't open directory" $
|
||||||
|
getDirsFiles' "test/getDirsFilesSpec/noPerms"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
59
test/GetFileTypeSpec.hs
Normal file
59
test/GetFileTypeSpec.hs
Normal file
@ -0,0 +1,59 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module GetFileTypeSpec where
|
||||||
|
|
||||||
|
|
||||||
|
import HSFM.FileSystem.FileOperations
|
||||||
|
import Test.Hspec
|
||||||
|
import System.IO.Error
|
||||||
|
(
|
||||||
|
ioeGetErrorType
|
||||||
|
)
|
||||||
|
import GHC.IO.Exception
|
||||||
|
(
|
||||||
|
IOErrorType(..)
|
||||||
|
)
|
||||||
|
import Utils
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
getFileTypeSpec :: Spec
|
||||||
|
getFileTypeSpec =
|
||||||
|
describe "HSFM.FileSystem.FileOperations.getFileType" $ do
|
||||||
|
|
||||||
|
-- successes --
|
||||||
|
it "getFileType, regular file" $
|
||||||
|
getFileType' "test/getFileTypeSpec/regularfile"
|
||||||
|
`shouldReturn` RegularFile
|
||||||
|
|
||||||
|
it "getFileType, directory" $
|
||||||
|
getFileType' "test/getFileTypeSpec/directory"
|
||||||
|
`shouldReturn` Directory
|
||||||
|
|
||||||
|
it "getFileType, directory with null permissions" $
|
||||||
|
getFileType' "test/getFileTypeSpec/noPerms"
|
||||||
|
`shouldReturn` Directory
|
||||||
|
|
||||||
|
it "getFileType, symlink to file" $
|
||||||
|
getFileType' "test/getFileTypeSpec/symlink"
|
||||||
|
`shouldReturn` SymbolicLink
|
||||||
|
|
||||||
|
it "getFileType, symlink to directory" $
|
||||||
|
getFileType' "test/getFileTypeSpec/symlinkD"
|
||||||
|
`shouldReturn` SymbolicLink
|
||||||
|
|
||||||
|
it "getFileType, broken symlink" $
|
||||||
|
getFileType' "test/getFileTypeSpec/brokenSymlink"
|
||||||
|
`shouldReturn` SymbolicLink
|
||||||
|
|
||||||
|
-- posix failures --
|
||||||
|
it "getFileType, file does not exist" $
|
||||||
|
getFileType' "test/getFileTypeSpec/nothingHere"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||||
|
|
||||||
|
it "getFileType, can't open directory" $
|
||||||
|
getFileType' "test/getFileTypeSpec/noPerms/forz"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
83
test/MoveFileSpec.hs
Normal file
83
test/MoveFileSpec.hs
Normal file
@ -0,0 +1,83 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module MoveFileSpec where
|
||||||
|
|
||||||
|
|
||||||
|
import Test.Hspec
|
||||||
|
import HSFM.FileSystem.Errors
|
||||||
|
import System.IO.Error
|
||||||
|
(
|
||||||
|
ioeGetErrorType
|
||||||
|
)
|
||||||
|
import GHC.IO.Exception
|
||||||
|
(
|
||||||
|
IOErrorType(..)
|
||||||
|
)
|
||||||
|
import Utils
|
||||||
|
|
||||||
|
|
||||||
|
moveFileSpec :: Spec
|
||||||
|
moveFileSpec =
|
||||||
|
describe "HSFM.FileSystem.FileOperations.moveFile" $ do
|
||||||
|
|
||||||
|
-- successes --
|
||||||
|
it "moveFile, all fine" $
|
||||||
|
moveFile' "test/moveFileSpec/myFile"
|
||||||
|
"test/moveFileSpec/movedFile"
|
||||||
|
|
||||||
|
it "moveFile, all fine" $
|
||||||
|
moveFile' "test/moveFileSpec/myFile"
|
||||||
|
"test/moveFileSpec/dir/movedFile"
|
||||||
|
|
||||||
|
it "moveFile, all fine on symlink" $
|
||||||
|
moveFile' "test/moveFileSpec/myFileL"
|
||||||
|
"test/moveFileSpec/movedFile"
|
||||||
|
|
||||||
|
it "moveFile, all fine on directory" $
|
||||||
|
moveFile' "test/moveFileSpec/dir"
|
||||||
|
"test/moveFileSpec/movedFile"
|
||||||
|
|
||||||
|
-- posix failures --
|
||||||
|
it "moveFile, source file does not exist" $
|
||||||
|
moveFile' "test/moveFileSpec/fileDoesNotExist"
|
||||||
|
"test/moveFileSpec/movedFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||||
|
|
||||||
|
it "moveFile, can't write to destination directory" $
|
||||||
|
moveFile' "test/moveFileSpec/myFile"
|
||||||
|
"test/moveFileSpec/noWritePerm/movedFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "moveFile, can't open destination directory" $
|
||||||
|
moveFile' "test/moveFileSpec/myFile"
|
||||||
|
"test/moveFileSpec/noPerms/movedFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "moveFile, can't open source directory" $
|
||||||
|
moveFile' "test/moveFileSpec/noPerms/myFile"
|
||||||
|
"test/moveFileSpec/movedFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
-- custom failures --
|
||||||
|
it "moveFile, destination file already exists" $
|
||||||
|
moveFile' "test/moveFileSpec/myFile"
|
||||||
|
"test/moveFileSpec/alreadyExists"
|
||||||
|
`shouldThrow`
|
||||||
|
isFileDoesExist
|
||||||
|
|
||||||
|
it "moveFile, move from file to dir" $
|
||||||
|
moveFile' "test/moveFileSpec/myFile"
|
||||||
|
"test/moveFileSpec/alreadyExistsD"
|
||||||
|
`shouldThrow`
|
||||||
|
isDirDoesExist
|
||||||
|
|
||||||
|
it "moveFile, source and dest are same file" $
|
||||||
|
moveFile' "test/moveFileSpec/myFile"
|
||||||
|
"test/moveFileSpec/myFile"
|
||||||
|
`shouldThrow`
|
||||||
|
isSameFile
|
||||||
|
|
81
test/RecreateSymlinkSpec.hs
Normal file
81
test/RecreateSymlinkSpec.hs
Normal file
@ -0,0 +1,81 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module RecreateSymlinkSpec where
|
||||||
|
|
||||||
|
|
||||||
|
import Test.Hspec
|
||||||
|
import System.IO.Error
|
||||||
|
(
|
||||||
|
ioeGetErrorType
|
||||||
|
)
|
||||||
|
import GHC.IO.Exception
|
||||||
|
(
|
||||||
|
IOErrorType(..)
|
||||||
|
)
|
||||||
|
import Utils
|
||||||
|
|
||||||
|
|
||||||
|
recreateSymlinkSpec :: Spec
|
||||||
|
recreateSymlinkSpec =
|
||||||
|
describe "HSFM.FileSystem.FileOperations.recreateSymlink" $ do
|
||||||
|
|
||||||
|
-- successes --
|
||||||
|
it "recreateSymLink, all fine" $ do
|
||||||
|
recreateSymlink' "test/recreateSymlinkSpec/myFileL"
|
||||||
|
"test/recreateSymlinkSpec/movedFile"
|
||||||
|
removeFileIfExists "test/recreateSymlinkSpec/movedFile"
|
||||||
|
|
||||||
|
it "recreateSymLink, all fine" $ do
|
||||||
|
recreateSymlink' "test/recreateSymlinkSpec/myFileL"
|
||||||
|
"test/recreateSymlinkSpec/dir/movedFile"
|
||||||
|
removeFileIfExists "test/recreateSymlinkSpec/dir/movedFile"
|
||||||
|
|
||||||
|
-- posix failures --
|
||||||
|
it "recreateSymLink, wrong input type (file)" $
|
||||||
|
recreateSymlink' "test/recreateSymlinkSpec/myFile"
|
||||||
|
"test/recreateSymlinkSpec/movedFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||||
|
|
||||||
|
it "recreateSymLink, wrong input type (directory)" $
|
||||||
|
recreateSymlink' "test/recreateSymlinkSpec/dir"
|
||||||
|
"test/recreateSymlinkSpec/movedFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||||
|
|
||||||
|
it "recreateSymLink, can't write to destination directory" $
|
||||||
|
recreateSymlink' "test/recreateSymlinkSpec/myFileL"
|
||||||
|
"test/recreateSymlinkSpec/noWritePerm/movedFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "recreateSymLink, can't open destination directory" $
|
||||||
|
recreateSymlink' "test/recreateSymlinkSpec/myFileL"
|
||||||
|
"test/recreateSymlinkSpec/noPerms/movedFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "recreateSymLink, can't open source directory" $
|
||||||
|
recreateSymlink' "test/recreateSymlinkSpec/noPerms/myFileL"
|
||||||
|
"test/recreateSymlinkSpec/movedFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "recreateSymLink, destination file already exists" $
|
||||||
|
recreateSymlink' "test/recreateSymlinkSpec/myFileL"
|
||||||
|
"test/recreateSymlinkSpec/alreadyExists"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||||
|
|
||||||
|
it "recreateSymLink, destination already exists and is a dir" $
|
||||||
|
recreateSymlink' "test/recreateSymlinkSpec/myFileL"
|
||||||
|
"test/recreateSymlinkSpec/alreadyExistsD"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||||
|
|
||||||
|
it "recreateSymLink, source and destination are the same file" $
|
||||||
|
recreateSymlink' "test/recreateSymlinkSpec/myFileL"
|
||||||
|
"test/recreateSymlinkSpec/myFileL"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||||
|
|
83
test/RenameFileSpec.hs
Normal file
83
test/RenameFileSpec.hs
Normal file
@ -0,0 +1,83 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module RenameFileSpec where
|
||||||
|
|
||||||
|
|
||||||
|
import Test.Hspec
|
||||||
|
import HSFM.FileSystem.Errors
|
||||||
|
import System.IO.Error
|
||||||
|
(
|
||||||
|
ioeGetErrorType
|
||||||
|
)
|
||||||
|
import GHC.IO.Exception
|
||||||
|
(
|
||||||
|
IOErrorType(..)
|
||||||
|
)
|
||||||
|
import Utils
|
||||||
|
|
||||||
|
|
||||||
|
renameFileSpec :: Spec
|
||||||
|
renameFileSpec =
|
||||||
|
describe "HSFM.FileSystem.FileOperations.renameFile" $ do
|
||||||
|
|
||||||
|
-- successes --
|
||||||
|
it "renameFile, all fine" $
|
||||||
|
renameFile' "test/renameFileSpec/myFile"
|
||||||
|
"test/renameFileSpec/renamedFile"
|
||||||
|
|
||||||
|
it "renameFile, all fine" $
|
||||||
|
renameFile' "test/renameFileSpec/myFile"
|
||||||
|
"test/renameFileSpec/dir/renamedFile"
|
||||||
|
|
||||||
|
it "renameFile, all fine on symlink" $
|
||||||
|
renameFile' "test/renameFileSpec/myFileL"
|
||||||
|
"test/renameFileSpec/renamedFile"
|
||||||
|
|
||||||
|
it "renameFile, all fine on directory" $
|
||||||
|
renameFile' "test/renameFileSpec/dir"
|
||||||
|
"test/renameFileSpec/renamedFile"
|
||||||
|
|
||||||
|
-- posix failures --
|
||||||
|
it "renameFile, source file does not exist" $
|
||||||
|
renameFile' "test/renameFileSpec/fileDoesNotExist"
|
||||||
|
"test/renameFileSpec/renamedFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||||
|
|
||||||
|
it "renameFile, can't write to output directory" $
|
||||||
|
renameFile' "test/renameFileSpec/myFile"
|
||||||
|
"test/renameFileSpec/noWritePerm/renamedFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "renameFile, can't open output directory" $
|
||||||
|
renameFile' "test/renameFileSpec/myFile"
|
||||||
|
"test/renameFileSpec/noPerms/renamedFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
it "renameFile, can't open source directory" $
|
||||||
|
renameFile' "test/renameFileSpec/noPerms/myFile"
|
||||||
|
"test/renameFileSpec/renamedFile"
|
||||||
|
`shouldThrow`
|
||||||
|
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||||
|
|
||||||
|
-- custom failures --
|
||||||
|
it "renameFile, destination file already exists" $
|
||||||
|
renameFile' "test/renameFileSpec/myFile"
|
||||||
|
"test/renameFileSpec/alreadyExists"
|
||||||
|
`shouldThrow`
|
||||||
|
isFileDoesExist
|
||||||
|
|
||||||
|
it "renameFile, move from file to dir" $
|
||||||
|
renameFile' "test/renameFileSpec/myFile"
|
||||||
|
"test/renameFileSpec/alreadyExistsD"
|
||||||
|
`shouldThrow`
|
||||||
|
isDirDoesExist
|
||||||
|
|
||||||
|
it "renameFile, source and dest are same file" $
|
||||||
|
renameFile' "test/renameFileSpec/myFile"
|
||||||
|
"test/renameFileSpec/myFile"
|
||||||
|
`shouldThrow`
|
||||||
|
isSameFile
|
||||||
|
|
834
test/Spec.hs
834
test/Spec.hs
@ -1,50 +1,20 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import HSFM.FileSystem.FileOperations
|
|
||||||
import Data.Maybe
|
|
||||||
(
|
|
||||||
fromJust
|
|
||||||
)
|
|
||||||
import qualified HPath as P
|
|
||||||
import System.Posix.Env.ByteString
|
|
||||||
(
|
|
||||||
getEnv
|
|
||||||
)
|
|
||||||
import HSFM.FileSystem.Errors
|
|
||||||
import HSFM.Utils.IO
|
|
||||||
import System.IO.Error
|
|
||||||
(
|
|
||||||
ioeGetErrorType
|
|
||||||
)
|
|
||||||
import GHC.IO.Exception
|
|
||||||
(
|
|
||||||
IOErrorType(..)
|
|
||||||
)
|
|
||||||
import Data.ByteString
|
|
||||||
(
|
|
||||||
ByteString
|
|
||||||
)
|
|
||||||
import System.Exit
|
|
||||||
import System.Process
|
|
||||||
import System.Posix.Files.ByteString
|
|
||||||
(
|
|
||||||
getSymbolicLinkStatus
|
|
||||||
, groupExecuteMode
|
|
||||||
, groupReadMode
|
|
||||||
, nullFileMode
|
|
||||||
, otherExecuteMode
|
|
||||||
, otherReadMode
|
|
||||||
, ownerExecuteMode
|
|
||||||
, ownerReadMode
|
|
||||||
, setFileMode
|
|
||||||
, unionFileModes
|
|
||||||
)
|
|
||||||
import Data.List
|
|
||||||
(
|
|
||||||
sort
|
|
||||||
)
|
|
||||||
|
|
||||||
|
import CopyDirRecursiveSpec
|
||||||
|
import CopyFileSpec
|
||||||
|
import CreateDirSpec
|
||||||
|
import CreateRegularFileSpec
|
||||||
|
import DeleteDirRecursiveSpec
|
||||||
|
import DeleteDirSpec
|
||||||
|
import DeleteFileSpec
|
||||||
|
import GetDirsFilesSpec
|
||||||
|
import GetFileTypeSpec
|
||||||
|
import MoveFileSpec
|
||||||
|
import RecreateSymlinkSpec
|
||||||
|
import RenameFileSpec
|
||||||
|
import Utils
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -78,16 +48,16 @@ main = hspec $ before_ fixPermissions $ after_ revertPermissions $ do
|
|||||||
,"test/copyDirRecursiveSpec/noWritePerm"
|
,"test/copyDirRecursiveSpec/noWritePerm"
|
||||||
,"test/createDirSpec/noWritePerms"
|
,"test/createDirSpec/noWritePerms"
|
||||||
,"test/createRegularFileSpec/noWritePerms"
|
,"test/createRegularFileSpec/noWritePerms"
|
||||||
,"test/renameFile/noWritePerm"
|
,"test/renameFileSpec/noWritePerm"
|
||||||
,"test/moveFile/noWritePerm"
|
,"test/moveFileSpec/noWritePerm"
|
||||||
,"test/recreateSymlinkSpec/noWritePerm"
|
,"test/recreateSymlinkSpec/noWritePerm"
|
||||||
]
|
]
|
||||||
noPermsDirs = ["test/copyFileSpec/noPerms"
|
noPermsDirs = ["test/copyFileSpec/noPerms"
|
||||||
,"test/copyDirRecursiveSpec/noPerms"
|
,"test/copyDirRecursiveSpec/noPerms"
|
||||||
,"test/createDirSpec/noPerms"
|
,"test/createDirSpec/noPerms"
|
||||||
,"test/createRegularFileSpec/noPerms"
|
,"test/createRegularFileSpec/noPerms"
|
||||||
,"test/renameFile/noPerms"
|
,"test/renameFileSpec/noPerms"
|
||||||
,"test/moveFile/noPerms"
|
,"test/moveFileSpec/noPerms"
|
||||||
,"test/recreateSymlinkSpec/noPerms"
|
,"test/recreateSymlinkSpec/noPerms"
|
||||||
,"test/getFileTypeSpec/noPerms"
|
,"test/getFileTypeSpec/noPerms"
|
||||||
,"test/getDirsFilesSpec/noPerms"
|
,"test/getDirsFilesSpec/noPerms"
|
||||||
@ -100,773 +70,3 @@ main = hspec $ before_ fixPermissions $ after_ revertPermissions $ do
|
|||||||
sequence_ $ fmap normalDirPerms noWriteDirs
|
sequence_ $ fmap normalDirPerms noWriteDirs
|
||||||
sequence_ $ fmap normalDirPerms noPermsDirs
|
sequence_ $ fmap normalDirPerms noPermsDirs
|
||||||
|
|
||||||
|
|
||||||
-------------
|
|
||||||
--[ Specs ]--
|
|
||||||
-------------
|
|
||||||
|
|
||||||
|
|
||||||
copyFileSpec :: Spec
|
|
||||||
copyFileSpec =
|
|
||||||
describe "HSFM.FileSystem.FileOperations.copyFile" $ do
|
|
||||||
|
|
||||||
-- successes --
|
|
||||||
it "copyFile, everything clear" $ do
|
|
||||||
copyFile' "test/copyFileSpec/inputFile"
|
|
||||||
"test/copyFileSpec/outputFile"
|
|
||||||
removeFileIfExists "test/copyFileSpec/outputFile"
|
|
||||||
|
|
||||||
it "copyFile, and compare" $ do
|
|
||||||
copyFile' "test/copyFileSpec/inputFile"
|
|
||||||
"test/copyFileSpec/outputFile"
|
|
||||||
(system $ "cmp -s " ++ "test/copyFileSpec/inputFile" ++ " "
|
|
||||||
++ "test/copyFileSpec/outputFile")
|
|
||||||
`shouldReturn` ExitSuccess
|
|
||||||
removeFileIfExists "test/copyFileSpec/outputFile"
|
|
||||||
|
|
||||||
-- posix failures --
|
|
||||||
it "copyFile, input file does not exist" $
|
|
||||||
copyFile' "test/copyFileSpec/noSuchFile"
|
|
||||||
"test/copyFileSpec/outputFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
|
||||||
|
|
||||||
it "copyFile, no permission to write to output directory" $
|
|
||||||
copyFile' "test/copyFileSpec/inputFile"
|
|
||||||
"test/copyFileSpec/outputDirNoWrite/outputFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "copyFile, cannot open output directory" $
|
|
||||||
copyFile' "test/copyFileSpec/inputFile"
|
|
||||||
"test/copyFileSpec/noPerms/outputFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "copyFile, cannot open source directory" $
|
|
||||||
copyFile' "test/copyFileSpec/noPerms/inputFile"
|
|
||||||
"test/copyFileSpec/outputFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "copyFile, wrong input type (symlink)" $
|
|
||||||
copyFile' "test/copyFileSpec/inputFileSymL"
|
|
||||||
"test/copyFileSpec/outputFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
|
||||||
|
|
||||||
it "copyFile, wrong input type (directory)" $
|
|
||||||
copyFile' "test/copyFileSpec/wrongInput"
|
|
||||||
"test/copyFileSpec/outputFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == InappropriateType)
|
|
||||||
|
|
||||||
it "copyFile, output and input are same file" $
|
|
||||||
copyFile' "test/copyFileSpec/inputFile"
|
|
||||||
"test/copyFileSpec/inputFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
|
||||||
|
|
||||||
it "copyFile, output file already exists" $
|
|
||||||
copyFile' "test/copyFileSpec/inputFile"
|
|
||||||
"test/copyFileSpec/alreadyExists"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
|
||||||
|
|
||||||
it "copyFile, output file already exists and is a dir" $
|
|
||||||
copyFile' "test/copyFileSpec/inputFile"
|
|
||||||
"test/copyFileSpec/alreadyExistsD"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
|
||||||
|
|
||||||
|
|
||||||
copyDirRecursiveSpec :: Spec
|
|
||||||
copyDirRecursiveSpec =
|
|
||||||
describe "HSFM.FileSystem.FileOperations.copyDirRecursive" $ do
|
|
||||||
|
|
||||||
-- successes --
|
|
||||||
it "copyDirRecursive, all fine" $ do
|
|
||||||
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
|
|
||||||
"test/copyDirRecursiveSpec/outputDir"
|
|
||||||
removeDirIfExists "test/copyDirRecursiveSpec/outputDir"
|
|
||||||
|
|
||||||
it "copyDirRecursive, all fine and compare" $ do
|
|
||||||
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
|
|
||||||
"test/copyDirRecursiveSpec/outputDir"
|
|
||||||
(system $ "diff -r --no-dereference "
|
|
||||||
++ "test/copyDirRecursiveSpec/inputDir" ++ " "
|
|
||||||
++ "test/copyDirRecursiveSpec/outputDir")
|
|
||||||
`shouldReturn` ExitSuccess
|
|
||||||
removeDirIfExists "test/copyDirRecursiveSpec/outputDir"
|
|
||||||
|
|
||||||
-- posix failures --
|
|
||||||
it "copyDirRecursive, source directory does not exist" $
|
|
||||||
copyDirRecursive' "test/copyDirRecursiveSpec/doesNotExist"
|
|
||||||
"test/copyDirRecursiveSpec/outputDir"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
|
||||||
|
|
||||||
it "copyDirRecursive, no write permission on output dir" $
|
|
||||||
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
|
|
||||||
"test/copyDirRecursiveSpec/noWritePerm/foo"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "copyDirRecursive, cannot open output dir" $
|
|
||||||
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
|
|
||||||
"test/copyDirRecursiveSpec/noPerms/foo"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "copyDirRecursive, cannot open source dir" $
|
|
||||||
copyDirRecursive' "test/copyDirRecursiveSpec/noPerms/inputDir"
|
|
||||||
"test/copyDirRecursiveSpec/foo"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "copyDirRecursive, destination dir already exists" $
|
|
||||||
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
|
|
||||||
"test/copyDirRecursiveSpec/alreadyExistsD"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
|
||||||
|
|
||||||
it "copyDirRecursive, destination already exists and is a file" $
|
|
||||||
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
|
|
||||||
"test/copyDirRecursiveSpec/alreadyExists"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
|
||||||
|
|
||||||
it "copyDirRecursive, destination and source same directory" $
|
|
||||||
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
|
|
||||||
"test/copyDirRecursiveSpec/inputDir"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
|
||||||
|
|
||||||
it "copyDirRecursive, wrong input (regular file)" $
|
|
||||||
copyDirRecursive' "test/copyDirRecursiveSpec/wrongInput"
|
|
||||||
"test/copyDirRecursiveSpec/outputDir"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == InappropriateType)
|
|
||||||
|
|
||||||
it "copyDirRecursive, wrong input (symlink to directory)" $
|
|
||||||
copyDirRecursive' "test/copyDirRecursiveSpec/wrongInputSymL"
|
|
||||||
"test/copyDirRecursiveSpec/outputDir"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
|
||||||
|
|
||||||
-- custom failures
|
|
||||||
it "copyDirRecursive, destination in source" $
|
|
||||||
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
|
|
||||||
"test/copyDirRecursiveSpec/inputDir/foo"
|
|
||||||
`shouldThrow`
|
|
||||||
isDestinationInSource
|
|
||||||
|
|
||||||
|
|
||||||
createDirSpec :: Spec
|
|
||||||
createDirSpec =
|
|
||||||
describe "HSFM.FileSystem.FileOperations.createDir" $ do
|
|
||||||
|
|
||||||
-- successes --
|
|
||||||
it "createDir, all fine" $ do
|
|
||||||
createDir' "test/createDirSpec/newDir"
|
|
||||||
removeDirIfExists "test/createDirSpec/newDir"
|
|
||||||
|
|
||||||
-- posix failures --
|
|
||||||
it "createDir, can't write to output directory" $
|
|
||||||
createDir' "test/createDirSpec/noWritePerms/newDir"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "createDir, can't open output directory" $
|
|
||||||
createDir' "test/createDirSpec/noPerms/newDir"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "createDir, destination directory already exists" $
|
|
||||||
createDir' "test/createDirSpec/alreadyExists"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
|
||||||
|
|
||||||
|
|
||||||
createRegularFileSpec :: Spec
|
|
||||||
createRegularFileSpec =
|
|
||||||
describe "HSFM.FileSystem.FileOperations.createRegularFile" $ do
|
|
||||||
|
|
||||||
-- successes --
|
|
||||||
it "createRegularFile, all fine" $ do
|
|
||||||
createRegularFile' "test/createRegularFileSpec/newDir"
|
|
||||||
removeFileIfExists "test/createRegularFileSpec/newDir"
|
|
||||||
|
|
||||||
-- posix failures --
|
|
||||||
it "createRegularFile, can't write to destination directory" $
|
|
||||||
createRegularFile' "test/createRegularFileSpec/noWritePerms/newDir"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "createRegularFile, can't write to destination directory" $
|
|
||||||
createRegularFile' "test/createRegularFileSpec/noPerms/newDir"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "createRegularFile, destination file already exists" $
|
|
||||||
createRegularFile' "test/createRegularFileSpec/alreadyExists"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
|
||||||
|
|
||||||
|
|
||||||
renameFileSpec :: Spec
|
|
||||||
renameFileSpec =
|
|
||||||
describe "HSFM.FileSystem.FileOperations.renameFile" $ do
|
|
||||||
|
|
||||||
-- successes --
|
|
||||||
it "renameFile, all fine" $
|
|
||||||
renameFile' "test/renameFile/myFile"
|
|
||||||
"test/renameFile/renamedFile"
|
|
||||||
|
|
||||||
it "renameFile, all fine" $
|
|
||||||
renameFile' "test/renameFile/myFile"
|
|
||||||
"test/renameFile/dir/renamedFile"
|
|
||||||
|
|
||||||
it "renameFile, all fine on symlink" $
|
|
||||||
renameFile' "test/renameFile/myFileL"
|
|
||||||
"test/renameFile/renamedFile"
|
|
||||||
|
|
||||||
it "renameFile, all fine on directory" $
|
|
||||||
renameFile' "test/renameFile/dir"
|
|
||||||
"test/renameFile/renamedFile"
|
|
||||||
|
|
||||||
-- posix failures --
|
|
||||||
it "renameFile, source file does not exist" $
|
|
||||||
renameFile' "test/renameFile/fileDoesNotExist"
|
|
||||||
"test/renameFile/renamedFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
|
||||||
|
|
||||||
it "renameFile, can't write to output directory" $
|
|
||||||
renameFile' "test/renameFile/myFile"
|
|
||||||
"test/renameFile/noWritePerm/renamedFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "renameFile, can't open output directory" $
|
|
||||||
renameFile' "test/renameFile/myFile"
|
|
||||||
"test/renameFile/noPerms/renamedFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "renameFile, can't open source directory" $
|
|
||||||
renameFile' "test/renameFile/noPerms/myFile"
|
|
||||||
"test/renameFile/renamedFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
-- custom failures --
|
|
||||||
it "renameFile, destination file already exists" $
|
|
||||||
renameFile' "test/renameFile/myFile"
|
|
||||||
"test/renameFile/alreadyExists"
|
|
||||||
`shouldThrow`
|
|
||||||
isFileDoesExist
|
|
||||||
|
|
||||||
it "renameFile, move from file to dir" $
|
|
||||||
renameFile' "test/renameFile/myFile"
|
|
||||||
"test/renameFile/alreadyExistsD"
|
|
||||||
`shouldThrow`
|
|
||||||
isDirDoesExist
|
|
||||||
|
|
||||||
it "renameFile, source and dest are same file" $
|
|
||||||
renameFile' "test/renameFile/myFile"
|
|
||||||
"test/renameFile/myFile"
|
|
||||||
`shouldThrow`
|
|
||||||
isSameFile
|
|
||||||
|
|
||||||
|
|
||||||
moveFileSpec :: Spec
|
|
||||||
moveFileSpec =
|
|
||||||
describe "HSFM.FileSystem.FileOperations.moveFile" $ do
|
|
||||||
|
|
||||||
-- successes --
|
|
||||||
it "moveFile, all fine" $
|
|
||||||
moveFile' "test/moveFile/myFile"
|
|
||||||
"test/moveFile/movedFile"
|
|
||||||
|
|
||||||
it "moveFile, all fine" $
|
|
||||||
moveFile' "test/moveFile/myFile"
|
|
||||||
"test/moveFile/dir/movedFile"
|
|
||||||
|
|
||||||
it "moveFile, all fine on symlink" $
|
|
||||||
moveFile' "test/moveFile/myFileL"
|
|
||||||
"test/moveFile/movedFile"
|
|
||||||
|
|
||||||
it "moveFile, all fine on directory" $
|
|
||||||
moveFile' "test/moveFile/dir"
|
|
||||||
"test/moveFile/movedFile"
|
|
||||||
|
|
||||||
-- posix failures --
|
|
||||||
it "moveFile, source file does not exist" $
|
|
||||||
moveFile' "test/moveFile/fileDoesNotExist"
|
|
||||||
"test/moveFile/movedFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
|
||||||
|
|
||||||
it "moveFile, can't write to destination directory" $
|
|
||||||
moveFile' "test/moveFile/myFile"
|
|
||||||
"test/moveFile/noWritePerm/movedFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "moveFile, can't open destination directory" $
|
|
||||||
moveFile' "test/moveFile/myFile"
|
|
||||||
"test/moveFile/noPerms/movedFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "moveFile, can't open source directory" $
|
|
||||||
moveFile' "test/moveFile/noPerms/myFile"
|
|
||||||
"test/moveFile/movedFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
-- custom failures --
|
|
||||||
it "moveFile, destination file already exists" $
|
|
||||||
moveFile' "test/moveFile/myFile"
|
|
||||||
"test/moveFile/alreadyExists"
|
|
||||||
`shouldThrow`
|
|
||||||
isFileDoesExist
|
|
||||||
|
|
||||||
it "moveFile, move from file to dir" $
|
|
||||||
moveFile' "test/moveFile/myFile"
|
|
||||||
"test/moveFile/alreadyExistsD"
|
|
||||||
`shouldThrow`
|
|
||||||
isDirDoesExist
|
|
||||||
|
|
||||||
it "moveFile, source and dest are same file" $
|
|
||||||
moveFile' "test/moveFile/myFile"
|
|
||||||
"test/moveFile/myFile"
|
|
||||||
`shouldThrow`
|
|
||||||
isSameFile
|
|
||||||
|
|
||||||
|
|
||||||
recreateSymlinkSpec :: Spec
|
|
||||||
recreateSymlinkSpec =
|
|
||||||
describe "HSFM.FileSystem.FileOperations.recreateSymlink" $ do
|
|
||||||
|
|
||||||
-- successes --
|
|
||||||
it "recreateSymLink, all fine" $ do
|
|
||||||
recreateSymlink' "test/recreateSymlinkSpec/myFileL"
|
|
||||||
"test/recreateSymlinkSpec/movedFile"
|
|
||||||
removeFileIfExists "test/recreateSymlinkSpec/movedFile"
|
|
||||||
|
|
||||||
it "recreateSymLink, all fine" $ do
|
|
||||||
recreateSymlink' "test/recreateSymlinkSpec/myFileL"
|
|
||||||
"test/recreateSymlinkSpec/dir/movedFile"
|
|
||||||
removeFileIfExists "test/recreateSymlinkSpec/dir/movedFile"
|
|
||||||
|
|
||||||
-- posix failures --
|
|
||||||
it "recreateSymLink, wrong input type (file)" $
|
|
||||||
recreateSymlink' "test/recreateSymlinkSpec/myFile"
|
|
||||||
"test/recreateSymlinkSpec/movedFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
|
||||||
|
|
||||||
it "recreateSymLink, wrong input type (directory)" $
|
|
||||||
recreateSymlink' "test/recreateSymlinkSpec/dir"
|
|
||||||
"test/recreateSymlinkSpec/movedFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
|
||||||
|
|
||||||
it "recreateSymLink, can't write to destination directory" $
|
|
||||||
recreateSymlink' "test/recreateSymlinkSpec/myFileL"
|
|
||||||
"test/recreateSymlinkSpec/noWritePerm/movedFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "recreateSymLink, can't open destination directory" $
|
|
||||||
recreateSymlink' "test/recreateSymlinkSpec/myFileL"
|
|
||||||
"test/recreateSymlinkSpec/noPerms/movedFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "recreateSymLink, can't open source directory" $
|
|
||||||
recreateSymlink' "test/recreateSymlinkSpec/noPerms/myFileL"
|
|
||||||
"test/recreateSymlinkSpec/movedFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
it "recreateSymLink, destination file already exists" $
|
|
||||||
recreateSymlink' "test/recreateSymlinkSpec/myFileL"
|
|
||||||
"test/recreateSymlinkSpec/alreadyExists"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
|
||||||
|
|
||||||
it "recreateSymLink, destination already exists and is a dir" $
|
|
||||||
recreateSymlink' "test/recreateSymlinkSpec/myFileL"
|
|
||||||
"test/recreateSymlinkSpec/alreadyExistsD"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
|
||||||
|
|
||||||
it "recreateSymLink, source and destination are the same file" $
|
|
||||||
recreateSymlink' "test/recreateSymlinkSpec/myFileL"
|
|
||||||
"test/recreateSymlinkSpec/myFileL"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
|
||||||
|
|
||||||
|
|
||||||
getFileTypeSpec :: Spec
|
|
||||||
getFileTypeSpec =
|
|
||||||
describe "HSFM.FileSystem.FileOperations.getFileType" $ do
|
|
||||||
|
|
||||||
-- successes --
|
|
||||||
it "getFileType, regular file" $
|
|
||||||
getFileType' "test/getFileTypeSpec/regularfile"
|
|
||||||
`shouldReturn` RegularFile
|
|
||||||
|
|
||||||
it "getFileType, directory" $
|
|
||||||
getFileType' "test/getFileTypeSpec/directory"
|
|
||||||
`shouldReturn` Directory
|
|
||||||
|
|
||||||
it "getFileType, directory with null permissions" $
|
|
||||||
getFileType' "test/getFileTypeSpec/noPerms"
|
|
||||||
`shouldReturn` Directory
|
|
||||||
|
|
||||||
it "getFileType, symlink to file" $
|
|
||||||
getFileType' "test/getFileTypeSpec/symlink"
|
|
||||||
`shouldReturn` SymbolicLink
|
|
||||||
|
|
||||||
it "getFileType, symlink to directory" $
|
|
||||||
getFileType' "test/getFileTypeSpec/symlinkD"
|
|
||||||
`shouldReturn` SymbolicLink
|
|
||||||
|
|
||||||
it "getFileType, broken symlink" $
|
|
||||||
getFileType' "test/getFileTypeSpec/brokenSymlink"
|
|
||||||
`shouldReturn` SymbolicLink
|
|
||||||
|
|
||||||
-- posix failures --
|
|
||||||
it "getFileType, file does not exist" $
|
|
||||||
getFileType' "test/getFileTypeSpec/nothingHere"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
|
||||||
|
|
||||||
it "getFileType, can't open directory" $
|
|
||||||
getFileType' "test/getFileTypeSpec/noPerms/forz"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
|
|
||||||
getDirsFilesSpec :: Spec
|
|
||||||
getDirsFilesSpec =
|
|
||||||
describe "HSFM.FileSystem.FileOperations.getDirsFiles" $ do
|
|
||||||
|
|
||||||
-- successes --
|
|
||||||
it "getDirsFiles, all fine" $ do
|
|
||||||
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
|
|
||||||
expectedFiles <- mapM P.parseRel ["test/getDirsFilesSpec/.hidden"
|
|
||||||
,"test/getDirsFilesSpec/Lala"
|
|
||||||
,"test/getDirsFilesSpec/dir"
|
|
||||||
,"test/getDirsFilesSpec/dirsym"
|
|
||||||
,"test/getDirsFilesSpec/file"
|
|
||||||
,"test/getDirsFilesSpec/noPerms"
|
|
||||||
,"test/getDirsFilesSpec/syml"]
|
|
||||||
(fmap sort $ getDirsFiles' "test/getDirsFilesSpec")
|
|
||||||
`shouldReturn` fmap (pwd P.</>) expectedFiles
|
|
||||||
|
|
||||||
-- posix failures --
|
|
||||||
it "getDirsFiles, nonexistent directory" $
|
|
||||||
getDirsFiles' "test/getDirsFilesSpec/nothingHere"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
|
||||||
|
|
||||||
it "getDirsFiles, wrong file type (file)" $
|
|
||||||
getDirsFiles' "test/getDirsFilesSpec/file"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == InappropriateType)
|
|
||||||
|
|
||||||
it "getDirsFiles, wrong file type (symlink to file)" $
|
|
||||||
getDirsFiles' "test/getDirsFilesSpec/syml"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
|
||||||
|
|
||||||
it "getDirsFiles, wrong file type (symlink to dir)" $
|
|
||||||
getDirsFiles' "test/getDirsFilesSpec/dirsym"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
|
||||||
|
|
||||||
it "getDirsFiles, can't open directory" $
|
|
||||||
getDirsFiles' "test/getDirsFilesSpec/noPerms"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
|
|
||||||
deleteFileSpec :: Spec
|
|
||||||
deleteFileSpec =
|
|
||||||
describe "HSFM.FileSystem.FileOperations.deleteFile" $ do
|
|
||||||
|
|
||||||
-- successes --
|
|
||||||
it "deleteFile, regular file, all fine" $ do
|
|
||||||
createRegularFile' "test/deleteFileSpec/testFile"
|
|
||||||
deleteFile' "test/deleteFileSpec/testFile"
|
|
||||||
getSymbolicLinkStatus "test/deleteFileSpec/testFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
|
||||||
|
|
||||||
it "deleteFile, symlink, all fine" $ do
|
|
||||||
recreateSymlink' "test/deleteFileSpec/syml"
|
|
||||||
"test/deleteFileSpec/testFile"
|
|
||||||
deleteFile' "test/deleteFileSpec/testFile"
|
|
||||||
getSymbolicLinkStatus "test/deleteFileSpec/testFile"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
|
||||||
|
|
||||||
-- posix failures --
|
|
||||||
it "deleteFile, wrong file type (directory)" $
|
|
||||||
deleteFile' "test/deleteFileSpec/dir"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == InappropriateType)
|
|
||||||
|
|
||||||
it "deleteFile, file does not exist" $
|
|
||||||
deleteFile' "test/deleteFileSpec/doesNotExist"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
|
||||||
|
|
||||||
it "deleteFile, can't read directory" $
|
|
||||||
deleteFile' "test/deleteFileSpec/noPerms/blah"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
|
||||||
|
|
||||||
|
|
||||||
deleteDirSpec :: Spec
|
|
||||||
deleteDirSpec =
|
|
||||||
describe "HSFM.FileSystem.FileOperations.deleteDir" $ do
|
|
||||||
|
|
||||||
-- successes --
|
|
||||||
it "deleteDir, empty directory, all fine" $ do
|
|
||||||
createDir' "test/deleteDirSpec/testDir"
|
|
||||||
deleteDir' "test/deleteDirSpec/testDir"
|
|
||||||
getSymbolicLinkStatus "test/deleteDirSpec/testDir"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
|
||||||
|
|
||||||
it "deleteDir, directory with null permissions, all fine" $ do
|
|
||||||
createDir' "test/deleteDirSpec/noPerms/testDir"
|
|
||||||
noPerms "test/deleteDirSpec/noPerms/testDir"
|
|
||||||
deleteDir' "test/deleteDirSpec/noPerms/testDir"
|
|
||||||
getSymbolicLinkStatus "test/deleteDirSpec/testDir"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
|
||||||
|
|
||||||
-- posix failures --
|
|
||||||
it "deleteDir, wrong file type (symlink to directory)" $
|
|
||||||
deleteDir' "test/deleteDirSpec/dirSym"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == InappropriateType)
|
|
||||||
|
|
||||||
it "deleteDir, wrong file type (regular file)" $
|
|
||||||
deleteDir' "test/deleteDirSpec/file"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == InappropriateType)
|
|
||||||
|
|
||||||
it "deleteDir, directory does not exist" $
|
|
||||||
deleteDir' "test/deleteDirSpec/doesNotExist"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
|
||||||
|
|
||||||
it "deleteDir, directory not empty" $
|
|
||||||
deleteDir' "test/deleteDirSpec/dir"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == UnsatisfiedConstraints)
|
|
||||||
|
|
||||||
it "deleteDir, can't open parent directory" $ do
|
|
||||||
createDir' "test/deleteDirSpec/noPerms/foo"
|
|
||||||
noPerms "test/deleteDirSpec/noPerms"
|
|
||||||
(deleteDir' "test/deleteDirSpec/noPerms/foo"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied))
|
|
||||||
>> normalDirPerms "test/deleteDirSpec/noPerms"
|
|
||||||
>> deleteDir' "test/deleteDirSpec/noPerms/foo"
|
|
||||||
|
|
||||||
it "deleteDir, can't write to parent directory, still fine" $ do
|
|
||||||
createDir' "test/deleteDirSpec/noWritable/foo"
|
|
||||||
noWritableDirPerms "test/deleteDirSpec/noWritable"
|
|
||||||
(deleteDir' "test/deleteDirSpec/noWritable/foo"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied))
|
|
||||||
normalDirPerms "test/deleteDirSpec/noWritable"
|
|
||||||
deleteDir' "test/deleteDirSpec/noWritable/foo"
|
|
||||||
|
|
||||||
|
|
||||||
deleteDirRecursiveSpec :: Spec
|
|
||||||
deleteDirRecursiveSpec =
|
|
||||||
describe "HSFM.FileSystem.FileOperations.deleteDirRecursive" $ do
|
|
||||||
|
|
||||||
-- successes --
|
|
||||||
it "deleteDirRecursive, empty directory, all fine" $ do
|
|
||||||
createDir' "test/deleteDirRecursiveSpec/testDir"
|
|
||||||
deleteDirRecursive' "test/deleteDirRecursiveSpec/testDir"
|
|
||||||
getSymbolicLinkStatus "test/deleteDirRecursiveSpec/testDir"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
|
||||||
|
|
||||||
it "deleteDirRecursive, empty directory with null permissions, all fine" $ do
|
|
||||||
createDir' "test/deleteDirRecursiveSpec/noPerms/testDir"
|
|
||||||
noPerms "test/deleteDirRecursiveSpec/noPerms/testDir"
|
|
||||||
deleteDirRecursive' "test/deleteDirRecursiveSpec/noPerms/testDir"
|
|
||||||
|
|
||||||
it "deleteDirRecursive, non-empty directory, all fine" $ do
|
|
||||||
createDir' "test/deleteDirRecursiveSpec/nonEmpty"
|
|
||||||
createDir' "test/deleteDirRecursiveSpec/nonEmpty/dir1"
|
|
||||||
createDir' "test/deleteDirRecursiveSpec/nonEmpty/dir2"
|
|
||||||
createDir' "test/deleteDirRecursiveSpec/nonEmpty/dir2/dir3"
|
|
||||||
createRegularFile' "test/deleteDirRecursiveSpec/nonEmpty/file1"
|
|
||||||
createRegularFile' "test/deleteDirRecursiveSpec/nonEmpty/dir1/file2"
|
|
||||||
deleteDirRecursive' "test/deleteDirRecursiveSpec/nonEmpty"
|
|
||||||
getSymbolicLinkStatus "test/deleteDirRecursiveSpec/nonEmpty"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
|
||||||
|
|
||||||
-- posix failures --
|
|
||||||
it "deleteDirRecursive, can't open parent directory" $ do
|
|
||||||
createDir' "test/deleteDirRecursiveSpec/noPerms/foo"
|
|
||||||
noPerms "test/deleteDirRecursiveSpec/noPerms"
|
|
||||||
(deleteDirRecursive' "test/deleteDirRecursiveSpec/noPerms/foo"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied))
|
|
||||||
>> normalDirPerms "test/deleteDirRecursiveSpec/noPerms"
|
|
||||||
>> deleteDir' "test/deleteDirRecursiveSpec/noPerms/foo"
|
|
||||||
|
|
||||||
it "deleteDirRecursive, can't write to parent directory" $ do
|
|
||||||
createDir' "test/deleteDirRecursiveSpec/noWritable/foo"
|
|
||||||
noWritableDirPerms "test/deleteDirRecursiveSpec/noWritable"
|
|
||||||
(deleteDirRecursive' "test/deleteDirRecursiveSpec/noWritable/foo"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == PermissionDenied))
|
|
||||||
normalDirPerms "test/deleteDirRecursiveSpec/noWritable"
|
|
||||||
deleteDir' "test/deleteDirRecursiveSpec/noWritable/foo"
|
|
||||||
|
|
||||||
it "deleteDirRecursive, wrong file type (symlink to directory)" $
|
|
||||||
deleteDirRecursive' "test/deleteDirRecursiveSpec/dirSym"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == InappropriateType)
|
|
||||||
|
|
||||||
it "deleteDirRecursive, wrong file type (regular file)" $
|
|
||||||
deleteDirRecursive' "test/deleteDirRecursiveSpec/file"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == InappropriateType)
|
|
||||||
|
|
||||||
it "deleteDirRecursive, directory does not exist" $
|
|
||||||
deleteDirRecursive' "test/deleteDirRecursiveSpec/doesNotExist"
|
|
||||||
`shouldThrow`
|
|
||||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-----------------
|
|
||||||
--[ Utilities ]--
|
|
||||||
-----------------
|
|
||||||
|
|
||||||
|
|
||||||
withPwd :: ByteString -> (P.Path P.Abs -> IO a) -> IO a
|
|
||||||
withPwd ip f = do
|
|
||||||
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
|
|
||||||
p <- (pwd P.</>) <$> P.parseRel ip
|
|
||||||
f p
|
|
||||||
|
|
||||||
|
|
||||||
withPwd' :: ByteString
|
|
||||||
-> ByteString
|
|
||||||
-> (P.Path P.Abs -> P.Path P.Abs -> IO a)
|
|
||||||
-> IO a
|
|
||||||
withPwd' ip1 ip2 f = do
|
|
||||||
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
|
|
||||||
p1 <- (pwd P.</>) <$> P.parseRel ip1
|
|
||||||
p2 <- (pwd P.</>) <$> P.parseRel ip2
|
|
||||||
f p1 p2
|
|
||||||
|
|
||||||
|
|
||||||
removeFileIfExists :: ByteString -> IO ()
|
|
||||||
removeFileIfExists bs =
|
|
||||||
withPwd bs $ \p -> whenM (doesFileExist p) (deleteFile p)
|
|
||||||
|
|
||||||
|
|
||||||
removeDirIfExists :: ByteString -> IO ()
|
|
||||||
removeDirIfExists bs =
|
|
||||||
withPwd bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p)
|
|
||||||
|
|
||||||
|
|
||||||
copyFile' :: ByteString -> ByteString -> IO ()
|
|
||||||
copyFile' inputFileP outputFileP =
|
|
||||||
withPwd' inputFileP outputFileP copyFile
|
|
||||||
|
|
||||||
|
|
||||||
copyDirRecursive' :: ByteString -> ByteString -> IO ()
|
|
||||||
copyDirRecursive' inputDirP outputDirP =
|
|
||||||
withPwd' inputDirP outputDirP copyDirRecursive
|
|
||||||
|
|
||||||
|
|
||||||
createDir' :: ByteString -> IO ()
|
|
||||||
createDir' dest = withPwd dest createDir
|
|
||||||
|
|
||||||
|
|
||||||
createRegularFile' :: ByteString -> IO ()
|
|
||||||
createRegularFile' dest = withPwd dest createRegularFile
|
|
||||||
|
|
||||||
|
|
||||||
renameFile' :: ByteString -> ByteString -> IO ()
|
|
||||||
renameFile' inputFileP outputFileP =
|
|
||||||
withPwd' inputFileP outputFileP $ \i o -> do
|
|
||||||
renameFile i o
|
|
||||||
renameFile o i
|
|
||||||
|
|
||||||
|
|
||||||
moveFile' :: ByteString -> ByteString -> IO ()
|
|
||||||
moveFile' inputFileP outputFileP =
|
|
||||||
withPwd' inputFileP outputFileP $ \i o -> do
|
|
||||||
moveFile i o
|
|
||||||
moveFile o i
|
|
||||||
|
|
||||||
|
|
||||||
recreateSymlink' :: ByteString -> ByteString -> IO ()
|
|
||||||
recreateSymlink' inputFileP outputFileP =
|
|
||||||
withPwd' inputFileP outputFileP recreateSymlink
|
|
||||||
|
|
||||||
|
|
||||||
noWritableDirPerms :: ByteString -> IO ()
|
|
||||||
noWritableDirPerms path = withPwd path $ \p ->
|
|
||||||
setFileMode (P.fromAbs p) perms
|
|
||||||
where
|
|
||||||
perms = ownerReadMode
|
|
||||||
`unionFileModes` ownerExecuteMode
|
|
||||||
`unionFileModes` groupReadMode
|
|
||||||
`unionFileModes` groupExecuteMode
|
|
||||||
`unionFileModes` otherReadMode
|
|
||||||
`unionFileModes` otherExecuteMode
|
|
||||||
|
|
||||||
|
|
||||||
noPerms :: ByteString -> IO ()
|
|
||||||
noPerms path = withPwd path $ \p -> setFileMode (P.fromAbs p) nullFileMode
|
|
||||||
|
|
||||||
|
|
||||||
normalDirPerms :: ByteString -> IO ()
|
|
||||||
normalDirPerms path =
|
|
||||||
withPwd path $ \p -> setFileMode (P.fromAbs p) newDirPerms
|
|
||||||
|
|
||||||
|
|
||||||
getFileType' :: ByteString -> IO FileType
|
|
||||||
getFileType' path = withPwd path getFileType
|
|
||||||
|
|
||||||
|
|
||||||
getDirsFiles' :: ByteString -> IO [P.Path P.Abs]
|
|
||||||
getDirsFiles' path = withPwd path getDirsFiles
|
|
||||||
|
|
||||||
|
|
||||||
deleteFile' :: ByteString -> IO ()
|
|
||||||
deleteFile' p = withPwd p deleteFile
|
|
||||||
|
|
||||||
|
|
||||||
deleteDir' :: ByteString -> IO ()
|
|
||||||
deleteDir' p = withPwd p deleteDir
|
|
||||||
|
|
||||||
|
|
||||||
deleteDirRecursive' :: ByteString -> IO ()
|
|
||||||
deleteDirRecursive' p = withPwd p deleteDirRecursive
|
|
||||||
|
146
test/Utils.hs
Normal file
146
test/Utils.hs
Normal file
@ -0,0 +1,146 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module Utils where
|
||||||
|
|
||||||
|
|
||||||
|
import HSFM.FileSystem.FileOperations
|
||||||
|
import Data.Maybe
|
||||||
|
(
|
||||||
|
fromJust
|
||||||
|
)
|
||||||
|
import qualified HPath as P
|
||||||
|
import System.Posix.Env.ByteString
|
||||||
|
(
|
||||||
|
getEnv
|
||||||
|
)
|
||||||
|
import HSFM.FileSystem.Errors
|
||||||
|
import HSFM.Utils.IO
|
||||||
|
import Data.ByteString
|
||||||
|
(
|
||||||
|
ByteString
|
||||||
|
)
|
||||||
|
import System.Posix.Files.ByteString
|
||||||
|
(
|
||||||
|
groupExecuteMode
|
||||||
|
, groupReadMode
|
||||||
|
, nullFileMode
|
||||||
|
, otherExecuteMode
|
||||||
|
, otherReadMode
|
||||||
|
, ownerExecuteMode
|
||||||
|
, ownerReadMode
|
||||||
|
, setFileMode
|
||||||
|
, unionFileModes
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-----------------
|
||||||
|
--[ Utilities ]--
|
||||||
|
-----------------
|
||||||
|
|
||||||
|
|
||||||
|
withPwd :: ByteString -> (P.Path P.Abs -> IO a) -> IO a
|
||||||
|
withPwd ip f = do
|
||||||
|
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
|
||||||
|
p <- (pwd P.</>) <$> P.parseRel ip
|
||||||
|
f p
|
||||||
|
|
||||||
|
|
||||||
|
withPwd' :: ByteString
|
||||||
|
-> ByteString
|
||||||
|
-> (P.Path P.Abs -> P.Path P.Abs -> IO a)
|
||||||
|
-> IO a
|
||||||
|
withPwd' ip1 ip2 f = do
|
||||||
|
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
|
||||||
|
p1 <- (pwd P.</>) <$> P.parseRel ip1
|
||||||
|
p2 <- (pwd P.</>) <$> P.parseRel ip2
|
||||||
|
f p1 p2
|
||||||
|
|
||||||
|
|
||||||
|
removeFileIfExists :: ByteString -> IO ()
|
||||||
|
removeFileIfExists bs =
|
||||||
|
withPwd bs $ \p -> whenM (doesFileExist p) (deleteFile p)
|
||||||
|
|
||||||
|
|
||||||
|
removeDirIfExists :: ByteString -> IO ()
|
||||||
|
removeDirIfExists bs =
|
||||||
|
withPwd bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p)
|
||||||
|
|
||||||
|
|
||||||
|
copyFile' :: ByteString -> ByteString -> IO ()
|
||||||
|
copyFile' inputFileP outputFileP =
|
||||||
|
withPwd' inputFileP outputFileP copyFile
|
||||||
|
|
||||||
|
|
||||||
|
copyDirRecursive' :: ByteString -> ByteString -> IO ()
|
||||||
|
copyDirRecursive' inputDirP outputDirP =
|
||||||
|
withPwd' inputDirP outputDirP copyDirRecursive
|
||||||
|
|
||||||
|
|
||||||
|
createDir' :: ByteString -> IO ()
|
||||||
|
createDir' dest = withPwd dest createDir
|
||||||
|
|
||||||
|
|
||||||
|
createRegularFile' :: ByteString -> IO ()
|
||||||
|
createRegularFile' dest = withPwd dest createRegularFile
|
||||||
|
|
||||||
|
|
||||||
|
renameFile' :: ByteString -> ByteString -> IO ()
|
||||||
|
renameFile' inputFileP outputFileP =
|
||||||
|
withPwd' inputFileP outputFileP $ \i o -> do
|
||||||
|
renameFile i o
|
||||||
|
renameFile o i
|
||||||
|
|
||||||
|
|
||||||
|
moveFile' :: ByteString -> ByteString -> IO ()
|
||||||
|
moveFile' inputFileP outputFileP =
|
||||||
|
withPwd' inputFileP outputFileP $ \i o -> do
|
||||||
|
moveFile i o
|
||||||
|
moveFile o i
|
||||||
|
|
||||||
|
|
||||||
|
recreateSymlink' :: ByteString -> ByteString -> IO ()
|
||||||
|
recreateSymlink' inputFileP outputFileP =
|
||||||
|
withPwd' inputFileP outputFileP recreateSymlink
|
||||||
|
|
||||||
|
|
||||||
|
noWritableDirPerms :: ByteString -> IO ()
|
||||||
|
noWritableDirPerms path = withPwd path $ \p ->
|
||||||
|
setFileMode (P.fromAbs p) perms
|
||||||
|
where
|
||||||
|
perms = ownerReadMode
|
||||||
|
`unionFileModes` ownerExecuteMode
|
||||||
|
`unionFileModes` groupReadMode
|
||||||
|
`unionFileModes` groupExecuteMode
|
||||||
|
`unionFileModes` otherReadMode
|
||||||
|
`unionFileModes` otherExecuteMode
|
||||||
|
|
||||||
|
|
||||||
|
noPerms :: ByteString -> IO ()
|
||||||
|
noPerms path = withPwd path $ \p -> setFileMode (P.fromAbs p) nullFileMode
|
||||||
|
|
||||||
|
|
||||||
|
normalDirPerms :: ByteString -> IO ()
|
||||||
|
normalDirPerms path =
|
||||||
|
withPwd path $ \p -> setFileMode (P.fromAbs p) newDirPerms
|
||||||
|
|
||||||
|
|
||||||
|
getFileType' :: ByteString -> IO FileType
|
||||||
|
getFileType' path = withPwd path getFileType
|
||||||
|
|
||||||
|
|
||||||
|
getDirsFiles' :: ByteString -> IO [P.Path P.Abs]
|
||||||
|
getDirsFiles' path = withPwd path getDirsFiles
|
||||||
|
|
||||||
|
|
||||||
|
deleteFile' :: ByteString -> IO ()
|
||||||
|
deleteFile' p = withPwd p deleteFile
|
||||||
|
|
||||||
|
|
||||||
|
deleteDir' :: ByteString -> IO ()
|
||||||
|
deleteDir' p = withPwd p deleteDir
|
||||||
|
|
||||||
|
|
||||||
|
deleteDirRecursive' :: ByteString -> IO ()
|
||||||
|
deleteDirRecursive' p = withPwd p deleteDirRecursive
|
||||||
|
|
Loading…
Reference in New Issue
Block a user