TESTS: less side effects plz
This commit is contained in:
parent
5d1c5cc2ce
commit
bc348c7dd5
@ -17,6 +17,11 @@ import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CanonicalizePathSpec"
|
||||
createTmpDir
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "file"
|
||||
@ -35,7 +40,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.canonicalizePath" $ do
|
||||
|
||||
-- successes --
|
||||
|
@ -26,8 +26,16 @@ import System.Posix.Env.ByteString
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
import Data.IORef
|
||||
(
|
||||
readIORef
|
||||
)
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CopyDirRecursiveCollectFailuresSpec"
|
||||
createTmpDir
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
@ -115,18 +123,19 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.copyDirRecursive" $ do
|
||||
|
||||
-- successes --
|
||||
it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do
|
||||
tmpDir' <- getRawTmpDir
|
||||
copyDirRecursive' "inputDir"
|
||||
"outputDir"
|
||||
Strict
|
||||
CollectFailures
|
||||
(system $ "diff -r --no-dereference "
|
||||
++ toString tmpDir ++ "inputDir" ++ " "
|
||||
++ toString tmpDir ++ "outputDir")
|
||||
++ toString tmpDir' ++ "inputDir" ++ " "
|
||||
++ toString tmpDir' ++ "outputDir")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeDirIfExists "outputDir"
|
||||
|
||||
@ -161,9 +170,8 @@ spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
normalDirPerms "outputDir1/foo2/foo4"
|
||||
normalDirPerms "outputDir1/foo2/foo4/inputFile4"
|
||||
c <- allDirectoryContents' "outputDir1"
|
||||
pwd <- fromJust <$> getEnv "PWD"
|
||||
let shouldC = (fmap (\x -> pwd `BS.append` "/" `BS.append`
|
||||
tmpDir `BS.append` x)
|
||||
tmpDir' <- getRawTmpDir
|
||||
let shouldC = (fmap (\x -> tmpDir' `BS.append` x)
|
||||
["outputDir1"
|
||||
,"outputDir1/foo2"
|
||||
,"outputDir1/foo2/inputFile1"
|
||||
|
@ -19,8 +19,17 @@ import System.Exit
|
||||
import System.Process
|
||||
import Utils
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
import Data.IORef
|
||||
(
|
||||
readIORef
|
||||
)
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CopyDirRecursiveOverwriteSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
@ -81,7 +90,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.copyDirRecursive" $ do
|
||||
|
||||
-- successes --
|
||||
@ -93,28 +102,30 @@ spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
removeDirIfExists "outputDir"
|
||||
|
||||
it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do
|
||||
tmpDir' <- getRawTmpDir
|
||||
copyDirRecursive' "inputDir"
|
||||
"outputDir"
|
||||
Overwrite
|
||||
FailEarly
|
||||
(system $ "diff -r --no-dereference "
|
||||
++ toString tmpDir ++ "inputDir" ++ " "
|
||||
++ toString tmpDir ++ "outputDir")
|
||||
++ toString tmpDir' ++ "inputDir" ++ " "
|
||||
++ toString tmpDir' ++ "outputDir")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeDirIfExists "outputDir"
|
||||
|
||||
it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do
|
||||
tmpDir' <- getRawTmpDir
|
||||
(system $ "diff -r --no-dereference "
|
||||
++ toString tmpDir ++ "inputDir" ++ " "
|
||||
++ toString tmpDir ++ "alreadyExistsD")
|
||||
++ toString tmpDir' ++ "inputDir" ++ " "
|
||||
++ toString tmpDir' ++ "alreadyExistsD")
|
||||
`shouldReturn` (ExitFailure 1)
|
||||
copyDirRecursive' "inputDir"
|
||||
"alreadyExistsD"
|
||||
Overwrite
|
||||
FailEarly
|
||||
(system $ "diff -r --no-dereference "
|
||||
++ toString tmpDir ++ "inputDir" ++ " "
|
||||
++ toString tmpDir ++ "alreadyExistsD")
|
||||
++ toString tmpDir' ++ "inputDir" ++ " "
|
||||
++ toString tmpDir' ++ "alreadyExistsD")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeDirIfExists "outputDir"
|
||||
|
||||
|
@ -19,9 +19,18 @@ import System.Exit
|
||||
import System.Process
|
||||
import Utils
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
import Data.IORef
|
||||
(
|
||||
readIORef
|
||||
)
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CopyDirRecursiveSpec"
|
||||
createTmpDir
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "alreadyExists"
|
||||
@ -67,7 +76,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.copyDirRecursive" $ do
|
||||
|
||||
-- successes --
|
||||
@ -79,13 +88,14 @@ spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
removeDirIfExists "outputDir"
|
||||
|
||||
it "copyDirRecursive (Strict, FailEarly), all fine and compare" $ do
|
||||
tmpDir' <- getRawTmpDir
|
||||
copyDirRecursive' "inputDir"
|
||||
"outputDir"
|
||||
Strict
|
||||
FailEarly
|
||||
(system $ "diff -r --no-dereference "
|
||||
++ toString tmpDir ++ "inputDir" ++ " "
|
||||
++ toString tmpDir ++ "outputDir")
|
||||
++ toString tmpDir' ++ "inputDir" ++ " "
|
||||
++ toString tmpDir' ++ "outputDir")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeDirIfExists "outputDir"
|
||||
|
||||
|
@ -18,6 +18,16 @@ import System.Exit
|
||||
import System.Process
|
||||
import Utils
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
import Data.IORef
|
||||
(
|
||||
readIORef
|
||||
)
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CopyFileOverwriteSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
@ -51,7 +61,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.copyFile" $ do
|
||||
|
||||
-- successes --
|
||||
@ -62,21 +72,23 @@ spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
removeFileIfExists "outputFile"
|
||||
|
||||
it "copyFile (Overwrite), output file already exists, all clear" $ do
|
||||
tmpDir' <- getRawTmpDir
|
||||
copyFile' "alreadyExists" "alreadyExists.bak" Strict
|
||||
copyFile' "inputFile" "alreadyExists" Overwrite
|
||||
(system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " "
|
||||
++ toString tmpDir ++ "alreadyExists")
|
||||
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "
|
||||
++ toString tmpDir' ++ "alreadyExists")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeFileIfExists "alreadyExists"
|
||||
copyFile' "alreadyExists.bak" "alreadyExists" Strict
|
||||
removeFileIfExists "alreadyExists.bak"
|
||||
|
||||
it "copyFile (Overwrite), and compare" $ do
|
||||
tmpDir' <- getRawTmpDir
|
||||
copyFile' "inputFile"
|
||||
"outputFile"
|
||||
Overwrite
|
||||
(system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " "
|
||||
++ toString tmpDir ++ "outputFile")
|
||||
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "
|
||||
++ toString tmpDir' ++ "outputFile")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeFileIfExists "outputFile"
|
||||
|
||||
|
@ -19,8 +19,17 @@ import System.Exit
|
||||
import System.Process
|
||||
import Utils
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
import Data.IORef
|
||||
(
|
||||
readIORef
|
||||
)
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CopyFileSpec"
|
||||
createTmpDir
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "inputFile"
|
||||
@ -51,7 +60,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.copyFile" $ do
|
||||
|
||||
-- successes --
|
||||
@ -62,11 +71,12 @@ spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
removeFileIfExists "outputFile"
|
||||
|
||||
it "copyFile (Strict), and compare" $ do
|
||||
tmpDir' <- getRawTmpDir
|
||||
copyFile' "inputFile"
|
||||
"outputFile"
|
||||
Strict
|
||||
(system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " "
|
||||
++ toString tmpDir ++ "outputFile")
|
||||
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "
|
||||
++ toString tmpDir' ++ "outputFile")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeFileIfExists "outputFile"
|
||||
|
||||
|
@ -15,6 +15,12 @@ import GHC.IO.Exception
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CreateDirSpec"
|
||||
createTmpDir
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createDir' "alreadyExists"
|
||||
@ -35,7 +41,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.createDir" $ do
|
||||
|
||||
-- successes --
|
||||
|
@ -15,6 +15,12 @@ import GHC.IO.Exception
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CreateRegularFileSpec"
|
||||
createTmpDir
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "alreadyExists"
|
||||
@ -23,8 +29,6 @@ setupFiles = do
|
||||
noPerms "noPerms"
|
||||
noWritableDirPerms "noWritePerms"
|
||||
|
||||
|
||||
|
||||
cleanupFiles :: IO ()
|
||||
cleanupFiles = do
|
||||
normalDirPerms "noPerms"
|
||||
@ -35,7 +39,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.createRegularFile" $ do
|
||||
|
||||
-- successes --
|
||||
|
@ -15,6 +15,12 @@ import GHC.IO.Exception
|
||||
import Utils
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "CreateSymlinkSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "alreadyExists"
|
||||
@ -34,7 +40,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.createSymlink" $ do
|
||||
|
||||
-- successes --
|
||||
|
@ -19,6 +19,13 @@ import GHC.IO.Exception
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "DeleteDirRecursiveSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "file"
|
||||
@ -44,7 +51,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.deleteDirRecursive" $ do
|
||||
|
||||
-- successes --
|
||||
|
@ -19,6 +19,14 @@ import GHC.IO.Exception
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "DeleteDirSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "file"
|
||||
@ -44,7 +52,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.deleteDir" $ do
|
||||
|
||||
-- successes --
|
||||
|
@ -20,6 +20,12 @@ import GHC.IO.Exception
|
||||
import Utils
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "DeleteFileSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "foo"
|
||||
@ -40,7 +46,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.deleteFile" $ do
|
||||
|
||||
-- successes --
|
||||
|
@ -21,6 +21,12 @@ import GHC.IO.Exception
|
||||
import Utils
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "GetDirsFilesSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "file"
|
||||
@ -47,7 +53,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.getDirsFiles" $ do
|
||||
|
||||
-- successes --
|
||||
|
@ -16,6 +16,13 @@ import GHC.IO.Exception
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "GetFileTypeSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "regularfile"
|
||||
@ -40,7 +47,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.getFileType" $ do
|
||||
|
||||
-- successes --
|
||||
|
@ -17,6 +17,13 @@ import GHC.IO.Exception
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "MoveFileOverwriteSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "myFile"
|
||||
@ -44,7 +51,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.moveFile" $ do
|
||||
|
||||
-- successes --
|
||||
|
@ -17,6 +17,13 @@ import GHC.IO.Exception
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "MoveFileSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "myFile"
|
||||
@ -46,7 +53,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.moveFile" $ do
|
||||
|
||||
-- successes --
|
||||
|
@ -20,6 +20,12 @@ import GHC.IO.Exception
|
||||
import Utils
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "RecreateSymlinkOverwriteSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "myFile"
|
||||
@ -52,7 +58,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.recreateSymlink" $ do
|
||||
|
||||
-- successes --
|
||||
|
@ -19,6 +19,13 @@ import GHC.IO.Exception
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "RecreateSymlinkSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "myFile"
|
||||
@ -47,7 +54,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.recreateSymlink" $ do
|
||||
|
||||
-- successes --
|
||||
|
@ -16,6 +16,13 @@ import GHC.IO.Exception
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
upTmpDir :: IO ()
|
||||
upTmpDir = do
|
||||
setTmpDir "RenameFileSpec"
|
||||
createTmpDir
|
||||
|
||||
|
||||
setupFiles :: IO ()
|
||||
setupFiles = do
|
||||
createRegularFile' "myFile"
|
||||
@ -44,7 +51,7 @@ cleanupFiles = do
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = before_ setupFiles $ after_ cleanupFiles $
|
||||
spec = beforeAll_ upTmpDir $ before_ setupFiles $ after_ cleanupFiles $
|
||||
describe "HPath.IO.renameFile" $ do
|
||||
|
||||
-- successes --
|
||||
|
@ -14,10 +14,6 @@ main :: IO ()
|
||||
main =
|
||||
hspecWith
|
||||
defaultConfig { configFormatter = Just progress }
|
||||
$ before_ up
|
||||
$ after_ down
|
||||
$ beforeAll_ createBaseTmpDir
|
||||
$ afterAll_ deleteBaseTmpDir
|
||||
$ Spec.spec
|
||||
where
|
||||
up = createTmpDir
|
||||
down = deleteTmpDir
|
||||
|
||||
|
@ -11,7 +11,20 @@ import Control.Applicative
|
||||
)
|
||||
import Control.Monad
|
||||
(
|
||||
void
|
||||
forM_
|
||||
, void
|
||||
)
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.IORef
|
||||
(
|
||||
newIORef
|
||||
, readIORef
|
||||
, writeIORef
|
||||
, IORef
|
||||
)
|
||||
import GHC.IO.Unsafe
|
||||
(
|
||||
unsafePerformIO
|
||||
)
|
||||
import HPath.IO
|
||||
import HPath.IO.Errors
|
||||
@ -51,8 +64,13 @@ import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB
|
||||
|
||||
|
||||
|
||||
tmpDir :: ByteString
|
||||
tmpDir = "test/HPath/IO/tmp/"
|
||||
baseTmpDir :: ByteString
|
||||
baseTmpDir = "test/HPath/IO/tmp/"
|
||||
|
||||
|
||||
tmpDir :: IORef ByteString
|
||||
{-# NOINLINE tmpDir #-}
|
||||
tmpDir = unsafePerformIO (newIORef baseTmpDir)
|
||||
|
||||
|
||||
|
||||
@ -61,31 +79,63 @@ tmpDir = "test/HPath/IO/tmp/"
|
||||
-----------------
|
||||
|
||||
|
||||
setTmpDir :: ByteString -> IO ()
|
||||
{-# NOINLINE setTmpDir #-}
|
||||
setTmpDir bs = writeIORef tmpDir (baseTmpDir `BS.append` bs)
|
||||
|
||||
|
||||
createTmpDir :: IO ()
|
||||
{-# NOINLINE createTmpDir #-}
|
||||
createTmpDir = do
|
||||
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
|
||||
tmp <- P.parseRel tmpDir
|
||||
tmp <- P.parseRel =<< readIORef tmpDir
|
||||
void $ createDir (pwd P.</> tmp)
|
||||
|
||||
|
||||
deleteTmpDir :: IO ()
|
||||
{-# NOINLINE deleteTmpDir #-}
|
||||
deleteTmpDir = do
|
||||
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
|
||||
tmp <- P.parseRel tmpDir
|
||||
tmp <- P.parseRel =<< readIORef tmpDir
|
||||
void $ deleteDir (pwd P.</> tmp)
|
||||
|
||||
|
||||
createBaseTmpDir :: IO ()
|
||||
{-# NOINLINE createBaseTmpDir #-}
|
||||
createBaseTmpDir = do
|
||||
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
|
||||
tmp <- P.parseRel baseTmpDir
|
||||
void $ createDir (pwd P.</> tmp)
|
||||
|
||||
|
||||
deleteBaseTmpDir :: IO ()
|
||||
{-# NOINLINE deleteBaseTmpDir #-}
|
||||
deleteBaseTmpDir = do
|
||||
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
|
||||
tmp <- P.parseRel baseTmpDir
|
||||
contents <- getDirsFiles (pwd P.</> tmp)
|
||||
forM_ contents deleteDir
|
||||
void $ deleteDir (pwd P.</> tmp)
|
||||
|
||||
|
||||
withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a
|
||||
{-# NOINLINE withRawTmpDir #-}
|
||||
withRawTmpDir f = do
|
||||
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
|
||||
tmp <- P.parseRel tmpDir
|
||||
tmp <- P.parseRel =<< readIORef tmpDir
|
||||
f (pwd P.</> tmp)
|
||||
|
||||
|
||||
getRawTmpDir :: IO ByteString
|
||||
{-# NOINLINE getRawTmpDir #-}
|
||||
getRawTmpDir = withRawTmpDir (return . flip BS.append "/" . P.fromAbs)
|
||||
|
||||
|
||||
withTmpDir :: ByteString -> (P.Path P.Abs -> IO a) -> IO a
|
||||
{-# NOINLINE withTmpDir #-}
|
||||
withTmpDir ip f = do
|
||||
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
|
||||
tmp <- P.parseRel tmpDir
|
||||
tmp <- P.parseRel =<< readIORef tmpDir
|
||||
p <- (pwd P.</> tmp P.</>) <$> P.parseRel ip
|
||||
f p
|
||||
|
||||
@ -94,49 +144,58 @@ withTmpDir' :: ByteString
|
||||
-> ByteString
|
||||
-> (P.Path P.Abs -> P.Path P.Abs -> IO a)
|
||||
-> IO a
|
||||
{-# NOINLINE withTmpDir' #-}
|
||||
withTmpDir' ip1 ip2 f = do
|
||||
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
|
||||
tmp <- P.parseRel tmpDir
|
||||
tmp <- P.parseRel =<< readIORef tmpDir
|
||||
p1 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip1
|
||||
p2 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip2
|
||||
f p1 p2
|
||||
|
||||
|
||||
removeFileIfExists :: ByteString -> IO ()
|
||||
{-# NOINLINE removeFileIfExists #-}
|
||||
removeFileIfExists bs =
|
||||
withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p)
|
||||
|
||||
|
||||
removeDirIfExists :: ByteString -> IO ()
|
||||
{-# NOINLINE removeDirIfExists #-}
|
||||
removeDirIfExists bs =
|
||||
withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p)
|
||||
|
||||
|
||||
copyFile' :: ByteString -> ByteString -> CopyMode -> IO ()
|
||||
{-# NOINLINE copyFile' #-}
|
||||
copyFile' inputFileP outputFileP cm =
|
||||
withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm)
|
||||
|
||||
|
||||
copyDirRecursive' :: ByteString -> ByteString
|
||||
-> CopyMode -> RecursiveMode -> IO ()
|
||||
{-# NOINLINE copyDirRecursive' #-}
|
||||
copyDirRecursive' inputDirP outputDirP cm rm =
|
||||
withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm)
|
||||
|
||||
|
||||
createDir' :: ByteString -> IO ()
|
||||
{-# NOINLINE createDir' #-}
|
||||
createDir' dest = withTmpDir dest createDir
|
||||
|
||||
|
||||
createRegularFile' :: ByteString -> IO ()
|
||||
{-# NOINLINE createRegularFile' #-}
|
||||
createRegularFile' dest = withTmpDir dest createRegularFile
|
||||
|
||||
|
||||
createSymlink' :: ByteString -> ByteString -> IO ()
|
||||
{-# NOINLINE createSymlink' #-}
|
||||
createSymlink' dest sympoint = withTmpDir dest
|
||||
(\x -> createSymlink x sympoint)
|
||||
|
||||
|
||||
renameFile' :: ByteString -> ByteString -> IO ()
|
||||
{-# NOINLINE renameFile' #-}
|
||||
renameFile' inputFileP outputFileP =
|
||||
withTmpDir' inputFileP outputFileP $ \i o -> do
|
||||
renameFile i o
|
||||
@ -144,6 +203,7 @@ renameFile' inputFileP outputFileP =
|
||||
|
||||
|
||||
moveFile' :: ByteString -> ByteString -> CopyMode -> IO ()
|
||||
{-# NOINLINE moveFile' #-}
|
||||
moveFile' inputFileP outputFileP cm =
|
||||
withTmpDir' inputFileP outputFileP $ \i o -> do
|
||||
moveFile i o cm
|
||||
@ -151,11 +211,13 @@ moveFile' inputFileP outputFileP cm =
|
||||
|
||||
|
||||
recreateSymlink' :: ByteString -> ByteString -> CopyMode -> IO ()
|
||||
{-# NOINLINE recreateSymlink' #-}
|
||||
recreateSymlink' inputFileP outputFileP cm =
|
||||
withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm)
|
||||
|
||||
|
||||
noWritableDirPerms :: ByteString -> IO ()
|
||||
{-# NOINLINE noWritableDirPerms #-}
|
||||
noWritableDirPerms path = withTmpDir path $ \p ->
|
||||
setFileMode (P.fromAbs p) perms
|
||||
where
|
||||
@ -168,39 +230,48 @@ noWritableDirPerms path = withTmpDir path $ \p ->
|
||||
|
||||
|
||||
noPerms :: ByteString -> IO ()
|
||||
{-# NOINLINE noPerms #-}
|
||||
noPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) nullFileMode
|
||||
|
||||
|
||||
normalDirPerms :: ByteString -> IO ()
|
||||
{-# NOINLINE normalDirPerms #-}
|
||||
normalDirPerms path =
|
||||
withTmpDir path $ \p -> setFileMode (P.fromAbs p) newDirPerms
|
||||
|
||||
|
||||
getFileType' :: ByteString -> IO FileType
|
||||
{-# NOINLINE getFileType' #-}
|
||||
getFileType' path = withTmpDir path getFileType
|
||||
|
||||
|
||||
getDirsFiles' :: ByteString -> IO [P.Path P.Abs]
|
||||
{-# NOINLINE getDirsFiles' #-}
|
||||
getDirsFiles' path = withTmpDir path getDirsFiles
|
||||
|
||||
|
||||
deleteFile' :: ByteString -> IO ()
|
||||
{-# NOINLINE deleteFile' #-}
|
||||
deleteFile' p = withTmpDir p deleteFile
|
||||
|
||||
|
||||
deleteDir' :: ByteString -> IO ()
|
||||
{-# NOINLINE deleteDir' #-}
|
||||
deleteDir' p = withTmpDir p deleteDir
|
||||
|
||||
|
||||
deleteDirRecursive' :: ByteString -> IO ()
|
||||
{-# NOINLINE deleteDirRecursive' #-}
|
||||
deleteDirRecursive' p = withTmpDir p deleteDirRecursive
|
||||
|
||||
|
||||
canonicalizePath' :: ByteString -> IO (P.Path P.Abs)
|
||||
{-# NOINLINE canonicalizePath' #-}
|
||||
canonicalizePath' p = withTmpDir p canonicalizePath
|
||||
|
||||
|
||||
writeFile' :: ByteString -> ByteString -> IO ()
|
||||
{-# NOINLINE writeFile' #-}
|
||||
writeFile' ip bs =
|
||||
withTmpDir ip $ \p -> do
|
||||
fd <- SPI.openFd (P.fromAbs p) SPI.WriteOnly Nothing
|
||||
@ -210,6 +281,7 @@ writeFile' ip bs =
|
||||
|
||||
|
||||
allDirectoryContents' :: ByteString -> IO [ByteString]
|
||||
{-# NOINLINE allDirectoryContents' #-}
|
||||
allDirectoryContents' ip =
|
||||
withTmpDir ip $ \p -> allDirectoryContents (P.fromAbs p)
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user