@@ -1,7 +0,0 @@ | |||
#include "dirutils.h" | |||
unsigned int | |||
__posixdir_d_type(struct dirent* d) | |||
{ | |||
return(d -> d_type); | |||
} | |||
@@ -1,13 +0,0 @@ | |||
#ifndef POSIXPATHS_CBITS_DIRUTILS_H | |||
#define POSIXPATHS_CBITS_DIRUTILS_H | |||
#include <stdlib.h> | |||
#include <dirent.h> | |||
#include <sys/types.h> | |||
#include <sys/stat.h> | |||
#include <fcntl.h> | |||
extern unsigned int | |||
__posixdir_d_type(struct dirent* d) | |||
; | |||
#endif |
@@ -19,23 +19,18 @@ tested-with: GHC==7.10.3 | |||
, GHC==8.8.1 | |||
extra-source-files: README.md | |||
CHANGELOG.md | |||
cbits/dirutils.h | |||
library | |||
if os(windows) | |||
build-depends: unbuildable<0 | |||
buildable: False | |||
exposed-modules: HPath.IO, | |||
HPath.IO.Errors, | |||
System.Posix.Directory.Foreign, | |||
System.Posix.Directory.Traversals, | |||
System.Posix.FD | |||
c-sources: cbits/dirutils.c | |||
exposed-modules: HPath.IO | |||
build-depends: base >= 4.8 && <5 | |||
, IfElse | |||
, bytestring >= 0.10.0.0 | |||
, exceptions | |||
, hpath >= 0.11 && < 0.12 | |||
, hpath-directory >= 0.13 && < 0.14 | |||
, hpath-filepath >= 0.10.2 && < 0.11 | |||
, safe-exceptions >= 0.1 | |||
, streamly >= 0.7 | |||
@@ -49,56 +44,6 @@ library | |||
hs-source-dirs: src | |||
default-language: Haskell2010 | |||
test-suite spec | |||
if os(windows) | |||
build-depends: unbuildable<0 | |||
buildable: False | |||
Type: exitcode-stdio-1.0 | |||
Default-Language: Haskell2010 | |||
Hs-Source-Dirs: test | |||
Main-Is: Main.hs | |||
other-modules: | |||
HPath.IO.AppendFileSpec | |||
HPath.IO.CanonicalizePathSpec | |||
HPath.IO.CopyDirRecursiveCollectFailuresSpec | |||
HPath.IO.CopyDirRecursiveOverwriteSpec | |||
HPath.IO.CopyDirRecursiveSpec | |||
HPath.IO.CopyFileOverwriteSpec | |||
HPath.IO.CopyFileSpec | |||
HPath.IO.CreateDirIfMissingSpec | |||
HPath.IO.CreateDirRecursiveSpec | |||
HPath.IO.CreateDirSpec | |||
HPath.IO.CreateRegularFileSpec | |||
HPath.IO.CreateSymlinkSpec | |||
HPath.IO.DeleteDirRecursiveSpec | |||
HPath.IO.DeleteDirSpec | |||
HPath.IO.DeleteFileSpec | |||
HPath.IO.GetDirsFilesSpec | |||
HPath.IO.GetFileTypeSpec | |||
HPath.IO.MoveFileOverwriteSpec | |||
HPath.IO.MoveFileSpec | |||
HPath.IO.ReadFileSpec | |||
HPath.IO.RecreateSymlinkOverwriteSpec | |||
HPath.IO.RecreateSymlinkSpec | |||
HPath.IO.RenameFileSpec | |||
HPath.IO.ToAbsSpec | |||
HPath.IO.WriteFileLSpec | |||
HPath.IO.WriteFileSpec | |||
Spec | |||
Utils | |||
GHC-Options: -Wall | |||
Build-Depends: base | |||
, HUnit | |||
, IfElse | |||
, bytestring >= 0.10.0.0 | |||
, hpath | |||
, hpath-io | |||
, hspec >= 1.3 | |||
, process | |||
, time >= 1.8 | |||
, unix | |||
, unix-bytestring | |||
, utf8-string | |||
source-repository head | |||
type: git | |||
@@ -9,15 +9,9 @@ | |||
-- | |||
-- This module provides high-level IO related file operations like | |||
-- copy, delete, move and so on. It only operates on /Path x/ which | |||
-- | |||
-- guarantees us well-typed paths. This is a thin wrapper over | |||
-- System.Posix.RawFilePath.Directory in 'hpath-directory'. It's | |||
-- encouraged to use this module. | |||
-- | |||
-- Some of these operations are due to their nature __not atomic__, which | |||
-- means they may do multiple syscalls which form one context. Some | |||
@@ -98,6 +92,7 @@ module HPath.IO | |||
, toAbs | |||
, withRawFilePath | |||
, withHandle | |||
, module System.Posix.RawFilePath.Directory.Errors | |||
) | |||
where | |||
@@ -197,7 +192,6 @@ import GHC.IO.Exception | |||
IOErrorType(..) | |||
) | |||
import HPath | |||
import HPath.IO.Errors | |||
import Prelude hiding (appendFile, readFile, writeFile) | |||
import Streamly | |||
import Streamly.External.ByteString | |||
@@ -227,10 +221,6 @@ import System.Posix.Directory.ByteString | |||
, openDirStream | |||
, removeDirectory | |||
) | |||
import System.Posix.Directory.Traversals | |||
( | |||
getDirectoryContents' | |||
) | |||
import System.Posix.Files.ByteString | |||
( | |||
createSymbolicLink | |||
@@ -260,9 +250,8 @@ import System.Posix.FD | |||
( | |||
openFd | |||
) | |||
import qualified System.Posix.Directory.Traversals as SPDT | |||
import qualified System.Posix.Directory.Foreign as SPDF | |||
import qualified System.Posix.Process.ByteString as SPP | |||
import System.Posix.RawFilePath.Directory.Errors | |||
import System.Posix.Types | |||
( | |||
FileMode | |||
@@ -272,48 +261,17 @@ import System.Posix.Types | |||
) | |||
import System.Posix.Time | |||
import qualified System.Posix.RawFilePath.Directory as RD | |||
import System.Posix.RawFilePath.Directory | |||
( | |||
FileType | |||
, RecursiveErrorMode | |||
, CopyMode | |||
) | |||
------------- | |||
--[ Types ]-- | |||
------------- | |||
data FileType = Directory | |||
| RegularFile | |||
| SymbolicLink | |||
| BlockDevice | |||
| CharacterDevice | |||
| NamedPipe | |||
| Socket | |||
deriving (Eq, Show) | |||
-- | |||
-- | |||
data RecursiveErrorMode = FailEarly | |||
| CollectFailures | |||
data CopyMode = Strict -- ^ fail if any target exists | |||
| Overwrite -- ^ overwrite targets | |||
-------------------- | |||
@@ -379,68 +337,8 @@ copyDirRecursive :: Path b1 -- ^ source dir | |||
-> CopyMode | |||
-> RecursiveErrorMode | |||
-> IO () | |||
copyDirRecursive fromp destdirp cm rm | |||
= do | |||
ce <- newIORef [] | |||
-- for performance, sanity checks are only done for the top dir | |||
throwSameFile fromp destdirp | |||
throwDestinationInSource fromp destdirp | |||
go ce fromp destdirp | |||
collectedExceptions <- readIORef ce | |||
unless (null collectedExceptions) | |||
(throwIO . RecursiveFailure $ collectedExceptions) | |||
where | |||
go :: IORef [(RecursiveFailureHint, IOException)] | |||
-> Path b1 -> Path b2 -> IO () | |||
go ce fromp'@(Path fromBS) destdirp'@(Path destdirpBS) = do | |||
-- NOTE: order is important here, so we don't get empty directories | |||
-- on failure | |||
-- get the contents of the source dir | |||
contents <- handleIOE (ReadContentsFailed fromBS destdirpBS) ce [] $ do | |||
contents <- getDirsFiles fromp' | |||
-- create the destination dir and | |||
-- only return contents if we succeed | |||
handleIOE (CreateDirFailed fromBS destdirpBS) ce [] $ do | |||
fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus fromBS | |||
case cm of | |||
Strict -> createDirectory destdirpBS fmode' | |||
Overwrite -> catchIOError (createDirectory destdirpBS | |||
fmode') | |||
$ \e -> | |||
case ioeGetErrorType e of | |||
AlreadyExists -> setFileMode destdirpBS | |||
fmode' | |||
_ -> ioError e | |||
return contents | |||
-- NOTE: we can't use `easyCopy` here, because we want to call `go` | |||
-- recursively to skip the top-level sanity checks | |||
-- if reading the contents and creating the destination dir worked, | |||
-- then copy the contents to the destination too | |||
for_ contents $ \f -> do | |||
ftype <- getFileType f | |||
newdest <- (destdirp' </>) <$> basename f | |||
case ftype of | |||
SymbolicLink -> handleIOE (RecreateSymlinkFailed (toFilePath f) (toFilePath newdest)) ce () | |||
$ recreateSymlink f newdest cm | |||
Directory -> go ce f newdest | |||
RegularFile -> handleIOE (CopyFileFailed (toFilePath f) (toFilePath newdest)) ce () | |||
$ copyFile f newdest cm | |||
_ -> return () | |||
-- helper to handle errors for both RecursiveErrorModes and return a | |||
-- default value | |||
handleIOE :: RecursiveFailureHint | |||
-> IORef [(RecursiveFailureHint, IOException)] | |||
-> a -> IO a -> IO a | |||
handleIOE hint ce def = case rm of | |||
FailEarly -> handleIOError throwIO | |||
CollectFailures -> handleIOError (\e -> modifyIORef ce ((hint, e):) | |||
>> return def) | |||
copyDirRecursive (Path fromp) (Path destdirp) cm rm | |||
= RD.copyDirRecursive fromp destdirp cm rm | |||
-- |Recreate a symlink. | |||
@@ -476,21 +374,8 @@ recreateSymlink :: Path b1 -- ^ the old symlink file | |||
-> Path b2 -- ^ destination file | |||
-> CopyMode | |||
-> IO () | |||
recreateSymlink symsource@(Path symsourceBS) newsym@(Path newsymBS) cm | |||
= do | |||
throwSameFile symsource newsym | |||
sympoint <- readSymbolicLink symsourceBS | |||
case cm of | |||
Strict -> return () | |||
Overwrite -> do | |||
writable <- toAbs newsym >>= (\p -> do | |||
e <- doesExist p | |||
if e then isWritable p else pure False) | |||
isfile <- doesFileExist newsym | |||
isdir <- doesDirectoryExist newsym | |||
when (writable && isfile) (deleteFile newsym) | |||
when (writable && isdir) (deleteDir newsym) | |||
createSymbolicLink sympoint newsymBS | |||
recreateSymlink (Path symsourceBS) (Path newsymBS) cm | |||
= RD.recreateSymlink symsourceBS newsymBS cm | |||
-- |Copies the given regular file to the given destination. | |||
@@ -535,36 +420,7 @@ copyFile :: Path b1 -- ^ source file | |||
-> Path b2 -- ^ destination file | |||
-> CopyMode | |||
-> IO () | |||
copyFile fp@(Path from) tp@(Path to) cm = do | |||
throwSameFile fp tp | |||
bracket (do | |||
fd <- openFd from SPI.ReadOnly [SPDF.oNofollow] Nothing | |||
handle <- SPI.fdToHandle fd | |||
pure (fd, handle)) | |||
(\(_, handle) -> SIO.hClose handle) | |||
$ \(fromFd, fH) -> do | |||
sourceFileMode <- System.Posix.Files.ByteString.fileMode <$> getFdStatus fromFd | |||
let dflags = [SPDF.oNofollow, case cm of | |||
Strict -> SPDF.oExcl | |||
Overwrite -> SPDF.oTrunc] | |||
bracketeer (do | |||
fd <- openFd to SPI.WriteOnly dflags $ Just sourceFileMode | |||
handle <- SPI.fdToHandle fd | |||
pure (fd, handle)) | |||
(\(_, handle) -> SIO.hClose handle) | |||
(\(_, handle) -> do | |||
SIO.hClose handle | |||
case cm of | |||
-- if we created the file and copying failed, it's | |||
-- safe to clean up | |||
Strict -> deleteFile tp | |||
Overwrite -> pure ()) | |||
$ \(_, tH) -> do | |||
SIO.hSetBinaryMode fH True | |||
SIO.hSetBinaryMode tH True | |||
streamlyCopy (fH, tH) | |||
where | |||
streamlyCopy (fH, tH) = S.fold (FH.writeChunks tH) $ IFH.toChunksWithBufferOf (256*1024) fH | |||
copyFile (Path from) (Path to) cm = RD.copyFile from to cm | |||
-- |Copies a regular file, directory or symbolic link. In case of a | |||
-- symbolic link it is just recreated, even if it points to a directory. | |||
@@ -581,13 +437,8 @@ easyCopy :: Path b1 | |||
-> CopyMode | |||
-> RecursiveErrorMode | |||
-> IO () | |||
easyCopy from to cm rm = do | |||
ftype <- getFileType from | |||
case ftype of | |||
SymbolicLink -> recreateSymlink from to cm | |||
RegularFile -> copyFile from to cm | |||
Directory -> copyDirRecursive from to cm rm | |||
_ -> return () | |||
easyCopy (Path from) (Path to) cm rm = RD.easyCopy from to cm rm | |||
@@ -607,7 +458,7 @@ easyCopy from to cm rm = do | |||
-- - `NoSuchThing` if the file does not exist | |||
-- - `PermissionDenied` if the directory cannot be read | |||
deleteFile :: Path b -> IO () | |||
deleteFile (Path p) = removeLink p | |||
deleteFile (Path p) = RD.deleteFile p | |||
-- |Deletes the given directory, which must be empty, never symlinks. | |||
@@ -622,7 +473,7 @@ deleteFile (Path p) = removeLink p | |||
-- | |||
-- Notes: calls `rmdir` | |||
deleteDir :: Path b -> IO () | |||
deleteDir (Path p) = removeDirectory p | |||
deleteDir (Path p) = RD.deleteDir p | |||
-- |Deletes the given directory recursively. Does not follow symbolic | |||
@@ -645,19 +496,8 @@ deleteDir (Path p) = removeDirectory p | |||
-- - `NoSuchThing` if directory does not exist | |||
-- - `PermissionDenied` if we can't open or write to parent directory | |||
deleteDirRecursive :: Path b -> IO () | |||
deleteDirRecursive p = | |||
catchErrno [eNOTEMPTY, eEXIST] | |||
(deleteDir p) | |||
$ do | |||
files <- getDirsFiles p | |||
for_ files $ \file -> do | |||
ftype <- getFileType file | |||
case ftype of | |||
SymbolicLink -> deleteFile file | |||
Directory -> deleteDirRecursive file | |||
RegularFile -> deleteFile file | |||
_ -> return () | |||
removeDirectory . toFilePath $ p | |||
deleteDirRecursive (Path p) = RD.deleteDirRecursive p | |||
-- |Deletes a file, directory or symlink. | |||
@@ -670,13 +510,7 @@ deleteDirRecursive p = | |||
-- * examines filetypes explicitly | |||
-- * calls `deleteDirRecursive` for directories | |||
easyDelete :: Path b -> IO () | |||
easyDelete p = do | |||
ftype <- getFileType p | |||
case ftype of | |||
SymbolicLink -> deleteFile p | |||
Directory -> deleteDirRecursive p | |||
RegularFile -> deleteFile p | |||
_ -> return () | |||
easyDelete (Path p) = RD.easyDelete p | |||
@@ -690,16 +524,14 @@ easyDelete p = do | |||
-- is not checked. This forks a process. | |||
openFile :: Path b | |||
-> IO ProcessID | |||
openFile (Path fp) = | |||
SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing | |||
openFile (Path fp) = RD.openFile fp | |||
-- |Executes a program with the given arguments. This forks a process. | |||
executeFile :: Path b -- ^ program | |||
-> [ByteString] -- ^ arguments | |||
-> IO ProcessID | |||
executeFile (Path fp) args = | |||
SPP.forkProcess $ SPP.executeFile fp True args Nothing | |||
executeFile (Path fp) args = RD.executeFile fp args | |||
@@ -719,11 +551,7 @@ executeFile (Path fp) args = | |||
-- - `NoSuchThing` if any of the parent components of the path | |||
-- do not exist | |||
createRegularFile :: FileMode -> Path b -> IO () | |||
createRegularFile fm (Path destBS) = | |||
bracket (SPI.openFd destBS SPI.WriteOnly (Just fm) | |||
(SPI.defaultFileFlags { exclusive = True })) | |||
SPI.closeFd | |||
(\_ -> return ()) | |||
createRegularFile fm (Path destBS) = RD.createRegularFile fm destBS | |||
-- |Create an empty directory at the given directory with the given filename. | |||
@@ -735,7 +563,7 @@ createRegularFile fm (Path destBS) = | |||
-- - `NoSuchThing` if any of the parent components of the path | |||
-- do not exist | |||
createDir :: FileMode -> Path b -> IO () | |||
createDir fm (Path destBS) = createDirectory destBS fm | |||
createDir fm (Path destBS) = RD.createDir fm destBS | |||
-- |Create an empty directory at the given directory with the given filename. | |||
-- | |||
@@ -745,8 +573,7 @@ createDir fm (Path destBS) = createDirectory destBS fm | |||
-- - `NoSuchThing` if any of the parent components of the path | |||
-- do not exist | |||
createDirIfMissing :: FileMode -> Path b -> IO () | |||
createDirIfMissing fm (Path destBS) = | |||
hideError AlreadyExists $ createDirectory destBS fm | |||
createDirIfMissing fm (Path destBS) = RD.createDirIfMissing fm destBS | |||
-- |Create an empty directory at the given directory with the given filename. | |||
@@ -770,18 +597,8 @@ createDirIfMissing fm (Path destBS) = | |||
-- | |||
-- Note: calls `getcwd` if the input path is a relative path | |||
createDirRecursive :: FileMode -> Path b -> IO () | |||
createDirRecursive fm p = | |||
toAbs p >>= go | |||
where | |||
go :: Path Abs -> IO () | |||
go dest@(Path destBS) = do | |||
catchIOError (createDirectory destBS fm) $ \e -> do | |||
errno <- getErrno | |||
case errno of | |||
en | en == eEXIST -> unlessM (doesDirectoryExist dest) (ioError e) | |||
| en == eNOENT -> createDirRecursive fm (dirname dest) | |||
>> createDirectory destBS fm | |||
| otherwise -> ioError e | |||
createDirRecursive fm (Path p) = RD.createDirRecursive fm p | |||
-- |Create a symlink. | |||
@@ -797,8 +614,7 @@ createDirRecursive fm p = | |||
createSymlink :: Path b -- ^ destination file | |||
-> ByteString -- ^ path the symlink points to | |||
-> IO () | |||
createSymlink (Path destBS) sympoint | |||
= createSymbolicLink sympoint destBS | |||
createSymlink (Path destBS) sympoint = RD.createSymlink destBS sympoint | |||
@@ -829,11 +645,8 @@ createSymlink (Path destBS) sympoint | |||
-- | |||
-- Note: calls `rename` (but does not allow to rename over existing files) | |||
renameFile :: Path b1 -> Path b2 -> IO () | |||
renameFile fromf@(Path fromfBS) tof@(Path tofBS) = do | |||
throwSameFile fromf tof | |||
throwFileDoesExist tof | |||
throwDirDoesExist tof | |||
rename fromfBS tofBS | |||
renameFile (Path from) (Path to) = RD.renameFile from to | |||
-- |Move a file. This also works across devices by copy-delete fallback. | |||
@@ -872,30 +685,7 @@ moveFile :: Path b1 -- ^ file to move | |||
-> Path b2 -- ^ destination | |||
-> CopyMode | |||
-> IO () | |||
moveFile from to cm = do | |||
throwSameFile from to | |||
case cm of | |||
Strict -> catchErrno [eXDEV] (renameFile from to) $ do | |||
easyCopy from to Strict FailEarly | |||
easyDelete from | |||
Overwrite -> do | |||
ft <- getFileType from | |||
writable <- toAbs to >>= (\p -> do | |||
e <- doesFileExist p | |||
if e then isWritable p else pure False) | |||
case ft of | |||
RegularFile -> do | |||
exists <- doesFileExist to | |||
when (exists && writable) (deleteFile to) | |||
SymbolicLink -> do | |||
exists <- doesFileExist to | |||
when (exists && writable) (deleteFile to) | |||
Directory -> do | |||
exists <- doesDirectoryExist to | |||
when (exists && writable) (deleteDir to) | |||
_ -> return () | |||
moveFile from to Strict | |||
moveFile (Path from) (Path to) cm = RD.moveFile from to cm | |||
@@ -922,9 +712,7 @@ moveFile from to cm = do | |||
-- containting it | |||
-- - `NoSuchThing` if the file does not exist | |||
readFile :: Path b -> IO L.ByteString | |||
readFile path = do | |||
stream <- readFileStream path | |||
toLazyByteString <$> S.fold FL.mconcat (fmap byteString stream) | |||
readFile (Path path) = RD.readFile path | |||
@@ -939,11 +727,7 @@ readFile path = do | |||
-- - `NoSuchThing` if the file does not exist | |||
readFileStream :: Path b | |||
-> IO (SerialT IO ByteString) | |||
readFileStream (Path fp) = do | |||
fd <- openFd fp SPI.ReadOnly [] Nothing | |||
handle <- SPI.fdToHandle fd | |||
let stream = fmap fromArray (S.unfold (SU.finally SIO.hClose FH.readChunks) handle) | |||
pure stream | |||
readFileStream (Path fp) = RD.readFileStream fp | |||
@@ -966,8 +750,7 @@ writeFile :: Path b | |||
-> Maybe FileMode -- ^ if Nothing, file must exist | |||
-> ByteString | |||
-> IO () | |||
writeFile (Path fp) fmode bs = | |||
bracket (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs | |||
writeFile (Path fp) fmode bs = RD.writeFile fp fmode bs | |||
-- |Write a given lazy ByteString to a file, truncating the file beforehand. | |||
@@ -985,11 +768,7 @@ writeFileL :: Path b | |||
-> Maybe FileMode -- ^ if Nothing, file must exist | |||
-> L.ByteString | |||
-> IO () | |||
writeFileL (Path fp) fmode lbs = do | |||
handle <- bracketOnError (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) $ SPI.fdToHandle | |||
finally (streamlyCopy handle) (SIO.hClose handle) | |||
where | |||
streamlyCopy tH = S.fold (FH.writeChunks tH) $ SL.toChunks lbs | |||
writeFileL (Path fp) fmode lbs = RD.writeFileL fp fmode lbs | |||
-- |Append a given ByteString to a file. | |||
@@ -1002,9 +781,7 @@ writeFileL (Path fp) fmode lbs = do | |||
-- containting it | |||
-- - `NoSuchThing` if the file does not exist | |||
appendFile :: Path b -> ByteString -> IO () | |||
appendFile (Path fp) bs = | |||
bracket (openFd fp SPI.WriteOnly [SPDF.oAppend] Nothing) | |||
(SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs | |||
appendFile (Path fp) bs = RD.appendFile fp bs | |||
@@ -1047,11 +824,7 @@ newDirPerms | |||
-- | |||
-- Only eNOENT is catched (and returns False). | |||
doesExist :: Path b -> IO Bool | |||
doesExist (Path bs) = | |||
catchErrno [eNOENT] (do | |||
_ <- PF.getSymbolicLinkStatus bs | |||
return $ True) | |||
$ return False | |||
doesExist (Path bs) = RD.doesExist bs | |||
-- |Checks if the given file exists and is not a directory. | |||
@@ -1059,11 +832,7 @@ doesExist (Path bs) = | |||
-- | |||
-- Only eNOENT is catched (and returns False). | |||
doesFileExist :: Path b -> IO Bool | |||
doesFileExist (Path bs) = | |||
catchErrno [eNOENT] (do | |||
fs <- PF.getSymbolicLinkStatus bs | |||
return $ not . PF.isDirectory $ fs) | |||
$ return False | |||
doesFileExist (Path bs) = RD.doesFileExist bs | |||
-- |Checks if the given file exists and is a directory. | |||
@@ -1071,11 +840,7 @@ doesFileExist (Path bs) = | |||
-- | |||
-- Only eNOENT is catched (and returns False). | |||
doesDirectoryExist :: Path b -> IO Bool | |||
doesDirectoryExist (Path bs) = | |||
catchErrno [eNOENT] (do | |||
fs <- PF.getSymbolicLinkStatus bs | |||
return $ PF.isDirectory fs) | |||
$ return False | |||
doesDirectoryExist (Path bs) = RD.doesDirectoryExist bs | |||
-- |Checks whether a file or folder is readable. | |||
@@ -1086,7 +851,7 @@ doesDirectoryExist (Path bs) = | |||
-- | |||
-- - `NoSuchThing` if the file does not exist | |||
isReadable :: Path b -> IO Bool | |||
isReadable (Path bs) = fileAccess bs True False False | |||
isReadable (Path bs) = RD.isReadable bs | |||
-- |Checks whether a file or folder is writable. | |||
-- | |||
@@ -1096,7 +861,7 @@ isReadable (Path bs) = fileAccess bs True False False | |||
-- | |||
-- - `NoSuchThing` if the file does not exist | |||
isWritable :: Path b -> IO Bool | |||
isWritable (Path bs) = fileAccess bs False True False | |||
isWritable (Path bs) = RD.isWritable bs | |||
-- |Checks whether a file or folder is executable. | |||
@@ -1107,19 +872,14 @@ isWritable (Path bs) = fileAccess bs False True False | |||
-- | |||
-- - `NoSuchThing` if the file does not exist | |||
isExecutable :: Path b -> IO Bool | |||
isExecutable (Path bs) = fileAccess bs False False True | |||
isExecutable (Path bs) = RD.isExecutable bs | |||
-- |Checks whether the directory at the given path exists and can be | |||
-- opened. This invokes `openDirStream` which follows symlinks. | |||
canOpenDirectory :: Path b -> IO Bool | |||
canOpenDirectory (Path bs) = | |||
handleIOError (\_ -> return False) $ do | |||
bracket (openDirStream bs) | |||
closeDirStream | |||
(\_ -> return ()) | |||
return True | |||
canOpenDirectory (Path bs) = RD.canOpenDirectory bs | |||
@@ -1130,21 +890,13 @@ canOpenDirectory (Path bs) = | |||
getModificationTime :: Path b -> IO UTCTime | |||
getModificationTime (Path bs) = do | |||
fs <- PF.getFileStatus bs | |||
pure $ posixSecondsToUTCTime $ PF.modificationTimeHiRes fs | |||
getModificationTime (Path bs) = RD.getModificationTime bs | |||
setModificationTime :: Path b -> EpochTime -> IO () | |||
setModificationTime (Path bs) t = do | |||
-- TODO: setFileTimes doesn't allow to pass NULL to utime | |||
ctime <- epochTime | |||
PF.setFileTimes bs ctime t | |||
setModificationTime (Path bs) t = RD.setModificationTime bs t | |||
setModificationTimeHiRes :: Path b -> POSIXTime -> IO () | |||
setModificationTimeHiRes (Path bs) t = do | |||
-- TODO: setFileTimesHiRes doesn't allow to pass NULL to utimes | |||
ctime <- getPOSIXTime | |||
PF.setFileTimesHiRes bs ctime t | |||
setModificationTimeHiRes (Path bs) t = RD.setModificationTimeHiRes bs t | |||
@@ -1177,13 +929,9 @@ getDirsFiles p@(Path fp) = do | |||
-- of prepending the base path. | |||
getDirsFiles' :: Path b -- ^ dir to read | |||
-> IO [Path Rel] | |||
getDirsFiles' p@(Path fp) = do | |||
fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing | |||
rawContents <- getDirectoryContents' fd | |||
fmap catMaybes $ for rawContents $ \(_, f) -> | |||
if FP.isSpecialDirectoryEntry f | |||
then pure Nothing | |||
else fmap Just $ parseRel f | |||
getDirsFiles' (Path fp) = do | |||
rawContents <- RD.getDirsFiles' fp | |||
for rawContents $ \r -> parseRel r | |||
@@ -1201,19 +949,7 @@ getDirsFiles' p@(Path fp) = do | |||
-- - `NoSuchThing` if the file does not exist | |||
-- - `PermissionDenied` if any part of the path is not accessible | |||
getFileType :: Path b -> IO FileType | |||
getFileType (Path fp) = do | |||
fs <- PF.getSymbolicLinkStatus fp | |||
decide fs | |||
where | |||
decide fs | |||
| PF.isDirectory fs = return Directory | |||
| PF.isRegularFile fs = return RegularFile | |||
| PF.isSymbolicLink fs = return SymbolicLink | |||
| PF.isBlockDevice fs = return BlockDevice | |||
| PF.isCharacterDevice fs = return CharacterDevice | |||
| PF.isNamedPipe fs = return NamedPipe | |||
| PF.isSocket fs = return Socket | |||
| otherwise = ioError $ userError "No filetype?!" | |||
getFileType (Path fp) = RD.getFileType fp | |||
@@ -1232,7 +968,7 @@ getFileType (Path fp) = do | |||
-- - `PathParseException` if realpath does not return an absolute path | |||
canonicalizePath :: Path b -> IO (Path Abs) | |||
canonicalizePath (Path l) = do | |||
nl <- SPDT.realpath l | |||
nl <- RD.canonicalizePath l | |||
parseAbs nl | |||
@@ -1,16 +0,0 @@ | |||
module HPath.IO where | |||
import HPath | |||
canonicalizePath :: Path b -> IO (Path Abs) | |||
toAbs :: Path b -> IO (Path Abs) | |||
doesFileExist :: Path b -> IO Bool | |||
doesDirectoryExist :: Path b -> IO Bool | |||
isWritable :: Path b -> IO Bool | |||
canOpenDirectory :: Path b -> IO Bool |
@@ -1,324 +0,0 @@ | |||
-- | |||
-- | |||
{-# LANGUAGE DeriveDataTypeable #-} | |||
{-# LANGUAGE ScopedTypeVariables #-} | |||
module HPath.IO.Errors | |||
( | |||
-- * Types | |||
HPathIOException(..) | |||
, RecursiveFailureHint(..) | |||
-- * Exception identifiers | |||
, isSameFile | |||
, isDestinationInSource | |||
, isRecursiveFailure | |||
, isReadContentsFailed | |||
, isCreateDirFailed | |||
, isCopyFileFailed | |||
, isRecreateSymlinkFailed | |||
-- * Path based functions | |||
, throwFileDoesExist | |||
, throwDirDoesExist | |||
, throwSameFile | |||
, sameFile | |||
, throwDestinationInSource | |||
-- * Error handling functions | |||
, catchErrno | |||
, rethrowErrnoAs | |||
, handleIOError | |||
, hideError | |||
, bracketeer | |||
, reactOnError | |||
) | |||
where | |||
import Control.Applicative | |||
( | |||
(<$>) | |||
) | |||
import Control.Exception.Safe hiding (handleIOError) | |||
import Control.Monad | |||
( | |||
forM | |||
, when | |||
) | |||
import Control.Monad.IfElse | |||
( | |||
whenM | |||
) | |||
import Data.ByteString | |||
( | |||
ByteString | |||
) | |||
import Data.ByteString.UTF8 | |||
( | |||
toString | |||
) | |||
import Data.Typeable | |||
( | |||
Typeable | |||
) | |||
import Foreign.C.Error | |||
( | |||
getErrno | |||
, Errno | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType | |||
) | |||
import HPath | |||
import {-# SOURCE #-} HPath.IO | |||
( | |||
canonicalizePath | |||
, toAbs | |||
, doesFileExist | |||
, doesDirectoryExist | |||
, isWritable | |||
, canOpenDirectory | |||
) | |||
import System.IO.Error | |||
( | |||
alreadyExistsErrorType | |||
, ioeGetErrorType | |||
, mkIOError | |||
) | |||
import qualified System.Posix.Directory.ByteString as PFD | |||
import System.Posix.Files.ByteString | |||
( | |||
fileAccess | |||
, getFileStatus | |||
) | |||
import qualified System.Posix.Files.ByteString as PF | |||
data HPathIOException = SameFile ByteString ByteString | |||
| DestinationInSource ByteString ByteString | |||
| RecursiveFailure [(RecursiveFailureHint, IOException)] | |||
deriving (Eq, Show, Typeable) | |||
-- | |||
data RecursiveFailureHint = ReadContentsFailed ByteString ByteString | |||
| CreateDirFailed ByteString ByteString | |||
| CopyFileFailed ByteString ByteString | |||
| RecreateSymlinkFailed ByteString ByteString | |||
deriving (Eq, Show) | |||
instance Exception HPathIOException | |||
toConstr :: HPathIOException -> String | |||
toConstr SameFile {} = "SameFile" | |||
toConstr DestinationInSource {} = "DestinationInSource" | |||
toConstr RecursiveFailure {} = "RecursiveFailure" | |||
----------------------------- | |||
--[ Exception identifiers ]-- | |||
----------------------------- | |||
isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool | |||
isSameFile ex = toConstr (ex :: HPathIOException) == toConstr (SameFile mempty mempty) | |||
isDestinationInSource ex = toConstr (ex :: HPathIOException) == (toConstr $ DestinationInSource mempty mempty) | |||
isRecursiveFailure ex = toConstr (ex :: HPathIOException) == (toConstr $ RecursiveFailure mempty) | |||
isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool | |||
isReadContentsFailed ReadContentsFailed{} = True | |||
isReadContentsFailed _ = False | |||
isCreateDirFailed CreateDirFailed{} = True | |||
isCreateDirFailed _ = False | |||
isCopyFileFailed CopyFileFailed{} = True | |||
isCopyFileFailed _ = False | |||
isRecreateSymlinkFailed RecreateSymlinkFailed{} = True | |||
isRecreateSymlinkFailed _ = False | |||
---------------------------- | |||
--[ Path based functions ]-- | |||
---------------------------- | |||
throwFileDoesExist :: Path b -> IO () | |||
throwFileDoesExist fp@(Path bs) = | |||
whenM (doesFileExist fp) | |||
(ioError . mkIOError | |||
alreadyExistsErrorType | |||
"File already exists" | |||
Nothing | |||
$ (Just (toString $ bs)) | |||
) | |||
throwDirDoesExist :: Path b -> IO () | |||
throwDirDoesExist fp@(Path bs) = | |||
whenM (doesDirectoryExist fp) | |||
(ioError . mkIOError | |||
alreadyExistsErrorType | |||
"Directory already exists" | |||
Nothing | |||
$ (Just (toString $ bs)) | |||
) | |||
throwSameFile :: Path b1 | |||
-> Path b2 | |||
-> IO () | |||
throwSameFile fp1@(Path bs1) fp2@(Path bs2) = | |||
whenM (sameFile fp1 fp2) | |||
(throwIO $ SameFile bs1 bs2) | |||
sameFile :: Path b1 -> Path b2 -> IO Bool | |||
sameFile (Path fp1) (Path fp2) = | |||
handleIOError (\_ -> return False) $ do | |||
fs1 <- getFileStatus fp1 | |||
fs2 <- getFileStatus fp2 | |||
if ((PF.deviceID fs1, PF.fileID fs1) == | |||
(PF.deviceID fs2, PF.fileID fs2)) | |||
then return True | |||
else return False | |||
throwDestinationInSource :: Path b1 -- ^ source dir | |||
-> Path b2 -- ^ full destination, @dirname dest@ | |||
-- must exist | |||
-> IO () | |||
throwDestinationInSource (Path sbs) dest@(Path dbs) = do | |||
destAbs <- toAbs dest | |||
dest' <- (\x -> maybe x (\y -> x </> y) $ basename dest) | |||
<$> (canonicalizePath $ dirname destAbs) | |||
dids <- forM (getAllParents dest') $ \p -> do | |||
fs <- PF.getSymbolicLinkStatus (fromAbs p) | |||
return (PF.deviceID fs, PF.fileID fs) | |||
sid <- fmap (\x -> (PF.deviceID x, PF.fileID x)) | |||
$ PF.getFileStatus sbs | |||
when (elem sid dids) | |||
(throwIO $ DestinationInSource dbs sbs) | |||
-------------------------------- | |||
--[ Error handling functions ]-- | |||
-------------------------------- | |||
catchErrno :: [Errno] -- ^ errno to catch | |||
-> IO a -- ^ action to try, which can raise an IOException | |||
-> IO a -- ^ action to carry out in case of an IOException and | |||
-- if errno matches | |||
-> IO a | |||
catchErrno en a1 a2 = | |||
catchIOError a1 $ \e -> do | |||
errno <- getErrno | |||
if errno `elem` en | |||
then a2 | |||
else ioError e | |||
rethrowErrnoAs :: Exception e | |||
=> [Errno] -- ^ errno to catch | |||
-> e -- ^ rethrow as if errno matches | |||
-> IO a -- ^ action to try | |||
-> IO a | |||
rethrowErrnoAs en fmex action = catchErrno en action (throwIO fmex) | |||
handleIOError :: (IOError -> IO a) -> IO a -> IO a | |||
handleIOError = flip catchIOError | |||
hideError :: IOErrorType -> IO () -> IO () | |||
hideError err = handleIO (\e -> if err == ioeGetErrorType e then pure () else ioError e) | |||
bracketeer :: IO a -- ^ computation to run first | |||
-> (a -> IO b) -- ^ computation to run last, when | |||
-- no exception was raised | |||
-> (a -> IO b) -- ^ computation to run last, | |||
-- when an exception was raised | |||
-> (a -> IO c) -- ^ computation to run in-between | |||
-> IO c | |||
bracketeer before after afterEx thing = | |||
mask $ \restore -> do | |||
a <- before | |||
r <- restore (thing a) `onException` afterEx a | |||
_ <- after a | |||
return r | |||
reactOnError :: IO a | |||
-> [(IOErrorType, IO a)] -- ^ reaction on IO errors | |||
-> [(HPathIOException, IO a)] -- ^ reaction on HPathIOException | |||
-> IO a | |||
reactOnError a ios fmios = | |||
a `catches` [iohandler, fmiohandler] | |||
where | |||
iohandler = Handler $ | |||
\(ex :: IOException) -> | |||
foldr (\(t, a') y -> if ioeGetErrorType ex == t | |||
then a' | |||
else y) | |||
(throwIO ex) | |||
ios | |||
fmiohandler = Handler $ | |||
\(ex :: HPathIOException) -> | |||
foldr (\(t, a') y -> if toConstr ex == toConstr t | |||
then a' | |||
else y) | |||
(throwIO ex) | |||
fmios | |||
@@ -1,55 +0,0 @@ | |||
module System.Posix.Directory.Foreign where | |||
import Data.Bits | |||
import Data.List (foldl') | |||
import Foreign.C.Types | |||
#include <limits.h> | |||
#include <stdlib.h> | |||
#include <dirent.h> | |||
#include <sys/types.h> | |||
#include <sys/stat.h> | |||
#include <fcntl.h> | |||
newtype DirType = DirType Int deriving (Eq, Show) | |||
data Flags = Flags Int | UnsupportedFlag String deriving (Eq, Show) | |||
unFlags :: Flags -> Int | |||
unFlags (Flags i) = i | |||
unFlags (UnsupportedFlag name) = error (name ++ " is not supported on this platform") | |||
isSupported :: Flags -> Bool | |||
isSupported (Flags _) = True | |||
isSupported _ = False | |||
oCloexec :: Flags | |||
#ifdef O_CLOEXEC | |||
oCloexec = Flags #{const O_CLOEXEC} | |||
#else | |||
{-# WARNING oCloexec | |||
"This version of posix-paths was compiled without @O_CLOEXEC@ support." #-} | |||
oCloexec = UnsupportedFlag "O_CLOEXEC" | |||
#endif | |||
#{enum DirType, DirType, DT_BLK, DT_CHR, DT_DIR, DT_FIFO, DT_LNK, DT_REG, DT_SOCK, DT_UNKNOWN} | |||
#{enum Flags, Flags, O_APPEND, O_ASYNC, O_CREAT, O_DIRECTORY, O_EXCL, O_NOCTTY, O_NOFOLLOW, O_NONBLOCK, O_RDONLY, O_WRONLY, O_RDWR, O_SYNC, O_TRUNC} | |||
pathMax :: Int | |||
pathMax = #{const PATH_MAX} | |||
unionFlags :: [Flags] -> CInt | |||
unionFlags = fromIntegral . foldl' ((. unFlags) . (.|.)) 0 |
@@ -1,264 +0,0 @@ | |||
-- | |||
-- | |||
{-# LANGUAGE CPP #-} | |||
{-# LANGUAGE ForeignFunctionInterface #-} | |||
{-# LANGUAGE OverloadedStrings #-} | |||
{-# LANGUAGE PackageImports #-} | |||
{-# LANGUAGE TupleSections #-} | |||
{-# LANGUAGE ViewPatterns #-} | |||
{-# OPTIONS_GHC -Wall #-} | |||
module System.Posix.Directory.Traversals ( | |||
getDirectoryContents | |||
, getDirectoryContents' | |||
, allDirectoryContents | |||
, allDirectoryContents' | |||
, traverseDirectory | |||
, readDirEnt | |||
, packDirStream | |||
, unpackDirStream | |||
, fdOpendir | |||
, realpath | |||
) where | |||
#if __GLASGOW_HASKELL__ < 710 | |||
import Control.Applicative ((<$>)) | |||
#endif | |||
import Control.Monad | |||
import System.Posix.FilePath ((</>)) | |||
import System.Posix.Directory.Foreign | |||
import qualified System.Posix as Posix | |||
import System.IO.Error | |||
import Control.Exception | |||
import qualified Data.ByteString.Char8 as BS | |||
import System.Posix.ByteString.FilePath | |||
import System.Posix.Directory.ByteString as PosixBS | |||
import System.Posix.Files.ByteString | |||
import System.IO.Unsafe | |||
import "unix" System.Posix.IO.ByteString (closeFd) | |||
import Unsafe.Coerce (unsafeCoerce) | |||
import Foreign.C.Error | |||
import Foreign.C.String | |||
import Foreign.C.Types | |||
import Foreign.Marshal.Alloc (alloca,allocaBytes) | |||
import Foreign.Ptr | |||
import Foreign.Storable | |||
---------------------------------------------------------- | |||
-- | |||
-- | |||
allDirectoryContents :: RawFilePath -> IO [RawFilePath] | |||
allDirectoryContents topdir = do | |||
namesAndTypes <- getDirectoryContents topdir | |||
let properNames = filter ((`notElem` [".", ".."]) . snd) namesAndTypes | |||
paths <- forM properNames $ \(typ,name) -> unsafeInterleaveIO $ do | |||
let path = topdir </> name | |||
case () of | |||
() | typ == dtDir -> allDirectoryContents path | |||
| typ == dtUnknown -> do | |||
isDir <- isDirectory <$> getFileStatus path | |||
if isDir | |||
then allDirectoryContents path | |||
else return [path] | |||
| otherwise -> return [path] | |||
return (topdir : concat paths) | |||
-- | |||
allDirectoryContents' :: RawFilePath -> IO [RawFilePath] | |||
allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) [] | |||
-- | |||
-- | |||
traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s | |||
traverseDirectory act s0 topdir = toploop | |||
where | |||
toploop = do | |||
isDir <- isDirectory <$> getFileStatus topdir | |||
s' <- act s0 topdir | |||
if isDir then actOnDirContents topdir s' loop | |||
else return s' | |||
loop typ path acc = do | |||
isDir <- case () of | |||
() | typ == dtDir -> return True | |||
| typ == dtUnknown -> isDirectory <$> getFileStatus path | |||
| otherwise -> return False | |||
if isDir | |||
then act acc path >>= \acc' -> actOnDirContents path acc' loop | |||
else act acc path | |||
actOnDirContents :: RawFilePath | |||
-> b | |||
-> (DirType -> RawFilePath -> b -> IO b) | |||
-> IO b | |||
actOnDirContents pathRelToTop b f = | |||
modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) . | |||
(`ioeSetLocation` "findBSTypRel")) $ | |||
bracket | |||
(openDirStream pathRelToTop) | |||
Posix.closeDirStream | |||
(\dirp -> loop dirp b) | |||
where | |||
loop dirp b' = do | |||
(typ,e) <- readDirEnt dirp | |||
if (e == "") | |||
then return b' | |||
else | |||
if (e == "." || e == "..") | |||
then loop dirp b' | |||
else f typ (pathRelToTop </> e) b' >>= loop dirp | |||
---------------------------------------------------------- | |||
type CDir = () | |||
type CDirent = () | |||
unpackDirStream :: DirStream -> Ptr CDir | |||
unpackDirStream = unsafeCoerce | |||
packDirStream :: Ptr CDir -> DirStream | |||
packDirStream = unsafeCoerce | |||
foreign import ccall unsafe "__hscore_readdir" | |||
c_readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt | |||
foreign import ccall unsafe "__hscore_free_dirent" | |||
c_freeDirEnt :: Ptr CDirent -> IO () | |||
foreign import ccall unsafe "__hscore_d_name" | |||
c_name :: Ptr CDirent -> IO CString | |||
foreign import ccall unsafe "__posixdir_d_type" | |||
c_type :: Ptr CDirent -> IO DirType | |||
foreign import ccall "realpath" | |||
c_realpath :: CString -> CString -> IO CString | |||
foreign import ccall unsafe "fdopendir" | |||
c_fdopendir :: Posix.Fd -> IO (Ptr ()) | |||
---------------------------------------------------------- | |||
readDirEnt :: DirStream -> IO (DirType, RawFilePath) | |||
readDirEnt (unpackDirStream -> dirp) = | |||
alloca $ \ptr_dEnt -> loop ptr_dEnt | |||
where | |||
loop ptr_dEnt = do | |||
resetErrno | |||
r <- c_readdir dirp ptr_dEnt | |||
if (r == 0) | |||
then do | |||
dEnt <- peek ptr_dEnt | |||
if (dEnt == nullPtr) | |||
then return (dtUnknown,BS.empty) | |||
else do | |||
dName <- c_name dEnt >>= peekFilePath | |||
dType <- c_type dEnt | |||
c_freeDirEnt dEnt | |||
return (dType, dName) | |||
else do | |||
errno <- getErrno | |||
if (errno == eINTR) | |||
then loop ptr_dEnt | |||
else do | |||
let (Errno eo) = errno | |||
if (eo == 0) | |||
then return (dtUnknown,BS.empty) | |||
else throwErrno "readDirEnt" | |||
getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)] | |||
getDirectoryContents path = | |||
modifyIOError ((`ioeSetFileName` (BS.unpack path)) . | |||
(`ioeSetLocation` "System.Posix.Directory.Traversals.getDirectoryContents")) $ | |||
bracket | |||
(PosixBS.openDirStream path) | |||
PosixBS.closeDirStream | |||
_dirloop | |||
fdOpendir :: Posix.Fd -> IO DirStream | |||
fdOpendir fd = | |||
packDirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd) | |||
-- | |||
getDirectoryContents' :: Posix.Fd -> IO [(DirType, RawFilePath)] | |||
getDirectoryContents' fd = do | |||
dirstream <- fdOpendir fd `catchIOError` \e -> do | |||
closeFd fd | |||
ioError e | |||
-- closeDirStream closes the filedescriptor | |||
finally (_dirloop dirstream) (PosixBS.closeDirStream dirstream) | |||
_dirloop :: DirStream -> IO [(DirType, RawFilePath)] | |||
{-# INLINE _dirloop #-} | |||
_dirloop dirp = do | |||
t@(_typ,e) <- readDirEnt dirp | |||
if BS.null e then return [] else do | |||
es <- _dirloop dirp | |||
return (t:es) | |||
-- | |||
realpath :: RawFilePath -> IO RawFilePath | |||
realpath inp = | |||
allocaBytes pathMax $ \tmp -> do | |||
void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp | |||
BS.packCString tmp |
@@ -1,75 +0,0 @@ | |||
-- | |||
-- | |||
{-# LANGUAGE ForeignFunctionInterface #-} | |||
{-# LANGUAGE OverloadedStrings #-} | |||
{-# LANGUAGE TupleSections #-} | |||
{-# OPTIONS_GHC -Wall #-} | |||
module System.Posix.FD ( | |||
openFd | |||
) where | |||
import Foreign.C.String | |||
import Foreign.C.Types | |||
import System.Posix.Directory.Foreign | |||
import qualified System.Posix as Posix | |||
import System.Posix.ByteString.FilePath | |||
foreign import ccall unsafe "open" | |||
c_open :: CString -> CInt -> Posix.CMode -> IO CInt | |||
open_ :: CString | |||
-> Posix.OpenMode | |||
-> [Flags] | |||
-> Maybe Posix.FileMode | |||
-> IO Posix.Fd | |||
open_ str how optional_flags maybe_mode = do | |||
fd <- c_open str all_flags mode_w | |||
return (Posix.Fd fd) | |||
where | |||
all_flags = unionFlags $ optional_flags ++ [open_mode] ++ creat | |||
(creat, mode_w) = case maybe_mode of | |||
Nothing -> ([],0) | |||
Just x -> ([oCreat], x) | |||
open_mode = case how of | |||
Posix.ReadOnly -> oRdonly | |||
Posix.WriteOnly -> oWronly | |||
Posix.ReadWrite -> oRdwr | |||
-- | |||
openFd :: RawFilePath | |||
-> Posix.OpenMode | |||
-> [Flags] -- ^ status flags of @open(2)@ | |||
-> Maybe Posix.FileMode -- ^ @Just x@ => creates the file with the given modes, Nothing => the file must exist. | |||
-> IO Posix.Fd | |||
openFd name how optional_flags maybe_mode = | |||
withFilePath name $ \str -> | |||
throwErrnoPathIfMinus1Retry "openFd" name $ | |||
open_ str how optional_flags maybe_mode | |||
@@ -1,108 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.AppendFileSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "AppendFileSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "fileWithContent" | |||
createRegularFile' "fileWithoutContent" | |||
createSymlink' "inputFileSymL" "fileWithContent" | |||
createDir' "alreadyExistsD" | |||
createRegularFile' "noPerms" | |||
noPerms "noPerms" | |||
createDir' "noPermsD" | |||
createRegularFile' "noPermsD/inputFile" | |||
noPerms "noPermsD" | |||
writeFile' "fileWithContent" "BLKASL" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
deleteFile' "fileWithContent" | |||
deleteFile' "fileWithoutContent" | |||
deleteFile' "inputFileSymL" | |||
deleteDir' "alreadyExistsD" | |||
normalFilePerms "noPerms" | |||
deleteFile' "noPerms" | |||
normalDirPerms "noPermsD" | |||
deleteFile' "noPermsD/inputFile" | |||
deleteDir' "noPermsD" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.appendFile" $ do | |||
-- successes -- | |||
it "appendFile file with content, everything clear" $ do | |||
appendFile' "fileWithContent" "blahfaselllll" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "BLKASLblahfaselllll" | |||
it "appendFile file with content, everything clear" $ do | |||
appendFile' "fileWithContent" "gagagaga" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "BLKASLblahfaselllllgagagaga" | |||
it "appendFile file with content, everything clear" $ do | |||
appendFile' "fileWithContent" "" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "BLKASLblahfaselllllgagagaga" | |||
it "appendFile file without content, everything clear" $ do | |||
appendFile' "fileWithoutContent" "blahfaselllll" | |||
out <- readFile' "fileWithoutContent" | |||
out `shouldBe` "blahfaselllll" | |||
it "appendFile, everything clear" $ do | |||
appendFile' "fileWithoutContent" "gagagaga" | |||
out <- readFile' "fileWithoutContent" | |||
out `shouldBe` "blahfaselllllgagagaga" | |||
it "appendFile symlink, everything clear" $ do | |||
appendFile' "inputFileSymL" "blahfaselllll" | |||
out <- readFile' "inputFileSymL" | |||
out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllll" | |||
it "appendFile symlink, everything clear" $ do | |||
appendFile' "inputFileSymL" "gagagaga" | |||
out <- readFile' "inputFileSymL" | |||
out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllllgagagaga" | |||
-- posix failures -- | |||
it "appendFile to dir, inappropriate type" $ do | |||
appendFile' "alreadyExistsD" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) | |||
it "appendFile, no permissions to file" $ do | |||
appendFile' "noPerms" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) | |||
it "appendFile, no permissions to file" $ do | |||
appendFile' "noPermsD/inputFile" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) | |||
it "appendFile, file does not exist" $ do | |||
appendFile' "gaga" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) |
@@ -1,78 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.CanonicalizePathSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CanonicalizePathSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "file" | |||
createDir' "dir" | |||
createSymlink' "dirSym" "dir/" | |||
createSymlink' "brokenSym" "nothing" | |||
createSymlink' "fileSym" "file" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
deleteFile' "file" | |||
deleteDir' "dir" | |||
deleteFile' "dirSym" | |||
deleteFile' "brokenSym" | |||
deleteFile' "fileSym" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.canonicalizePath" $ do | |||
-- successes -- | |||
it "canonicalizePath, all fine" $ do | |||
path <- withTmpDir "file" return | |||
canonicalizePath' "file" | |||
`shouldReturn` path | |||
it "canonicalizePath, all fine" $ do | |||
path <- withTmpDir "dir" return | |||
canonicalizePath' "dir" | |||
`shouldReturn` path | |||
it "canonicalizePath, all fine" $ do | |||
path <- withTmpDir "file" return | |||
canonicalizePath' "fileSym" | |||
`shouldReturn` path | |||
it "canonicalizePath, all fine" $ do | |||
path <- withTmpDir "dir" return | |||
canonicalizePath' "dirSym" | |||
`shouldReturn` path | |||
-- posix failures -- | |||
it "canonicalizePath, broken symlink" $ | |||
canonicalizePath' "brokenSym" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "canonicalizePath, file does not exist" $ | |||
canonicalizePath' "nothingBlah" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
@@ -1,248 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.CopyDirRecursiveCollectFailuresSpec where | |||
import Test.Hspec | |||
import Data.List (sort) | |||
import HPath.IO | |||
import HPath.IO.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import System.Exit | |||
import System.Process | |||
import Utils | |||
import qualified Data.ByteString as BS | |||
import Data.ByteString.UTF8 (toString) | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CopyDirRecursiveCollectFailuresSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "alreadyExists" | |||
createRegularFile' "wrongInput" | |||
createSymlink' "wrongInputSymL" "inputDir/" | |||
createDir' "alreadyExistsD" | |||
createDir' "noPerms" | |||
createDir' "noWritePerm" | |||
createDir' "inputDir" | |||
createDir' "inputDir/bar" | |||
createDir' "inputDir/foo" | |||
createRegularFile' "inputDir/foo/inputFile1" | |||
createRegularFile' "inputDir/inputFile2" | |||
createRegularFile' "inputDir/bar/inputFile3" | |||
writeFile' "inputDir/foo/inputFile1" "SDAADSdsada" | |||
writeFile' "inputDir/inputFile2" "Blahfaselgagaga" | |||
writeFile' "inputDir/bar/inputFile3" | |||
"fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4" | |||
createDir' "inputDir1" | |||
createDir' "inputDir1/foo2" | |||
createDir' "inputDir1/foo2/foo3" | |||
createDir' "inputDir1/foo2/foo4" | |||
createRegularFile' "inputDir1/foo2/inputFile1" | |||
createRegularFile' "inputDir1/foo2/inputFile2" | |||
createRegularFile' "inputDir1/foo2/inputFile3" | |||
createRegularFile' "inputDir1/foo2/foo4/inputFile4" | |||
createRegularFile' "inputDir1/foo2/foo4/inputFile6" | |||
createRegularFile' "inputDir1/foo2/foo3/inputFile5" | |||
noPerms "inputDir1/foo2/foo3" | |||
createDir' "outputDir1" | |||
createDir' "outputDir1/foo2" | |||
createDir' "outputDir1/foo2/foo4" | |||
createDir' "outputDir1/foo2/foo4/inputFile4" | |||
createRegularFile' "outputDir1/foo2/foo4/inputFile6" | |||
noPerms "outputDir1/foo2/foo4/inputFile4" | |||
noPerms "outputDir1/foo2/foo4" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerm" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerm" | |||
normalDirPerms "inputDir1/foo2/foo3" | |||
deleteFile' "inputDir1/foo2/foo4/inputFile4" | |||
deleteFile' "inputDir1/foo2/foo4/inputFile6" | |||
deleteFile' "inputDir1/foo2/inputFile1" | |||
deleteFile' "inputDir1/foo2/inputFile2" | |||
deleteFile' "inputDir1/foo2/inputFile3" | |||
deleteFile' "inputDir1/foo2/foo3/inputFile5" | |||
deleteDir' "inputDir1/foo2/foo3" | |||
deleteDir' "inputDir1/foo2/foo4" | |||
deleteDir' "inputDir1/foo2" | |||
deleteDir' "inputDir1" | |||
normalDirPerms "outputDir1/foo2/foo4" | |||
normalDirPerms "outputDir1/foo2/foo4/inputFile4" | |||
deleteFile' "outputDir1/foo2/foo4/inputFile6" | |||
deleteDir' "outputDir1/foo2/foo4/inputFile4" | |||
deleteDir' "outputDir1/foo2/foo4" | |||
deleteDir' "outputDir1/foo2" | |||
deleteDir' "outputDir1" | |||
deleteFile' "alreadyExists" | |||
deleteFile' "wrongInput" | |||
deleteFile' "wrongInputSymL" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerm" | |||
deleteFile' "inputDir/foo/inputFile1" | |||
deleteFile' "inputDir/inputFile2" | |||
deleteFile' "inputDir/bar/inputFile3" | |||
deleteDir' "inputDir/foo" | |||
deleteDir' "inputDir/bar" | |||
deleteDir' "inputDir" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.copyDirRecursive" $ do | |||
-- successes -- | |||
it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do | |||
tmpDir' <- getRawTmpDir | |||
copyDirRecursive' "inputDir" | |||
"outputDir" | |||
Strict | |||
CollectFailures | |||
(system $ "diff -r --no-dereference " | |||
++ toString tmpDir' ++ "inputDir" ++ " " | |||
++ toString tmpDir' ++ "outputDir" | |||
++ " >/dev/null") | |||
`shouldReturn` ExitSuccess | |||
removeDirIfExists "outputDir" | |||
-- posix failures -- | |||
it "copyDirRecursive (Strict, CollectFailures), source directory does not exist" $ | |||
copyDirRecursive' "doesNotExist" | |||
"outputDir" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "copyDirRecursive (Strict, CollectFailures), cannot open source dir" $ | |||
copyDirRecursive' "noPerms/inputDir" | |||
"foo" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
-- custom failures | |||
it "copyDirRecursive (Overwrite, CollectFailures), various failures" $ do | |||
copyDirRecursive' "inputDir1/foo2" | |||
"outputDir1/foo2" | |||
Overwrite | |||
CollectFailures | |||
`shouldThrow` | |||
(\(RecursiveFailure ex@[_, _]) -> | |||
any (\(h, e) -> ioeGetErrorType e == InappropriateType | |||
&& isCopyFileFailed h) ex && | |||
any (\(h, e) -> ioeGetErrorType e == PermissionDenied | |||
&& isReadContentsFailed h) ex) | |||
normalDirPerms "outputDir1/foo2/foo4" | |||
normalDirPerms "outputDir1/foo2/foo4/inputFile4" | |||
c <- allDirectoryContents' "outputDir1" | |||
tmpDir' <- getRawTmpDir | |||
let shouldC = (fmap (\x -> tmpDir' `BS.append` x) | |||
["outputDir1" | |||
,"outputDir1/foo2" | |||
,"outputDir1/foo2/inputFile1" | |||
,"outputDir1/foo2/inputFile2" | |||
,"outputDir1/foo2/inputFile3" | |||
,"outputDir1/foo2/foo4" | |||
,"outputDir1/foo2/foo4/inputFile6" | |||
,"outputDir1/foo2/foo4/inputFile4"]) | |||
deleteFile' "outputDir1/foo2/inputFile1" | |||
deleteFile' "outputDir1/foo2/inputFile2" | |||
deleteFile' "outputDir1/foo2/inputFile3" | |||
sort c `shouldBe` sort shouldC | |||
it "copyDirRecursive (Strict, CollectFailures), no write permission on output dir" $ | |||
copyDirRecursive' "inputDir" | |||
"noWritePerm/foo" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
(\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == PermissionDenied) | |||
it "copyDirRecursive (Strict, CollectFailures), cannot open output dir" $ | |||
copyDirRecursive' "inputDir" | |||
"noPerms/foo" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
isRecursiveFailure | |||
it "copyDirRecursive (Strict, CollectFailures), destination dir already exists" $ | |||
copyDirRecursive' "inputDir" | |||
"alreadyExistsD" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
(\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == AlreadyExists) | |||
it "copyDirRecursive (Strict, CollectFailures), destination already exists and is a file" $ | |||
copyDirRecursive' "inputDir" | |||
"alreadyExists" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
isRecursiveFailure | |||
it "copyDirRecursive (Strict, CollectFailures), wrong input (regular file)" $ | |||
copyDirRecursive' "wrongInput" | |||
"outputDir" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
(\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InappropriateType) | |||
it "copyDirRecursive (Strict, CollectFailures), wrong input (symlink to directory)" $ | |||
copyDirRecursive' "wrongInputSymL" | |||
"outputDir" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
(\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InvalidArgument) | |||
it "copyDirRecursive (Strict, CollectFailures), destination in source" $ | |||
copyDirRecursive' "inputDir" | |||
"inputDir/foo" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
isDestinationInSource | |||
it "copyDirRecursive (Strict, CollectFailures), destination and source same directory" $ | |||
copyDirRecursive' "inputDir" | |||
"inputDir" | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
isSameFile | |||
@@ -1,205 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.CopyDirRecursiveOverwriteSpec where | |||
import Test.Hspec | |||
import HPath.IO | |||
import HPath.IO.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import System.Exit | |||
import System.Process | |||
import Utils | |||
import Data.ByteString.UTF8 (toString) | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CopyDirRecursiveOverwriteSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "alreadyExists" | |||
createRegularFile' "wrongInput" | |||
createSymlink' "wrongInputSymL" "inputDir/" | |||
createDir' "noPerms" | |||
createDir' "noWritePerm" | |||
createDir' "inputDir" | |||
createDir' "inputDir/bar" | |||
createDir' "inputDir/foo" | |||
createRegularFile' "inputDir/foo/inputFile1" | |||
createRegularFile' "inputDir/inputFile2" | |||
createRegularFile' "inputDir/bar/inputFile3" | |||
writeFile' "inputDir/foo/inputFile1" "SDAADSdsada" | |||
writeFile' "inputDir/inputFile2" "Blahfaselgagaga" | |||
writeFile' "inputDir/bar/inputFile3" | |||
"fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4" | |||
createDir' "alreadyExistsD" | |||
createDir' "alreadyExistsD/bar" | |||
createDir' "alreadyExistsD/foo" | |||
createRegularFile' "alreadyExistsD/foo/inputFile1" | |||
createRegularFile' "alreadyExistsD/inputFile2" | |||
createRegularFile' "alreadyExistsD/bar/inputFile3" | |||
writeFile' "alreadyExistsD/foo/inputFile1" "DAAsada" | |||
writeFile' "alreadyExistsD/inputFile2" "ahfaagaga" | |||
writeFile' "alreadyExistsD/bar/inputFile3" | |||
"f3223sasdasdaasdasdasasd4" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerm" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerm" | |||
deleteFile' "alreadyExists" | |||
deleteFile' "wrongInput" | |||
deleteFile' "wrongInputSymL" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerm" | |||
deleteFile' "inputDir/foo/inputFile1" | |||
deleteFile' "inputDir/inputFile2" | |||
deleteFile' "inputDir/bar/inputFile3" | |||
deleteDir' "inputDir/foo" | |||
deleteDir' "inputDir/bar" | |||
deleteDir' "inputDir" | |||
deleteFile' "alreadyExistsD/foo/inputFile1" | |||
deleteFile' "alreadyExistsD/inputFile2" | |||
deleteFile' "alreadyExistsD/bar/inputFile3" | |||
deleteDir' "alreadyExistsD/foo" | |||
deleteDir' "alreadyExistsD/bar" | |||
deleteDir' "alreadyExistsD" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.copyDirRecursive" $ do | |||
-- successes -- | |||
it "copyDirRecursive (Overwrite, FailEarly), all fine" $ do | |||
copyDirRecursive' "inputDir" | |||
"outputDir" | |||
Overwrite | |||
FailEarly | |||
removeDirIfExists "outputDir" | |||
it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do | |||
tmpDir' <- getRawTmpDir | |||
copyDirRecursive' "inputDir" | |||
"outputDir" | |||
Overwrite | |||
FailEarly | |||
(system $ "diff -r --no-dereference " | |||
++ toString tmpDir' ++ "inputDir" ++ " " | |||
++ toString tmpDir' ++ "outputDir" | |||
++ " >/dev/null") | |||
`shouldReturn` ExitSuccess | |||
removeDirIfExists "outputDir" | |||
it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do | |||
tmpDir' <- getRawTmpDir | |||
(system $ "diff -r --no-dereference " | |||
++ toString tmpDir' ++ "inputDir" ++ " " | |||
++ toString tmpDir' ++ "alreadyExistsD" | |||
++ " >/dev/null") | |||
`shouldReturn` (ExitFailure 1) | |||
copyDirRecursive' "inputDir" | |||
"alreadyExistsD" | |||
Overwrite | |||
FailEarly | |||
(system $ "diff -r --no-dereference " | |||
++ toString tmpDir' ++ "inputDir" ++ " " | |||
++ toString tmpDir' ++ "alreadyExistsD" | |||
++ " >/dev/null") | |||
`shouldReturn` ExitSuccess | |||
removeDirIfExists "outputDir" | |||
-- posix failures -- | |||
it "copyDirRecursive, source directory does not exist" $ | |||
copyDirRecursive' "doesNotExist" | |||
"outputDir" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "copyDirRecursive, no write permission on output dir" $ | |||
copyDirRecursive' "inputDir" | |||
"noWritePerm/foo" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyDirRecursive, cannot open output dir" $ | |||
copyDirRecursive' "inputDir" | |||
"noPerms/foo" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyDirRecursive, cannot open source dir" $ | |||
copyDirRecursive' "noPerms/inputDir" | |||
"foo" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyDirRecursive, destination already exists and is a file" $ | |||
copyDirRecursive' "inputDir" | |||
"alreadyExists" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "copyDirRecursive, wrong input (regular file)" $ | |||
copyDirRecursive' "wrongInput" | |||
"outputDir" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "copyDirRecursive, wrong input (symlink to directory)" $ | |||
copyDirRecursive' "wrongInputSymL" | |||
"outputDir" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
-- custom failures | |||
it "copyDirRecursive (Overwrite, FailEarly), destination in source" $ | |||
copyDirRecursive' "inputDir" | |||
"inputDir/foo" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
isDestinationInSource | |||
it "copyDirRecursive (Overwrite, FailEarly), destination and source same directory" $ | |||
copyDirRecursive' "inputDir" | |||
"inputDir" | |||
Overwrite | |||
FailEarly | |||
`shouldThrow` | |||
isSameFile |
@@ -1,181 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.CopyDirRecursiveSpec where | |||
import Test.Hspec | |||
import HPath.IO | |||
import HPath.IO.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import System.Exit | |||
import System.Process | |||
import Utils | |||
import Data.ByteString.UTF8 (toString) | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CopyDirRecursiveSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "alreadyExists" | |||
createRegularFile' "wrongInput" | |||
createSymlink' "wrongInputSymL" "inputDir/" | |||
createDir' "alreadyExistsD" | |||
createDir' "noPerms" | |||
createDir' "noWritePerm" | |||
createDir' "inputDir" | |||
createDir' "inputDir/bar" | |||
createDir' "inputDir/foo" | |||
createRegularFile' "inputDir/foo/inputFile1" | |||
createRegularFile' "inputDir/inputFile2" | |||
createRegularFile' "inputDir/bar/inputFile3" | |||
writeFile' "inputDir/foo/inputFile1" "SDAADSdsada" | |||
writeFile' "inputDir/inputFile2" "Blahfaselgagaga" | |||
writeFile' "inputDir/bar/inputFile3" | |||
"fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerm" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerm" | |||
deleteFile' "alreadyExists" | |||
deleteFile' "wrongInput" | |||
deleteFile' "wrongInputSymL" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerm" | |||
deleteFile' "inputDir/foo/inputFile1" | |||
deleteFile' "inputDir/inputFile2" | |||
deleteFile' "inputDir/bar/inputFile3" | |||
deleteDir' "inputDir/foo" | |||
deleteDir' "inputDir/bar" | |||
deleteDir' "inputDir" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.copyDirRecursive" $ do | |||
-- successes -- | |||
it "copyDirRecursive (Strict, FailEarly), all fine" $ do | |||
copyDirRecursive' "inputDir" | |||
"outputDir" | |||
Strict | |||
FailEarly | |||
removeDirIfExists "outputDir" | |||
it "copyDirRecursive (Strict, FailEarly), all fine and compare" $ do | |||
tmpDir' <- getRawTmpDir | |||
copyDirRecursive' "inputDir" | |||
"outputDir" | |||
Strict | |||
FailEarly | |||
(system $ "diff -r --no-dereference " | |||
++ toString tmpDir' ++ "inputDir" ++ " " | |||
++ toString tmpDir' ++ "outputDir" | |||
++ " >/dev/null") | |||
`shouldReturn` ExitSuccess | |||
removeDirIfExists "outputDir" | |||
-- posix failures -- | |||
it "copyDirRecursive (Strict, FailEarly), source directory does not exist" $ | |||
copyDirRecursive' "doesNotExist" | |||
"outputDir" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "copyDirRecursive (Strict, FailEarly), no write permission on output dir" $ | |||
copyDirRecursive' "inputDir" | |||
"noWritePerm/foo" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyDirRecursive (Strict, FailEarly), cannot open output dir" $ | |||
copyDirRecursive' "inputDir" | |||
"noPerms/foo" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyDirRecursive (Strict, FailEarly), cannot open source dir" $ | |||
copyDirRecursive' "noPerms/inputDir" | |||
"foo" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyDirRecursive (Strict, FailEarly), destination dir already exists" $ | |||
copyDirRecursive' "inputDir" | |||
"alreadyExistsD" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "copyDirRecursive (Strict, FailEarly), destination already exists and is a file" $ | |||
copyDirRecursive' "inputDir" | |||
"alreadyExists" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "copyDirRecursive (Strict, FailEarly), wrong input (regular file)" $ | |||
copyDirRecursive' "wrongInput" | |||
"outputDir" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "copyDirRecursive (Strict, FailEarly), wrong input (symlink to directory)" $ | |||
copyDirRecursive' "wrongInputSymL" | |||
"outputDir" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
-- custom failures | |||
it "copyDirRecursive (Strict, FailEarly), destination in source" $ | |||
copyDirRecursive' "inputDir" | |||
"inputDir/foo" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
isDestinationInSource | |||
it "copyDirRecursive (Strict, FailEarly), destination and source same directory" $ | |||
copyDirRecursive' "inputDir" | |||
"inputDir" | |||
Strict | |||
FailEarly | |||
`shouldThrow` | |||
isSameFile | |||
@@ -1,148 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.CopyFileOverwriteSpec where | |||
import Test.Hspec | |||
import HPath.IO | |||
import HPath.IO.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import System.Exit | |||
import System.Process | |||
import Utils | |||
import Data.ByteString.UTF8 (toString) | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CopyFileOverwriteSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "inputFile" | |||
createRegularFile' "alreadyExists" | |||
createSymlink' "inputFileSymL" "inputFile" | |||
createDir' "alreadyExistsD" | |||
createDir' "noPerms" | |||
createRegularFile' "noPerms/inputFile" | |||
createDir' "outputDirNoWrite" | |||
createDir' "wrongInput" | |||
noPerms "noPerms" | |||
noWritableDirPerms "outputDirNoWrite" | |||
writeFile' "inputFile" "Blahfaselgagaga" | |||
writeFile' "alreadyExists" "dsaldsalkaklsdlkasksdadasl" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "outputDirNoWrite" | |||
deleteFile' "noPerms/inputFile" | |||
deleteFile' "inputFile" | |||
deleteFile' "alreadyExists" | |||
deleteFile' "inputFileSymL" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "noPerms" | |||
deleteDir' "outputDirNoWrite" | |||
deleteDir' "wrongInput" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.copyFile" $ do | |||
-- successes -- | |||
it "copyFile (Overwrite), everything clear" $ do | |||
copyFile' "inputFile" | |||
"outputFile" | |||
Overwrite | |||
removeFileIfExists "outputFile" | |||
it "copyFile (Overwrite), output file already exists, all clear" $ do | |||
tmpDir' <- getRawTmpDir | |||
copyFile' "alreadyExists" "alreadyExists.bak" Strict | |||
copyFile' "inputFile" "alreadyExists" Overwrite | |||
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " | |||
++ toString tmpDir' ++ "alreadyExists") | |||
`shouldReturn` ExitSuccess | |||
removeFileIfExists "alreadyExists" | |||
copyFile' "alreadyExists.bak" "alreadyExists" Strict | |||
removeFileIfExists "alreadyExists.bak" | |||
it "copyFile (Overwrite), and compare" $ do | |||
tmpDir' <- getRawTmpDir | |||
copyFile' "inputFile" | |||
"outputFile" | |||
Overwrite | |||
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " | |||
++ toString tmpDir' ++ "outputFile") | |||
`shouldReturn` ExitSuccess | |||
removeFileIfExists "outputFile" | |||
-- posix failures -- | |||
it "copyFile (Overwrite), input file does not exist" $ | |||
copyFile' "noSuchFile" | |||
"outputFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "copyFile (Overwrite), no permission to write to output directory" $ | |||
copyFile' "inputFile" | |||
"outputDirNoWrite/outputFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyFile (Overwrite), cannot open output directory" $ | |||
copyFile' "inputFile" | |||
"noPerms/outputFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyFile (Overwrite), cannot open source directory" $ | |||
copyFile' "noPerms/inputFile" | |||
"outputFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyFile (Overwrite), wrong input type (symlink)" $ | |||
copyFile' "inputFileSymL" | |||
"outputFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
it "copyFile (Overwrite), wrong input type (directory)" $ | |||
copyFile' "wrongInput" | |||
"outputFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "copyFile (Overwrite), output file already exists and is a dir" $ | |||
copyFile' "inputFile" | |||
"alreadyExistsD" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
-- custom failures -- | |||
it "copyFile (Overwrite), output and input are same file" $ | |||
copyFile' "inputFile" | |||
"inputFile" | |||
Overwrite | |||
`shouldThrow` isSameFile |
@@ -1,143 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.CopyFileSpec where | |||
import Test.Hspec | |||
import HPath.IO | |||
import HPath.IO.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import System.Exit | |||
import System.Process | |||
import Utils | |||
import Data.ByteString.UTF8 (toString) | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CopyFileSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "inputFile" | |||
createRegularFile' "alreadyExists" | |||
createSymlink' "inputFileSymL" "inputFile" | |||
createDir' "alreadyExistsD" | |||
createDir' "noPerms" | |||
createRegularFile' "noPerms/inputFile" | |||
createDir' "outputDirNoWrite" | |||
createDir' "wrongInput" | |||
noPerms "noPerms" | |||
noWritableDirPerms "outputDirNoWrite" | |||
writeFile' "inputFile" "Blahfaselgagaga" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "outputDirNoWrite" | |||
deleteFile' "noPerms/inputFile" | |||
deleteFile' "inputFile" | |||
deleteFile' "alreadyExists" | |||
deleteFile' "inputFileSymL" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "noPerms" | |||
deleteDir' "outputDirNoWrite" | |||
deleteDir' "wrongInput" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.copyFile" $ do | |||
-- successes -- | |||
it "copyFile (Strict), everything clear" $ do | |||
copyFile' "inputFile" | |||
"outputFile" | |||
Strict | |||
removeFileIfExists "outputFile" | |||
it "copyFile (Strict), and compare" $ do | |||
tmpDir' <- getRawTmpDir | |||
copyFile' "inputFile" | |||
"outputFile" | |||
Strict | |||
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " | |||
++ toString tmpDir' ++ "outputFile") | |||
`shouldReturn` ExitSuccess | |||
removeFileIfExists "outputFile" | |||
-- posix failures -- | |||
it "copyFile (Strict), input file does not exist" $ | |||
copyFile' "noSuchFile" | |||
"outputFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "copyFile (Strict), no permission to write to output directory" $ | |||
copyFile' "inputFile" | |||
"outputDirNoWrite/outputFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyFile (Strict), cannot open output directory" $ | |||
copyFile' "inputFile" | |||
"noPerms/outputFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyFile (Strict), cannot open source directory" $ | |||
copyFile' "noPerms/inputFile" | |||
"outputFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "copyFile (Strict), wrong input type (symlink)" $ | |||
copyFile' "inputFileSymL" | |||
"outputFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
it "copyFile (Strict), wrong input type (directory)" $ | |||
copyFile' "wrongInput" | |||
"outputFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "copyFile (Strict), output file already exists" $ | |||
copyFile' "inputFile" | |||
"alreadyExists" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "copyFile (Strict), output file already exists and is a dir" $ | |||
copyFile' "inputFile" | |||
"alreadyExistsD" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
-- custom failures -- | |||
it "copyFile (Strict), output and input are same file" $ | |||
copyFile' "inputFile" | |||
"inputFile" | |||
Strict | |||
`shouldThrow` | |||
isSameFile |
@@ -1,69 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.CreateDirIfMissingSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CreateDirIfMissingSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createDir' "alreadyExists" | |||
createDir' "noPerms" | |||
createDir' "noWritePerms" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerms" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerms" | |||
deleteDir' "alreadyExists" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerms" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.CreateDirIfMissing" $ do | |||
-- successes -- | |||
it "createDirIfMissing, all fine" $ do | |||
createDirIfMissing' "newDir" | |||
removeDirIfExists "newDir" | |||
it "createDirIfMissing, destination directory already exists" $ | |||
createDirIfMissing' "alreadyExists" | |||
-- posix failures -- | |||
it "createDirIfMissing, parent directories do not exist" $ | |||
createDirIfMissing' "some/thing/dada" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "createDirIfMissing, can't write to output directory" $ | |||
createDirIfMissing' "noWritePerms/newDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "createDirIfMissing, can't open output directory" $ | |||
createDirIfMissing' "noPerms/newDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) |
@@ -1,78 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.CreateDirRecursiveSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CreateDirRecursiveSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createDir' "alreadyExists" | |||
createRegularFile' "alreadyExistsF" | |||
createDir' "noPerms" | |||
createDir' "noWritePerms" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerms" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerms" | |||
deleteDir' "alreadyExists" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerms" | |||
deleteFile' "alreadyExistsF" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.createDirRecursive" $ do | |||
-- successes -- | |||
it "createDirRecursive, all fine" $ do | |||
createDirRecursive' "newDir" | |||
deleteDir' "newDir" | |||
it "createDirRecursive, parent directories do not exist" $ do | |||
createDirRecursive' "some/thing/dada" | |||
deleteDir' "some/thing/dada" | |||
deleteDir' "some/thing" | |||
deleteDir' "some" | |||
it "createDirRecursive, destination directory already exists" $ | |||
createDirRecursive' "alreadyExists" | |||
-- posix failures -- | |||
it "createDirRecursive, destination already exists and is a file" $ | |||
createDirRecursive' "alreadyExistsF" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "createDirRecursive, can't write to output directory" $ | |||
createDirRecursive' "noWritePerms/newDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "createDirRecursive, can't open output directory" $ | |||
createDirRecursive' "noPerms/newDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
@@ -1,72 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.CreateDirSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CreateDirSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createDir' "alreadyExists" | |||
createDir' "noPerms" | |||
createDir' "noWritePerms" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerms" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerms" | |||
deleteDir' "alreadyExists" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerms" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.createDir" $ do | |||
-- successes -- | |||
it "createDir, all fine" $ do | |||
createDir' "newDir" | |||
removeDirIfExists "newDir" | |||
-- posix failures -- | |||
it "createDir, parent directories do not exist" $ | |||
createDir' "some/thing/dada" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "createDir, can't write to output directory" $ | |||
createDir' "noWritePerms/newDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "createDir, can't open output directory" $ | |||
createDir' "noPerms/newDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "createDir, destination directory already exists" $ | |||
createDir' "alreadyExists" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
@@ -1,70 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.CreateRegularFileSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CreateRegularFileSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "alreadyExists" | |||
createDir' "noPerms" | |||
createDir' "noWritePerms" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerms" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerms" | |||
deleteFile' "alreadyExists" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerms" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.createRegularFile" $ do | |||
-- successes -- | |||
it "createRegularFile, all fine" $ do | |||
createRegularFile' "newDir" | |||
removeFileIfExists "newDir" | |||
-- posix failures -- | |||
it "createRegularFile, parent directories do not exist" $ | |||
createRegularFile' "some/thing/dada" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "createRegularFile, can't write to destination directory" $ | |||
createRegularFile' "noWritePerms/newDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "createRegularFile, can't write to destination directory" $ | |||
createRegularFile' "noPerms/newDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "createRegularFile, destination file already exists" $ | |||
createRegularFile' "alreadyExists" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
@@ -1,71 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.CreateSymlinkSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "CreateSymlinkSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "alreadyExists" | |||
createDir' "noPerms" | |||
createDir' "noWritePerms" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerms" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerms" | |||
deleteFile' "alreadyExists" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerms" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.createSymlink" $ do | |||
-- successes -- | |||
it "createSymlink, all fine" $ do | |||
createSymlink' "newSymL" "alreadyExists/" | |||
removeFileIfExists "newSymL" | |||
-- posix failures -- | |||
it "createSymlink, parent directories do not exist" $ | |||
createSymlink' "some/thing/dada" "lala" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "createSymlink, can't write to destination directory" $ | |||
createSymlink' "noWritePerms/newDir" "lala" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "createSymlink, can't write to destination directory" $ | |||
createSymlink' "noPerms/newDir" "lala" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "createSymlink, destination file already exists" $ | |||
createSymlink' "alreadyExists" "lala" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
@@ -1,116 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.DeleteDirRecursiveSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import System.Posix.Files.ByteString | |||
( | |||
getSymbolicLinkStatus | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "DeleteDirRecursiveSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "file" | |||
createDir' "dir" | |||
createRegularFile' "dir/.keep" | |||
createSymlink' "dirSym" "dir/" | |||
createDir' "noPerms" | |||
createRegularFile' "noPerms/.keep" | |||
createDir' "noWritable" | |||
createRegularFile' "noWritable/.keep" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
deleteFile' "file" | |||
deleteFile' "dir/.keep" | |||
deleteDir' "dir" | |||
deleteFile' "dirSym" | |||
deleteFile' "noPerms/.keep" | |||
deleteDir' "noPerms" | |||
deleteFile' "noWritable/.keep" | |||
deleteDir' "noWritable" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.deleteDirRecursive" $ do | |||
-- successes -- | |||
it "deleteDirRecursive, empty directory, all fine" $ do | |||
createDir' "testDir" | |||
deleteDirRecursive' "testDir" | |||
getSymbolicLinkStatus "testDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "deleteDirRecursive, empty directory with null permissions, all fine" $ do | |||
createDir' "noPerms/testDir" | |||
noPerms "noPerms/testDir" | |||
deleteDirRecursive' "noPerms/testDir" | |||
it "deleteDirRecursive, non-empty directory, all fine" $ do | |||
createDir' "nonEmpty" | |||
createDir' "nonEmpty/dir1" | |||
createDir' "nonEmpty/dir2" | |||
createDir' "nonEmpty/dir2/dir3" | |||
createRegularFile' "nonEmpty/file1" | |||
createRegularFile' "nonEmpty/dir1/file2" | |||
deleteDirRecursive' "nonEmpty" | |||
getSymbolicLinkStatus "nonEmpty" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
-- posix failures -- | |||
it "deleteDirRecursive, can't open parent directory" $ do | |||
createDir' "noPerms/foo" | |||
noPerms "noPerms" | |||
(deleteDirRecursive' "noPerms/foo") | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
normalDirPerms "noPerms" | |||
deleteDir' "noPerms/foo" | |||
it "deleteDirRecursive, can't write to parent directory" $ do | |||
createDir' "noWritable/foo" | |||
noWritableDirPerms "noWritable" | |||
(deleteDirRecursive' "noWritable/foo") | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
normalDirPerms "noWritable" | |||
deleteDir' "noWritable/foo" | |||
it "deleteDirRecursive, wrong file type (symlink to directory)" $ | |||
deleteDirRecursive' "dirSym" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "deleteDirRecursive, wrong file type (regular file)" $ | |||
deleteDirRecursive' "file" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "deleteDirRecursive, directory does not exist" $ | |||
deleteDirRecursive' "doesNotExist" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
@@ -1,114 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.DeleteDirSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import System.Posix.Files.ByteString | |||
( | |||
getSymbolicLinkStatus | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "DeleteDirSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "file" | |||
createDir' "dir" | |||
createRegularFile' "dir/.keep" | |||
createSymlink' "dirSym" "dir/" | |||
createDir' "noPerms" | |||
createRegularFile' "noPerms/.keep" | |||
createDir' "noWritable" | |||
createRegularFile' "noWritable/.keep" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
deleteFile' "file" | |||
deleteFile' "dir/.keep" | |||
deleteDir' "dir" | |||
deleteFile' "dirSym" | |||
deleteFile' "noPerms/.keep" | |||
deleteDir' "noPerms" | |||
deleteFile' "noWritable/.keep" | |||
deleteDir' "noWritable" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.deleteDir" $ do | |||
-- successes -- | |||
it "deleteDir, empty directory, all fine" $ do | |||
createDir' "testDir" | |||
deleteDir' "testDir" | |||
getSymbolicLinkStatus "testDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "deleteDir, directory with null permissions, all fine" $ do | |||
createDir' "noPerms/testDir" | |||
noPerms "noPerms/testDir" | |||
deleteDir' "noPerms/testDir" | |||
getSymbolicLinkStatus "testDir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
-- posix failures -- | |||
it "deleteDir, wrong file type (symlink to directory)" $ | |||
deleteDir' "dirSym" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "deleteDir, wrong file type (regular file)" $ | |||
deleteDir' "file" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "deleteDir, directory does not exist" $ | |||
deleteDir' "doesNotExist" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "deleteDir, directory not empty" $ | |||
deleteDir' "dir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == UnsatisfiedConstraints) | |||
it "deleteDir, can't open parent directory" $ do | |||
createDir' "noPerms/foo" | |||
noPerms "noPerms" | |||
(deleteDir' "noPerms/foo") | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
normalDirPerms "noPerms" | |||
deleteDir' "noPerms/foo" | |||
it "deleteDir, can't write to parent directory, still fine" $ do | |||
createDir' "noWritable/foo" | |||
noWritableDirPerms "noWritable" | |||
(deleteDir' "noWritable/foo") | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
normalDirPerms "noWritable" | |||
deleteDir' "noWritable/foo" | |||
@@ -1,84 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.DeleteFileSpec where | |||
import Test.Hspec | |||
import HPath.IO | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import System.Posix.Files.ByteString | |||
( | |||
getSymbolicLinkStatus | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "DeleteFileSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "foo" | |||
createSymlink' "syml" "foo" | |||
createDir' "dir" | |||
createDir' "noPerms" | |||
noPerms "noPerms" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
deleteFile' "foo" | |||
deleteFile' "syml" | |||
deleteDir' "dir" | |||
deleteDir' "noPerms" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.deleteFile" $ do | |||
-- successes -- | |||
it "deleteFile, regular file, all fine" $ do | |||
createRegularFile' "testFile" | |||
deleteFile' "testFile" | |||
getSymbolicLinkStatus "testFile" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "deleteFile, symlink, all fine" $ do | |||
recreateSymlink' "syml" | |||
"testFile" | |||
Strict | |||
deleteFile' "testFile" | |||
getSymbolicLinkStatus "testFile" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
-- posix failures -- | |||
it "deleteFile, wrong file type (directory)" $ | |||
deleteFile' "dir" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "deleteFile, file does not exist" $ | |||
deleteFile' "doesNotExist" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "deleteFile, can't read directory" $ | |||
deleteFile' "noPerms/blah" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
@@ -1,100 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.GetDirsFilesSpec where | |||
import Data.List | |||
( | |||
sort | |||
) | |||
import qualified HPath as P | |||
import HPath.IO hiding (getDirsFiles') | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "GetDirsFilesSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "file" | |||
createRegularFile' "Lala" | |||
createRegularFile' ".hidden" | |||
createSymlink' "syml" "Lala" | |||
createDir' "dir" | |||
createSymlink' "dirsym" "dir" | |||
createDir' "noPerms" | |||
noPerms "noPerms" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
deleteFile' "file" | |||
deleteFile' "Lala" | |||
deleteFile' ".hidden" | |||
deleteFile' "syml" | |||
deleteDir' "dir" | |||
deleteFile' "dirsym" | |||
deleteDir' "noPerms" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.getDirsFiles" $ do | |||
-- successes -- | |||
it "getDirsFiles, all fine" $ | |||
withRawTmpDir $ \p -> do | |||
expectedFiles <- mapM P.parseRel [".hidden" | |||
,"Lala" | |||
,"dir" | |||
,"dirsym" | |||
,"file" | |||
,"noPerms" | |||
,"syml"] | |||
(fmap sort $ getDirsFiles p) | |||
`shouldReturn` fmap (p P.</>) expectedFiles | |||
-- posix failures -- | |||
it "getDirsFiles, nonexistent directory" $ | |||
getDirsFiles' "nothingHere" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "getDirsFiles, wrong file type (file)" $ | |||
getDirsFiles' "file" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InappropriateType) | |||
it "getDirsFiles, wrong file type (symlink to file)" $ | |||
getDirsFiles' "syml" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
it "getDirsFiles, wrong file type (symlink to dir)" $ | |||
getDirsFiles' "dirsym" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
it "getDirsFiles, can't open directory" $ | |||
getDirsFiles' "noPerms" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
@@ -1,88 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.GetFileTypeSpec where | |||
import HPath.IO | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "GetFileTypeSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "regularfile" | |||
createSymlink' "symlink" "regularfile" | |||
createSymlink' "brokenSymlink" "broken" | |||
createDir' "directory" | |||
createSymlink' "symlinkD" "directory" | |||
createDir' "noPerms" | |||
noPerms "noPerms" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
deleteFile' "regularfile" | |||
deleteFile' "symlink" | |||
deleteFile' "brokenSymlink" | |||
deleteDir' "directory" | |||
deleteFile' "symlinkD" | |||
deleteDir' "noPerms" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.getFileType" $ do | |||
-- successes -- | |||
it "getFileType, regular file" $ | |||
getFileType' "regularfile" | |||
`shouldReturn` RegularFile | |||
it "getFileType, directory" $ | |||
getFileType' "directory" | |||
`shouldReturn` Directory | |||
it "getFileType, directory with null permissions" $ | |||
getFileType' "noPerms" | |||
`shouldReturn` Directory | |||
it "getFileType, symlink to file" $ | |||
getFileType' "symlink" | |||
`shouldReturn` SymbolicLink | |||
it "getFileType, symlink to directory" $ | |||
getFileType' "symlinkD" | |||
`shouldReturn` SymbolicLink | |||
it "getFileType, broken symlink" $ | |||
getFileType' "brokenSymlink" | |||
`shouldReturn` SymbolicLink | |||
-- posix failures -- | |||
it "getFileType, file does not exist" $ | |||
getFileType' "nothingHere" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "getFileType, can't open directory" $ | |||
getFileType' "noPerms/forz" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
@@ -1,126 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.MoveFileOverwriteSpec where | |||
import Test.Hspec | |||
import HPath.IO | |||
import HPath.IO.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "MoveFileOverwriteSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "myFile" | |||
createSymlink' "myFileL" "myFile" | |||
createDir' "alreadyExistsD" | |||
createDir' "dir" | |||
createDir' "noPerms" | |||
createDir' "noWritePerm" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerm" | |||
writeFile' "myFile" "Blahfaselgagaga" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerm" | |||
deleteFile' "myFile" | |||
deleteFile' "myFileL" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "dir" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerm" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.moveFile" $ do | |||
-- successes -- | |||
it "moveFile (Overwrite), all fine" $ | |||
moveFile' "myFile" | |||
"movedFile" | |||
Overwrite | |||
it "moveFile (Overwrite), all fine" $ | |||
moveFile' "myFile" | |||
"dir/movedFile" | |||
Overwrite | |||
it "moveFile (Overwrite), all fine on symlink" $ | |||
moveFile' "myFileL" | |||
"movedFile" | |||
Overwrite | |||
it "moveFile (Overwrite), all fine on directory" $ | |||
moveFile' "dir" | |||
"movedFile" | |||
Overwrite | |||
it "moveFile (Overwrite), destination file already exists" $ | |||
moveFile' "myFile" | |||
"alreadyExists" | |||
Overwrite | |||
-- posix failures -- | |||
it "moveFile (Overwrite), source file does not exist" $ | |||
moveFile' "fileDoesNotExist" | |||
"movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "moveFile (Overwrite), can't write to destination directory" $ | |||
moveFile' "myFile" | |||
"noWritePerm/movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "moveFile (Overwrite), can't open destination directory" $ | |||
moveFile' "myFile" | |||
"noPerms/movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "moveFile (Overwrite), can't open source directory" $ | |||
moveFile' "noPerms/myFile" | |||
"movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
-- custom failures -- | |||
it "moveFile (Overwrite), move from file to dir" $ | |||
moveFile' "myFile" | |||
"alreadyExistsD" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "moveFile (Overwrite), source and dest are same file" $ | |||
moveFile' "myFile" | |||
"myFile" | |||
Overwrite | |||
`shouldThrow` | |||
isSameFile |
@@ -1,129 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.MoveFileSpec where | |||
import Test.Hspec | |||
import HPath.IO | |||
import HPath.IO.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "MoveFileSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "myFile" | |||
createSymlink' "myFileL" "myFile" | |||
createRegularFile' "alreadyExists" | |||
createDir' "alreadyExistsD" | |||
createDir' "dir" | |||
createDir' "noPerms" | |||
createDir' "noWritePerm" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerm" | |||
writeFile' "myFile" "Blahfaselgagaga" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerm" | |||
deleteFile' "myFile" | |||
deleteFile' "myFileL" | |||
deleteFile' "alreadyExists" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "dir" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerm" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.moveFile" $ do | |||
-- successes -- | |||
it "moveFile (Strict), all fine" $ | |||
moveFile' "myFile" | |||
"movedFile" | |||
Strict | |||
it "moveFile (Strict), all fine" $ | |||
moveFile' "myFile" | |||
"dir/movedFile" | |||
Strict | |||
it "moveFile (Strict), all fine on symlink" $ | |||
moveFile' "myFileL" | |||
"movedFile" | |||
Strict | |||
it "moveFile (Strict), all fine on directory" $ | |||
moveFile' "dir" | |||
"movedFile" | |||
Strict | |||
-- posix failures -- | |||
it "moveFile (Strict), source file does not exist" $ | |||
moveFile' "fileDoesNotExist" | |||
"movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "moveFile (Strict), can't write to destination directory" $ | |||
moveFile' "myFile" | |||
"noWritePerm/movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "moveFile (Strict), can't open destination directory" $ | |||
moveFile' "myFile" | |||
"noPerms/movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "moveFile (Strict), can't open source directory" $ | |||
moveFile' "noPerms/myFile" | |||
"movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
-- custom failures -- | |||
it "moveFile (Strict), destination file already exists" $ | |||
moveFile' "myFile" | |||
"alreadyExists" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "moveFile (Strict), move from file to dir" $ | |||
moveFile' "myFile" | |||
"alreadyExistsD" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "moveFile (Strict), source and dest are same file" $ | |||
moveFile' "myFile" | |||
"myFile" | |||
Strict | |||
`shouldThrow` | |||
isSameFile |
@@ -1,85 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.ReadFileSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "ReadFileSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "fileWithContent" | |||
createRegularFile' "fileWithoutContent" | |||
createSymlink' "inputFileSymL" "fileWithContent" | |||
createDir' "alreadyExistsD" | |||
createRegularFile' "noPerms" | |||
noPerms "noPerms" | |||
createDir' "noPermsD" | |||
createRegularFile' "noPermsD/inputFile" | |||
noPerms "noPermsD" | |||
writeFile' "fileWithContent" "Blahfaselgagaga" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
deleteFile' "fileWithContent" | |||
deleteFile' "fileWithoutContent" | |||
deleteFile' "inputFileSymL" | |||
deleteDir' "alreadyExistsD" | |||
normalFilePerms "noPerms" | |||
deleteFile' "noPerms" | |||
normalDirPerms "noPermsD" | |||
deleteFile' "noPermsD/inputFile" | |||
deleteDir' "noPermsD" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.readFile" $ do | |||
-- successes -- | |||
it "readFile (Strict) file with content, everything clear" $ do | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "Blahfaselgagaga" | |||
it "readFile (Strict) symlink, everything clear" $ do | |||
out <- readFile' "inputFileSymL" | |||
out `shouldBe` "Blahfaselgagaga" | |||
it "readFile (Strict) empty file, everything clear" $ do | |||
out <- readFile' "fileWithoutContent" | |||
out `shouldBe` "" | |||
-- posix failures -- | |||
it "readFile (Strict) directory, wrong file type" $ do | |||
readFile' "alreadyExistsD" | |||
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) | |||
it "readFile (Strict) file, no permissions" $ do | |||
readFile' "noPerms" | |||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) | |||
it "readFile (Strict) file, no permissions on dir" $ do | |||
readFile' "noPermsD/inputFile" | |||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) | |||
it "readFile (Strict) file, no such file" $ do | |||
readFile' "lalala" | |||
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) |
@@ -1,139 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.RecreateSymlinkOverwriteSpec where | |||
import Test.Hspec | |||
import HPath.IO | |||
import HPath.IO.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "RecreateSymlinkOverwriteSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "myFile" | |||
createSymlink' "myFileL" "myFile" | |||
createRegularFile' "alreadyExists" | |||
createDir' "alreadyExistsD" | |||
createDir' "dir" | |||
createDir' "noPerms" | |||
createDir' "noWritePerm" | |||
createDir' "alreadyExistsD2" | |||
createRegularFile' "alreadyExistsD2/lala" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerm" | |||
writeFile' "myFile" "Blahfaselgagaga" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerm" | |||
deleteFile' "myFile" | |||
deleteFile' "myFileL" | |||
deleteFile' "alreadyExists" | |||
deleteFile' "alreadyExistsD2/lala" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "alreadyExistsD2" | |||
deleteDir' "dir" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerm" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.recreateSymlink" $ do | |||
-- successes -- | |||
it "recreateSymLink (Overwrite), all fine" $ do | |||
recreateSymlink' "myFileL" | |||
"movedFile" | |||
Overwrite | |||
removeFileIfExists "movedFile" | |||
it "recreateSymLink (Overwrite), all fine" $ do | |||
recreateSymlink' "myFileL" | |||
"dir/movedFile" | |||
Overwrite | |||
removeFileIfExists "dir/movedFile" | |||
it "recreateSymLink (Overwrite), destination file already exists" $ | |||
recreateSymlink' "myFileL" | |||
"alreadyExists" | |||
Overwrite | |||
it "recreateSymLink (Overwrite), destination already exists and is an empty dir" $ do | |||
recreateSymlink' "myFileL" | |||
"alreadyExistsD" | |||
Overwrite | |||
deleteFile' "alreadyExistsD" | |||
createDir' "alreadyExistsD" | |||
-- posix failures -- | |||
it "recreateSymLink (Overwrite), destination already exists and is a non-empty dir" $ | |||
recreateSymlink' "myFileL" | |||
"alreadyExistsD2" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == UnsatisfiedConstraints) | |||
it "recreateSymLink (Overwrite), wrong input type (file)" $ | |||
recreateSymlink' "myFile" | |||
"movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
it "recreateSymLink (Overwrite), wrong input type (directory)" $ | |||
recreateSymlink' "dir" | |||
"movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
it "recreateSymLink (Overwrite), can't write to destination directory" $ | |||
recreateSymlink' "myFileL" | |||
"noWritePerm/movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "recreateSymLink (Overwrite), can't open destination directory" $ | |||
recreateSymlink' "myFileL" | |||
"noPerms/movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "recreateSymLink (Overwrite), can't open source directory" $ | |||
recreateSymlink' "noPerms/myFileL" | |||
"movedFile" | |||
Overwrite | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
-- custom failures -- | |||
it "recreateSymLink (Overwrite), source and destination are the same file" $ | |||
recreateSymlink' "myFileL" | |||
"myFileL" | |||
Overwrite | |||
`shouldThrow` | |||
isSameFile | |||
@@ -1,130 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.RecreateSymlinkSpec where | |||
import Test.Hspec | |||
import HPath.IO | |||
import HPath.IO.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "RecreateSymlinkSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "myFile" | |||
createSymlink' "myFileL" "myFile" | |||
createRegularFile' "alreadyExists" | |||
createDir' "alreadyExistsD" | |||
createDir' "dir" | |||
createDir' "noPerms" | |||
createDir' "noWritePerm" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerm" | |||
writeFile' "myFile" "Blahfaselgagaga" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerm" | |||
deleteFile' "myFile" | |||
deleteFile' "myFileL" | |||
deleteFile' "alreadyExists" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "dir" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerm" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.recreateSymlink" $ do | |||
-- successes -- | |||
it "recreateSymLink (Strict), all fine" $ do | |||
recreateSymlink' "myFileL" | |||
"movedFile" | |||
Strict | |||
removeFileIfExists "movedFile" | |||
it "recreateSymLink (Strict), all fine" $ do | |||
recreateSymlink' "myFileL" | |||
"dir/movedFile" | |||
Strict | |||
removeFileIfExists "dir/movedFile" | |||
-- posix failures -- | |||
it "recreateSymLink (Strict), wrong input type (file)" $ | |||
recreateSymlink' "myFile" | |||
"movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
it "recreateSymLink (Strict), wrong input type (directory)" $ | |||
recreateSymlink' "dir" | |||
"movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == InvalidArgument) | |||
it "recreateSymLink (Strict), can't write to destination directory" $ | |||
recreateSymlink' "myFileL" | |||
"noWritePerm/movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "recreateSymLink (Strict), can't open destination directory" $ | |||
recreateSymlink' "myFileL" | |||
"noPerms/movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "recreateSymLink (Strict), can't open source directory" $ | |||
recreateSymlink' "noPerms/myFileL" | |||
"movedFile" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "recreateSymLink (Strict), destination file already exists" $ | |||
recreateSymlink' "myFileL" | |||
"alreadyExists" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "recreateSymLink (Strict), destination already exists and is a dir" $ | |||
recreateSymlink' "myFileL" | |||
"alreadyExistsD" | |||
Strict | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
-- custom failures -- | |||
it "recreateSymLink (Strict), source and destination are the same file" $ | |||
recreateSymlink' "myFileL" | |||
"myFileL" | |||
Strict | |||
`shouldThrow` | |||
isSameFile | |||
@@ -1,117 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.RenameFileSpec where | |||
import Test.Hspec | |||
import HPath.IO.Errors | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "RenameFileSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "myFile" | |||
createSymlink' "myFileL" "myFile" | |||
createRegularFile' "alreadyExists" | |||
createDir' "alreadyExistsD" | |||
createDir' "dir" | |||
createDir' "noPerms" | |||
createDir' "noWritePerm" | |||
noPerms "noPerms" | |||
noWritableDirPerms "noWritePerm" | |||
writeFile' "myFile" "Blahfaselgagaga" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
normalDirPerms "noPerms" | |||
normalDirPerms "noWritePerm" | |||
deleteFile' "myFile" | |||
deleteFile' "myFileL" | |||
deleteFile' "alreadyExists" | |||
deleteDir' "alreadyExistsD" | |||
deleteDir' "dir" | |||
deleteDir' "noPerms" | |||
deleteDir' "noWritePerm" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.renameFile" $ do | |||
-- successes -- | |||
it "renameFile, all fine" $ | |||
renameFile' "myFile" | |||
"renamedFile" | |||
it "renameFile, all fine" $ | |||
renameFile' "myFile" | |||
"dir/renamedFile" | |||
it "renameFile, all fine on symlink" $ | |||
renameFile' "myFileL" | |||
"renamedFile" | |||
it "renameFile, all fine on directory" $ | |||
renameFile' "dir" | |||
"renamedFile" | |||
-- posix failures -- | |||
it "renameFile, source file does not exist" $ | |||
renameFile' "fileDoesNotExist" | |||
"renamedFile" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == NoSuchThing) | |||
it "renameFile, can't write to output directory" $ | |||
renameFile' "myFile" | |||
"noWritePerm/renamedFile" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "renameFile, can't open output directory" $ | |||
renameFile' "myFile" | |||
"noPerms/renamedFile" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
it "renameFile, can't open source directory" $ | |||
renameFile' "noPerms/myFile" | |||
"renamedFile" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == PermissionDenied) | |||
-- custom failures -- | |||
it "renameFile, destination file already exists" $ | |||
renameFile' "myFile" | |||
"alreadyExists" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "renameFile, move from file to dir" $ | |||
renameFile' "myFile" | |||
"alreadyExistsD" | |||
`shouldThrow` | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "renameFile, source and dest are same file" $ | |||
renameFile' "myFile" | |||
"myFile" | |||
`shouldThrow` | |||
isSameFile | |||
@@ -1,27 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.ToAbsSpec where | |||
import Test.Hspec | |||
import HPath | |||
import HPath.IO | |||
spec :: Spec | |||
spec = describe "HPath.IO.toAbs" $ do | |||
-- successes -- | |||
it "toAbs returns absolute paths unchanged" $ do | |||
p1 <- parseAbs "/a/b/c/d" | |||
to <- toAbs p1 | |||
p1 `shouldBe` to | |||
it "toAbs returns even existing absolute paths unchanged" $ do | |||
p1 <- parseAbs "/home" | |||
to <- toAbs p1 | |||
p1 `shouldBe` to | |||
@@ -1,108 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.WriteFileLSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "WriteFileLSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "fileWithContent" | |||
createRegularFile' "fileWithoutContent" | |||
createSymlink' "inputFileSymL" "fileWithContent" | |||
createDir' "alreadyExistsD" | |||
createRegularFile' "noPerms" | |||
noPerms "noPerms" | |||
createDir' "noPermsD" | |||
createRegularFile' "noPermsD/inputFile" | |||
noPerms "noPermsD" | |||
writeFile' "fileWithContent" "BLKASL" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
deleteFile' "fileWithContent" | |||
deleteFile' "fileWithoutContent" | |||
deleteFile' "inputFileSymL" | |||
deleteDir' "alreadyExistsD" | |||
normalFilePerms "noPerms" | |||
deleteFile' "noPerms" | |||
normalDirPerms "noPermsD" | |||
deleteFile' "noPermsD/inputFile" | |||
deleteDir' "noPermsD" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.WriteFileL" $ do | |||
-- successes -- | |||
it "WriteFileL file with content, everything clear" $ do | |||
writeFileL' "fileWithContent" "blahfaselllll" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "blahfaselllll" | |||
it "WriteFileL file with content, everything clear" $ do | |||
writeFileL' "fileWithContent" "gagagaga" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "gagagaga" | |||
it "WriteFileL file with content, everything clear" $ do | |||
writeFileL' "fileWithContent" "" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "" | |||
it "WriteFileL file without content, everything clear" $ do | |||
writeFileL' "fileWithoutContent" "blahfaselllll" | |||
out <- readFile' "fileWithoutContent" | |||
out `shouldBe` "blahfaselllll" | |||
it "WriteFileL, everything clear" $ do | |||
writeFileL' "fileWithoutContent" "gagagaga" | |||
out <- readFile' "fileWithoutContent" | |||
out `shouldBe` "gagagaga" | |||
it "WriteFileL symlink, everything clear" $ do | |||
writeFileL' "inputFileSymL" "blahfaselllll" | |||
out <- readFile' "inputFileSymL" | |||
out `shouldBe` "blahfaselllll" | |||
it "WriteFileL symlink, everything clear" $ do | |||
writeFileL' "inputFileSymL" "gagagaga" | |||
out <- readFile' "inputFileSymL" | |||
out `shouldBe` "gagagaga" | |||
-- posix failures -- | |||
it "WriteFileL to dir, inappropriate type" $ do | |||
writeFileL' "alreadyExistsD" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) | |||
it "WriteFileL, no permissions to file" $ do | |||
writeFileL' "noPerms" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) | |||
it "WriteFileL, no permissions to file" $ do | |||
writeFileL' "noPermsD/inputFile" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) | |||
it "WriteFileL, file does not exist" $ do | |||
writeFileL' "gaga" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) |
@@ -1,108 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
module HPath.IO.WriteFileSpec where | |||
import Test.Hspec | |||
import System.IO.Error | |||
( | |||
ioeGetErrorType | |||
) | |||
import GHC.IO.Exception | |||
( | |||
IOErrorType(..) | |||
) | |||
import Utils | |||
upTmpDir :: IO () | |||
upTmpDir = do | |||
setTmpDir "WriteFileSpec" | |||
createTmpDir | |||
setupFiles :: IO () | |||
setupFiles = do | |||
createRegularFile' "fileWithContent" | |||
createRegularFile' "fileWithoutContent" | |||
createSymlink' "inputFileSymL" "fileWithContent" | |||
createDir' "alreadyExistsD" | |||
createRegularFile' "noPerms" | |||
noPerms "noPerms" | |||
createDir' "noPermsD" | |||
createRegularFile' "noPermsD/inputFile" | |||
noPerms "noPermsD" | |||
writeFile' "fileWithContent" "BLKASL" | |||
cleanupFiles :: IO () | |||
cleanupFiles = do | |||
deleteFile' "fileWithContent" | |||
deleteFile' "fileWithoutContent" | |||
deleteFile' "inputFileSymL" | |||
deleteDir' "alreadyExistsD" | |||
normalFilePerms "noPerms" | |||
deleteFile' "noPerms" | |||
normalDirPerms "noPermsD" | |||
deleteFile' "noPermsD/inputFile" | |||
deleteDir' "noPermsD" | |||
spec :: Spec | |||
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
describe "HPath.IO.writeFile" $ do | |||
-- successes -- | |||
it "writeFile file with content, everything clear" $ do | |||
writeFile' "fileWithContent" "blahfaselllll" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "blahfaselllll" | |||
it "writeFile file with content, everything clear" $ do | |||
writeFile' "fileWithContent" "gagagaga" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "gagagaga" | |||
it "writeFile file with content, everything clear" $ do | |||
writeFile' "fileWithContent" "" | |||
out <- readFile' "fileWithContent" | |||
out `shouldBe` "" | |||
it "writeFile file without content, everything clear" $ do | |||
writeFile' "fileWithoutContent" "blahfaselllll" | |||
out <- readFile' "fileWithoutContent" | |||
out `shouldBe` "blahfaselllll" | |||
it "writeFile, everything clear" $ do | |||
writeFile' "fileWithoutContent" "gagagaga" | |||
out <- readFile' "fileWithoutContent" | |||
out `shouldBe` "gagagaga" | |||
it "writeFile symlink, everything clear" $ do | |||
writeFile' "inputFileSymL" "blahfaselllll" | |||
out <- readFile' "inputFileSymL" | |||
out `shouldBe` "blahfaselllll" | |||
it "writeFile symlink, everything clear" $ do | |||
writeFile' "inputFileSymL" "gagagaga" | |||
out <- readFile' "inputFileSymL" | |||
out `shouldBe` "gagagaga" | |||
-- posix failures -- | |||
it "writeFile to dir, inappropriate type" $ do | |||
writeFile' "alreadyExistsD" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) | |||
it "writeFile, no permissions to file" $ do | |||
writeFile' "noPerms" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) | |||
it "writeFile, no permissions to file" $ do | |||
writeFile' "noPermsD/inputFile" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) | |||
it "writeFile, file does not exist" $ do | |||
writeFile' "gaga" "" | |||
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) |
@@ -1,24 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
import qualified Data.ByteString as BS | |||
import Data.IORef | |||
import Test.Hspec | |||
import Test.Hspec.Runner | |||
import Test.Hspec.Formatters | |||
import qualified Spec | |||
import Utils | |||
import System.Posix.Temp.ByteString (mkdtemp) | |||
main :: IO () | |||
main = do | |||
tmpBase <- mkdtemp "/tmp/" | |||
writeIORef baseTmpDir (Just (tmpBase `BS.append` "/")) | |||
putStrLn $ ("Temporary test directory at: " ++ show tmpBase) | |||
hspecWith | |||
defaultConfig { configFormatter = Just progress } | |||
$ afterAll_ deleteBaseTmpDir | |||
$ Spec.spec |
@@ -1,2 +0,0 @@ | |||
{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} |
@@ -1,294 +0,0 @@ | |||
{-# LANGUAGE OverloadedStrings #-} | |||
{-# LANGUAGE PackageImports #-} | |||
module Utils where | |||
import Control.Applicative | |||
( | |||
(<$>) | |||
) | |||
import Control.Monad | |||
( | |||
forM_ | |||
, void | |||
) | |||
import Control.Monad.IfElse | |||
( | |||
whenM | |||
) | |||
import qualified Data.ByteString as BS | |||
import qualified Data.ByteString.Lazy as BSL | |||
import Data.IORef | |||
( | |||
newIORef | |||
, readIORef | |||
, writeIORef | |||
, IORef | |||
) | |||
import HPath.IO | |||
import Prelude hiding (appendFile, readFile, writeFile) | |||
import Data.Maybe | |||
( | |||
fromJust | |||
) | |||
import qualified HPath as P | |||
import System.IO.Unsafe | |||
( | |||
unsafePerformIO | |||
) | |||
import qualified System.Posix.Directory.Traversals as DT | |||
import Data.ByteString | |||
( | |||
ByteString | |||
) | |||
import qualified Data.ByteString.Lazy as L | |||
import System.Posix.Files.ByteString | |||
( | |||
groupExecuteMode | |||
, groupReadMode | |||
, nullFileMode | |||
, otherExecuteMode | |||
, otherReadMode | |||
, ownerExecuteMode | |||
, ownerReadMode | |||
, setFileMode | |||
, unionFileModes | |||
) | |||
baseTmpDir :: IORef (Maybe ByteString) | |||
{-# NOINLINE baseTmpDir #-} | |||
baseTmpDir = unsafePerformIO (newIORef Nothing) | |||
tmpDir :: IORef (Maybe ByteString) | |||
{-# NOINLINE tmpDir #-} | |||
tmpDir = unsafePerformIO (newIORef Nothing) | |||
----------------- | |||
--[ Utilities ]-- | |||
----------------- | |||
setTmpDir :: ByteString -> IO () | |||
{-# NOINLINE setTmpDir #-} | |||
setTmpDir bs = do | |||
tmp <- fromJust <$> readIORef baseTmpDir | |||
writeIORef tmpDir (Just (tmp `BS.append` bs)) | |||
createTmpDir :: IO () | |||
{-# NOINLINE createTmpDir #-} | |||
createTmpDir = do | |||
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir) | |||
void $ createDir newDirPerms tmp | |||
deleteTmpDir :: IO () | |||
{-# NOINLINE deleteTmpDir #-} | |||
deleteTmpDir = do | |||
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir) | |||
void $ deleteDir tmp | |||
deleteBaseTmpDir :: IO () | |||
{-# NOINLINE deleteBaseTmpDir #-} | |||
deleteBaseTmpDir = do | |||
tmp <- (fromJust <$> readIORef baseTmpDir) >>= P.parseAbs | |||
contents <- getDirsFiles tmp | |||
forM_ contents deleteDir | |||
void $ deleteDir tmp | |||
withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a | |||
{-# NOINLINE withRawTmpDir #-} | |||
withRawTmpDir f = do | |||
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir) | |||
f tmp | |||
getRawTmpDir :: IO ByteString | |||
{-# NOINLINE getRawTmpDir #-} | |||
getRawTmpDir = withRawTmpDir (return . flip BS.append "/" . P.fromAbs) | |||
withTmpDir :: ByteString -> (P.Path P.Abs -> IO a) -> IO a | |||
{-# NOINLINE withTmpDir #-} | |||
withTmpDir ip f = do | |||
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir) | |||
p <- (tmp P.</>) <$> P.parseRel ip | |||
f p | |||
withTmpDir' :: ByteString | |||
-> ByteString | |||
-> (P.Path P.Abs -> P.Path P.Abs -> IO a) | |||
-> IO a | |||
{-# NOINLINE withTmpDir' #-} | |||
withTmpDir' ip1 ip2 f = do | |||
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir) | |||
p1 <- (tmp P.</>) <$> P.parseRel ip1 | |||
p2 <- (tmp P.</>) <$> P.parseRel ip2 | |||
f p1 p2 | |||
removeFileIfExists :: ByteString -> IO () | |||
{-# NOINLINE removeFileIfExists #-} | |||
removeFileIfExists bs = | |||
withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p) | |||
removeDirIfExists :: ByteString -> IO () | |||
{-# NOINLINE removeDirIfExists #-} | |||
removeDirIfExists bs = | |||
withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p) | |||
copyFile' :: ByteString -> ByteString -> CopyMode -> IO () | |||
{-# NOINLINE copyFile' #-} | |||
copyFile' inputFileP outputFileP cm = | |||
withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm) | |||
copyDirRecursive' :: ByteString -> ByteString | |||
-> CopyMode -> RecursiveErrorMode -> IO () | |||
{-# NOINLINE copyDirRecursive' #-} | |||
copyDirRecursive' inputDirP outputDirP cm rm = | |||
withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm) | |||
createDir' :: ByteString -> IO () | |||
{-# NOINLINE createDir' #-} | |||
createDir' dest = withTmpDir dest (createDir newDirPerms) | |||
createDirIfMissing' :: ByteString -> IO () | |||
{-# NOINLINE createDirIfMissing' #-} | |||
createDirIfMissing' dest = withTmpDir dest (createDirIfMissing newDirPerms) | |||
createDirRecursive' :: ByteString -> IO () | |||
{-# NOINLINE createDirRecursive' #-} | |||
createDirRecursive' dest = withTmpDir dest (createDirRecursive newDirPerms) | |||
createRegularFile' :: ByteString -> IO () | |||
{-# NOINLINE createRegularFile' #-} | |||
createRegularFile' dest = withTmpDir dest (createRegularFile newFilePerms) | |||
createSymlink' :: ByteString -> ByteString -> IO () | |||
{-# NOINLINE createSymlink' #-} | |||
createSymlink' dest sympoint = withTmpDir dest | |||
(\x -> createSymlink x sympoint) | |||
renameFile' :: ByteString -> ByteString -> IO () | |||
{-# NOINLINE renameFile' #-} | |||
renameFile' inputFileP outputFileP = | |||
withTmpDir' inputFileP outputFileP $ \i o -> do | |||
renameFile i o | |||
renameFile o i | |||
moveFile' :: ByteString -> ByteString -> CopyMode -> IO () | |||
{-# NOINLINE moveFile' #-} | |||
moveFile' inputFileP outputFileP cm = | |||
withTmpDir' inputFileP outputFileP $ \i o -> do | |||
moveFile i o cm | |||
moveFile o i Strict | |||
recreateSymlink' :: ByteString -> ByteString -> CopyMode -> IO () | |||
{-# NOINLINE recreateSymlink' #-} | |||
recreateSymlink' inputFileP outputFileP cm = | |||
withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm) | |||
noWritableDirPerms :: ByteString -> IO () | |||
{-# NOINLINE noWritableDirPerms #-} | |||
noWritableDirPerms path = withTmpDir path $ \p -> | |||
setFileMode (P.fromAbs p) perms | |||
where | |||
perms = ownerReadMode | |||
`unionFileModes` ownerExecuteMode | |||
`unionFileModes` groupReadMode | |||
`unionFileModes` groupExecuteMode | |||
`unionFileModes` otherReadMode | |||
`unionFileModes` otherExecuteMode | |||
noPerms :: ByteString -> IO () | |||
{-# NOINLINE noPerms #-} | |||
noPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) nullFileMode | |||
normalDirPerms :: ByteString -> IO () | |||
{-# NOINLINE normalDirPerms #-} | |||
normalDirPerms path = | |||
withTmpDir path $ \p -> setFileMode (P.fromAbs p) newDirPerms | |||
normalFilePerms :: ByteString -> IO () | |||
{-# NOINLINE normalFilePerms #-} | |||
normalFilePerms path = | |||
withTmpDir path $ \p -> setFileMode (P.fromAbs p) newFilePerms | |||
getFileType' :: ByteString -> IO FileType | |||
{-# NOINLINE getFileType' #-} | |||
getFileType' path = withTmpDir path getFileType | |||
getDirsFiles' :: ByteString -> IO [P.Path P.Abs] | |||
{-# NOINLINE getDirsFiles' #-} | |||
getDirsFiles' path = withTmpDir path getDirsFiles | |||
deleteFile' :: ByteString -> IO () | |||
{-# NOINLINE deleteFile' #-} | |||
deleteFile' p = withTmpDir p deleteFile | |||
deleteDir' :: ByteString -> IO () | |||
{-# NOINLINE deleteDir' #-} | |||
deleteDir' p = withTmpDir p deleteDir | |||
deleteDirRecursive' :: ByteString -> IO () | |||
{-# NOINLINE deleteDirRecursive' #-} | |||
deleteDirRecursive' p = withTmpDir p deleteDirRecursive | |||
canonicalizePath' :: ByteString -> IO (P.Path P.Abs) | |||
{-# NOINLINE canonicalizePath' #-} | |||
canonicalizePath' p = withTmpDir p canonicalizePath | |||
writeFile' :: ByteString -> ByteString -> IO () | |||
{-# NOINLINE writeFile' #-} | |||
writeFile' ip bs = | |||
withTmpDir ip $ \p -> writeFile p Nothing bs | |||
writeFileL' :: ByteString -> BSL.ByteString -> IO () | |||
{-# NOINLINE writeFileL' #-} | |||
writeFileL' ip bs = | |||
withTmpDir ip $ \p -> writeFileL p Nothing bs | |||
appendFile' :: ByteString -> ByteString -> IO () | |||
{-# NOINLINE appendFile' #-} | |||
appendFile' ip bs = | |||
withTmpDir ip $ \p -> appendFile p bs | |||
allDirectoryContents' :: ByteString -> IO [ByteString] | |||
{-# NOINLINE allDirectoryContents' #-} | |||
allDirectoryContents' ip = | |||
withTmpDir ip $ \p -> DT.allDirectoryContents' (P.fromAbs p) | |||
readFile' :: ByteString -> IO ByteString | |||
{-# NOINLINE readFile' #-} | |||
readFile' p = withTmpDir p (fmap L.toStrict . readFile) | |||