TESTS: refacotr

This commit is contained in:
Julian Ospald 2016-05-03 12:44:05 +02:00
parent 8b0e59faa7
commit 37773383af
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28

View File

@ -111,16 +111,18 @@ copyFileSpec =
describe "HSFM.FileSystem.FileOperations.copyFile" $ do describe "HSFM.FileSystem.FileOperations.copyFile" $ do
-- successes -- -- successes --
it "copyFile, everything clear" $ it "copyFile, everything clear" $ do
copyFile' "test/copyFileSpec/inputFile" copyFile' "test/copyFileSpec/inputFile"
"test/copyFileSpec/outputFile" "test/copyFileSpec/outputFile"
removeFileIfExists "test/copyFileSpec/outputFile"
it "copyFile, and compare" $ it "copyFile, and compare" $ do
copyFile'' "test/copyFileSpec/inputFile" copyFile' "test/copyFileSpec/inputFile"
"test/copyFileSpec/outputFile" "test/copyFileSpec/outputFile"
(system $ "cmp -s " ++ "test/copyFileSpec/inputFile" ++ " " (system $ "cmp -s " ++ "test/copyFileSpec/inputFile" ++ " "
++ "test/copyFileSpec/outputFile") ++ "test/copyFileSpec/outputFile")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeFileIfExists "test/copyFileSpec/outputFile"
-- posix failures -- -- posix failures --
it "copyFile, input file does not exist" $ it "copyFile, input file does not exist" $
@ -183,17 +185,19 @@ copyDirRecursiveSpec =
describe "HSFM.FileSystem.FileOperations.copyDirRecursive" $ do describe "HSFM.FileSystem.FileOperations.copyDirRecursive" $ do
-- successes -- -- successes --
it "copyDirRecursive, all fine" $ it "copyDirRecursive, all fine" $ do
copyDirRecursive' "test/copyDirRecursiveSpec/inputDir" copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
"test/copyDirRecursiveSpec/outputDir" "test/copyDirRecursiveSpec/outputDir"
removeDirIfExists "test/copyDirRecursiveSpec/outputDir"
it "copyDirRecursive, all fine and compare" $ it "copyDirRecursive, all fine and compare" $ do
copyDirRecursive'' "test/copyDirRecursiveSpec/inputDir" copyDirRecursive' "test/copyDirRecursiveSpec/inputDir"
"test/copyDirRecursiveSpec/outputDir" "test/copyDirRecursiveSpec/outputDir"
(system $ "diff -r --no-dereference " (system $ "diff -r --no-dereference "
++ "test/copyDirRecursiveSpec/inputDir" ++ " " ++ "test/copyDirRecursiveSpec/inputDir" ++ " "
++ "test/copyDirRecursiveSpec/outputDir") ++ "test/copyDirRecursiveSpec/outputDir")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeDirIfExists "test/copyDirRecursiveSpec/outputDir"
-- posix failures -- -- posix failures --
it "copyDirRecursive, source directory does not exist" $ it "copyDirRecursive, source directory does not exist" $
@ -263,8 +267,9 @@ createDirSpec =
describe "HSFM.FileSystem.FileOperations.createDir" $ do describe "HSFM.FileSystem.FileOperations.createDir" $ do
-- successes -- -- successes --
it "createDir, all fine" $ it "createDir, all fine" $ do
createDir' "test/createDirSpec/newDir" createDir' "test/createDirSpec/newDir"
removeDirIfExists "test/createDirSpec/newDir"
-- posix failures -- -- posix failures --
it "createDir, can't write to output directory" $ it "createDir, can't write to output directory" $
@ -288,8 +293,9 @@ createRegularFileSpec =
describe "HSFM.FileSystem.FileOperations.createRegularFile" $ do describe "HSFM.FileSystem.FileOperations.createRegularFile" $ do
-- successes -- -- successes --
it "createRegularFile, all fine" $ it "createRegularFile, all fine" $ do
createRegularFile' "test/createRegularFileSpec/newDir" createRegularFile' "test/createRegularFileSpec/newDir"
removeFileIfExists "test/createRegularFileSpec/newDir"
-- posix failures -- -- posix failures --
it "createRegularFile, can't write to destination directory" $ it "createRegularFile, can't write to destination directory" $
@ -445,13 +451,15 @@ recreateSymlinkSpec =
describe "HSFM.FileSystem.FileOperations.recreateSymlink" $ do describe "HSFM.FileSystem.FileOperations.recreateSymlink" $ do
-- successes -- -- successes --
it "recreateSymLink, all fine" $ it "recreateSymLink, all fine" $ do
recreateSymlink' "test/recreateSymlinkSpec/myFileL" recreateSymlink' "test/recreateSymlinkSpec/myFileL"
"test/recreateSymlinkSpec/movedFile" "test/recreateSymlinkSpec/movedFile"
removeFileIfExists "test/recreateSymlinkSpec/movedFile"
it "recreateSymLink, all fine" $ it "recreateSymLink, all fine" $ do
recreateSymlink' "test/recreateSymlinkSpec/myFileL" recreateSymlink' "test/recreateSymlinkSpec/myFileL"
"test/recreateSymlinkSpec/dir/movedFile" "test/recreateSymlinkSpec/dir/movedFile"
removeFileIfExists "test/recreateSymlinkSpec/dir/movedFile"
-- posix failures -- -- posix failures --
it "recreateSymLink, wrong input type (file)" $ it "recreateSymLink, wrong input type (file)" $
@ -594,15 +602,15 @@ deleteFileSpec =
-- successes -- -- successes --
it "deleteFile, regular file, all fine" $ do it "deleteFile, regular file, all fine" $ do
createRegularFile'' "test/deleteFileSpec/testFile" createRegularFile' "test/deleteFileSpec/testFile"
deleteFile' "test/deleteFileSpec/testFile" deleteFile' "test/deleteFileSpec/testFile"
getSymbolicLinkStatus "test/deleteFileSpec/testFile" getSymbolicLinkStatus "test/deleteFileSpec/testFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "deleteFile, symlink, all fine" $ do it "deleteFile, symlink, all fine" $ do
recreateSymlink'' "test/deleteFileSpec/syml" recreateSymlink' "test/deleteFileSpec/syml"
"test/deleteFileSpec/testFile" "test/deleteFileSpec/testFile"
deleteFile' "test/deleteFileSpec/testFile" deleteFile' "test/deleteFileSpec/testFile"
getSymbolicLinkStatus "test/deleteFileSpec/testFile" getSymbolicLinkStatus "test/deleteFileSpec/testFile"
`shouldThrow` `shouldThrow`
@ -631,14 +639,14 @@ deleteDirSpec =
-- successes -- -- successes --
it "deleteDir, empty directory, all fine" $ do it "deleteDir, empty directory, all fine" $ do
createDir'' "test/deleteDirSpec/testDir" createDir' "test/deleteDirSpec/testDir"
deleteDir' "test/deleteDirSpec/testDir" deleteDir' "test/deleteDirSpec/testDir"
getSymbolicLinkStatus "test/deleteDirSpec/testDir" getSymbolicLinkStatus "test/deleteDirSpec/testDir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "deleteDir, directory with null permissions, all fine" $ do it "deleteDir, directory with null permissions, all fine" $ do
createDir'' "test/deleteDirSpec/noPerms/testDir" createDir' "test/deleteDirSpec/noPerms/testDir"
noPerms "test/deleteDirSpec/noPerms/testDir" noPerms "test/deleteDirSpec/noPerms/testDir"
deleteDir' "test/deleteDirSpec/noPerms/testDir" deleteDir' "test/deleteDirSpec/noPerms/testDir"
getSymbolicLinkStatus "test/deleteDirSpec/testDir" getSymbolicLinkStatus "test/deleteDirSpec/testDir"
@ -667,7 +675,7 @@ deleteDirSpec =
(\e -> ioeGetErrorType e == UnsatisfiedConstraints) (\e -> ioeGetErrorType e == UnsatisfiedConstraints)
it "deleteDir, can't open parent directory" $ do it "deleteDir, can't open parent directory" $ do
createDir'' "test/deleteDirSpec/noPerms/foo" createDir' "test/deleteDirSpec/noPerms/foo"
noPerms "test/deleteDirSpec/noPerms" noPerms "test/deleteDirSpec/noPerms"
(deleteDir' "test/deleteDirSpec/noPerms/foo" (deleteDir' "test/deleteDirSpec/noPerms/foo"
`shouldThrow` `shouldThrow`
@ -676,7 +684,7 @@ deleteDirSpec =
>> deleteDir' "test/deleteDirSpec/noPerms/foo" >> deleteDir' "test/deleteDirSpec/noPerms/foo"
it "deleteDir, can't write to parent directory, still fine" $ do it "deleteDir, can't write to parent directory, still fine" $ do
createDir'' "test/deleteDirSpec/noWritable/foo" createDir' "test/deleteDirSpec/noWritable/foo"
noWritableDirPerms "test/deleteDirSpec/noWritable" noWritableDirPerms "test/deleteDirSpec/noWritable"
(deleteDir' "test/deleteDirSpec/noWritable/foo" (deleteDir' "test/deleteDirSpec/noWritable/foo"
`shouldThrow` `shouldThrow`
@ -691,24 +699,24 @@ deleteDirRecursiveSpec =
-- successes -- -- successes --
it "deleteDirRecursive, empty directory, all fine" $ do it "deleteDirRecursive, empty directory, all fine" $ do
createDir'' "test/deleteDirRecursiveSpec/testDir" createDir' "test/deleteDirRecursiveSpec/testDir"
deleteDirRecursive' "test/deleteDirRecursiveSpec/testDir" deleteDirRecursive' "test/deleteDirRecursiveSpec/testDir"
getSymbolicLinkStatus "test/deleteDirRecursiveSpec/testDir" getSymbolicLinkStatus "test/deleteDirRecursiveSpec/testDir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "deleteDirRecursive, empty directory with null permissions, all fine" $ do it "deleteDirRecursive, empty directory with null permissions, all fine" $ do
createDir'' "test/deleteDirRecursiveSpec/noPerms/testDir" createDir' "test/deleteDirRecursiveSpec/noPerms/testDir"
noPerms "test/deleteDirRecursiveSpec/noPerms/testDir" noPerms "test/deleteDirRecursiveSpec/noPerms/testDir"
deleteDirRecursive' "test/deleteDirRecursiveSpec/noPerms/testDir" deleteDirRecursive' "test/deleteDirRecursiveSpec/noPerms/testDir"
it "deleteDirRecursive, non-empty directory, all fine" $ do it "deleteDirRecursive, non-empty directory, all fine" $ do
createDir'' "test/deleteDirRecursiveSpec/nonEmpty" createDir' "test/deleteDirRecursiveSpec/nonEmpty"
createDir'' "test/deleteDirRecursiveSpec/nonEmpty/dir1" createDir' "test/deleteDirRecursiveSpec/nonEmpty/dir1"
createDir'' "test/deleteDirRecursiveSpec/nonEmpty/dir2" createDir' "test/deleteDirRecursiveSpec/nonEmpty/dir2"
createDir'' "test/deleteDirRecursiveSpec/nonEmpty/dir2/dir3" createDir' "test/deleteDirRecursiveSpec/nonEmpty/dir2/dir3"
createRegularFile'' "test/deleteDirRecursiveSpec/nonEmpty/file1" createRegularFile' "test/deleteDirRecursiveSpec/nonEmpty/file1"
createRegularFile'' "test/deleteDirRecursiveSpec/nonEmpty/dir1/file2" createRegularFile' "test/deleteDirRecursiveSpec/nonEmpty/dir1/file2"
deleteDirRecursive' "test/deleteDirRecursiveSpec/nonEmpty" deleteDirRecursive' "test/deleteDirRecursiveSpec/nonEmpty"
getSymbolicLinkStatus "test/deleteDirRecursiveSpec/nonEmpty" getSymbolicLinkStatus "test/deleteDirRecursiveSpec/nonEmpty"
`shouldThrow` `shouldThrow`
@ -716,7 +724,7 @@ deleteDirRecursiveSpec =
-- posix failures -- -- posix failures --
it "deleteDirRecursive, can't open parent directory" $ do it "deleteDirRecursive, can't open parent directory" $ do
createDir'' "test/deleteDirRecursiveSpec/noPerms/foo" createDir' "test/deleteDirRecursiveSpec/noPerms/foo"
noPerms "test/deleteDirRecursiveSpec/noPerms" noPerms "test/deleteDirRecursiveSpec/noPerms"
(deleteDirRecursive' "test/deleteDirRecursiveSpec/noPerms/foo" (deleteDirRecursive' "test/deleteDirRecursiveSpec/noPerms/foo"
`shouldThrow` `shouldThrow`
@ -725,7 +733,7 @@ deleteDirRecursiveSpec =
>> deleteDir' "test/deleteDirRecursiveSpec/noPerms/foo" >> deleteDir' "test/deleteDirRecursiveSpec/noPerms/foo"
it "deleteDirRecursive, can't write to parent directory" $ do it "deleteDirRecursive, can't write to parent directory" $ do
createDir'' "test/deleteDirRecursiveSpec/noWritable/foo" createDir' "test/deleteDirRecursiveSpec/noWritable/foo"
noWritableDirPerms "test/deleteDirRecursiveSpec/noWritable" noWritableDirPerms "test/deleteDirRecursiveSpec/noWritable"
(deleteDirRecursive' "test/deleteDirRecursiveSpec/noWritable/foo" (deleteDirRecursive' "test/deleteDirRecursiveSpec/noWritable/foo"
`shouldThrow` `shouldThrow`
@ -758,108 +766,74 @@ deleteDirRecursiveSpec =
----------------- -----------------
copyFile'' :: ByteString -> ByteString -> IO a -> IO a withPwd :: ByteString -> (P.Path P.Abs -> IO a) -> IO a
copyFile'' inputFileP outputFileP before_cleanup = do withPwd ip f = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
inputFile <- (pwd P.</>) <$> P.parseRel inputFileP p <- (pwd P.</>) <$> P.parseRel ip
outputFile <- (pwd P.</>) <$> P.parseRel outputFileP f p
copyFile inputFile outputFile
r <- before_cleanup
whenM (doesFileExist outputFile) (deleteFile outputFile) withPwd' :: ByteString
return r -> 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' :: ByteString -> ByteString -> IO ()
copyFile' inputFileP outputFileP = copyFile' inputFileP outputFileP =
copyFile'' inputFileP outputFileP (return ()) withPwd' inputFileP outputFileP copyFile
copyDirRecursive'' :: ByteString -> ByteString -> IO a -> IO a
copyDirRecursive'' inputDirP outputDirP before_cleanup = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
inputDir <- (pwd P.</>) <$> P.parseRel inputDirP
outputDir <- (pwd P.</>) <$> P.parseRel outputDirP
copyDirRecursive inputDir outputDir
r <- before_cleanup
whenM (doesDirectoryExist outputDir) (deleteDirRecursive outputDir)
return r
copyDirRecursive' :: ByteString -> ByteString -> IO () copyDirRecursive' :: ByteString -> ByteString -> IO ()
copyDirRecursive' inputDirP outputDirP = copyDirRecursive' inputDirP outputDirP =
copyDirRecursive'' inputDirP outputDirP (return ()) withPwd' inputDirP outputDirP copyDirRecursive
createDir' :: ByteString -> IO () createDir' :: ByteString -> IO ()
createDir' dest = do createDir' dest = withPwd dest createDir
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
outputDir <- (pwd P.</>) <$> P.parseRel dest
createDir outputDir
whenM (doesDirectoryExist outputDir) (deleteDir outputDir)
createDir'' :: ByteString -> IO ()
createDir'' dest = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
outputDir <- (pwd P.</>) <$> P.parseRel dest
createDir outputDir
createRegularFile' :: ByteString -> IO () createRegularFile' :: ByteString -> IO ()
createRegularFile' dest = do createRegularFile' dest = withPwd dest createRegularFile
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
outputFile <- (pwd P.</>) <$> P.parseRel dest
createRegularFile outputFile
whenM (doesFileExist outputFile) (deleteFile outputFile)
createRegularFile'' :: ByteString -> IO ()
createRegularFile'' dest = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
outputFile <- (pwd P.</>) <$> P.parseRel dest
createRegularFile outputFile
renameFile' :: ByteString -> ByteString -> IO () renameFile' :: ByteString -> ByteString -> IO ()
renameFile' inputFileP outputFileP = do renameFile' inputFileP outputFileP =
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs withPwd' inputFileP outputFileP $ \i o -> do
inputFile <- (pwd P.</>) <$> P.parseRel inputFileP renameFile i o
outputFile <- (pwd P.</>) <$> P.parseRel outputFileP renameFile o i
renameFile inputFile outputFile
renameFile outputFile inputFile
moveFile' :: ByteString -> ByteString -> IO () moveFile' :: ByteString -> ByteString -> IO ()
moveFile' inputFileP outputFileP = do moveFile' inputFileP outputFileP =
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs withPwd' inputFileP outputFileP $ \i o -> do
inputFile <- (pwd P.</>) <$> P.parseRel inputFileP moveFile i o
outputFile <- (pwd P.</>) <$> P.parseRel outputFileP moveFile o i
moveFile inputFile outputFile
moveFile outputFile inputFile
recreateSymlink' :: ByteString -> ByteString -> IO () recreateSymlink' :: ByteString -> ByteString -> IO ()
recreateSymlink' inputFileP outputFileP = do recreateSymlink' inputFileP outputFileP =
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs withPwd' inputFileP outputFileP recreateSymlink
inputFile <- (pwd P.</>) <$> P.parseRel inputFileP
outputFile <- (pwd P.</>) <$> P.parseRel outputFileP
recreateSymlink inputFile outputFile
whenM (doesFileExist outputFile) (deleteFile outputFile)
recreateSymlink'' :: ByteString -> ByteString -> IO ()
recreateSymlink'' inputFileP outputFileP = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
inputFile <- (pwd P.</>) <$> P.parseRel inputFileP
outputFile <- (pwd P.</>) <$> P.parseRel outputFileP
recreateSymlink inputFile outputFile
noWritableDirPerms :: ByteString -> IO () noWritableDirPerms :: ByteString -> IO ()
noWritableDirPerms path = do noWritableDirPerms path = withPwd path $ \p ->
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs setFileMode (P.fromAbs p) perms
file <- (pwd P.</>) <$> P.parseRel path
setFileMode (P.fromAbs file) perms
where where
perms = ownerReadMode perms = ownerReadMode
`unionFileModes` ownerExecuteMode `unionFileModes` ownerExecuteMode
@ -870,49 +844,29 @@ noWritableDirPerms path = do
noPerms :: ByteString -> IO () noPerms :: ByteString -> IO ()
noPerms path = do noPerms path = withPwd path $ \p -> setFileMode (P.fromAbs p) nullFileMode
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
file <- (pwd P.</>) <$> P.parseRel path
setFileMode (P.fromAbs file) nullFileMode
normalDirPerms :: ByteString -> IO () normalDirPerms :: ByteString -> IO ()
normalDirPerms path = do normalDirPerms path =
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs withPwd path $ \p -> setFileMode (P.fromAbs p) newDirPerms
file <- (pwd P.</>) <$> P.parseRel path
setFileMode (P.fromAbs file) newDirPerms
getFileType' :: ByteString -> IO FileType getFileType' :: ByteString -> IO FileType
getFileType' path = do getFileType' path = withPwd path getFileType
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
file <- (pwd P.</>) <$> P.parseRel path
getFileType file
getDirsFiles' :: ByteString -> IO [P.Path P.Abs] getDirsFiles' :: ByteString -> IO [P.Path P.Abs]
getDirsFiles' path = do getDirsFiles' path = withPwd path getDirsFiles
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
file <- (pwd P.</>) <$> P.parseRel path
getDirsFiles file
deleteFile' :: ByteString -> IO () deleteFile' :: ByteString -> IO ()
deleteFile' p = do deleteFile' p = withPwd p deleteFile
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
file <- (pwd P.</>) <$> P.parseRel p
deleteFile file
deleteDir' :: ByteString -> IO () deleteDir' :: ByteString -> IO ()
deleteDir' p = do deleteDir' p = withPwd p deleteDir
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
dir <- (pwd P.</>) <$> P.parseRel p
deleteDir dir
deleteDirRecursive' :: ByteString -> IO () deleteDirRecursive' :: ByteString -> IO ()
deleteDirRecursive' p = do deleteDirRecursive' p = withPwd p deleteDirRecursive
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
dir <- (pwd P.</>) <$> P.parseRel p
deleteDirRecursive dir