Browse Source

Make hpath-io use hpath-directory

travis
Julian Ospald 4 years ago
parent
commit
1d00ae469d
No known key found for this signature in database GPG Key ID: 511B62C09D50CD28
38 changed files with 57 additions and 4270 deletions
  1. +0
    -7
      hpath-io/cbits/dirutils.c
  2. +0
    -13
      hpath-io/cbits/dirutils.h
  3. +2
    -57
      hpath-io/hpath-io.cabal
  4. +55
    -299
      hpath-io/src/HPath/IO.hs
  5. +0
    -16
      hpath-io/src/HPath/IO.hs-boot
  6. +0
    -289
      hpath-io/src/HPath/IO/Errors.hs
  7. +0
    -45
      hpath-io/src/System/Posix/Directory/Foreign.hsc
  8. +0
    -225
      hpath-io/src/System/Posix/Directory/Traversals.hs
  9. +0
    -60
      hpath-io/src/System/Posix/FD.hs
  10. +0
    -108
      hpath-io/test/HPath/IO/AppendFileSpec.hs
  11. +0
    -78
      hpath-io/test/HPath/IO/CanonicalizePathSpec.hs
  12. +0
    -248
      hpath-io/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs
  13. +0
    -205
      hpath-io/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs
  14. +0
    -181
      hpath-io/test/HPath/IO/CopyDirRecursiveSpec.hs
  15. +0
    -148
      hpath-io/test/HPath/IO/CopyFileOverwriteSpec.hs
  16. +0
    -143
      hpath-io/test/HPath/IO/CopyFileSpec.hs
  17. +0
    -69
      hpath-io/test/HPath/IO/CreateDirIfMissingSpec.hs
  18. +0
    -78
      hpath-io/test/HPath/IO/CreateDirRecursiveSpec.hs
  19. +0
    -72
      hpath-io/test/HPath/IO/CreateDirSpec.hs
  20. +0
    -70
      hpath-io/test/HPath/IO/CreateRegularFileSpec.hs
  21. +0
    -71
      hpath-io/test/HPath/IO/CreateSymlinkSpec.hs
  22. +0
    -116
      hpath-io/test/HPath/IO/DeleteDirRecursiveSpec.hs
  23. +0
    -114
      hpath-io/test/HPath/IO/DeleteDirSpec.hs
  24. +0
    -84
      hpath-io/test/HPath/IO/DeleteFileSpec.hs
  25. +0
    -100
      hpath-io/test/HPath/IO/GetDirsFilesSpec.hs
  26. +0
    -88
      hpath-io/test/HPath/IO/GetFileTypeSpec.hs
  27. +0
    -126
      hpath-io/test/HPath/IO/MoveFileOverwriteSpec.hs
  28. +0
    -129
      hpath-io/test/HPath/IO/MoveFileSpec.hs
  29. +0
    -85
      hpath-io/test/HPath/IO/ReadFileSpec.hs
  30. +0
    -138
      hpath-io/test/HPath/IO/RecreateSymlinkOverwriteSpec.hs
  31. +0
    -130
      hpath-io/test/HPath/IO/RecreateSymlinkSpec.hs
  32. +0
    -117
      hpath-io/test/HPath/IO/RenameFileSpec.hs
  33. +0
    -27
      hpath-io/test/HPath/IO/ToAbsSpec.hs
  34. +0
    -108
      hpath-io/test/HPath/IO/WriteFileLSpec.hs
  35. +0
    -108
      hpath-io/test/HPath/IO/WriteFileSpec.hs
  36. +0
    -23
      hpath-io/test/Main.hs
  37. +0
    -1
      hpath-io/test/Spec.hs
  38. +0
    -294
      hpath-io/test/Utils.hs

+ 0
- 7
hpath-io/cbits/dirutils.c View File

@@ -1,7 +0,0 @@
#include "dirutils.h"
unsigned int
__posixdir_d_type(struct dirent* d)
{
return(d -> d_type);
}


+ 0
- 13
hpath-io/cbits/dirutils.h View File

@@ -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

+ 2
- 57
hpath-io/hpath-io.cabal View File

@@ -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


+ 55
- 299
hpath-io/src/HPath/IO.hs View File

@@ -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




+ 0
- 16
hpath-io/src/HPath/IO.hs-boot View File

@@ -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

+ 0
- 289
hpath-io/src/HPath/IO/Errors.hs View File

@@ -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


+ 0
- 45
hpath-io/src/System/Posix/Directory/Foreign.hsc View File

@@ -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

+ 0
- 225
hpath-io/src/System/Posix/Directory/Traversals.hs View File

@@ -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

+ 0
- 60
hpath-io/src/System/Posix/FD.hs View File

@@ -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


+ 0
- 108
hpath-io/test/HPath/IO/AppendFileSpec.hs View File

@@ -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)

+ 0
- 78
hpath-io/test/HPath/IO/CanonicalizePathSpec.hs View File

@@ -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)


+ 0
- 248
hpath-io/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs View File

@@ -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



+ 0
- 205
hpath-io/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs View File

@@ -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

+ 0
- 181
hpath-io/test/HPath/IO/CopyDirRecursiveSpec.hs View File

@@ -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



+ 0
- 148
hpath-io/test/HPath/IO/CopyFileOverwriteSpec.hs View File

@@ -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

+ 0
- 143
hpath-io/test/HPath/IO/CopyFileSpec.hs View File

@@ -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

+ 0
- 69
hpath-io/test/HPath/IO/CreateDirIfMissingSpec.hs View File

@@ -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)

+ 0
- 78
hpath-io/test/HPath/IO/CreateDirRecursiveSpec.hs View File

@@ -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)




+ 0
- 72
hpath-io/test/HPath/IO/CreateDirSpec.hs View File

@@ -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)


+ 0
- 70
hpath-io/test/HPath/IO/CreateRegularFileSpec.hs View File

@@ -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)


+ 0
- 71
hpath-io/test/HPath/IO/CreateSymlinkSpec.hs View File

@@ -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)


+ 0
- 116
hpath-io/test/HPath/IO/DeleteDirRecursiveSpec.hs View File

@@ -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)



+ 0
- 114
hpath-io/test/HPath/IO/DeleteDirSpec.hs View File

@@ -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"




+ 0
- 84
hpath-io/test/HPath/IO/DeleteFileSpec.hs View File

@@ -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)


+ 0
- 100
hpath-io/test/HPath/IO/GetDirsFilesSpec.hs View File

@@ -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)





+ 0
- 88
hpath-io/test/HPath/IO/GetFileTypeSpec.hs View File

@@ -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)


+ 0
- 126
hpath-io/test/HPath/IO/MoveFileOverwriteSpec.hs View File

@@ -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

+ 0
- 129
hpath-io/test/HPath/IO/MoveFileSpec.hs View File

@@ -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

+ 0
- 85
hpath-io/test/HPath/IO/ReadFileSpec.hs View File

@@ -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)

+ 0
- 138
hpath-io/test/HPath/IO/RecreateSymlinkOverwriteSpec.hs View File

@@ -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


+ 0
- 130
hpath-io/test/HPath/IO/RecreateSymlinkSpec.hs View File

@@ -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


+ 0
- 117
hpath-io/test/HPath/IO/RenameFileSpec.hs View File

@@ -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


+ 0
- 27
hpath-io/test/HPath/IO/ToAbsSpec.hs View File

@@ -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



+ 0
- 108
hpath-io/test/HPath/IO/WriteFileLSpec.hs View File

@@ -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)

+ 0
- 108
hpath-io/test/HPath/IO/WriteFileSpec.hs View File

@@ -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)

+ 0
- 23
hpath-io/test/Main.hs View File

@@ -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

+ 0
- 1
hpath-io/test/Spec.hs View File

@@ -1,2 +0,0 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}

+ 0
- 294
hpath-io/test/Utils.hs View File

@@ -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)


Loading…
Cancel
Save