diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,9 +1,8 @@ # HPath -[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) +[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hpath.svg)](http://packdeps.haskellers.com/feed?needle=hpath) -Support for well-typed paths in Haskell. Also provides ByteString based filepath -manipulation. +Support for well-typed paths in Haskell. ## Motivation @@ -17,16 +16,10 @@ but the API turned out to be oddly complicated for my use case, so I decided to fork it. -Similarly, [posix-paths](https://github.com/JohnLato/posix-paths) -was exactly what I wanted for the low-level operations, but upstream seems dead, -so it is forked as well and merged into this library. - ## Goals * well-typed paths -* high-level API to file operations like recursive directory copy * safe filepath manipulation, never using String as filepath, but ByteString -* still allowing sufficient control to interact with the underlying low-level calls Note: this library was written for __posix__ systems and it will probably not support other systems. @@ -42,46 +35,3 @@ * uses simple doctest for testing * allows `~/` as relative path, because on posix level `~` is just a regular filename that does _NOT_ point to `$HOME` * remove TH, it sucks - -## Differences to 'posix-paths' - -* uses the `word8` package for save word8 literals instead of `OverloadedStrings` -* `hasTrailingPathSeparator` and `dropTrailingPathSeparator` behave in the same way as their `System.FilePath` counterpart -* added various functions: - * `equalFilePath` - * `getSearchPath` - * `hasParentDir` - * `hiddenFile` - * `isFileName` - * `isValid` - * `makeRelative` - * `makeValid` - * `normalise` - * `splitSearchPath` - * `stripExtension` -* has a custom versions of `openFd` which allows more control over the flags than its unix package counterpart -* adds a `getDirectoryContents'` version that works on Fd - -## Examples in ghci - -Start ghci via `cabal repl`: - -```hs --- enable OverloadedStrings -:set -XOverloadedStrings --- import HPath.IO -import HPath.IO --- parse an absolute path -abspath <- parseAbs "/home" --- parse a relative path (e.g. user users home directory) -relpath <- parseRel "jule" --- concatenate paths -let newpath = abspath relpath --- get file type -getFileType newpath --- return all contents of that directory -getDirsFiles newpath --- return all contents of the parent directory -getDirsFiles (dirname newpath) -``` - diff --git a/cbits/dirutils.c b/cbits/dirutils.c deleted file mode 100644 --- a/cbits/dirutils.c +++ /dev/null @@ -1,7 +0,0 @@ -#include "dirutils.h" -unsigned int - __posixdir_d_type(struct dirent* d) - { - return(d -> d_type); - } - diff --git a/cbits/dirutils.h b/cbits/dirutils.h deleted file mode 100644 --- a/cbits/dirutils.h +++ /dev/null @@ -1,13 +0,0 @@ -#ifndef POSIXPATHS_CBITS_DIRUTILS_H -#define POSIXPATHS_CBITS_DIRUTILS_H - -#include -#include -#include -#include -#include - -extern unsigned int - __posixdir_d_type(struct dirent* d) - ; -#endif diff --git a/doctests-hpath.hs b/doctests-hpath.hs deleted file mode 100644 --- a/doctests-hpath.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Main where - - -import Test.DocTest -import Test.HUnit - -main = - doctest - ["-isrc" - , "-XOverloadedStrings" - , "src/HPath.hs" - ] - diff --git a/doctests-posix.hs b/doctests-posix.hs deleted file mode 100644 --- a/doctests-posix.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Main where - -import Control.Applicative -import System.Posix.Directory.Traversals - -import Test.DocTest -import Test.HUnit - -main = do - doctest - [ "-isrc" - , "-XOverloadedStrings" - , "System.Posix.FilePath" - ] - runTestTT unitTests - - -unitTests :: Test -unitTests = test - [ TestCase $ do - r <- (==) <$> allDirectoryContents "." <*> allDirectoryContents' "." - assertBool "allDirectoryContents == allDirectoryContents'" r - ] diff --git a/hpath.cabal b/hpath.cabal --- a/hpath.cabal +++ b/hpath.cabal @@ -1,5 +1,5 @@ name: hpath -version: 0.9.2 +version: 0.10.0 synopsis: Support for well-typed paths description: Support for well-typed paths, utilizing ByteString under the hood. license: BSD3 @@ -10,11 +10,14 @@ category: Filesystem build-type: Simple cabal-version: 1.14 +tested-with: GHC==7.10.3 + , GHC==8.0.2 + , GHC==8.2.2 + , GHC==8.4.4 + , GHC==8.6.5 + , GHC==8.8.1 extra-source-files: README.md CHANGELOG - cbits/dirutils.h - doctests-hpath.hs - doctests-posix.hs library if os(windows) @@ -26,105 +29,14 @@ ghc-options: -Wall -Wno-redundant-constraints else ghc-options: -Wall - c-sources: cbits/dirutils.c - exposed-modules: HPath, - HPath.IO, - HPath.IO.Errors, - System.Posix.Directory.Foreign, - System.Posix.Directory.Traversals, - System.Posix.FD, - System.Posix.FilePath - other-modules: HPath.Internal - build-depends: base >= 4.6 && <5 - , IfElse + exposed-modules: HPath + HPath.Internal + build-depends: base >= 4.8 && <5 , bytestring >= 0.10.0.0 , deepseq , exceptions - , hspec - , simple-sendfile >= 0.2.24 - , unix >= 2.5 - , unix-bytestring - , utf8-string + , hpath-filepath >= 0.10 && < 0.11 , word8 - - -test-suite doctests-hpath - if os(windows) - build-depends: unbuildable<0 - buildable: False - default-language: Haskell2010 - type: exitcode-stdio-1.0 - ghc-options: -threaded - main-is: doctests-hpath.hs - build-depends: base - , HUnit - , QuickCheck - , doctest >= 0.8 - , hpath - -test-suite doctests-posix - if os(windows) - build-depends: unbuildable<0 - buildable: False - default-language: Haskell2010 - type: exitcode-stdio-1.0 - ghc-options: -threaded - main-is: doctests-posix.hs - build-depends: base, - bytestring >= 0.10.0.0, - unix, - hpath, - doctest >= 0.8, - HUnit, - QuickCheck - -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.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.ReadFileEOFSpec - HPath.IO.ReadFileSpec - HPath.IO.RecreateSymlinkOverwriteSpec - HPath.IO.RecreateSymlinkSpec - HPath.IO.RenameFileSpec - HPath.IO.ToAbsSpec - HPath.IO.WriteFileSpec - Spec - Utils - GHC-Options: -Wall - Build-Depends: base - , HUnit - , IfElse - , bytestring >= 0.10.0.0 - , hpath - , hspec >= 1.3 - , process - , unix - , unix-bytestring - , utf8-string source-repository head type: git diff --git a/src/HPath/IO.hs b/src/HPath/IO.hs deleted file mode 100644 --- a/src/HPath/IO.hs +++ /dev/null @@ -1,1104 +0,0 @@ --- | --- Module : HPath.IO --- Copyright : © 2016 Julian Ospald --- License : BSD3 --- --- Maintainer : Julian Ospald --- Stability : experimental --- Portability : portable --- --- 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. Passing in /Path Abs/ to any --- of these functions generally increases safety. Passing /Path Rel/ --- may trigger looking up the current directory via `getcwd` in some --- cases where it cannot be avoided. --- --- Some functions are just path-safe wrappers around --- unix functions, others have stricter exception handling --- and some implement functionality that doesn't have a unix --- counterpart (like `copyDirRecursive`). --- --- Some of these operations are due to their nature __not atomic__, which --- means they may do multiple syscalls which form one context. Some --- of them also have to examine the filetypes explicitly before the --- syscalls, so a reasonable decision can be made. That means --- the result is undefined if another process changes that context --- while the non-atomic operation is still happening. However, where --- possible, as few syscalls as possible are used and the underlying --- exception handling is kept. --- --- Note: `BlockDevice`, `CharacterDevice`, `NamedPipe` and `Socket` --- are ignored by some of the more high-level functions (like `easyCopy`). --- For other functions (like `copyFile`), the behavior on these file types is --- unreliable/unsafe. Check the documentation of those functions for details. - -{-# LANGUAGE CPP #-} -{-# LANGUAGE PackageImports #-} -{-# LANGUAGE OverloadedStrings #-} - -module HPath.IO - ( - -- * Types - FileType(..) - , RecursiveErrorMode(..) - , CopyMode(..) - -- * File copying - , copyDirRecursive - , recreateSymlink - , copyFile - , easyCopy - -- * File deletion - , deleteFile - , deleteDir - , deleteDirRecursive - , easyDelete - -- * File opening - , openFile - , executeFile - -- * File creation - , createRegularFile - , createDir - , createDirRecursive - , createSymlink - -- * File renaming/moving - , renameFile - , moveFile - -- * File reading - , readFile - , readFileEOF - -- * File writing - , writeFile - , appendFile - -- * File permissions - , newFilePerms - , newDirPerms - -- * Directory reading - , getDirsFiles - -- * Filetype operations - , getFileType - -- * Others - , canonicalizePath - , toAbs - ) - where - - -import Control.Applicative - ( - (<$>) - ) -import Control.Exception - ( - IOException - , bracket - , throwIO - ) -import Control.Monad - ( - unless - , void - , when - ) -import Control.Monad.IfElse - ( - unlessM - ) -import Data.ByteString - ( - ByteString - ) -#if MIN_VERSION_bytestring(0,10,2) -import Data.ByteString.Builder -#else -import Data.ByteString.Lazy.Builder -#endif - ( - Builder - , byteString - , toLazyByteString - ) -import qualified Data.ByteString.Lazy as L -import Data.ByteString.Unsafe - ( - unsafePackCStringFinalizer - ) -import Data.Foldable - ( - for_ - ) -import Data.IORef - ( - IORef - , modifyIORef - , newIORef - , readIORef - ) -import Data.Maybe - ( - catMaybes - ) -import Data.Monoid - ( - (<>) - , mempty - ) -import Data.Word - ( - Word8 - ) -import Foreign.C.Error - ( - eEXIST - , eINVAL - , eNOENT - , eNOSYS - , eNOTEMPTY - , eXDEV - , getErrno - ) -import Foreign.C.Types - ( - CSize - ) -import Foreign.Marshal.Alloc - ( - allocaBytes - ) -import Foreign.Ptr - ( - Ptr - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import HPath -import HPath.Internal -import HPath.IO.Errors -import Prelude hiding (appendFile, readFile, writeFile) -import System.IO.Error - ( - catchIOError - , ioeGetErrorType - ) -import System.Linux.Sendfile - ( - sendfileFd - , FileRange(..) - ) -import System.Posix.ByteString - ( - exclusive - ) -import System.Posix.Directory.ByteString - ( - createDirectory - , getWorkingDirectory - , removeDirectory - ) -import System.Posix.Directory.Traversals - ( - getDirectoryContents' - ) -import System.Posix.Files.ByteString - ( - createSymbolicLink - , fileMode - , getFdStatus - , groupExecuteMode - , groupReadMode - , groupWriteMode - , otherExecuteMode - , otherReadMode - , otherWriteMode - , ownerModes - , ownerReadMode - , ownerWriteMode - , readSymbolicLink - , removeLink - , rename - , setFileMode - , unionFileModes - ) -import qualified System.Posix.Files.ByteString as PF -import qualified "unix" System.Posix.IO.ByteString as SPI -import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB -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.Types - ( - FileMode - , ProcessID - , Fd - ) - - - - - - ------------- - --[ Types ]-- - ------------- - - -data FileType = Directory - | RegularFile - | SymbolicLink - | BlockDevice - | CharacterDevice - | NamedPipe - | Socket - deriving (Eq, Show) - - - --- |The error mode for recursive operations. --- --- On `FailEarly` the whole operation fails immediately if any of the --- recursive sub-operations fail, which is sort of the default --- for IO operations. --- --- On `CollectFailures` skips errors in the recursion and keeps on recursing. --- However all errors are collected in the `RecursiveFailure` error type, --- which is raised finally if there was any error. Also note that --- `RecursiveFailure` does not give any guarantees on the ordering --- of the collected exceptions. -data RecursiveErrorMode = FailEarly - | CollectFailures - - --- |The mode for copy and file moves. --- Overwrite mode is usually not very well defined, but is a convenience --- shortcut. -data CopyMode = Strict -- ^ fail if any target exists - | Overwrite -- ^ overwrite targets - - - - - -------------------- - --[ File Copying ]-- - -------------------- - - - --- |Copies the contents of a directory recursively to the given destination, while preserving permissions. --- Does not follow symbolic links. This behaves more or less like --- the following, without descending into the destination if it --- already exists: --- --- @ --- cp -a \/source\/dir \/destination\/somedir --- @ --- --- For directory contents, this will ignore any file type that is not --- `RegularFile`, `SymbolicLink` or `Directory`. --- --- For `Overwrite` copy mode this does not prune destination directory --- contents, so the destination might contain more files than the source after --- the operation has completed. Permissions of existing directories are --- fixed. --- --- Safety/reliability concerns: --- --- * not atomic --- * examines filetypes explicitly --- * an explicit check `throwDestinationInSource` is carried out for the --- top directory for basic sanity, because otherwise we might end up --- with an infinite copy loop... however, this operation is not --- carried out recursively (because it's slow) --- --- Throws: --- --- - `NoSuchThing` if source directory does not exist --- - `PermissionDenied` if source directory can't be opened --- - `SameFile` if source and destination are the same file --- (`HPathIOException`) --- - `DestinationInSource` if destination is contained in source --- (`HPathIOException`) --- --- Throws in `FailEarly` RecursiveErrorMode only: --- --- - `PermissionDenied` if output directory is not writable --- - `InvalidArgument` if source directory is wrong type (symlink) --- - `InappropriateType` if source directory is wrong type (regular file) --- --- Throws in `CollectFailures` RecursiveErrorMode only: --- --- - `RecursiveFailure` if any of the recursive operations that are not --- part of the top-directory sanity-checks fail (`HPathIOException`) --- --- Throws in `Strict` CopyMode only: --- --- - `AlreadyExists` if destination already exists -copyDirRecursive :: Path b1 -- ^ source dir - -> Path b2 -- ^ destination (parent dirs - -- are not automatically created) - -> 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'@(MkPath fromBS) destdirp'@(MkPath 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) - - --- |Recreate a symlink. --- --- In `Overwrite` copy mode only files and empty directories are deleted. --- --- Safety/reliability concerns: --- --- * `Overwrite` mode is inherently non-atomic --- --- Throws: --- --- - `InvalidArgument` if source file is wrong type (not a symlink) --- - `PermissionDenied` if output directory cannot be written to --- - `PermissionDenied` if source directory cannot be opened --- - `SameFile` if source and destination are the same file --- (`HPathIOException`) --- --- --- Throws in `Strict` mode only: --- --- - `AlreadyExists` if destination already exists --- --- Throws in `Overwrite` mode only: --- --- - `UnsatisfiedConstraints` if destination file is non-empty directory --- --- Note: calls `symlink` -recreateSymlink :: Path b1 -- ^ the old symlink file - -> Path b2 -- ^ destination file - -> CopyMode - -> IO () -recreateSymlink symsource@(MkPath symsourceBS) newsym@(MkPath newsymBS) cm - = do - throwSameFile symsource newsym - sympoint <- readSymbolicLink symsourceBS - case cm of - Strict -> return () - Overwrite -> do - writable <- toAbs newsym >>= isWritable - isfile <- doesFileExist newsym - isdir <- doesDirectoryExist newsym - when (writable && isfile) (deleteFile newsym) - when (writable && isdir) (deleteDir newsym) - createSymbolicLink sympoint newsymBS - - --- |Copies the given regular file to the given destination. --- Neither follows symbolic links, nor accepts them. --- For "copying" symbolic links, use `recreateSymlink` instead. --- --- Note that this is still sort of a low-level function and doesn't --- examine file types. For a more high-level version, use `easyCopy` --- instead. --- --- In `Overwrite` copy mode only overwrites actual files, not directories. --- --- Safety/reliability concerns: --- --- * `Overwrite` mode is not atomic --- * when used on `CharacterDevice`, reads the "contents" and copies --- them to a regular file, which might take indefinitely --- * when used on `BlockDevice`, may either read the "contents" --- and copy them to a regular file (potentially hanging indefinitely) --- or may create a regular empty destination file --- * when used on `NamedPipe`, will hang indefinitely --- --- Throws: --- --- - `NoSuchThing` if source file does not exist --- - `NoSuchThing` if source file is a a `Socket` --- - `PermissionDenied` if output directory is not writable --- - `PermissionDenied` if source directory can't be opened --- - `InvalidArgument` if source file is wrong type (symlink or directory) --- - `SameFile` if source and destination are the same file --- (`HPathIOException`) --- --- Throws in `Strict` mode only: --- --- - `AlreadyExists` if destination already exists --- --- Note: calls `sendfile` and possibly `read`/`write` as fallback -copyFile :: Path b1 -- ^ source file - -> Path b2 -- ^ destination file - -> CopyMode - -> IO () -copyFile from to cm = do - throwSameFile from to - - case cm of - Strict -> _copyFile [SPDF.oNofollow] - [SPDF.oNofollow, SPDF.oExcl] - from to - Overwrite -> - catchIOError (_copyFile [SPDF.oNofollow] - [SPDF.oNofollow, SPDF.oTrunc] - from to) $ \e -> - case ioeGetErrorType e of - -- if the destination file is not writable, we need to - -- figure out if we can still copy by deleting it first - PermissionDenied -> do - exists <- doesFileExist to - writable <- toAbs to >>= isWritable - if (exists && writable) - then deleteFile to >> copyFile from to Strict - else ioError e - _ -> ioError e - - -_copyFile :: [SPDF.Flags] - -> [SPDF.Flags] - -> Path b1 -- ^ source file - -> Path b2 -- ^ destination file - -> IO () -_copyFile sflags dflags (MkPath fromBS) to@(MkPath toBS) - = - -- from sendfile(2) manpage: - -- Applications may wish to fall back to read(2)/write(2) in - -- the case where sendfile() fails with EINVAL or ENOSYS. - catchErrno [eINVAL, eNOSYS] - (sendFileCopy fromBS toBS) - (void $ readWriteCopy fromBS toBS) - where - copyWith copyAction source dest = - bracket (openFd source SPI.ReadOnly sflags Nothing) - SPI.closeFd - $ \sfd -> do - fileM <- System.Posix.Files.ByteString.fileMode - <$> getFdStatus sfd - bracketeer (openFd dest SPI.WriteOnly - dflags $ Just fileM) - SPI.closeFd - (\fd -> SPI.closeFd fd >> deleteFile to) - $ \dfd -> copyAction sfd dfd - -- this is low-level stuff utilizing sendfile(2) for speed - sendFileCopy :: ByteString -> ByteString -> IO () - sendFileCopy = copyWith - (\sfd dfd -> sendfileFd dfd sfd EntireFile $ return ()) - -- low-level copy operation utilizing read(2)/write(2) - -- in case `sendFileCopy` fails/is unsupported - readWriteCopy :: ByteString -> ByteString -> IO Int - readWriteCopy = copyWith - (\sfd dfd -> allocaBytes (fromIntegral bufSize) - $ \buf -> write' sfd dfd buf 0) - where - bufSize :: CSize - bufSize = 8192 - write' :: Fd -> Fd -> Ptr Word8 -> Int -> IO Int - write' sfd dfd buf totalsize = do - size <- SPB.fdReadBuf sfd buf bufSize - if size == 0 - then return $ fromIntegral totalsize - else do rsize <- SPB.fdWriteBuf dfd buf size - when (rsize /= size) (ioError $ userError - "wrong size!") - write' sfd dfd buf (totalsize + fromIntegral size) - - --- |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. --- Any other file type is ignored. --- --- Safety/reliability concerns: --- --- * examines filetypes explicitly --- * calls `copyDirRecursive` for directories -easyCopy :: Path b1 - -> Path b2 - -> 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 () - - - - - - --------------------- - --[ File Deletion ]-- - --------------------- - - --- |Deletes the given file. Raises `eISDIR` --- if run on a directory. Does not follow symbolic links. --- --- Throws: --- --- - `InappropriateType` for wrong file type (directory) --- - `NoSuchThing` if the file does not exist --- - `PermissionDenied` if the directory cannot be read -deleteFile :: Path b -> IO () -deleteFile (MkPath p) = removeLink p - - --- |Deletes the given directory, which must be empty, never symlinks. --- --- Throws: --- --- - `InappropriateType` for wrong file type (symlink to directory) --- - `InappropriateType` for wrong file type (regular file) --- - `NoSuchThing` if directory does not exist --- - `UnsatisfiedConstraints` if directory is not empty --- - `PermissionDenied` if we can't open or write to parent directory --- --- Notes: calls `rmdir` -deleteDir :: Path b -> IO () -deleteDir (MkPath p) = removeDirectory p - - --- |Deletes the given directory recursively. Does not follow symbolic --- links. Tries `deleteDir` first before attemtping a recursive --- deletion. --- --- On directory contents this behaves like `easyDelete` --- and thus will ignore any file type that is not `RegularFile`, --- `SymbolicLink` or `Directory`. --- --- Safety/reliability concerns: --- --- * not atomic --- * examines filetypes explicitly --- --- Throws: --- --- - `InappropriateType` for wrong file type (symlink to directory) --- - `InappropriateType` for wrong file type (regular file) --- - `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 - - --- |Deletes a file, directory or symlink. --- In case of directory, performs recursive deletion. In case of --- a symlink, the symlink file is deleted. --- Any other file type is ignored. --- --- Safety/reliability concerns: --- --- * 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 () - - - - - -------------------- - --[ File Opening ]-- - -------------------- - - --- |Opens a file appropriately by invoking xdg-open. The file type --- is not checked. This forks a process. -openFile :: Path b - -> IO ProcessID -openFile (MkPath fp) = - SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing - - --- |Executes a program with the given arguments. This forks a process. -executeFile :: Path b -- ^ program - -> [ByteString] -- ^ arguments - -> IO ProcessID -executeFile (MkPath fp) args = - SPP.forkProcess $ SPP.executeFile fp True args Nothing - - - - - --------------------- - --[ File Creation ]-- - --------------------- - - --- |Create an empty regular file at the given directory with the given --- filename. --- --- Throws: --- --- - `PermissionDenied` if output directory cannot be written to --- - `AlreadyExists` if destination already exists --- - `NoSuchThing` if any of the parent components of the path --- do not exist -createRegularFile :: FileMode -> Path b -> IO () -createRegularFile fm (MkPath destBS) = - bracket (SPI.openFd destBS SPI.WriteOnly (Just fm) - (SPI.defaultFileFlags { exclusive = True })) - SPI.closeFd - (\_ -> return ()) - - --- |Create an empty directory at the given directory with the given filename. --- --- Throws: --- --- - `PermissionDenied` if output directory cannot be written to --- - `AlreadyExists` if destination already exists --- - `NoSuchThing` if any of the parent components of the path --- do not exist -createDir :: FileMode -> Path b -> IO () -createDir fm (MkPath destBS) = createDirectory destBS fm - - --- |Create an empty directory at the given directory with the given filename. --- All parent directories are created with the same filemode. This --- basically behaves like: --- --- @ --- mkdir -p \/some\/dir --- @ --- --- Safety/reliability concerns: --- --- * not atomic --- --- Throws: --- --- - `PermissionDenied` if any part of the path components do not --- exist and cannot be written to --- - `AlreadyExists` if destination already exists and --- is not a directory -createDirRecursive :: FileMode -> Path b -> IO () -createDirRecursive fm p = - toAbs p >>= go - where - go :: Path Abs -> IO () - go dest@(MkPath 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 - - --- |Create a symlink. --- --- Throws: --- --- - `PermissionDenied` if output directory cannot be written to --- - `AlreadyExists` if destination file already exists --- - `NoSuchThing` if any of the parent components of the path --- do not exist --- --- Note: calls `symlink` -createSymlink :: Path b -- ^ destination file - -> ByteString -- ^ path the symlink points to - -> IO () -createSymlink (MkPath destBS) sympoint - = createSymbolicLink sympoint destBS - - - - ---------------------------- - --[ File Renaming/Moving ]-- - ---------------------------- - - --- |Rename a given file with the provided filename. Destination and source --- must be on the same device, otherwise `eXDEV` will be raised. --- --- Does not follow symbolic links, but renames the symbolic link file. --- --- Safety/reliability concerns: --- --- * has a separate set of exception handling, apart from the syscall --- --- Throws: --- --- - `NoSuchThing` if source file does not exist --- - `PermissionDenied` if output directory cannot be written to --- - `PermissionDenied` if source directory cannot be opened --- - `UnsupportedOperation` if source and destination are on different --- devices --- - `AlreadyExists` if destination already exists --- - `SameFile` if destination and source are the same file --- (`HPathIOException`) --- --- Note: calls `rename` (but does not allow to rename over existing files) -renameFile :: Path b1 -> Path b2 -> IO () -renameFile fromf@(MkPath fromfBS) tof@(MkPath tofBS) = do - throwSameFile fromf tof - throwFileDoesExist tof - throwDirDoesExist tof - rename fromfBS tofBS - - --- |Move a file. This also works across devices by copy-delete fallback. --- And also works on directories. --- --- Does not follow symbolic links, but renames the symbolic link file. --- --- --- Safety/reliability concerns: --- --- * `Overwrite` mode is not atomic --- * copy-delete fallback is inherently non-atomic --- * since this function calls `easyCopy` and `easyDelete` as a fallback --- to `renameFile`, file types that are not `RegularFile`, `SymbolicLink` --- or `Directory` may be ignored --- * for `Overwrite` mode, the destination will be deleted (not recursively) --- before moving --- --- Throws: --- --- - `NoSuchThing` if source file does not exist --- - `PermissionDenied` if output directory cannot be written to --- - `PermissionDenied` if source directory cannot be opened --- - `SameFile` if destination and source are the same file --- (`HPathIOException`) --- --- Throws in `Strict` mode only: --- --- - `AlreadyExists` if destination already exists --- --- Note: calls `rename` (but does not allow to rename over existing files) -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 >>= isWritable - 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 - - - - - - -------------------- - --[ File Reading ]-- - -------------------- - - --- |Read the given file at once into memory as a strict ByteString. --- Symbolic links are followed, no sanity checks on file size --- or file type. File must exist. --- --- Note: the size of the file is determined in advance, as to only --- have one allocation. --- --- Safety/reliability concerns: --- --- * since amount of bytes to read is determined in advance, --- the file might be read partially only if something else is --- appending to it while reading --- * the whole file is read into memory! --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFile :: Path b -> IO ByteString -readFile (MkPath fp) = - bracket (openFd fp SPI.ReadOnly [] Nothing) (SPI.closeFd) $ \fd -> do - stat <- PF.getFdStatus fd - let fsize = PF.fileSize stat - SPB.fdRead fd (fromIntegral fsize) - - --- |Read the given file in chunks of size `8192` into memory until --- `fread` returns 0. Returns a lazy ByteString, because it uses --- Builders under the hood. --- --- Safety/reliability concerns: --- --- * the whole file is read into memory! --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFileEOF :: Path b -> IO L.ByteString -readFileEOF (MkPath fp) = - bracket (openFd fp SPI.ReadOnly [] Nothing) (SPI.closeFd) $ \fd -> - allocaBytes (fromIntegral bufSize) $ \buf -> read' fd buf mempty - where - bufSize :: CSize - bufSize = 8192 - read' :: Fd -> Ptr Word8 -> Builder -> IO L.ByteString - read' fd buf builder = do - size <- SPB.fdReadBuf fd buf bufSize - if size == 0 - then return $ toLazyByteString builder - else do - readBS <- unsafePackCStringFinalizer buf - (fromIntegral size) - (return ()) - read' fd buf (builder <> byteString readBS) - - - - - -------------------- - --[ File Writing ]-- - -------------------- - - --- |Write a given ByteString to a file, truncating the file beforehand. --- The file must exist. Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -writeFile :: Path b -> ByteString -> IO () -writeFile (MkPath fp) bs = - bracket (openFd fp SPI.WriteOnly [SPDF.oTrunc] Nothing) (SPI.closeFd) $ \fd -> - void $ SPB.fdWrite fd bs - - --- |Append a given ByteString to a file. --- The file must exist. Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -appendFile :: Path b -> ByteString -> IO () -appendFile (MkPath fp) bs = - bracket (openFd fp SPI.WriteOnly [SPDF.oAppend] Nothing) - (SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs - - - - - ----------------------- - --[ File Permissions]-- - ----------------------- - - --- |Default permissions for a new file. -newFilePerms :: FileMode -newFilePerms - = ownerWriteMode - `unionFileModes` ownerReadMode - `unionFileModes` groupWriteMode - `unionFileModes` groupReadMode - `unionFileModes` otherWriteMode - `unionFileModes` otherReadMode - - --- |Default permissions for a new directory. -newDirPerms :: FileMode -newDirPerms - = ownerModes - `unionFileModes` groupExecuteMode - `unionFileModes` groupReadMode - `unionFileModes` otherExecuteMode - `unionFileModes` otherReadMode - - - - ------------------------- - --[ Directory reading ]-- - ------------------------- - - --- |Gets all filenames of the given directory. This excludes "." and "..". --- This version does not follow symbolic links. --- --- The contents are not sorted and there is no guarantee on the ordering. --- --- Throws: --- --- - `NoSuchThing` if directory does not exist --- - `InappropriateType` if file type is wrong (file) --- - `InappropriateType` if file type is wrong (symlink to file) --- - `InappropriateType` if file type is wrong (symlink to dir) --- - `PermissionDenied` if directory cannot be opened -getDirsFiles :: Path b -- ^ dir to read - -> IO [Path b] -getDirsFiles p@(MkPath fp) = do - fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing - return - . catMaybes - . fmap (\x -> () p <$> (parseMaybe . snd $ x)) - =<< getDirectoryContents' fd - where - parseMaybe :: ByteString -> Maybe (Path Fn) - parseMaybe = parseFn - - - - - --------------------------- - --[ FileType operations ]-- - --------------------------- - - --- |Get the file type of the file located at the given path. Does --- not follow symbolic links. --- --- Throws: --- --- - `NoSuchThing` if the file does not exist --- - `PermissionDenied` if any part of the path is not accessible -getFileType :: Path b -> IO FileType -getFileType (MkPath 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?!" - - - - -------------- - --[ Others ]-- - -------------- - - - --- |Applies `realpath` on the given path. --- --- Throws: --- --- - `NoSuchThing` if the file at the given path does not exist --- - `NoSuchThing` if the symlink is broken -canonicalizePath :: Path b -> IO (Path Abs) -canonicalizePath (MkPath l) = do - nl <- SPDT.realpath l - return $ MkPath nl - - --- |Converts any path to an absolute path. --- This is done in the following way: --- --- - if the path is already an absolute one, just return it --- - if it's a relative path, prepend the current directory to it -toAbs :: Path b -> IO (Path Abs) -toAbs (MkPath bs) = do - let mabs = parseAbs bs :: Maybe (Path Abs) - case mabs of - Just a -> return a - Nothing -> do - cwd <- getWorkingDirectory >>= parseAbs - rel <- parseRel bs -- we know it must be relative now - return $ cwd rel diff --git a/src/HPath/IO.hs-boot b/src/HPath/IO.hs-boot deleted file mode 100644 --- a/src/HPath/IO.hs-boot +++ /dev/null @@ -1,8 +0,0 @@ -module HPath.IO where - - -import HPath - -canonicalizePath :: Path b -> IO (Path Abs) - -toAbs :: Path b -> IO (Path Abs) diff --git a/src/HPath/IO/Errors.hs b/src/HPath/IO/Errors.hs deleted file mode 100644 --- a/src/HPath/IO/Errors.hs +++ /dev/null @@ -1,360 +0,0 @@ --- | --- Module : HPath.IO.Errors --- Copyright : © 2016 Julian Ospald --- License : BSD3 --- --- Maintainer : Julian Ospald --- Stability : experimental --- Portability : portable --- --- Provides error handling. - -{-# 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 - , doesFileExist - , doesDirectoryExist - , isWritable - , canOpenDirectory - - -- * Error handling functions - , catchErrno - , rethrowErrnoAs - , handleIOError - , bracketeer - , reactOnError - ) - where - - -import Control.Applicative - ( - (<$>) - ) -import Control.Exception -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 HPath.Internal - ( - Path(..) - ) -import {-# SOURCE #-} HPath.IO - ( - canonicalizePath - , toAbs - ) -import System.IO.Error - ( - alreadyExistsErrorType - , catchIOError - , 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 - - --- |Additional generic IO exceptions that the posix functions --- do not provide. -data HPathIOException = SameFile ByteString ByteString - | DestinationInSource ByteString ByteString - | RecursiveFailure [(RecursiveFailureHint, IOException)] - deriving (Eq, Show, Typeable) - - --- |A type for giving failure hints on recursive failure, which allows --- to programmatically make choices without examining --- the weakly typed I/O error attributes (like `ioeGetFileName`). --- --- The first argument to the data constructor is always the --- source and the second the destination. -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{} -isDestinationInSource ex = toConstr (ex :: HPathIOException) == toConstr DestinationInSource{} -isRecursiveFailure ex = toConstr (ex :: HPathIOException) == toConstr RecursiveFailure{} - - -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 ]-- - ---------------------------- - - --- |Throws `AlreadyExists` `IOError` if file exists. -throwFileDoesExist :: Path b -> IO () -throwFileDoesExist fp@(MkPath bs) = - whenM (doesFileExist fp) - (ioError . mkIOError - alreadyExistsErrorType - "File already exists" - Nothing - $ (Just (toString $ bs)) - ) - - --- |Throws `AlreadyExists` `IOError` if directory exists. -throwDirDoesExist :: Path b -> IO () -throwDirDoesExist fp@(MkPath bs) = - whenM (doesDirectoryExist fp) - (ioError . mkIOError - alreadyExistsErrorType - "Directory already exists" - Nothing - $ (Just (toString $ bs)) - ) - - --- |Uses `isSameFile` and throws `SameFile` if it returns True. -throwSameFile :: Path b1 - -> Path b2 - -> IO () -throwSameFile fp1@(MkPath bs1) fp2@(MkPath bs2) = - whenM (sameFile fp1 fp2) - (throwIO $ SameFile bs1 bs2) - - --- |Check if the files are the same by examining device and file id. --- This follows symbolic links. -sameFile :: Path b1 -> Path b2 -> IO Bool -sameFile (MkPath fp1) (MkPath 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 - - --- TODO: make this more robust when destination does not exist --- |Checks whether the destination directory is contained --- within the source directory by comparing the device+file ID of the --- source directory with all device+file IDs of the parent directories --- of the destination. -throwDestinationInSource :: Path b1 -- ^ source dir - -> Path b2 -- ^ full destination, @dirname dest@ - -- must exist - -> IO () -throwDestinationInSource (MkPath sbs) dest@(MkPath 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) - - --- |Checks if the given file exists and is not a directory. --- Does not follow symlinks. -doesFileExist :: Path b -> IO Bool -doesFileExist (MkPath bs) = - handleIOError (\_ -> return False) $ do - fs <- PF.getSymbolicLinkStatus bs - return $ not . PF.isDirectory $ fs - - --- |Checks if the given file exists and is a directory. --- Does not follow symlinks. -doesDirectoryExist :: Path b -> IO Bool -doesDirectoryExist (MkPath bs) = - handleIOError (\_ -> return False) $ do - fs <- PF.getSymbolicLinkStatus bs - return $ PF.isDirectory fs - - --- |Checks whether a file or folder is writable. -isWritable :: Path b -> IO Bool -isWritable (MkPath bs) = - handleIOError (\_ -> return False) $ - fileAccess bs False True False - - --- |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 (MkPath bs) = - handleIOError (\_ -> return False) $ do - bracket (PFD.openDirStream bs) - PFD.closeDirStream - (\_ -> return ()) - return True - - - - - -------------------------------- - --[ Error handling functions ]-- - -------------------------------- - - --- |Carries out an action, then checks if there is an IOException and --- a specific errno. If so, then it carries out another action, otherwise --- it rethrows the error. -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 - - --- |Execute the given action and retrow IO exceptions as a new Exception --- that have the given errno. If errno does not match the exception is rethrown --- as is. -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) - - - --- |Like `catchIOError`, with arguments swapped. -handleIOError :: (IOError -> IO a) -> IO a -> IO a -handleIOError = flip catchIOError - - --- |Like `bracket`, but allows to have different clean-up --- actions depending on whether the in-between computation --- has raised an exception or not. -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 - diff --git a/src/System/Posix/Directory/Foreign.hsc b/src/System/Posix/Directory/Foreign.hsc deleted file mode 100644 --- a/src/System/Posix/Directory/Foreign.hsc +++ /dev/null @@ -1,55 +0,0 @@ -module System.Posix.Directory.Foreign where - -import Data.Bits -import Data.List (foldl') -import Foreign.C.Types - -#include -#include -#include -#include -#include -#include - -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") - --- |Returns @True@ if posix-paths was compiled with support for the provided --- flag. (As of this writing, the only flag for which this check may be --- necessary is 'oCloexec'; all other flags will always yield @True@.) -isSupported :: Flags -> Bool -isSupported (Flags _) = True -isSupported _ = False - --- |@O_CLOEXEC@ is not supported on every POSIX platform. Use --- @'isSupported' oCloexec@ to determine if support for @O_CLOEXEC@ was --- compiled into your version of posix-paths. (If not, using @oCloexec@ will --- throw an exception.) -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 - - - --- If these enum declarations occur earlier in the file, haddock --- gets royally confused about the above doc comments. --- Probably http://trac.haskell.org/haddock/ticket/138 - -#{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 diff --git a/src/System/Posix/Directory/Traversals.hs b/src/System/Posix/Directory/Traversals.hs deleted file mode 100644 --- a/src/System/Posix/Directory/Traversals.hs +++ /dev/null @@ -1,264 +0,0 @@ --- | --- Module : System.Posix.Directory.Traversals --- Copyright : © 2016 Julian Ospald --- License : BSD3 --- --- Maintainer : Julian Ospald --- Stability : experimental --- Portability : portable --- --- Traversal and read operations on directories. - - -{-# 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 - --- lower-level stuff -, 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 - - - - ----------------------------------------------------------- - --- | Get all files from a directory and its subdirectories. --- --- Upon entering a directory, 'allDirectoryContents' will get all entries --- strictly. However the returned list is lazy in that directories will only --- be accessed on demand. --- --- Follows symbolic links for the input dir. -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) - --- | Get all files from a directory and its subdirectories strictly. --- --- Follows symbolic links for the input dir. -allDirectoryContents' :: RawFilePath -> IO [RawFilePath] -allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) [] --- this uses traverseDirectory because it's more efficient than forcing the --- lazy version. - --- | Recursively apply the 'action' to the parent directory and all --- files/subdirectories. --- --- This function allows for memory-efficient traversals. --- --- Follows symbolic links for the input dir. -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 - - ----------------------------------------------------------- --- dodgy stuff - -type CDir = () -type CDirent = () - --- Posix doesn't export DirStream, so to re-use that type we need to use --- unsafeCoerce. It's just a newtype, so this is a legitimate usage. --- ugly trick. -unpackDirStream :: DirStream -> Ptr CDir -unpackDirStream = unsafeCoerce - -packDirStream :: Ptr CDir -> DirStream -packDirStream = unsafeCoerce - --- the __hscore_* functions are defined in the unix package. We can import them and let --- the linker figure it out. -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 ()) - ----------------------------------------------------------- --- less dodgy but still lower-level - - -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" - - --- |Gets all directory contents (not recursively). -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 - - --- |Binding to @fdopendir(3)@. -fdOpendir :: Posix.Fd -> IO DirStream -fdOpendir fd = - packDirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd) - - --- |Like `getDirectoryContents` except for a file descriptor. --- --- To avoid complicated error checks, the file descriptor is --- __always__ closed, even if `fdOpendir` fails. Usually, this --- only happens on successful `fdOpendir` and after the directory --- stream is closed. Also see the manpage of @fdopendir(3)@ for --- more details. -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) - - --- | return the canonicalized absolute pathname --- --- like canonicalizePath, but uses @realpath(3)@ -realpath :: RawFilePath -> IO RawFilePath -realpath inp = - allocaBytes pathMax $ \tmp -> do - void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp - BS.packCString tmp diff --git a/src/System/Posix/FD.hs b/src/System/Posix/FD.hs deleted file mode 100644 --- a/src/System/Posix/FD.hs +++ /dev/null @@ -1,75 +0,0 @@ --- | --- Module : System.Posix.FD --- Copyright : © 2016 Julian Ospald --- License : BSD3 --- --- Maintainer : Julian Ospald --- Stability : experimental --- Portability : portable --- --- Provides an alternative for `System.Posix.IO.ByteString.openFd` --- which gives us more control on what status flags to pass to the --- low-level @open(2)@ call, in contrast to the unix package. - - -{-# 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 - - --- |Open and optionally create this file. See 'System.Posix.Files' --- for information on how to use the 'FileMode' type. --- --- Note that passing @Just x@ as the 4th argument triggers the --- `oCreat` status flag, which must be set when you pass in `oExcl` --- to the status flags. Also see the manpage for @open(2)@. -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 - diff --git a/src/System/Posix/FilePath.hs b/src/System/Posix/FilePath.hs deleted file mode 100644 --- a/src/System/Posix/FilePath.hs +++ /dev/null @@ -1,823 +0,0 @@ --- | --- Module : System.Posix.FilePath --- Copyright : © 2016 Julian Ospald --- License : BSD3 --- --- Maintainer : Julian Ospald --- Stability : experimental --- Portability : portable --- --- The equivalent of "System.FilePath" on raw (byte string) file paths. --- --- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute! - - -{-# LANGUAGE CPP #-} -{-# LANGUAGE TupleSections #-} - -{-# OPTIONS_GHC -Wall #-} - - -module System.Posix.FilePath ( - - -- * Separator predicates - pathSeparator -, isPathSeparator -, searchPathSeparator -, isSearchPathSeparator -, extSeparator -, isExtSeparator - - -- * $PATH methods -, splitSearchPath -, getSearchPath - - -- * Extension functions -, splitExtension -, takeExtension -, replaceExtension -, dropExtension -, addExtension -, hasExtension -, (<.>) -, splitExtensions -, dropExtensions -, takeExtensions -, stripExtension - - -- * Filename\/directory functions -, splitFileName -, takeFileName -, replaceFileName -, dropFileName -, takeBaseName -, replaceBaseName -, takeDirectory -, replaceDirectory -, combine -, () -, splitPath -, joinPath -, splitDirectories - - -- * Trailing slash functions -, hasTrailingPathSeparator -, addTrailingPathSeparator -, dropTrailingPathSeparator - - -- * File name manipulations -, normalise -, makeRelative -, equalFilePath -, isRelative -, isAbsolute -, isValid -, makeValid -, isFileName -, hasParentDir -, hiddenFile - -, module System.Posix.ByteString.FilePath -) where - -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.String (fromString) -import System.Posix.ByteString.FilePath -import qualified System.Posix.Env.ByteString as PE - -import Data.Maybe (isJust) -import Data.Word8 -#if !MIN_VERSION_bytestring(0,10,8) -import qualified Data.List as L -#endif -import Control.Arrow (second) - --- $setup --- >>> import Data.Char --- >>> import Data.Maybe --- >>> import Test.QuickCheck --- >>> import Control.Applicative --- >>> import qualified Data.ByteString as BS --- >>> instance Arbitrary ByteString where arbitrary = BS.pack <$> arbitrary --- >>> instance CoArbitrary ByteString where coarbitrary = coarbitrary . BS.unpack --- --- >>> let _chr :: Word8 -> Char; _chr = chr . fromIntegral - - - ------------------------- --- Separator predicates - - --- | Path separator character -pathSeparator :: Word8 -pathSeparator = _slash - - --- | Check if a character is the path separator --- --- prop> \n -> (_chr n == '/') == isPathSeparator n -isPathSeparator :: Word8 -> Bool -isPathSeparator = (== pathSeparator) - - --- | Search path separator -searchPathSeparator :: Word8 -searchPathSeparator = _colon - - --- | Check if a character is the search path separator --- --- prop> \n -> (_chr n == ':') == isSearchPathSeparator n -isSearchPathSeparator :: Word8 -> Bool -isSearchPathSeparator = (== searchPathSeparator) - - --- | File extension separator -extSeparator :: Word8 -extSeparator = _period - - --- | Check if a character is the file extension separator --- --- prop> \n -> (_chr n == '.') == isExtSeparator n -isExtSeparator :: Word8 -> Bool -isExtSeparator = (== extSeparator) - - - ------------------------- --- $PATH methods - - --- | Take a ByteString, split it on the 'searchPathSeparator'. --- Blank items are converted to @.@. --- --- Follows the recommendations in --- --- --- >>> splitSearchPath "File1:File2:File3" --- ["File1","File2","File3"] --- >>> splitSearchPath "File1::File2:File3" --- ["File1",".","File2","File3"] --- >>> splitSearchPath "" --- ["."] -splitSearchPath :: ByteString -> [RawFilePath] -splitSearchPath = f - where - f bs = let (pre, post) = BS.break isSearchPathSeparator bs - in if BS.null post - then g pre - else g pre ++ f (BS.tail post) - g x - | BS.null x = [BS.singleton _period] - | otherwise = [x] - - --- | Get a list of 'RawFilePath's in the $PATH variable. -getSearchPath :: IO [RawFilePath] -getSearchPath = fmap (maybe [] splitSearchPath) (PE.getEnv $ fromString "PATH") - - - ------------------------- --- Extension functions - --- | Split a 'RawFilePath' into a path+filename and extension --- --- >>> splitExtension "file.exe" --- ("file",".exe") --- >>> splitExtension "file" --- ("file","") --- >>> splitExtension "/path/file.tar.gz" --- ("/path/file.tar",".gz") --- --- prop> \path -> uncurry (BS.append) (splitExtension path) == path -splitExtension :: RawFilePath -> (RawFilePath, ByteString) -splitExtension x = if BS.null basename - then (x,BS.empty) - else (BS.append path (BS.init basename),BS.cons extSeparator fileExt) - where - (path,file) = splitFileNameRaw x - (basename,fileExt) = BS.breakEnd isExtSeparator file - - --- | Get the final extension from a 'RawFilePath' --- --- >>> takeExtension "file.exe" --- ".exe" --- >>> takeExtension "file" --- "" --- >>> takeExtension "/path/file.tar.gz" --- ".gz" -takeExtension :: RawFilePath -> ByteString -takeExtension = snd . splitExtension - - --- | Change a file's extension --- --- prop> \path -> let ext = takeExtension path in replaceExtension path ext == path -replaceExtension :: RawFilePath -> ByteString -> RawFilePath -replaceExtension path ext = dropExtension path <.> ext - - --- | Drop the final extension from a 'RawFilePath' --- --- >>> dropExtension "file.exe" --- "file" --- >>> dropExtension "file" --- "file" --- >>> dropExtension "/path/file.tar.gz" --- "/path/file.tar" -dropExtension :: RawFilePath -> RawFilePath -dropExtension = fst . splitExtension - - --- | Add an extension to a 'RawFilePath' --- --- >>> addExtension "file" ".exe" --- "file.exe" --- >>> addExtension "file.tar" ".gz" --- "file.tar.gz" --- >>> addExtension "/path/" ".ext" --- "/path/.ext" -addExtension :: RawFilePath -> ByteString -> RawFilePath -addExtension file ext - | BS.null ext = file - | isExtSeparator (BS.head ext) = BS.append file ext - | otherwise = BS.intercalate (BS.singleton extSeparator) [file, ext] - - --- | Check if a 'RawFilePath' has an extension --- --- >>> hasExtension "file" --- False --- >>> hasExtension "file.tar" --- True --- >>> hasExtension "/path.part1/" --- False -hasExtension :: RawFilePath -> Bool -hasExtension = isJust . BS.elemIndex extSeparator . takeFileName - - --- | Operator version of 'addExtension' -(<.>) :: RawFilePath -> ByteString -> RawFilePath -(<.>) = addExtension - - --- | Split a 'RawFilePath' on the first extension. --- --- >>> splitExtensions "/path/file.tar.gz" --- ("/path/file",".tar.gz") --- --- prop> \path -> uncurry addExtension (splitExtensions path) == path -splitExtensions :: RawFilePath -> (RawFilePath, ByteString) -splitExtensions x = if BS.null basename - then (path,fileExt) - else (BS.append path basename,fileExt) - where - (path,file) = splitFileNameRaw x - (basename,fileExt) = BS.break isExtSeparator file - - --- | Remove all extensions from a 'RawFilePath' --- --- >>> dropExtensions "/path/file.tar.gz" --- "/path/file" -dropExtensions :: RawFilePath -> RawFilePath -dropExtensions = fst . splitExtensions - - --- | Take all extensions from a 'RawFilePath' --- --- >>> takeExtensions "/path/file.tar.gz" --- ".tar.gz" -takeExtensions :: RawFilePath -> ByteString -takeExtensions = snd . splitExtensions - - --- | Drop the given extension from a FilePath, and the @\".\"@ preceding it. --- Returns 'Nothing' if the FilePath does not have the given extension, or --- 'Just' and the part before the extension if it does. --- --- This function can be more predictable than 'dropExtensions', --- especially if the filename might itself contain @.@ characters. --- --- >>> stripExtension "hs.o" "foo.x.hs.o" --- Just "foo.x" --- >>> stripExtension "hi.o" "foo.x.hs.o" --- Nothing --- >>> stripExtension ".c.d" "a.b.c.d" --- Just "a.b" --- >>> stripExtension ".c.d" "a.b..c.d" --- Just "a.b." --- >>> stripExtension "baz" "foo.bar" --- Nothing --- >>> stripExtension "bar" "foobar" --- Nothing --- --- prop> \path -> stripExtension "" path == Just path --- prop> \path -> dropExtension path == fromJust (stripExtension (takeExtension path) path) --- prop> \path -> dropExtensions path == fromJust (stripExtension (takeExtensions path) path) -stripExtension :: ByteString -> RawFilePath -> Maybe RawFilePath -stripExtension bs path - | BS.null bs = Just path - | otherwise = stripSuffix' dotExt path - where - dotExt = if isExtSeparator $ BS.head bs - then bs - else extSeparator `BS.cons` bs -#if MIN_VERSION_bytestring(0,10,8) - stripSuffix' = BS.stripSuffix -#else - stripSuffix' xs ys = fmap (BS.pack . reverse) $ L.stripPrefix (reverse $ BS.unpack xs) (reverse $ BS.unpack ys) -#endif - - ------------------------- --- Filename/directory functions - - --- | Split a 'RawFilePath' into (path,file). 'combine' is the inverse --- --- >>> splitFileName "path/file.txt" --- ("path/","file.txt") --- >>> splitFileName "path/" --- ("path/","") --- >>> splitFileName "file.txt" --- ("./","file.txt") --- --- prop> \path -> uncurry combine (splitFileName path) == path || fst (splitFileName path) == "./" -splitFileName :: RawFilePath -> (RawFilePath, RawFilePath) -splitFileName x = if BS.null path - then (dotSlash, file) - else (path,file) - where - (path,file) = splitFileNameRaw x - dotSlash = _period `BS.cons` (BS.singleton pathSeparator) - - --- | Get the file name --- --- >>> takeFileName "path/file.txt" --- "file.txt" --- >>> takeFileName "path/" --- "" -takeFileName :: RawFilePath -> RawFilePath -takeFileName = snd . splitFileName - - --- | Change the file name --- --- prop> \path -> replaceFileName path (takeFileName path) == path -replaceFileName :: RawFilePath -> ByteString -> RawFilePath -replaceFileName x y = fst (splitFileNameRaw x) y - - --- | Drop the file name --- --- >>> dropFileName "path/file.txt" --- "path/" --- >>> dropFileName "file.txt" --- "./" -dropFileName :: RawFilePath -> RawFilePath -dropFileName = fst . splitFileName - - --- | Get the file name, without a trailing extension --- --- >>> takeBaseName "path/file.tar.gz" --- "file.tar" --- >>> takeBaseName "" --- "" -takeBaseName :: RawFilePath -> ByteString -takeBaseName = dropExtension . takeFileName - - --- | Change the base name --- --- >>> replaceBaseName "path/file.tar.gz" "bob" --- "path/bob.gz" --- --- prop> \path -> replaceBaseName path (takeBaseName path) == path -replaceBaseName :: RawFilePath -> ByteString -> RawFilePath -replaceBaseName path name = combineRaw dir (name <.> ext) - where - (dir,file) = splitFileNameRaw path - ext = takeExtension file - - --- | Get the directory, moving up one level if it's already a directory --- --- >>> takeDirectory "path/file.txt" --- "path" --- >>> takeDirectory "file" --- "." --- >>> takeDirectory "/path/to/" --- "/path/to" --- >>> takeDirectory "/path/to" --- "/path" -takeDirectory :: RawFilePath -> RawFilePath -takeDirectory x = case () of - () | x == BS.singleton pathSeparator -> x - | BS.null res && not (BS.null file) -> file - | otherwise -> res - where - res = fst $ BS.spanEnd isPathSeparator file - file = dropFileName x - - --- | Change the directory component of a 'RawFilePath' --- --- prop> \path -> replaceDirectory path (takeDirectory path) `equalFilePath` path || takeDirectory path == "." -replaceDirectory :: RawFilePath -> ByteString -> RawFilePath -replaceDirectory file dir = combineRaw dir (takeFileName file) - - --- | Join two paths together --- --- >>> combine "/" "file" --- "/file" --- >>> combine "/path/to" "file" --- "/path/to/file" --- >>> combine "file" "/absolute/path" --- "/absolute/path" -combine :: RawFilePath -> RawFilePath -> RawFilePath -combine a b | not (BS.null b) && isPathSeparator (BS.head b) = b - | otherwise = combineRaw a b - - --- | Operator version of combine -() :: RawFilePath -> RawFilePath -> RawFilePath -() = combine - --- | Split a path into a list of components: --- --- >>> splitPath "/path/to/file.txt" --- ["/","path/","to/","file.txt"] --- --- prop> \path -> BS.concat (splitPath path) == path -splitPath :: RawFilePath -> [RawFilePath] -splitPath = splitter - where - splitter x - | BS.null x = [] - | otherwise = case BS.elemIndex pathSeparator x of - Nothing -> [x] - Just ix -> case BS.findIndex (not . isPathSeparator) $ BS.drop (ix+1) x of - Nothing -> [x] - Just runlen -> uncurry (:) . second splitter $ BS.splitAt (ix+1+runlen) x - - --- | Join a split path back together --- --- prop> \path -> joinPath (splitPath path) == path --- --- >>> joinPath ["path","to","file.txt"] --- "path/to/file.txt" -joinPath :: [RawFilePath] -> RawFilePath -joinPath = foldr () BS.empty - - --- | Like 'splitPath', but without trailing slashes --- --- >>> splitDirectories "/path/to/file.txt" --- ["/","path","to","file.txt"] --- >>> splitDirectories "" --- [] -splitDirectories :: RawFilePath -> [RawFilePath] -splitDirectories x - | BS.null x = [] - | isPathSeparator (BS.head x) = let (root,rest) = BS.splitAt 1 x - in root : splitter rest - | otherwise = splitter x - where - splitter = filter (not . BS.null) . BS.split pathSeparator - - - ------------------------- --- Trailing slash functions - --- | Check if the last character of a 'RawFilePath' is '/'. --- --- >>> hasTrailingPathSeparator "/path/" --- True --- >>> hasTrailingPathSeparator "/" --- True --- >>> hasTrailingPathSeparator "/path" --- False -hasTrailingPathSeparator :: RawFilePath -> Bool -hasTrailingPathSeparator x - | BS.null x = False - | otherwise = isPathSeparator $ BS.last x - - --- | Add a trailing path separator. --- --- >>> addTrailingPathSeparator "/path" --- "/path/" --- >>> addTrailingPathSeparator "/path/" --- "/path/" --- >>> addTrailingPathSeparator "/" --- "/" -addTrailingPathSeparator :: RawFilePath -> RawFilePath -addTrailingPathSeparator x = if hasTrailingPathSeparator x - then x - else x `BS.snoc` pathSeparator - - --- | Remove a trailing path separator --- --- >>> dropTrailingPathSeparator "/path/" --- "/path" --- >>> dropTrailingPathSeparator "/path////" --- "/path" --- >>> dropTrailingPathSeparator "/" --- "/" --- >>> dropTrailingPathSeparator "//" --- "/" -dropTrailingPathSeparator :: RawFilePath -> RawFilePath -dropTrailingPathSeparator x - | x == BS.singleton pathSeparator = x - | otherwise = if hasTrailingPathSeparator x - then dropTrailingPathSeparator $ BS.init x - else x - - - ------------------------- --- File name manipulations - - --- |Normalise a file. --- --- >>> normalise "/file/\\test////" --- "/file/\\test/" --- >>> normalise "/file/./test" --- "/file/test" --- >>> normalise "/test/file/../bob/fred/" --- "/test/file/../bob/fred/" --- >>> normalise "../bob/fred/" --- "../bob/fred/" --- >>> normalise "./bob/fred/" --- "bob/fred/" --- >>> normalise "./bob////.fred/./...///./..///#." --- "bob/.fred/.../../#." --- >>> normalise "." --- "." --- >>> normalise "./" --- "./" --- >>> normalise "./." --- "./" --- >>> normalise "/./" --- "/" --- >>> normalise "/" --- "/" --- >>> normalise "bob/fred/." --- "bob/fred/" --- >>> normalise "//home" --- "/home" -normalise :: RawFilePath -> RawFilePath -normalise filepath = - result `BS.append` - (if addPathSeparator - then BS.singleton pathSeparator - else BS.empty) - where - result = let n = f filepath - in if BS.null n - then BS.singleton _period - else n - addPathSeparator = isDirPath filepath && - not (hasTrailingPathSeparator result) - isDirPath xs = hasTrailingPathSeparator xs - || not (BS.null xs) && BS.last xs == _period - && hasTrailingPathSeparator (BS.init xs) - f = joinPath . dropDots . propSep . splitDirectories - propSep :: [ByteString] -> [ByteString] - propSep (x:xs) - | BS.all (== pathSeparator) x = BS.singleton pathSeparator : xs - | otherwise = x : xs - propSep [] = [] - dropDots :: [ByteString] -> [ByteString] - dropDots = filter (BS.singleton _period /=) - - - --- | Contract a filename, based on a relative path. Note that the resulting --- path will never introduce @..@ paths, as the presence of symlinks --- means @..\/b@ may not reach @a\/b@ if it starts from @a\/c@. For a --- worked example see --- . --- --- >>> makeRelative "/directory" "/directory/file.ext" --- "file.ext" --- >>> makeRelative "/Home" "/home/bob" --- "/home/bob" --- >>> makeRelative "/home/" "/home/bob/foo/bar" --- "bob/foo/bar" --- >>> makeRelative "/fred" "bob" --- "bob" --- >>> makeRelative "/file/test" "/file/test/fred" --- "fred" --- >>> makeRelative "/file/test" "/file/test/fred/" --- "fred/" --- >>> makeRelative "some/path" "some/path/a/b/c" --- "a/b/c" --- --- prop> \p -> makeRelative p p == "." --- prop> \p -> makeRelative (takeDirectory p) p `equalFilePath` takeFileName p --- prop \x y -> equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y makeRelative y x) x -makeRelative :: RawFilePath -> RawFilePath -> RawFilePath -makeRelative root path - | equalFilePath root path = BS.singleton _period - | takeAbs root /= takeAbs path = path - | otherwise = f (dropAbs root) (dropAbs path) - where - f x y - | BS.null x = BS.dropWhile isPathSeparator y - | otherwise = let (x1,x2) = g x - (y1,y2) = g y - in if equalFilePath x1 y1 then f x2 y2 else path - g x = (BS.dropWhile isPathSeparator a, BS.dropWhile isPathSeparator b) - where (a, b) = BS.break isPathSeparator $ BS.dropWhile isPathSeparator x - dropAbs x = snd $ BS.span (== _slash) x - takeAbs x = fst $ BS.span (== _slash) x - - --- |Equality of two filepaths. The filepaths are normalised --- and trailing path separators are dropped. --- --- >>> equalFilePath "foo" "foo" --- True --- >>> equalFilePath "foo" "foo/" --- True --- >>> equalFilePath "foo" "./foo" --- True --- >>> equalFilePath "" "" --- True --- >>> equalFilePath "foo" "/foo" --- False --- >>> equalFilePath "foo" "FOO" --- False --- >>> equalFilePath "foo" "../foo" --- False --- --- prop> \p -> equalFilePath p p -equalFilePath :: RawFilePath -> RawFilePath -> Bool -equalFilePath p1 p2 = f p1 == f p2 - where - f x = dropTrailingPathSeparator $ normalise x - - --- | Check if a path is relative --- --- prop> \path -> isRelative path /= isAbsolute path -isRelative :: RawFilePath -> Bool -isRelative = not . isAbsolute - - --- | Check if a path is absolute --- --- >>> isAbsolute "/path" --- True --- >>> isAbsolute "path" --- False --- >>> isAbsolute "" --- False -isAbsolute :: RawFilePath -> Bool -isAbsolute x - | BS.length x > 0 = isPathSeparator (BS.head x) - | otherwise = False - - --- | Is a FilePath valid, i.e. could you create a file like it? --- --- >>> isValid "" --- False --- >>> isValid "\0" --- False --- >>> isValid "/random_ path:*" --- True -isValid :: RawFilePath -> Bool -isValid filepath - | BS.null filepath = False - | _nul `BS.elem` filepath = False - | otherwise = True - - --- | Take a FilePath and make it valid; does not change already valid FilePaths. --- --- >>> makeValid "" --- "_" --- >>> makeValid "file\0name" --- "file_name" --- --- prop> \p -> if isValid p then makeValid p == p else makeValid p /= p --- prop> \p -> isValid (makeValid p) -makeValid :: RawFilePath -> RawFilePath -makeValid path - | BS.null path = BS.singleton _underscore - | otherwise = BS.map (\x -> if x == _nul then _underscore else x) path - - --- | Is the given path a valid filename? This includes --- "." and "..". --- --- >>> isFileName "lal" --- True --- >>> isFileName "." --- True --- >>> isFileName ".." --- True --- >>> isFileName "" --- False --- >>> isFileName "\0" --- False --- >>> isFileName "/random_ path:*" --- False -isFileName :: RawFilePath -> Bool -isFileName filepath = - not (BS.singleton pathSeparator `BS.isInfixOf` filepath) && - not (BS.null filepath) && - not (_nul `BS.elem` filepath) - - --- | Check if the filepath has any parent directories in it. --- --- >>> hasParentDir "/.." --- True --- >>> hasParentDir "foo/bar/.." --- True --- >>> hasParentDir "foo/../bar/." --- True --- >>> hasParentDir "foo/bar" --- False --- >>> hasParentDir "foo" --- False --- >>> hasParentDir "" --- False --- >>> hasParentDir ".." --- False -hasParentDir :: RawFilePath -> Bool -hasParentDir filepath = - (pathSeparator `BS.cons` pathDoubleDot) - `BS.isSuffixOf` filepath - || - (BS.singleton pathSeparator - `BS.append` pathDoubleDot - `BS.append` BS.singleton pathSeparator) - `BS.isInfixOf` filepath - || - (pathDoubleDot `BS.append` BS.singleton pathSeparator) - `BS.isPrefixOf` filepath - where - pathDoubleDot = BS.pack [_period, _period] - - --- | Whether the file is a hidden file. --- --- >>> hiddenFile ".foo" --- True --- >>> hiddenFile "..foo.bar" --- True --- >>> hiddenFile "some/path/.bar" --- True --- >>> hiddenFile "..." --- True --- >>> hiddenFile "dod.bar" --- False --- >>> hiddenFile "." --- False --- >>> hiddenFile ".." --- False --- >>> hiddenFile "" --- False -hiddenFile :: RawFilePath -> Bool -hiddenFile fp - | fn == BS.pack [_period, _period] = False - | fn == BS.pack [_period] = False - | otherwise = BS.pack [extSeparator] - `BS.isPrefixOf` fn - where - fn = takeFileName fp - - - ------------------------- --- internal stuff - --- Just split the input FileName without adding/normalizing or changing --- anything. -splitFileNameRaw :: RawFilePath -> (RawFilePath, RawFilePath) -splitFileNameRaw = BS.breakEnd isPathSeparator - --- | Combine two paths, assuming rhs is NOT absolute. -combineRaw :: RawFilePath -> RawFilePath -> RawFilePath -combineRaw a b | BS.null a = b - | BS.null b = a - | isPathSeparator (BS.last a) = BS.append a b - | otherwise = BS.intercalate (BS.singleton pathSeparator) [a, b] - diff --git a/test/HPath/IO/AppendFileSpec.hs b/test/HPath/IO/AppendFileSpec.hs deleted file mode 100644 --- a/test/HPath/IO/AppendFileSpec.hs +++ /dev/null @@ -1,109 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - - -module HPath.IO.AppendFileSpec where - - -import Test.Hspec -import System.IO.Error - ( - ioeGetErrorType - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import System.Process -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) diff --git a/test/HPath/IO/CanonicalizePathSpec.hs b/test/HPath/IO/CanonicalizePathSpec.hs deleted file mode 100644 --- a/test/HPath/IO/CanonicalizePathSpec.hs +++ /dev/null @@ -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) - diff --git a/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs b/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs deleted file mode 100644 --- a/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs +++ /dev/null @@ -1,247 +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") - `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 - - diff --git a/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs b/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs deleted file mode 100644 --- a/test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs +++ /dev/null @@ -1,202 +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") - `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") - `shouldReturn` (ExitFailure 1) - copyDirRecursive' "inputDir" - "alreadyExistsD" - Overwrite - FailEarly - (system $ "diff -r --no-dereference " - ++ toString tmpDir' ++ "inputDir" ++ " " - ++ toString tmpDir' ++ "alreadyExistsD") - `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 diff --git a/test/HPath/IO/CopyDirRecursiveSpec.hs b/test/HPath/IO/CopyDirRecursiveSpec.hs deleted file mode 100644 --- a/test/HPath/IO/CopyDirRecursiveSpec.hs +++ /dev/null @@ -1,180 +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") - `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 - - diff --git a/test/HPath/IO/CopyFileOverwriteSpec.hs b/test/HPath/IO/CopyFileOverwriteSpec.hs deleted file mode 100644 --- a/test/HPath/IO/CopyFileOverwriteSpec.hs +++ /dev/null @@ -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 diff --git a/test/HPath/IO/CopyFileSpec.hs b/test/HPath/IO/CopyFileSpec.hs deleted file mode 100644 --- a/test/HPath/IO/CopyFileSpec.hs +++ /dev/null @@ -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 diff --git a/test/HPath/IO/CreateDirRecursiveSpec.hs b/test/HPath/IO/CreateDirRecursiveSpec.hs deleted file mode 100644 --- a/test/HPath/IO/CreateDirRecursiveSpec.hs +++ /dev/null @@ -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) - - - diff --git a/test/HPath/IO/CreateDirSpec.hs b/test/HPath/IO/CreateDirSpec.hs deleted file mode 100644 --- a/test/HPath/IO/CreateDirSpec.hs +++ /dev/null @@ -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) - diff --git a/test/HPath/IO/CreateRegularFileSpec.hs b/test/HPath/IO/CreateRegularFileSpec.hs deleted file mode 100644 --- a/test/HPath/IO/CreateRegularFileSpec.hs +++ /dev/null @@ -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) - diff --git a/test/HPath/IO/CreateSymlinkSpec.hs b/test/HPath/IO/CreateSymlinkSpec.hs deleted file mode 100644 --- a/test/HPath/IO/CreateSymlinkSpec.hs +++ /dev/null @@ -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) - diff --git a/test/HPath/IO/DeleteDirRecursiveSpec.hs b/test/HPath/IO/DeleteDirRecursiveSpec.hs deleted file mode 100644 --- a/test/HPath/IO/DeleteDirRecursiveSpec.hs +++ /dev/null @@ -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) - - diff --git a/test/HPath/IO/DeleteDirSpec.hs b/test/HPath/IO/DeleteDirSpec.hs deleted file mode 100644 --- a/test/HPath/IO/DeleteDirSpec.hs +++ /dev/null @@ -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" - - - diff --git a/test/HPath/IO/DeleteFileSpec.hs b/test/HPath/IO/DeleteFileSpec.hs deleted file mode 100644 --- a/test/HPath/IO/DeleteFileSpec.hs +++ /dev/null @@ -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) - diff --git a/test/HPath/IO/GetDirsFilesSpec.hs b/test/HPath/IO/GetDirsFilesSpec.hs deleted file mode 100644 --- a/test/HPath/IO/GetDirsFilesSpec.hs +++ /dev/null @@ -1,100 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module HPath.IO.GetDirsFilesSpec where - - -import Data.List - ( - sort - ) -import qualified HPath as P -import HPath.IO -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) - - - - diff --git a/test/HPath/IO/GetFileTypeSpec.hs b/test/HPath/IO/GetFileTypeSpec.hs deleted file mode 100644 --- a/test/HPath/IO/GetFileTypeSpec.hs +++ /dev/null @@ -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) - diff --git a/test/HPath/IO/MoveFileOverwriteSpec.hs b/test/HPath/IO/MoveFileOverwriteSpec.hs deleted file mode 100644 --- a/test/HPath/IO/MoveFileOverwriteSpec.hs +++ /dev/null @@ -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 diff --git a/test/HPath/IO/MoveFileSpec.hs b/test/HPath/IO/MoveFileSpec.hs deleted file mode 100644 --- a/test/HPath/IO/MoveFileSpec.hs +++ /dev/null @@ -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 diff --git a/test/HPath/IO/ReadFileEOFSpec.hs b/test/HPath/IO/ReadFileEOFSpec.hs deleted file mode 100644 --- a/test/HPath/IO/ReadFileEOFSpec.hs +++ /dev/null @@ -1,86 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - - -module HPath.IO.ReadFileEOFSpec where - - -import Test.Hspec -import System.IO.Error - ( - ioeGetErrorType - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import System.Process -import Utils - - - -upTmpDir :: IO () -upTmpDir = do - setTmpDir "ReadFileEOFSpec" - 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.readFileEOF" $ do - - -- successes -- - it "readFileEOF (Strict) file with content, everything clear" $ do - out <- readFileEOF' "fileWithContent" - out `shouldBe` "Blahfaselgagaga" - - it "readFileEOF (Strict) symlink, everything clear" $ do - out <- readFileEOF' "inputFileSymL" - out `shouldBe` "Blahfaselgagaga" - - it "readFileEOF (Strict) empty file, everything clear" $ do - out <- readFileEOF' "fileWithoutContent" - out `shouldBe` "" - - - -- posix failures -- - it "readFileEOF (Strict) directory, wrong file type" $ do - readFileEOF' "alreadyExistsD" - `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) - - it "readFileEOF (Strict) file, no permissions" $ do - readFileEOF' "noPerms" - `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - - it "readFileEOF (Strict) file, no permissions on dir" $ do - readFileEOF' "noPermsD/inputFile" - `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - - it "readFileEOF (Strict) file, no such file" $ do - readFileEOF' "lalala" - `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) diff --git a/test/HPath/IO/ReadFileSpec.hs b/test/HPath/IO/ReadFileSpec.hs deleted file mode 100644 --- a/test/HPath/IO/ReadFileSpec.hs +++ /dev/null @@ -1,86 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - - -module HPath.IO.ReadFileSpec where - - -import Test.Hspec -import System.IO.Error - ( - ioeGetErrorType - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import System.Process -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) diff --git a/test/HPath/IO/RecreateSymlinkOverwriteSpec.hs b/test/HPath/IO/RecreateSymlinkOverwriteSpec.hs deleted file mode 100644 --- a/test/HPath/IO/RecreateSymlinkOverwriteSpec.hs +++ /dev/null @@ -1,139 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module HPath.IO.RecreateSymlinkOverwriteSpec where - - --- TODO: exception if destination exists but is not a file + `OverWrite` CopyMode - - -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 - diff --git a/test/HPath/IO/RecreateSymlinkSpec.hs b/test/HPath/IO/RecreateSymlinkSpec.hs deleted file mode 100644 --- a/test/HPath/IO/RecreateSymlinkSpec.hs +++ /dev/null @@ -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 - diff --git a/test/HPath/IO/RenameFileSpec.hs b/test/HPath/IO/RenameFileSpec.hs deleted file mode 100644 --- a/test/HPath/IO/RenameFileSpec.hs +++ /dev/null @@ -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 - diff --git a/test/HPath/IO/ToAbsSpec.hs b/test/HPath/IO/ToAbsSpec.hs deleted file mode 100644 --- a/test/HPath/IO/ToAbsSpec.hs +++ /dev/null @@ -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 - - diff --git a/test/HPath/IO/WriteFileSpec.hs b/test/HPath/IO/WriteFileSpec.hs deleted file mode 100644 --- a/test/HPath/IO/WriteFileSpec.hs +++ /dev/null @@ -1,109 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - - -module HPath.IO.WriteFileSpec where - - -import Test.Hspec -import System.IO.Error - ( - ioeGetErrorType - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import System.Process -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) diff --git a/test/Main.hs b/test/Main.hs deleted file mode 100644 --- a/test/Main.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -import Test.Hspec -import Test.Hspec.Runner -import Test.Hspec.Formatters -import qualified Spec -import Utils - - --- TODO: chardev, blockdev, namedpipe, socket - - -main :: IO () -main = - hspecWith - defaultConfig { configFormatter = Just progress } - $ beforeAll_ createBaseTmpDir - $ afterAll_ deleteBaseTmpDir - $ Spec.spec diff --git a/test/Spec.hs b/test/Spec.hs deleted file mode 100644 --- a/test/Spec.hs +++ /dev/null @@ -1,2 +0,0 @@ --- file test/Spec.hs -{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} diff --git a/test/Utils.hs b/test/Utils.hs deleted file mode 100644 --- a/test/Utils.hs +++ /dev/null @@ -1,310 +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 Data.IORef - ( - newIORef - , readIORef - , writeIORef - , IORef - ) -import HPath.IO -import HPath.IO.Errors -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 System.Posix.Env.ByteString - ( - getEnv - ) -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 - ) - -import qualified "unix" System.Posix.IO.ByteString as SPI -import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB - - - -baseTmpDir :: ByteString -baseTmpDir = "test/HPath/IO/tmp/" - - -tmpDir :: IORef ByteString -{-# NOINLINE tmpDir #-} -tmpDir = unsafePerformIO (newIORef baseTmpDir) - - - - ----------------- - --[ Utilities ]-- - ----------------- - - -setTmpDir :: ByteString -> IO () -{-# NOINLINE setTmpDir #-} -setTmpDir bs = writeIORef tmpDir (baseTmpDir `BS.append` bs) - - -createTmpDir :: IO () -{-# NOINLINE createTmpDir #-} -createTmpDir = do - pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel =<< readIORef tmpDir - void $ createDir newDirPerms (pwd P. tmp) - - -deleteTmpDir :: IO () -{-# NOINLINE deleteTmpDir #-} -deleteTmpDir = do - pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel =<< readIORef tmpDir - void $ deleteDir (pwd P. tmp) - - -createBaseTmpDir :: IO () -{-# NOINLINE createBaseTmpDir #-} -createBaseTmpDir = do - pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel baseTmpDir - void $ createDir newDirPerms (pwd P. tmp) - - -deleteBaseTmpDir :: IO () -{-# NOINLINE deleteBaseTmpDir #-} -deleteBaseTmpDir = do - pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel baseTmpDir - contents <- getDirsFiles (pwd P. tmp) - forM_ contents deleteDir - void $ deleteDir (pwd P. tmp) - - -withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a -{-# NOINLINE withRawTmpDir #-} -withRawTmpDir f = do - pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel =<< readIORef tmpDir - f (pwd P. tmp) - - -getRawTmpDir :: IO ByteString -{-# NOINLINE getRawTmpDir #-} -getRawTmpDir = withRawTmpDir (return . flip BS.append "/" . P.fromAbs) - - -withTmpDir :: ByteString -> (P.Path P.Abs -> IO a) -> IO a -{-# NOINLINE withTmpDir #-} -withTmpDir ip f = do - pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel =<< readIORef tmpDir - p <- (pwd 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 - pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs - tmp <- P.parseRel =<< readIORef tmpDir - p1 <- (pwd P. tmp P.) <$> P.parseRel ip1 - p2 <- (pwd P. tmp P.) <$> P.parseRel ip2 - f p1 p2 - - -removeFileIfExists :: ByteString -> IO () -{-# NOINLINE removeFileIfExists #-} -removeFileIfExists bs = - withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p) - - -removeDirIfExists :: ByteString -> IO () -{-# NOINLINE removeDirIfExists #-} -removeDirIfExists bs = - withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p) - - -copyFile' :: ByteString -> ByteString -> CopyMode -> IO () -{-# NOINLINE copyFile' #-} -copyFile' inputFileP outputFileP cm = - withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm) - - -copyDirRecursive' :: ByteString -> ByteString - -> CopyMode -> 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) - -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 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 readFile - - -readFileEOF' :: ByteString -> IO L.ByteString -{-# NOINLINE readFileEOF' #-} -readFileEOF' p = withTmpDir p readFileEOF -