diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for hpath-io +## 0.13.0 -- 2020-01-26 + +* switch to using 'hpath-bytestring' for the implementation (this is now just a wrapper module, mostly) + ## 0.12.0 -- 2020-01-20 * breaking API changes diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,10 +2,14 @@ [![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-io.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-io) [![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-io.svg)](http://packdeps.haskellers.com/feed?needle=hpath-io) -High-level IO operations on files/directories, utilizing type-safe Paths. +High-level IO operations on files/directories, utilizing type-safe Paths. This uses [hpath-directory](https://hackage.haskell.org/package/hpath-directory) under the hood. -This package is part of the HPath suite, also check out [hpath](https://hackage.haskell.org/package/hpath) and [hpath-filepath](https://hackage.haskell.org/package/hpath-filepath). +This package is part of the HPath suite, also check out: +* [hpath](https://hackage.haskell.org/package/hpath) +* [hpath-directory](https://hackage.haskell.org/package/hpath-directory) +* [hpath-filepath](https://hackage.haskell.org/package/hpath-filepath) + ## Motivation The motivation came during development of @@ -20,9 +24,4 @@ * unit-testing exceptions (because yes, people may rely on them) Note: this library was written for __posix__ systems and it will probably not support other systems. - -## Differences to 'posix-paths' - -* 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 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/hpath-io.cabal b/hpath-io.cabal --- a/hpath-io.cabal +++ b/hpath-io.cabal @@ -1,5 +1,5 @@ name: hpath-io -version: 0.12.0 +version: 0.13.0 synopsis: High-level IO operations on files/directories description: High-level IO operations on files/directories, utilizing type-safe Paths -- bug-reports: @@ -19,89 +19,26 @@ , GHC==8.8.1 extra-source-files: README.md CHANGELOG.md - cbits/dirutils.h library if os(windows) build-depends: unbuildable<0 buildable: False - exposed-modules: HPath.IO, - HPath.IO.Errors, - System.Posix.Directory.Foreign, - System.Posix.Directory.Traversals, - System.Posix.FD - c-sources: cbits/dirutils.c - - other-modules: Streamly.ByteString - Streamly.ByteString.Lazy - -- other-extensions: + exposed-modules: HPath.IO build-depends: base >= 4.8 && <5 - , IfElse , bytestring >= 0.10.0.0 , exceptions , hpath >= 0.11 && < 0.12 - , hpath-filepath >= 0.10.2 && < 0.11 + , hpath-directory >= 0.13 && < 0.14 , safe-exceptions >= 0.1 , streamly >= 0.7 , time >= 1.8 , unix >= 2.5 - , unix-bytestring - , utf8-string if !impl(ghc>=7.11) build-depends: transformers hs-source-dirs: src default-language: Haskell2010 -test-suite spec - if os(windows) - build-depends: unbuildable<0 - buildable: False - Type: exitcode-stdio-1.0 - Default-Language: Haskell2010 - Hs-Source-Dirs: test - Main-Is: Main.hs - other-modules: - HPath.IO.AppendFileSpec - HPath.IO.CanonicalizePathSpec - HPath.IO.CopyDirRecursiveCollectFailuresSpec - HPath.IO.CopyDirRecursiveOverwriteSpec - HPath.IO.CopyDirRecursiveSpec - HPath.IO.CopyFileOverwriteSpec - HPath.IO.CopyFileSpec - HPath.IO.CreateDirIfMissingSpec - HPath.IO.CreateDirRecursiveSpec - HPath.IO.CreateDirSpec - HPath.IO.CreateRegularFileSpec - HPath.IO.CreateSymlinkSpec - HPath.IO.DeleteDirRecursiveSpec - HPath.IO.DeleteDirSpec - HPath.IO.DeleteFileSpec - HPath.IO.GetDirsFilesSpec - HPath.IO.GetFileTypeSpec - HPath.IO.MoveFileOverwriteSpec - HPath.IO.MoveFileSpec - HPath.IO.ReadFileSpec - HPath.IO.RecreateSymlinkOverwriteSpec - HPath.IO.RecreateSymlinkSpec - HPath.IO.RenameFileSpec - HPath.IO.ToAbsSpec - HPath.IO.WriteFileLSpec - HPath.IO.WriteFileSpec - Spec - Utils - GHC-Options: -Wall - Build-Depends: base - , HUnit - , IfElse - , bytestring >= 0.10.0.0 - , hpath - , hpath-io - , hspec >= 1.3 - , process - , time >= 1.8 - , unix - , unix-bytestring - , utf8-string source-repository head type: git diff --git a/src/HPath/IO.hs b/src/HPath/IO.hs --- a/src/HPath/IO.hs +++ b/src/HPath/IO.hs @@ -9,15 +9,9 @@ -- -- This module provides high-level IO related file operations like -- copy, delete, move and so on. It only operates on /Path x/ which --- guarantees us well-typed paths. 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`). +-- guarantees us well-typed paths. This is a thin wrapper over +-- System.Posix.RawFilePath.Directory in 'hpath-directory'. It's +-- encouraged to use this module. -- -- Some of these operations are due to their nature __not atomic__, which -- means they may do multiple syscalls which form one context. Some @@ -33,10 +27,7 @@ -- 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 #-} -{-# LANGUAGE FlexibleContexts #-} module HPath.IO ( @@ -74,8 +65,8 @@ , writeFileL , appendFile -- * File permissions - , newFilePerms - , newDirPerms + , RD.newFilePerms + , RD.newDirPerms -- * File checks , doesExist , doesFileExist @@ -98,224 +89,51 @@ , toAbs , withRawFilePath , withHandle + , module System.Posix.RawFilePath.Directory.Errors ) - where +where -import Control.Applicative - ( - (<$>) - ) -import Control.Exception.Safe - ( - IOException - , bracket - , bracketOnError - , throwIO - , finally - ) -import Control.Monad - ( - unless - , void - , when - ) -import Control.Monad.Catch (MonadThrow(..)) -import Control.Monad.IfElse - ( - unlessM - ) -import Data.ByteString - ( - ByteString - ) +import Control.Exception.Safe ( bracketOnError + , finally + ) +import Control.Monad.Catch ( MonadThrow(..) ) + +import Data.ByteString ( ByteString ) import Data.Traversable ( for ) -import Data.Functor ( ($>) ) -#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.Time.Clock -import Data.Time.Clock.POSIX (getPOSIXTime, posixSecondsToUTCTime, POSIXTime) -import Data.Word - ( - Word8 - ) -import Foreign.C.Error - ( - eEXIST - , eNOENT - , 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.IO.Errors -import Prelude hiding (appendFile, readFile, writeFile) -import Streamly -import Streamly.ByteString -import qualified Streamly.ByteString.Lazy as SL -import qualified Streamly.Data.Fold as FL -import Streamly.Memory.Array -import qualified Streamly.FileSystem.Handle as FH -import qualified Streamly.Internal.Data.Unfold as SU -import qualified Streamly.Internal.FileSystem.Handle as IFH -import qualified Streamly.Internal.Memory.ArrayStream as AS -import qualified Streamly.Prelude as S -import qualified System.IO as SIO -import System.IO.Error - ( - catchIOError - , ioeGetErrorType - ) -import System.Posix.ByteString - ( - exclusive - ) -import System.Posix.Directory.ByteString - ( - createDirectory - , closeDirStream - , getWorkingDirectory - , openDirStream - , removeDirectory - ) -import System.Posix.Directory.Traversals - ( - getDirectoryContents' - ) -import System.Posix.Files.ByteString - ( - createSymbolicLink - , fileAccess - , fileMode - , getFdStatus - , groupExecuteMode - , groupReadMode - , groupWriteMode - , otherExecuteMode - , otherReadMode - , otherWriteMode - , ownerModes - , ownerReadMode - , ownerWriteMode - , readSymbolicLink - , removeLink - , rename - , setFileMode - , unionFileModes - ) -import qualified System.Posix.FilePath as FP -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 - , EpochTime - ) -import System.Posix.Time +import qualified Data.ByteString.Lazy as L +import Data.Time.Clock +import Data.Time.Clock.POSIX ( POSIXTime ) +import HPath +import Prelude hiding ( appendFile + , readFile + , writeFile + ) +import Streamly +import qualified System.IO as SIO +import System.Posix.Directory.ByteString + ( getWorkingDirectory ) +import qualified "unix" System.Posix.IO.ByteString + as SPI +import System.Posix.FD ( openFd ) +import System.Posix.RawFilePath.Directory.Errors +import System.Posix.Types ( FileMode + , ProcessID + , EpochTime + ) +import qualified System.Posix.RawFilePath.Directory + as RD +import System.Posix.RawFilePath.Directory + ( FileType + , RecursiveErrorMode + , CopyMode + ) - ------------- - --[ Types ]-- - ------------- - -data FileType = Directory - | RegularFile - | SymbolicLink - | BlockDevice - | CharacterDevice - | NamedPipe - | Socket - deriving (Eq, Show) - - - --- |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 ]-- -------------------- @@ -379,68 +197,8 @@ -> CopyMode -> RecursiveErrorMode -> IO () -copyDirRecursive fromp destdirp cm rm - = do - ce <- newIORef [] - -- for performance, sanity checks are only done for the top dir - throwSameFile fromp destdirp - throwDestinationInSource fromp destdirp - go ce fromp destdirp - collectedExceptions <- readIORef ce - unless (null collectedExceptions) - (throwIO . RecursiveFailure $ collectedExceptions) - where - go :: IORef [(RecursiveFailureHint, IOException)] - -> Path b1 -> Path b2 -> IO () - go ce fromp'@(Path fromBS) destdirp'@(Path destdirpBS) = do - - -- NOTE: order is important here, so we don't get empty directories - -- on failure - - -- get the contents of the source dir - contents <- handleIOE (ReadContentsFailed fromBS destdirpBS) ce [] $ do - contents <- getDirsFiles fromp' - - -- create the destination dir and - -- only return contents if we succeed - handleIOE (CreateDirFailed fromBS destdirpBS) ce [] $ do - fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus fromBS - case cm of - Strict -> createDirectory destdirpBS fmode' - Overwrite -> catchIOError (createDirectory destdirpBS - fmode') - $ \e -> - case ioeGetErrorType e of - AlreadyExists -> setFileMode destdirpBS - fmode' - _ -> ioError e - return contents - - -- NOTE: we can't use `easyCopy` here, because we want to call `go` - -- recursively to skip the top-level sanity checks - - -- if reading the contents and creating the destination dir worked, - -- then copy the contents to the destination too - for_ contents $ \f -> do - ftype <- getFileType f - newdest <- (destdirp' ) <$> basename f - case ftype of - SymbolicLink -> handleIOE (RecreateSymlinkFailed (toFilePath f) (toFilePath newdest)) ce () - $ recreateSymlink f newdest cm - Directory -> go ce f newdest - RegularFile -> handleIOE (CopyFileFailed (toFilePath f) (toFilePath newdest)) ce () - $ copyFile f newdest cm - _ -> return () - - -- helper to handle errors for both RecursiveErrorModes and return a - -- default value - handleIOE :: RecursiveFailureHint - -> IORef [(RecursiveFailureHint, IOException)] - -> a -> IO a -> IO a - handleIOE hint ce def = case rm of - FailEarly -> handleIOError throwIO - CollectFailures -> handleIOError (\e -> modifyIORef ce ((hint, e):) - >> return def) +copyDirRecursive (Path fromp) (Path destdirp) cm rm = + RD.copyDirRecursive fromp destdirp cm rm -- |Recreate a symlink. @@ -476,21 +234,8 @@ -> Path b2 -- ^ destination file -> CopyMode -> IO () -recreateSymlink symsource@(Path symsourceBS) newsym@(Path newsymBS) cm - = do - throwSameFile symsource newsym - sympoint <- readSymbolicLink symsourceBS - case cm of - Strict -> return () - Overwrite -> do - writable <- toAbs newsym >>= (\p -> do - e <- doesExist p - if e then isWritable p else pure False) - isfile <- doesFileExist newsym - isdir <- doesDirectoryExist newsym - when (writable && isfile) (deleteFile newsym) - when (writable && isdir) (deleteDir newsym) - createSymbolicLink sympoint newsymBS +recreateSymlink (Path symsourceBS) (Path newsymBS) cm = + RD.recreateSymlink symsourceBS newsymBS cm -- |Copies the given regular file to the given destination. @@ -535,36 +280,7 @@ -> Path b2 -- ^ destination file -> CopyMode -> IO () -copyFile fp@(Path from) tp@(Path to) cm = do - throwSameFile fp tp - bracket (do - fd <- openFd from SPI.ReadOnly [SPDF.oNofollow] Nothing - handle <- SPI.fdToHandle fd - pure (fd, handle)) - (\(_, handle) -> SIO.hClose handle) - $ \(fromFd, fH) -> do - sourceFileMode <- System.Posix.Files.ByteString.fileMode <$> getFdStatus fromFd - let dflags = [SPDF.oNofollow, case cm of - Strict -> SPDF.oExcl - Overwrite -> SPDF.oTrunc] - bracketeer (do - fd <- openFd to SPI.WriteOnly dflags $ Just sourceFileMode - handle <- SPI.fdToHandle fd - pure (fd, handle)) - (\(_, handle) -> SIO.hClose handle) - (\(_, handle) -> do - SIO.hClose handle - case cm of - -- if we created the file and copying failed, it's - -- safe to clean up - Strict -> deleteFile tp - Overwrite -> pure ()) - $ \(_, tH) -> do - SIO.hSetBinaryMode fH True - SIO.hSetBinaryMode tH True - streamlyCopy (fH, tH) - where - streamlyCopy (fH, tH) = S.fold (FH.writeChunks tH) $ IFH.toChunksWithBufferOf (256*1024) fH +copyFile (Path from) (Path to) cm = RD.copyFile from to cm -- |Copies a regular file, directory or symbolic link. In case of a -- symbolic link it is just recreated, even if it points to a directory. @@ -576,23 +292,14 @@ -- * calls `copyDirRecursive` for directories -- -- Note: may call `getcwd` in Overwrite mode (if destination is a relative path) -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 () +easyCopy :: Path b1 -> Path b2 -> CopyMode -> RecursiveErrorMode -> IO () +easyCopy (Path from) (Path to) cm rm = RD.easyCopy from to cm rm + --------------------- --[ File Deletion ]-- --------------------- @@ -607,7 +314,7 @@ -- - `NoSuchThing` if the file does not exist -- - `PermissionDenied` if the directory cannot be read deleteFile :: Path b -> IO () -deleteFile (Path p) = removeLink p +deleteFile (Path p) = RD.deleteFile p -- |Deletes the given directory, which must be empty, never symlinks. @@ -622,7 +329,7 @@ -- -- Notes: calls `rmdir` deleteDir :: Path b -> IO () -deleteDir (Path p) = removeDirectory p +deleteDir (Path p) = RD.deleteDir p -- |Deletes the given directory recursively. Does not follow symbolic @@ -645,21 +352,10 @@ -- - `NoSuchThing` if directory does not exist -- - `PermissionDenied` if we can't open or write to parent directory deleteDirRecursive :: Path b -> IO () -deleteDirRecursive p = - catchErrno [eNOTEMPTY, eEXIST] - (deleteDir p) - $ do - files <- getDirsFiles p - for_ files $ \file -> do - ftype <- getFileType file - case ftype of - SymbolicLink -> deleteFile file - Directory -> deleteDirRecursive file - RegularFile -> deleteFile file - _ -> return () - removeDirectory . toFilePath $ p +deleteDirRecursive (Path p) = RD.deleteDirRecursive p + -- |Deletes a file, directory or symlink. -- In case of directory, performs recursive deletion. In case of -- a symlink, the symlink file is deleted. @@ -670,13 +366,7 @@ -- * examines filetypes explicitly -- * calls `deleteDirRecursive` for directories easyDelete :: Path b -> IO () -easyDelete p = do - ftype <- getFileType p - case ftype of - SymbolicLink -> deleteFile p - Directory -> deleteDirRecursive p - RegularFile -> deleteFile p - _ -> return () +easyDelete (Path p) = RD.easyDelete p @@ -688,18 +378,15 @@ -- |Opens a file appropriately by invoking xdg-open. The file type -- is not checked. This forks a process. -openFile :: Path b - -> IO ProcessID -openFile (Path fp) = - SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing +openFile :: Path b -> IO ProcessID +openFile (Path fp) = RD.openFile fp -- |Executes a program with the given arguments. This forks a process. executeFile :: Path b -- ^ program -> [ByteString] -- ^ arguments -> IO ProcessID -executeFile (Path fp) args = - SPP.forkProcess $ SPP.executeFile fp True args Nothing +executeFile (Path fp) args = RD.executeFile fp args @@ -719,11 +406,7 @@ -- - `NoSuchThing` if any of the parent components of the path -- do not exist createRegularFile :: FileMode -> Path b -> IO () -createRegularFile fm (Path destBS) = - bracket (SPI.openFd destBS SPI.WriteOnly (Just fm) - (SPI.defaultFileFlags { exclusive = True })) - SPI.closeFd - (\_ -> return ()) +createRegularFile fm (Path destBS) = RD.createRegularFile fm destBS -- |Create an empty directory at the given directory with the given filename. @@ -735,7 +418,7 @@ -- - `NoSuchThing` if any of the parent components of the path -- do not exist createDir :: FileMode -> Path b -> IO () -createDir fm (Path destBS) = createDirectory destBS fm +createDir fm (Path destBS) = RD.createDir fm destBS -- |Create an empty directory at the given directory with the given filename. -- @@ -745,8 +428,7 @@ -- - `NoSuchThing` if any of the parent components of the path -- do not exist createDirIfMissing :: FileMode -> Path b -> IO () -createDirIfMissing fm (Path destBS) = - hideError AlreadyExists $ createDirectory destBS fm +createDirIfMissing fm (Path destBS) = RD.createDirIfMissing fm destBS -- |Create an empty directory at the given directory with the given filename. @@ -770,20 +452,10 @@ -- -- Note: calls `getcwd` if the input path is a relative path createDirRecursive :: FileMode -> Path b -> IO () -createDirRecursive fm p = - toAbs p >>= go - where - go :: Path Abs -> IO () - go dest@(Path destBS) = do - catchIOError (createDirectory destBS fm) $ \e -> do - errno <- getErrno - case errno of - en | en == eEXIST -> unlessM (doesDirectoryExist dest) (ioError e) - | en == eNOENT -> createDirRecursive fm (dirname dest) - >> createDirectory destBS fm - | otherwise -> ioError e +createDirRecursive fm (Path p) = RD.createDirRecursive fm p + -- |Create a symlink. -- -- Throws: @@ -797,8 +469,7 @@ createSymlink :: Path b -- ^ destination file -> ByteString -- ^ path the symlink points to -> IO () -createSymlink (Path destBS) sympoint - = createSymbolicLink sympoint destBS +createSymlink (Path destBS) sympoint = RD.createSymlink destBS sympoint @@ -829,13 +500,10 @@ -- -- Note: calls `rename` (but does not allow to rename over existing files) renameFile :: Path b1 -> Path b2 -> IO () -renameFile fromf@(Path fromfBS) tof@(Path tofBS) = do - throwSameFile fromf tof - throwFileDoesExist tof - throwDirDoesExist tof - rename fromfBS tofBS +renameFile (Path from) (Path to) = RD.renameFile from to + -- |Move a file. This also works across devices by copy-delete fallback. -- And also works on directories. -- @@ -872,30 +540,7 @@ -> Path b2 -- ^ destination -> CopyMode -> IO () -moveFile from to cm = do - throwSameFile from to - case cm of - Strict -> catchErrno [eXDEV] (renameFile from to) $ do - easyCopy from to Strict FailEarly - easyDelete from - Overwrite -> do - ft <- getFileType from - writable <- toAbs to >>= (\p -> do - e <- doesFileExist p - if e then isWritable p else pure False) - - case ft of - RegularFile -> do - exists <- doesFileExist to - when (exists && writable) (deleteFile to) - SymbolicLink -> do - exists <- doesFileExist to - when (exists && writable) (deleteFile to) - Directory -> do - exists <- doesDirectoryExist to - when (exists && writable) (deleteDir to) - _ -> return () - moveFile from to Strict +moveFile (Path from) (Path to) cm = RD.moveFile from to cm @@ -922,9 +567,7 @@ -- containting it -- - `NoSuchThing` if the file does not exist readFile :: Path b -> IO L.ByteString -readFile path = do - stream <- readFileStream path - toLazyByteString <$> S.fold FL.mconcat (fmap byteString stream) +readFile (Path path) = RD.readFile path @@ -937,13 +580,8 @@ -- - `PermissionDenied` if we cannot read the file or the directory -- containting it -- - `NoSuchThing` if the file does not exist -readFileStream :: Path b - -> IO (SerialT IO ByteString) -readFileStream (Path fp) = do - fd <- openFd fp SPI.ReadOnly [] Nothing - handle <- SPI.fdToHandle fd - let stream = (S.unfold (SU.finally SIO.hClose FH.readChunks) handle) >>= arrayToByteString - pure stream +readFileStream :: Path b -> IO (SerialT IO ByteString) +readFileStream (Path fp) = RD.readFileStream fp @@ -966,8 +604,7 @@ -> Maybe FileMode -- ^ if Nothing, file must exist -> ByteString -> IO () -writeFile (Path fp) fmode bs = - bracket (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs +writeFile (Path fp) fmode bs = RD.writeFile fp fmode bs -- |Write a given lazy ByteString to a file, truncating the file beforehand. @@ -985,11 +622,7 @@ -> Maybe FileMode -- ^ if Nothing, file must exist -> L.ByteString -> IO () -writeFileL (Path fp) fmode lbs = do - handle <- bracketOnError (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) $ SPI.fdToHandle - finally (streamlyCopy handle) (SIO.hClose handle) - where - streamlyCopy tH = S.fold (FH.writeChunks tH) $ SL.fromByteString lbs +writeFileL (Path fp) fmode lbs = RD.writeFileL fp fmode lbs -- |Append a given ByteString to a file. @@ -1002,41 +635,12 @@ -- containting it -- - `NoSuchThing` if the file does not exist appendFile :: Path b -> ByteString -> IO () -appendFile (Path fp) bs = - bracket (openFd fp SPI.WriteOnly [SPDF.oAppend] Nothing) - (SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs +appendFile (Path fp) bs = RD.appendFile fp bs - ----------------------- - --[ 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 - - - - ------------------- --[ File checks ]-- ------------------- @@ -1047,11 +651,7 @@ -- -- Only eNOENT is catched (and returns False). doesExist :: Path b -> IO Bool -doesExist (Path bs) = - catchErrno [eNOENT] (do - _ <- PF.getSymbolicLinkStatus bs - return $ True) - $ return False +doesExist (Path bs) = RD.doesExist bs -- |Checks if the given file exists and is not a directory. @@ -1059,11 +659,7 @@ -- -- Only eNOENT is catched (and returns False). doesFileExist :: Path b -> IO Bool -doesFileExist (Path bs) = - catchErrno [eNOENT] (do - fs <- PF.getSymbolicLinkStatus bs - return $ not . PF.isDirectory $ fs) - $ return False +doesFileExist (Path bs) = RD.doesFileExist bs -- |Checks if the given file exists and is a directory. @@ -1071,11 +667,7 @@ -- -- Only eNOENT is catched (and returns False). doesDirectoryExist :: Path b -> IO Bool -doesDirectoryExist (Path bs) = - catchErrno [eNOENT] (do - fs <- PF.getSymbolicLinkStatus bs - return $ PF.isDirectory fs) - $ return False +doesDirectoryExist (Path bs) = RD.doesDirectoryExist bs -- |Checks whether a file or folder is readable. @@ -1086,7 +678,7 @@ -- -- - `NoSuchThing` if the file does not exist isReadable :: Path b -> IO Bool -isReadable (Path bs) = fileAccess bs True False False +isReadable (Path bs) = RD.isReadable bs -- |Checks whether a file or folder is writable. -- @@ -1096,7 +688,7 @@ -- -- - `NoSuchThing` if the file does not exist isWritable :: Path b -> IO Bool -isWritable (Path bs) = fileAccess bs False True False +isWritable (Path bs) = RD.isWritable bs -- |Checks whether a file or folder is executable. @@ -1107,19 +699,14 @@ -- -- - `NoSuchThing` if the file does not exist isExecutable :: Path b -> IO Bool -isExecutable (Path bs) = fileAccess bs False False True +isExecutable (Path bs) = RD.isExecutable bs -- |Checks whether the directory at the given path exists and can be -- opened. This invokes `openDirStream` which follows symlinks. canOpenDirectory :: Path b -> IO Bool -canOpenDirectory (Path bs) = - handleIOError (\_ -> return False) $ do - bracket (openDirStream bs) - closeDirStream - (\_ -> return ()) - return True +canOpenDirectory (Path bs) = RD.canOpenDirectory bs @@ -1130,21 +717,13 @@ getModificationTime :: Path b -> IO UTCTime -getModificationTime (Path bs) = do - fs <- PF.getFileStatus bs - pure $ posixSecondsToUTCTime $ PF.modificationTimeHiRes fs +getModificationTime (Path bs) = RD.getModificationTime bs setModificationTime :: Path b -> EpochTime -> IO () -setModificationTime (Path bs) t = do - -- TODO: setFileTimes doesn't allow to pass NULL to utime - ctime <- epochTime - PF.setFileTimes bs ctime t +setModificationTime (Path bs) t = RD.setModificationTime bs t setModificationTimeHiRes :: Path b -> POSIXTime -> IO () -setModificationTimeHiRes (Path bs) t = do - -- TODO: setFileTimesHiRes doesn't allow to pass NULL to utimes - ctime <- getPOSIXTime - PF.setFileTimesHiRes bs ctime t +setModificationTimeHiRes (Path bs) t = RD.setModificationTimeHiRes bs t @@ -1168,7 +747,7 @@ -- - `PathParseException` if a filename could not be parsed (should never happen) getDirsFiles :: Path b -- ^ dir to read -> IO [Path b] -getDirsFiles p@(Path fp) = do +getDirsFiles p = do contents <- getDirsFiles' p pure $ fmap (p ) contents @@ -1176,14 +755,10 @@ -- | Like 'getDirsFiles', but returns the filename only, instead -- of prepending the base path. getDirsFiles' :: Path b -- ^ dir to read - -> IO [Path Rel] -getDirsFiles' p@(Path fp) = do - fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing - rawContents <- getDirectoryContents' fd - fmap catMaybes $ for rawContents $ \(_, f) -> - if FP.isSpecialDirectoryEntry f - then pure Nothing - else fmap Just $ parseRel f + -> IO [Path Rel] +getDirsFiles' (Path fp) = do + rawContents <- RD.getDirsFiles' fp + for rawContents $ \r -> parseRel r @@ -1201,19 +776,7 @@ -- - `NoSuchThing` if the file does not exist -- - `PermissionDenied` if any part of the path is not accessible getFileType :: Path b -> IO FileType -getFileType (Path fp) = do - fs <- PF.getSymbolicLinkStatus fp - decide fs - where - decide fs - | PF.isDirectory fs = return Directory - | PF.isRegularFile fs = return RegularFile - | PF.isSymbolicLink fs = return SymbolicLink - | PF.isBlockDevice fs = return BlockDevice - | PF.isCharacterDevice fs = return CharacterDevice - | PF.isNamedPipe fs = return NamedPipe - | PF.isSocket fs = return Socket - | otherwise = ioError $ userError "No filetype?!" +getFileType (Path fp) = RD.getFileType fp @@ -1232,7 +795,7 @@ -- - `PathParseException` if realpath does not return an absolute path canonicalizePath :: Path b -> IO (Path Abs) canonicalizePath (Path l) = do - nl <- SPDT.realpath l + nl <- RD.canonicalizePath l parseAbs nl @@ -1245,11 +808,11 @@ toAbs (Path bs) = do let mabs = parseAbs bs :: Maybe (Path Abs) case mabs of - Just a -> return a - Nothing -> do + Just a -> return a + Nothing -> do cwd <- getWorkingDirectory >>= parseAbs - rel <- parseRel bs -- we know it must be relative now - return $ cwd rel + r <- parseRel bs -- we know it must be relative now + return $ cwd r -- | Helper function to use the Path library without @@ -1260,7 +823,10 @@ -- -- - `PathParseException` if the bytestring could neither be parsed as -- relative or absolute Path -withRawFilePath :: MonadThrow m => ByteString -> (Either (Path Abs) (Path Rel) -> m b) -> m b +withRawFilePath :: MonadThrow m + => ByteString + -> (Either (Path Abs) (Path Rel) -> m b) + -> m b withRawFilePath bs action = do path <- parseAny bs action path @@ -1281,6 +847,6 @@ withHandle bs mode action = do path <- parseAny bs handle <- - bracketOnError (openFd bs mode [] (Just newFilePerms)) (SPI.closeFd) + bracketOnError (openFd bs mode [] (Just RD.newFilePerms)) (SPI.closeFd) $ SPI.fdToHandle finally (action (handle, path)) (SIO.hClose handle) 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,16 +0,0 @@ -module HPath.IO where - - -import HPath - -canonicalizePath :: Path b -> IO (Path Abs) - -toAbs :: Path b -> IO (Path Abs) - -doesFileExist :: Path b -> IO Bool - -doesDirectoryExist :: Path b -> IO Bool - -isWritable :: Path b -> IO Bool - -canOpenDirectory :: Path b -> IO Bool 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,324 +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 - - -- * Error handling functions - , catchErrno - , rethrowErrnoAs - , handleIOError - , hideError - , bracketeer - , reactOnError - ) - where - - -import Control.Applicative - ( - (<$>) - ) -import Control.Exception.Safe hiding (handleIOError) -import Control.Monad - ( - forM - , when - ) -import Control.Monad.IfElse - ( - whenM - ) -import Data.ByteString - ( - ByteString - ) -import Data.ByteString.UTF8 - ( - toString - ) -import Data.Typeable - ( - Typeable - ) -import Foreign.C.Error - ( - getErrno - , Errno - ) -import GHC.IO.Exception - ( - IOErrorType - ) -import HPath -import {-# SOURCE #-} HPath.IO - ( - canonicalizePath - , toAbs - , doesFileExist - , doesDirectoryExist - , isWritable - , canOpenDirectory - ) -import System.IO.Error - ( - alreadyExistsErrorType - , ioeGetErrorType - , mkIOError - ) - -import qualified System.Posix.Directory.ByteString as PFD -import System.Posix.Files.ByteString - ( - fileAccess - , getFileStatus - ) -import qualified System.Posix.Files.ByteString as PF - - --- |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 mempty mempty) -isDestinationInSource ex = toConstr (ex :: HPathIOException) == (toConstr $ DestinationInSource mempty mempty) -isRecursiveFailure ex = toConstr (ex :: HPathIOException) == (toConstr $ RecursiveFailure mempty) - - -isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool -isReadContentsFailed ReadContentsFailed{} = True -isReadContentsFailed _ = False -isCreateDirFailed CreateDirFailed{} = True -isCreateDirFailed _ = False -isCopyFileFailed CopyFileFailed{} = True -isCopyFileFailed _ = False -isRecreateSymlinkFailed RecreateSymlinkFailed{} = True -isRecreateSymlinkFailed _ = False - - - - - - ---------------------------- - --[ Path based functions ]-- - ---------------------------- - - --- |Throws `AlreadyExists` `IOError` if file exists. -throwFileDoesExist :: Path b -> IO () -throwFileDoesExist fp@(Path 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@(Path 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@(Path bs1) fp2@(Path 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 (Path fp1) (Path fp2) = - handleIOError (\_ -> return False) $ do - fs1 <- getFileStatus fp1 - fs2 <- getFileStatus fp2 - - if ((PF.deviceID fs1, PF.fileID fs1) == - (PF.deviceID fs2, PF.fileID fs2)) - then return True - else return False - - --- 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 (Path sbs) dest@(Path dbs) = do - destAbs <- toAbs dest - dest' <- (\x -> maybe x (\y -> x y) $ basename dest) - <$> (canonicalizePath $ dirname destAbs) - dids <- forM (getAllParents dest') $ \p -> do - fs <- PF.getSymbolicLinkStatus (fromAbs p) - return (PF.deviceID fs, PF.fileID fs) - sid <- fmap (\x -> (PF.deviceID x, PF.fileID x)) - $ PF.getFileStatus sbs - when (elem sid dids) - (throwIO $ DestinationInSource dbs sbs) - - - - - -------------------------------- - --[ Error handling functions ]-- - -------------------------------- - - --- |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 - - -hideError :: IOErrorType -> IO () -> IO () -hideError err = handleIO (\e -> if err == ioeGetErrorType e then pure () else ioError e) - - --- |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/Streamly/ByteString.hs b/src/Streamly/ByteString.hs deleted file mode 100644 --- a/src/Streamly/ByteString.hs +++ /dev/null @@ -1,57 +0,0 @@ -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Streamly.ByteString where - -import Control.Monad.IO.Class -import Data.ByteString hiding (length) -import qualified Data.ByteString as BS -import Data.ByteString.Unsafe -import Data.Word (Word8) -import Foreign.ForeignPtr -import Foreign.ForeignPtr.Unsafe -import Foreign.Ptr (castPtr, minusPtr, plusPtr) -import Prelude hiding (length) -import Streamly -import Streamly.Internal.Memory.Array.Types -import Streamly.Memory.Array -import qualified Streamly.Prelude as S - -toByteString :: - forall m. (MonadIO m, MonadAsync m) - => SerialT m (Array Word8) - -> m ByteString -toByteString stream = - let xs = S.mapM arrayToByteString stream - ys = S.foldlM' (\a b -> pure $ a <> b) mempty xs - in ys - -arrayToByteString :: (MonadIO m) => Array Word8 -> m ByteString -arrayToByteString arr - | length arr == 0 = return mempty -arrayToByteString Array {..} = - liftIO $ - withForeignPtr aStart $ \ptr -> - unsafePackCStringFinalizer ptr aLen (return ()) - where - aLen = - let p = unsafeForeignPtrToPtr aStart - in aEnd `minusPtr` p - -byteStringToArray :: (MonadIO m) => ByteString -> m (Array Word8) -byteStringToArray bs = - liftIO $ - unsafeUseAsCStringLen - bs - (\(ptr, _) -> do - let endPtr pr = (castPtr pr `plusPtr` (BS.length bs)) - fptr <- newForeignPtr_ (castPtr ptr) - return $ Array {aStart = fptr, aEnd = endPtr ptr, aBound = endPtr ptr}) - -fromByteString :: - forall m. (MonadIO m) - => ByteString - -> m (Array Word8) -fromByteString bs = byteStringToArray bs diff --git a/src/Streamly/ByteString/Lazy.hs b/src/Streamly/ByteString/Lazy.hs deleted file mode 100644 --- a/src/Streamly/ByteString/Lazy.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Streamly.ByteString.Lazy where - -import Control.Monad.IO.Class -import qualified Data.ByteString as BS -import Data.ByteString.Lazy (ByteString, foldlChunks, fromChunks) -import Data.ByteString.Unsafe -import Data.Word (Word8) -import Foreign.ForeignPtr -import Foreign.ForeignPtr.Unsafe -import Foreign.Ptr (castPtr, minusPtr, plusPtr) -import Prelude hiding (length) -import Streamly -import Streamly.ByteString (arrayToByteString, byteStringToArray) -import Streamly.Memory.Array -import qualified Streamly.Prelude as S - -toByteString :: - forall m. (MonadIO m, MonadAsync m) - => SerialT m (Array Word8) - -> m ByteString -toByteString stream = do - ys :: [BS.ByteString] <- S.toList $ S.mapM arrayToByteString stream - pure $ fromChunks ys - -stepFunction :: - forall m. (MonadIO m) - => SerialT m (Array Word8) - -> BS.ByteString - -> SerialT m (Array Word8) -stepFunction stream1 bs = do - arr <- liftIO $ byteStringToArray bs - let stream2 = pure arr - stream1 <> stream2 - -fromByteString :: - forall m. (MonadIO m) - => ByteString - -> SerialT m (Array Word8) -fromByteString bs = foldlChunks stepFunction mempty bs - 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/test/HPath/IO/AppendFileSpec.hs b/test/HPath/IO/AppendFileSpec.hs deleted file mode 100644 --- a/test/HPath/IO/AppendFileSpec.hs +++ /dev/null @@ -1,108 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - - -module HPath.IO.AppendFileSpec where - - -import Test.Hspec -import System.IO.Error - ( - ioeGetErrorType - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import Utils - - - -upTmpDir :: IO () -upTmpDir = do - setTmpDir "AppendFileSpec" - createTmpDir - -setupFiles :: IO () -setupFiles = do - createRegularFile' "fileWithContent" - createRegularFile' "fileWithoutContent" - createSymlink' "inputFileSymL" "fileWithContent" - createDir' "alreadyExistsD" - createRegularFile' "noPerms" - noPerms "noPerms" - createDir' "noPermsD" - createRegularFile' "noPermsD/inputFile" - noPerms "noPermsD" - writeFile' "fileWithContent" "BLKASL" - - -cleanupFiles :: IO () -cleanupFiles = do - deleteFile' "fileWithContent" - deleteFile' "fileWithoutContent" - deleteFile' "inputFileSymL" - deleteDir' "alreadyExistsD" - normalFilePerms "noPerms" - deleteFile' "noPerms" - normalDirPerms "noPermsD" - deleteFile' "noPermsD/inputFile" - deleteDir' "noPermsD" - - -spec :: Spec -spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "HPath.IO.appendFile" $ do - - -- successes -- - it "appendFile file with content, everything clear" $ do - appendFile' "fileWithContent" "blahfaselllll" - out <- readFile' "fileWithContent" - out `shouldBe` "BLKASLblahfaselllll" - - it "appendFile file with content, everything clear" $ do - appendFile' "fileWithContent" "gagagaga" - out <- readFile' "fileWithContent" - out `shouldBe` "BLKASLblahfaselllllgagagaga" - - it "appendFile file with content, everything clear" $ do - appendFile' "fileWithContent" "" - out <- readFile' "fileWithContent" - out `shouldBe` "BLKASLblahfaselllllgagagaga" - - it "appendFile file without content, everything clear" $ do - appendFile' "fileWithoutContent" "blahfaselllll" - out <- readFile' "fileWithoutContent" - out `shouldBe` "blahfaselllll" - - it "appendFile, everything clear" $ do - appendFile' "fileWithoutContent" "gagagaga" - out <- readFile' "fileWithoutContent" - out `shouldBe` "blahfaselllllgagagaga" - - it "appendFile symlink, everything clear" $ do - appendFile' "inputFileSymL" "blahfaselllll" - out <- readFile' "inputFileSymL" - out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllll" - - it "appendFile symlink, everything clear" $ do - appendFile' "inputFileSymL" "gagagaga" - out <- readFile' "inputFileSymL" - out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllllgagagaga" - - - -- posix failures -- - it "appendFile to dir, inappropriate type" $ do - appendFile' "alreadyExistsD" "" - `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) - - it "appendFile, no permissions to file" $ do - appendFile' "noPerms" "" - `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - - it "appendFile, no permissions to file" $ do - appendFile' "noPermsD/inputFile" "" - `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - - it "appendFile, file does not exist" $ do - appendFile' "gaga" "" - `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) 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,248 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - - -module HPath.IO.CopyDirRecursiveCollectFailuresSpec where - - -import Test.Hspec -import Data.List (sort) -import HPath.IO -import HPath.IO.Errors -import System.IO.Error - ( - ioeGetErrorType - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import System.Exit -import System.Process -import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) - - - -upTmpDir :: IO () -upTmpDir = do - setTmpDir "CopyDirRecursiveCollectFailuresSpec" - createTmpDir - -setupFiles :: IO () -setupFiles = do - createRegularFile' "alreadyExists" - createRegularFile' "wrongInput" - createSymlink' "wrongInputSymL" "inputDir/" - createDir' "alreadyExistsD" - createDir' "noPerms" - createDir' "noWritePerm" - - createDir' "inputDir" - createDir' "inputDir/bar" - createDir' "inputDir/foo" - createRegularFile' "inputDir/foo/inputFile1" - createRegularFile' "inputDir/inputFile2" - createRegularFile' "inputDir/bar/inputFile3" - writeFile' "inputDir/foo/inputFile1" "SDAADSdsada" - writeFile' "inputDir/inputFile2" "Blahfaselgagaga" - writeFile' "inputDir/bar/inputFile3" - "fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4" - - createDir' "inputDir1" - createDir' "inputDir1/foo2" - createDir' "inputDir1/foo2/foo3" - createDir' "inputDir1/foo2/foo4" - createRegularFile' "inputDir1/foo2/inputFile1" - createRegularFile' "inputDir1/foo2/inputFile2" - createRegularFile' "inputDir1/foo2/inputFile3" - createRegularFile' "inputDir1/foo2/foo4/inputFile4" - createRegularFile' "inputDir1/foo2/foo4/inputFile6" - createRegularFile' "inputDir1/foo2/foo3/inputFile5" - noPerms "inputDir1/foo2/foo3" - - createDir' "outputDir1" - createDir' "outputDir1/foo2" - createDir' "outputDir1/foo2/foo4" - createDir' "outputDir1/foo2/foo4/inputFile4" - createRegularFile' "outputDir1/foo2/foo4/inputFile6" - noPerms "outputDir1/foo2/foo4/inputFile4" - noPerms "outputDir1/foo2/foo4" - - noPerms "noPerms" - noWritableDirPerms "noWritePerm" - - -cleanupFiles :: IO () -cleanupFiles = do - normalDirPerms "noPerms" - normalDirPerms "noWritePerm" - - normalDirPerms "inputDir1/foo2/foo3" - deleteFile' "inputDir1/foo2/foo4/inputFile4" - deleteFile' "inputDir1/foo2/foo4/inputFile6" - deleteFile' "inputDir1/foo2/inputFile1" - deleteFile' "inputDir1/foo2/inputFile2" - deleteFile' "inputDir1/foo2/inputFile3" - deleteFile' "inputDir1/foo2/foo3/inputFile5" - deleteDir' "inputDir1/foo2/foo3" - deleteDir' "inputDir1/foo2/foo4" - deleteDir' "inputDir1/foo2" - deleteDir' "inputDir1" - - normalDirPerms "outputDir1/foo2/foo4" - normalDirPerms "outputDir1/foo2/foo4/inputFile4" - deleteFile' "outputDir1/foo2/foo4/inputFile6" - deleteDir' "outputDir1/foo2/foo4/inputFile4" - deleteDir' "outputDir1/foo2/foo4" - deleteDir' "outputDir1/foo2" - deleteDir' "outputDir1" - - deleteFile' "alreadyExists" - deleteFile' "wrongInput" - deleteFile' "wrongInputSymL" - deleteDir' "alreadyExistsD" - deleteDir' "noPerms" - deleteDir' "noWritePerm" - deleteFile' "inputDir/foo/inputFile1" - deleteFile' "inputDir/inputFile2" - deleteFile' "inputDir/bar/inputFile3" - deleteDir' "inputDir/foo" - deleteDir' "inputDir/bar" - deleteDir' "inputDir" - - - - -spec :: Spec -spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "HPath.IO.copyDirRecursive" $ do - - -- successes -- - it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do - tmpDir' <- getRawTmpDir - copyDirRecursive' "inputDir" - "outputDir" - Strict - CollectFailures - (system $ "diff -r --no-dereference " - ++ toString tmpDir' ++ "inputDir" ++ " " - ++ toString tmpDir' ++ "outputDir" - ++ " >/dev/null") - `shouldReturn` ExitSuccess - removeDirIfExists "outputDir" - - -- posix failures -- - it "copyDirRecursive (Strict, CollectFailures), source directory does not exist" $ - copyDirRecursive' "doesNotExist" - "outputDir" - Strict - CollectFailures - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) - - it "copyDirRecursive (Strict, CollectFailures), cannot open source dir" $ - copyDirRecursive' "noPerms/inputDir" - "foo" - Strict - CollectFailures - `shouldThrow` - (\e -> ioeGetErrorType e == PermissionDenied) - - - -- custom failures - it "copyDirRecursive (Overwrite, CollectFailures), various failures" $ do - copyDirRecursive' "inputDir1/foo2" - "outputDir1/foo2" - Overwrite - CollectFailures - `shouldThrow` - (\(RecursiveFailure ex@[_, _]) -> - any (\(h, e) -> ioeGetErrorType e == InappropriateType - && isCopyFileFailed h) ex && - any (\(h, e) -> ioeGetErrorType e == PermissionDenied - && isReadContentsFailed h) ex) - normalDirPerms "outputDir1/foo2/foo4" - normalDirPerms "outputDir1/foo2/foo4/inputFile4" - c <- allDirectoryContents' "outputDir1" - tmpDir' <- getRawTmpDir - let shouldC = (fmap (\x -> tmpDir' `BS.append` x) - ["outputDir1" - ,"outputDir1/foo2" - ,"outputDir1/foo2/inputFile1" - ,"outputDir1/foo2/inputFile2" - ,"outputDir1/foo2/inputFile3" - ,"outputDir1/foo2/foo4" - ,"outputDir1/foo2/foo4/inputFile6" - ,"outputDir1/foo2/foo4/inputFile4"]) - deleteFile' "outputDir1/foo2/inputFile1" - deleteFile' "outputDir1/foo2/inputFile2" - deleteFile' "outputDir1/foo2/inputFile3" - sort c `shouldBe` sort shouldC - - - it "copyDirRecursive (Strict, CollectFailures), no write permission on output dir" $ - copyDirRecursive' "inputDir" - "noWritePerm/foo" - Strict - CollectFailures - `shouldThrow` - (\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == PermissionDenied) - - it "copyDirRecursive (Strict, CollectFailures), cannot open output dir" $ - copyDirRecursive' "inputDir" - "noPerms/foo" - Strict - CollectFailures - `shouldThrow` - isRecursiveFailure - - it "copyDirRecursive (Strict, CollectFailures), destination dir already exists" $ - copyDirRecursive' "inputDir" - "alreadyExistsD" - Strict - CollectFailures - `shouldThrow` - (\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == AlreadyExists) - - it "copyDirRecursive (Strict, CollectFailures), destination already exists and is a file" $ - copyDirRecursive' "inputDir" - "alreadyExists" - Strict - CollectFailures - `shouldThrow` - isRecursiveFailure - - it "copyDirRecursive (Strict, CollectFailures), wrong input (regular file)" $ - copyDirRecursive' "wrongInput" - "outputDir" - Strict - CollectFailures - `shouldThrow` - (\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InappropriateType) - - it "copyDirRecursive (Strict, CollectFailures), wrong input (symlink to directory)" $ - copyDirRecursive' "wrongInputSymL" - "outputDir" - Strict - CollectFailures - `shouldThrow` - (\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InvalidArgument) - - it "copyDirRecursive (Strict, CollectFailures), destination in source" $ - copyDirRecursive' "inputDir" - "inputDir/foo" - Strict - CollectFailures - `shouldThrow` - isDestinationInSource - - it "copyDirRecursive (Strict, CollectFailures), destination and source same directory" $ - copyDirRecursive' "inputDir" - "inputDir" - Strict - CollectFailures - `shouldThrow` - isSameFile - - 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,205 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - - -module HPath.IO.CopyDirRecursiveOverwriteSpec where - - -import Test.Hspec -import HPath.IO -import HPath.IO.Errors -import System.IO.Error - ( - ioeGetErrorType - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import System.Exit -import System.Process -import Utils -import Data.ByteString.UTF8 (toString) - - - -upTmpDir :: IO () -upTmpDir = do - setTmpDir "CopyDirRecursiveOverwriteSpec" - createTmpDir - - -setupFiles :: IO () -setupFiles = do - createRegularFile' "alreadyExists" - createRegularFile' "wrongInput" - createSymlink' "wrongInputSymL" "inputDir/" - createDir' "noPerms" - createDir' "noWritePerm" - - createDir' "inputDir" - createDir' "inputDir/bar" - createDir' "inputDir/foo" - createRegularFile' "inputDir/foo/inputFile1" - createRegularFile' "inputDir/inputFile2" - createRegularFile' "inputDir/bar/inputFile3" - writeFile' "inputDir/foo/inputFile1" "SDAADSdsada" - writeFile' "inputDir/inputFile2" "Blahfaselgagaga" - writeFile' "inputDir/bar/inputFile3" - "fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4" - - createDir' "alreadyExistsD" - createDir' "alreadyExistsD/bar" - createDir' "alreadyExistsD/foo" - createRegularFile' "alreadyExistsD/foo/inputFile1" - createRegularFile' "alreadyExistsD/inputFile2" - createRegularFile' "alreadyExistsD/bar/inputFile3" - writeFile' "alreadyExistsD/foo/inputFile1" "DAAsada" - writeFile' "alreadyExistsD/inputFile2" "ahfaagaga" - writeFile' "alreadyExistsD/bar/inputFile3" - "f3223sasdasdaasdasdasasd4" - - noPerms "noPerms" - noWritableDirPerms "noWritePerm" - - -cleanupFiles :: IO () -cleanupFiles = do - normalDirPerms "noPerms" - normalDirPerms "noWritePerm" - deleteFile' "alreadyExists" - deleteFile' "wrongInput" - deleteFile' "wrongInputSymL" - deleteDir' "noPerms" - deleteDir' "noWritePerm" - deleteFile' "inputDir/foo/inputFile1" - deleteFile' "inputDir/inputFile2" - deleteFile' "inputDir/bar/inputFile3" - deleteDir' "inputDir/foo" - deleteDir' "inputDir/bar" - deleteDir' "inputDir" - deleteFile' "alreadyExistsD/foo/inputFile1" - deleteFile' "alreadyExistsD/inputFile2" - deleteFile' "alreadyExistsD/bar/inputFile3" - deleteDir' "alreadyExistsD/foo" - deleteDir' "alreadyExistsD/bar" - deleteDir' "alreadyExistsD" - - - -spec :: Spec -spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "HPath.IO.copyDirRecursive" $ do - - -- successes -- - it "copyDirRecursive (Overwrite, FailEarly), all fine" $ do - copyDirRecursive' "inputDir" - "outputDir" - Overwrite - FailEarly - removeDirIfExists "outputDir" - - it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do - tmpDir' <- getRawTmpDir - copyDirRecursive' "inputDir" - "outputDir" - Overwrite - FailEarly - (system $ "diff -r --no-dereference " - ++ toString tmpDir' ++ "inputDir" ++ " " - ++ toString tmpDir' ++ "outputDir" - ++ " >/dev/null") - `shouldReturn` ExitSuccess - removeDirIfExists "outputDir" - - it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do - tmpDir' <- getRawTmpDir - (system $ "diff -r --no-dereference " - ++ toString tmpDir' ++ "inputDir" ++ " " - ++ toString tmpDir' ++ "alreadyExistsD" - ++ " >/dev/null") - `shouldReturn` (ExitFailure 1) - copyDirRecursive' "inputDir" - "alreadyExistsD" - Overwrite - FailEarly - (system $ "diff -r --no-dereference " - ++ toString tmpDir' ++ "inputDir" ++ " " - ++ toString tmpDir' ++ "alreadyExistsD" - ++ " >/dev/null") - `shouldReturn` ExitSuccess - removeDirIfExists "outputDir" - - - -- posix failures -- - it "copyDirRecursive, source directory does not exist" $ - copyDirRecursive' "doesNotExist" - "outputDir" - Overwrite - FailEarly - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) - - it "copyDirRecursive, no write permission on output dir" $ - copyDirRecursive' "inputDir" - "noWritePerm/foo" - Overwrite - FailEarly - `shouldThrow` - (\e -> ioeGetErrorType e == PermissionDenied) - - it "copyDirRecursive, cannot open output dir" $ - copyDirRecursive' "inputDir" - "noPerms/foo" - Overwrite - FailEarly - `shouldThrow` - (\e -> ioeGetErrorType e == PermissionDenied) - - it "copyDirRecursive, cannot open source dir" $ - copyDirRecursive' "noPerms/inputDir" - "foo" - Overwrite - FailEarly - `shouldThrow` - (\e -> ioeGetErrorType e == PermissionDenied) - - it "copyDirRecursive, destination already exists and is a file" $ - copyDirRecursive' "inputDir" - "alreadyExists" - Overwrite - FailEarly - `shouldThrow` - (\e -> ioeGetErrorType e == InappropriateType) - - it "copyDirRecursive, wrong input (regular file)" $ - copyDirRecursive' "wrongInput" - "outputDir" - Overwrite - FailEarly - `shouldThrow` - (\e -> ioeGetErrorType e == InappropriateType) - - it "copyDirRecursive, wrong input (symlink to directory)" $ - copyDirRecursive' "wrongInputSymL" - "outputDir" - Overwrite - FailEarly - `shouldThrow` - (\e -> ioeGetErrorType e == InvalidArgument) - - -- custom failures - it "copyDirRecursive (Overwrite, FailEarly), destination in source" $ - copyDirRecursive' "inputDir" - "inputDir/foo" - Overwrite - FailEarly - `shouldThrow` - isDestinationInSource - - it "copyDirRecursive (Overwrite, FailEarly), destination and source same directory" $ - copyDirRecursive' "inputDir" - "inputDir" - Overwrite - FailEarly - `shouldThrow` - isSameFile 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,181 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - - -module HPath.IO.CopyDirRecursiveSpec where - - -import Test.Hspec -import HPath.IO -import HPath.IO.Errors -import System.IO.Error - ( - ioeGetErrorType - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import System.Exit -import System.Process -import Utils -import Data.ByteString.UTF8 (toString) - - - -upTmpDir :: IO () -upTmpDir = do - setTmpDir "CopyDirRecursiveSpec" - createTmpDir - -setupFiles :: IO () -setupFiles = do - createRegularFile' "alreadyExists" - createRegularFile' "wrongInput" - createSymlink' "wrongInputSymL" "inputDir/" - createDir' "alreadyExistsD" - createDir' "noPerms" - createDir' "noWritePerm" - - createDir' "inputDir" - createDir' "inputDir/bar" - createDir' "inputDir/foo" - createRegularFile' "inputDir/foo/inputFile1" - createRegularFile' "inputDir/inputFile2" - createRegularFile' "inputDir/bar/inputFile3" - writeFile' "inputDir/foo/inputFile1" "SDAADSdsada" - writeFile' "inputDir/inputFile2" "Blahfaselgagaga" - writeFile' "inputDir/bar/inputFile3" - "fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4" - - noPerms "noPerms" - noWritableDirPerms "noWritePerm" - - -cleanupFiles :: IO () -cleanupFiles = do - normalDirPerms "noPerms" - normalDirPerms "noWritePerm" - deleteFile' "alreadyExists" - deleteFile' "wrongInput" - deleteFile' "wrongInputSymL" - deleteDir' "alreadyExistsD" - deleteDir' "noPerms" - deleteDir' "noWritePerm" - deleteFile' "inputDir/foo/inputFile1" - deleteFile' "inputDir/inputFile2" - deleteFile' "inputDir/bar/inputFile3" - deleteDir' "inputDir/foo" - deleteDir' "inputDir/bar" - deleteDir' "inputDir" - - - - -spec :: Spec -spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "HPath.IO.copyDirRecursive" $ do - - -- successes -- - it "copyDirRecursive (Strict, FailEarly), all fine" $ do - copyDirRecursive' "inputDir" - "outputDir" - Strict - FailEarly - removeDirIfExists "outputDir" - - it "copyDirRecursive (Strict, FailEarly), all fine and compare" $ do - tmpDir' <- getRawTmpDir - copyDirRecursive' "inputDir" - "outputDir" - Strict - FailEarly - (system $ "diff -r --no-dereference " - ++ toString tmpDir' ++ "inputDir" ++ " " - ++ toString tmpDir' ++ "outputDir" - ++ " >/dev/null") - `shouldReturn` ExitSuccess - removeDirIfExists "outputDir" - - -- posix failures -- - it "copyDirRecursive (Strict, FailEarly), source directory does not exist" $ - copyDirRecursive' "doesNotExist" - "outputDir" - Strict - FailEarly - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) - - it "copyDirRecursive (Strict, FailEarly), no write permission on output dir" $ - copyDirRecursive' "inputDir" - "noWritePerm/foo" - Strict - FailEarly - `shouldThrow` - (\e -> ioeGetErrorType e == PermissionDenied) - - it "copyDirRecursive (Strict, FailEarly), cannot open output dir" $ - copyDirRecursive' "inputDir" - "noPerms/foo" - Strict - FailEarly - `shouldThrow` - (\e -> ioeGetErrorType e == PermissionDenied) - - it "copyDirRecursive (Strict, FailEarly), cannot open source dir" $ - copyDirRecursive' "noPerms/inputDir" - "foo" - Strict - FailEarly - `shouldThrow` - (\e -> ioeGetErrorType e == PermissionDenied) - - it "copyDirRecursive (Strict, FailEarly), destination dir already exists" $ - copyDirRecursive' "inputDir" - "alreadyExistsD" - Strict - FailEarly - `shouldThrow` - (\e -> ioeGetErrorType e == AlreadyExists) - - it "copyDirRecursive (Strict, FailEarly), destination already exists and is a file" $ - copyDirRecursive' "inputDir" - "alreadyExists" - Strict - FailEarly - `shouldThrow` - (\e -> ioeGetErrorType e == AlreadyExists) - - it "copyDirRecursive (Strict, FailEarly), wrong input (regular file)" $ - copyDirRecursive' "wrongInput" - "outputDir" - Strict - FailEarly - `shouldThrow` - (\e -> ioeGetErrorType e == InappropriateType) - - it "copyDirRecursive (Strict, FailEarly), wrong input (symlink to directory)" $ - copyDirRecursive' "wrongInputSymL" - "outputDir" - Strict - FailEarly - `shouldThrow` - (\e -> ioeGetErrorType e == InvalidArgument) - - -- custom failures - it "copyDirRecursive (Strict, FailEarly), destination in source" $ - copyDirRecursive' "inputDir" - "inputDir/foo" - Strict - FailEarly - `shouldThrow` - isDestinationInSource - - it "copyDirRecursive (Strict, FailEarly), destination and source same directory" $ - copyDirRecursive' "inputDir" - "inputDir" - Strict - FailEarly - `shouldThrow` - isSameFile - - 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/CreateDirIfMissingSpec.hs b/test/HPath/IO/CreateDirIfMissingSpec.hs deleted file mode 100644 --- a/test/HPath/IO/CreateDirIfMissingSpec.hs +++ /dev/null @@ -1,69 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module HPath.IO.CreateDirIfMissingSpec where - - -import Test.Hspec -import System.IO.Error - ( - ioeGetErrorType - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import Utils - - - -upTmpDir :: IO () -upTmpDir = do - setTmpDir "CreateDirIfMissingSpec" - createTmpDir - -setupFiles :: IO () -setupFiles = do - createDir' "alreadyExists" - createDir' "noPerms" - createDir' "noWritePerms" - noPerms "noPerms" - noWritableDirPerms "noWritePerms" - - - -cleanupFiles :: IO () -cleanupFiles = do - normalDirPerms "noPerms" - normalDirPerms "noWritePerms" - deleteDir' "alreadyExists" - deleteDir' "noPerms" - deleteDir' "noWritePerms" - - -spec :: Spec -spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "HPath.IO.CreateDirIfMissing" $ do - - -- successes -- - it "createDirIfMissing, all fine" $ do - createDirIfMissing' "newDir" - removeDirIfExists "newDir" - - it "createDirIfMissing, destination directory already exists" $ - createDirIfMissing' "alreadyExists" - - -- posix failures -- - it "createDirIfMissing, parent directories do not exist" $ - createDirIfMissing' "some/thing/dada" - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) - - it "createDirIfMissing, can't write to output directory" $ - createDirIfMissing' "noWritePerms/newDir" - `shouldThrow` - (\e -> ioeGetErrorType e == PermissionDenied) - - it "createDirIfMissing, can't open output directory" $ - createDirIfMissing' "noPerms/newDir" - `shouldThrow` - (\e -> ioeGetErrorType e == PermissionDenied) 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 hiding (getDirsFiles') -import Test.Hspec -import System.IO.Error - ( - ioeGetErrorType - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import Utils - - -upTmpDir :: IO () -upTmpDir = do - setTmpDir "GetDirsFilesSpec" - createTmpDir - - -setupFiles :: IO () -setupFiles = do - createRegularFile' "file" - createRegularFile' "Lala" - createRegularFile' ".hidden" - createSymlink' "syml" "Lala" - createDir' "dir" - createSymlink' "dirsym" "dir" - createDir' "noPerms" - noPerms "noPerms" - - -cleanupFiles :: IO () -cleanupFiles = do - normalDirPerms "noPerms" - deleteFile' "file" - deleteFile' "Lala" - deleteFile' ".hidden" - deleteFile' "syml" - deleteDir' "dir" - deleteFile' "dirsym" - deleteDir' "noPerms" - - - -spec :: Spec -spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "HPath.IO.getDirsFiles" $ do - - -- successes -- - it "getDirsFiles, all fine" $ - withRawTmpDir $ \p -> do - expectedFiles <- mapM P.parseRel [".hidden" - ,"Lala" - ,"dir" - ,"dirsym" - ,"file" - ,"noPerms" - ,"syml"] - (fmap sort $ getDirsFiles p) - `shouldReturn` fmap (p P.) expectedFiles - - -- posix failures -- - it "getDirsFiles, nonexistent directory" $ - getDirsFiles' "nothingHere" - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) - - it "getDirsFiles, wrong file type (file)" $ - getDirsFiles' "file" - `shouldThrow` - (\e -> ioeGetErrorType e == InappropriateType) - - it "getDirsFiles, wrong file type (symlink to file)" $ - getDirsFiles' "syml" - `shouldThrow` - (\e -> ioeGetErrorType e == InvalidArgument) - - it "getDirsFiles, wrong file type (symlink to dir)" $ - getDirsFiles' "dirsym" - `shouldThrow` - (\e -> ioeGetErrorType e == InvalidArgument) - - it "getDirsFiles, can't open directory" $ - getDirsFiles' "noPerms" - `shouldThrow` - (\e -> ioeGetErrorType e == PermissionDenied) - - - - 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/ReadFileSpec.hs b/test/HPath/IO/ReadFileSpec.hs deleted file mode 100644 --- a/test/HPath/IO/ReadFileSpec.hs +++ /dev/null @@ -1,85 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - - -module HPath.IO.ReadFileSpec where - - -import Test.Hspec -import System.IO.Error - ( - ioeGetErrorType - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import Utils - - - -upTmpDir :: IO () -upTmpDir = do - setTmpDir "ReadFileSpec" - createTmpDir - -setupFiles :: IO () -setupFiles = do - createRegularFile' "fileWithContent" - createRegularFile' "fileWithoutContent" - createSymlink' "inputFileSymL" "fileWithContent" - createDir' "alreadyExistsD" - createRegularFile' "noPerms" - noPerms "noPerms" - createDir' "noPermsD" - createRegularFile' "noPermsD/inputFile" - noPerms "noPermsD" - writeFile' "fileWithContent" "Blahfaselgagaga" - - -cleanupFiles :: IO () -cleanupFiles = do - deleteFile' "fileWithContent" - deleteFile' "fileWithoutContent" - deleteFile' "inputFileSymL" - deleteDir' "alreadyExistsD" - normalFilePerms "noPerms" - deleteFile' "noPerms" - normalDirPerms "noPermsD" - deleteFile' "noPermsD/inputFile" - deleteDir' "noPermsD" - - -spec :: Spec -spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "HPath.IO.readFile" $ do - - -- successes -- - it "readFile (Strict) file with content, everything clear" $ do - out <- readFile' "fileWithContent" - out `shouldBe` "Blahfaselgagaga" - - it "readFile (Strict) symlink, everything clear" $ do - out <- readFile' "inputFileSymL" - out `shouldBe` "Blahfaselgagaga" - - it "readFile (Strict) empty file, everything clear" $ do - out <- readFile' "fileWithoutContent" - out `shouldBe` "" - - - -- posix failures -- - it "readFile (Strict) directory, wrong file type" $ do - readFile' "alreadyExistsD" - `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) - - it "readFile (Strict) file, no permissions" $ do - readFile' "noPerms" - `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - - it "readFile (Strict) file, no permissions on dir" $ do - readFile' "noPermsD/inputFile" - `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - - it "readFile (Strict) file, no such file" $ do - readFile' "lalala" - `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) 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/WriteFileLSpec.hs b/test/HPath/IO/WriteFileLSpec.hs deleted file mode 100644 --- a/test/HPath/IO/WriteFileLSpec.hs +++ /dev/null @@ -1,108 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - - -module HPath.IO.WriteFileLSpec where - - -import Test.Hspec -import System.IO.Error - ( - ioeGetErrorType - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import Utils - - - -upTmpDir :: IO () -upTmpDir = do - setTmpDir "WriteFileLSpec" - createTmpDir - -setupFiles :: IO () -setupFiles = do - createRegularFile' "fileWithContent" - createRegularFile' "fileWithoutContent" - createSymlink' "inputFileSymL" "fileWithContent" - createDir' "alreadyExistsD" - createRegularFile' "noPerms" - noPerms "noPerms" - createDir' "noPermsD" - createRegularFile' "noPermsD/inputFile" - noPerms "noPermsD" - writeFile' "fileWithContent" "BLKASL" - - -cleanupFiles :: IO () -cleanupFiles = do - deleteFile' "fileWithContent" - deleteFile' "fileWithoutContent" - deleteFile' "inputFileSymL" - deleteDir' "alreadyExistsD" - normalFilePerms "noPerms" - deleteFile' "noPerms" - normalDirPerms "noPermsD" - deleteFile' "noPermsD/inputFile" - deleteDir' "noPermsD" - - -spec :: Spec -spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "HPath.IO.WriteFileL" $ do - - -- successes -- - it "WriteFileL file with content, everything clear" $ do - writeFileL' "fileWithContent" "blahfaselllll" - out <- readFile' "fileWithContent" - out `shouldBe` "blahfaselllll" - - it "WriteFileL file with content, everything clear" $ do - writeFileL' "fileWithContent" "gagagaga" - out <- readFile' "fileWithContent" - out `shouldBe` "gagagaga" - - it "WriteFileL file with content, everything clear" $ do - writeFileL' "fileWithContent" "" - out <- readFile' "fileWithContent" - out `shouldBe` "" - - it "WriteFileL file without content, everything clear" $ do - writeFileL' "fileWithoutContent" "blahfaselllll" - out <- readFile' "fileWithoutContent" - out `shouldBe` "blahfaselllll" - - it "WriteFileL, everything clear" $ do - writeFileL' "fileWithoutContent" "gagagaga" - out <- readFile' "fileWithoutContent" - out `shouldBe` "gagagaga" - - it "WriteFileL symlink, everything clear" $ do - writeFileL' "inputFileSymL" "blahfaselllll" - out <- readFile' "inputFileSymL" - out `shouldBe` "blahfaselllll" - - it "WriteFileL symlink, everything clear" $ do - writeFileL' "inputFileSymL" "gagagaga" - out <- readFile' "inputFileSymL" - out `shouldBe` "gagagaga" - - - -- posix failures -- - it "WriteFileL to dir, inappropriate type" $ do - writeFileL' "alreadyExistsD" "" - `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) - - it "WriteFileL, no permissions to file" $ do - writeFileL' "noPerms" "" - `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - - it "WriteFileL, no permissions to file" $ do - writeFileL' "noPermsD/inputFile" "" - `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - - it "WriteFileL, file does not exist" $ do - writeFileL' "gaga" "" - `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) 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,108 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - - -module HPath.IO.WriteFileSpec where - - -import Test.Hspec -import System.IO.Error - ( - ioeGetErrorType - ) -import GHC.IO.Exception - ( - IOErrorType(..) - ) -import Utils - - - -upTmpDir :: IO () -upTmpDir = do - setTmpDir "WriteFileSpec" - createTmpDir - -setupFiles :: IO () -setupFiles = do - createRegularFile' "fileWithContent" - createRegularFile' "fileWithoutContent" - createSymlink' "inputFileSymL" "fileWithContent" - createDir' "alreadyExistsD" - createRegularFile' "noPerms" - noPerms "noPerms" - createDir' "noPermsD" - createRegularFile' "noPermsD/inputFile" - noPerms "noPermsD" - writeFile' "fileWithContent" "BLKASL" - - -cleanupFiles :: IO () -cleanupFiles = do - deleteFile' "fileWithContent" - deleteFile' "fileWithoutContent" - deleteFile' "inputFileSymL" - deleteDir' "alreadyExistsD" - normalFilePerms "noPerms" - deleteFile' "noPerms" - normalDirPerms "noPermsD" - deleteFile' "noPermsD/inputFile" - deleteDir' "noPermsD" - - -spec :: Spec -spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "HPath.IO.writeFile" $ do - - -- successes -- - it "writeFile file with content, everything clear" $ do - writeFile' "fileWithContent" "blahfaselllll" - out <- readFile' "fileWithContent" - out `shouldBe` "blahfaselllll" - - it "writeFile file with content, everything clear" $ do - writeFile' "fileWithContent" "gagagaga" - out <- readFile' "fileWithContent" - out `shouldBe` "gagagaga" - - it "writeFile file with content, everything clear" $ do - writeFile' "fileWithContent" "" - out <- readFile' "fileWithContent" - out `shouldBe` "" - - it "writeFile file without content, everything clear" $ do - writeFile' "fileWithoutContent" "blahfaselllll" - out <- readFile' "fileWithoutContent" - out `shouldBe` "blahfaselllll" - - it "writeFile, everything clear" $ do - writeFile' "fileWithoutContent" "gagagaga" - out <- readFile' "fileWithoutContent" - out `shouldBe` "gagagaga" - - it "writeFile symlink, everything clear" $ do - writeFile' "inputFileSymL" "blahfaselllll" - out <- readFile' "inputFileSymL" - out `shouldBe` "blahfaselllll" - - it "writeFile symlink, everything clear" $ do - writeFile' "inputFileSymL" "gagagaga" - out <- readFile' "inputFileSymL" - out `shouldBe` "gagagaga" - - - -- posix failures -- - it "writeFile to dir, inappropriate type" $ do - writeFile' "alreadyExistsD" "" - `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) - - it "writeFile, no permissions to file" $ do - writeFile' "noPerms" "" - `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - - it "writeFile, no permissions to file" $ do - writeFile' "noPermsD/inputFile" "" - `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - - it "writeFile, file does not exist" $ do - writeFile' "gaga" "" - `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) diff --git a/test/Main.hs b/test/Main.hs deleted file mode 100644 --- a/test/Main.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -import qualified Data.ByteString as BS -import Data.IORef -import Test.Hspec -import Test.Hspec.Runner -import Test.Hspec.Formatters -import qualified Spec -import Utils -import System.Posix.Temp.ByteString (mkdtemp) - - --- TODO: chardev, blockdev, namedpipe, socket - - -main :: IO () -main = do - tmpBase <- mkdtemp "/tmp/" - writeIORef baseTmpDir (Just (tmpBase `BS.append` "/")) - putStrLn $ ("Temporary test directory at: " ++ show tmpBase) - hspecWith - defaultConfig { configFormatter = Just progress } - $ afterAll_ deleteBaseTmpDir - $ Spec.spec 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,294 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PackageImports #-} - - -module Utils where - - -import Control.Applicative - ( - (<$>) - ) -import Control.Monad - ( - forM_ - , void - ) -import Control.Monad.IfElse - ( - whenM - ) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as BSL -import Data.IORef - ( - newIORef - , readIORef - , writeIORef - , IORef - ) -import HPath.IO -import Prelude hiding (appendFile, readFile, writeFile) -import Data.Maybe - ( - fromJust - ) -import qualified HPath as P -import System.IO.Unsafe - ( - unsafePerformIO - ) -import qualified System.Posix.Directory.Traversals as DT -import Data.ByteString - ( - ByteString - ) -import qualified Data.ByteString.Lazy as L -import System.Posix.Files.ByteString - ( - groupExecuteMode - , groupReadMode - , nullFileMode - , otherExecuteMode - , otherReadMode - , ownerExecuteMode - , ownerReadMode - , setFileMode - , unionFileModes - ) - -baseTmpDir :: IORef (Maybe ByteString) -{-# NOINLINE baseTmpDir #-} -baseTmpDir = unsafePerformIO (newIORef Nothing) - - -tmpDir :: IORef (Maybe ByteString) -{-# NOINLINE tmpDir #-} -tmpDir = unsafePerformIO (newIORef Nothing) - - - - ----------------- - --[ Utilities ]-- - ----------------- - - -setTmpDir :: ByteString -> IO () -{-# NOINLINE setTmpDir #-} -setTmpDir bs = do - tmp <- fromJust <$> readIORef baseTmpDir - writeIORef tmpDir (Just (tmp `BS.append` bs)) - - -createTmpDir :: IO () -{-# NOINLINE createTmpDir #-} -createTmpDir = do - tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir) - void $ createDir newDirPerms tmp - - -deleteTmpDir :: IO () -{-# NOINLINE deleteTmpDir #-} -deleteTmpDir = do - tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir) - void $ deleteDir tmp - - -deleteBaseTmpDir :: IO () -{-# NOINLINE deleteBaseTmpDir #-} -deleteBaseTmpDir = do - tmp <- (fromJust <$> readIORef baseTmpDir) >>= P.parseAbs - contents <- getDirsFiles tmp - forM_ contents deleteDir - void $ deleteDir tmp - - -withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a -{-# NOINLINE withRawTmpDir #-} -withRawTmpDir f = do - tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir) - f tmp - - -getRawTmpDir :: IO ByteString -{-# NOINLINE getRawTmpDir #-} -getRawTmpDir = withRawTmpDir (return . flip BS.append "/" . P.fromAbs) - - -withTmpDir :: ByteString -> (P.Path P.Abs -> IO a) -> IO a -{-# NOINLINE withTmpDir #-} -withTmpDir ip f = do - tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir) - p <- (tmp P.) <$> P.parseRel ip - f p - - -withTmpDir' :: ByteString - -> ByteString - -> (P.Path P.Abs -> P.Path P.Abs -> IO a) - -> IO a -{-# NOINLINE withTmpDir' #-} -withTmpDir' ip1 ip2 f = do - tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir) - p1 <- (tmp P.) <$> P.parseRel ip1 - p2 <- (tmp P.) <$> P.parseRel ip2 - f p1 p2 - - -removeFileIfExists :: ByteString -> IO () -{-# NOINLINE removeFileIfExists #-} -removeFileIfExists bs = - withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p) - - -removeDirIfExists :: ByteString -> IO () -{-# NOINLINE removeDirIfExists #-} -removeDirIfExists bs = - withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p) - - -copyFile' :: ByteString -> ByteString -> CopyMode -> IO () -{-# NOINLINE copyFile' #-} -copyFile' inputFileP outputFileP cm = - withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm) - - -copyDirRecursive' :: ByteString -> ByteString - -> CopyMode -> RecursiveErrorMode -> IO () -{-# NOINLINE copyDirRecursive' #-} -copyDirRecursive' inputDirP outputDirP cm rm = - withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm) - - -createDir' :: ByteString -> IO () -{-# NOINLINE createDir' #-} -createDir' dest = withTmpDir dest (createDir newDirPerms) - -createDirIfMissing' :: ByteString -> IO () -{-# NOINLINE createDirIfMissing' #-} -createDirIfMissing' dest = withTmpDir dest (createDirIfMissing newDirPerms) - -createDirRecursive' :: ByteString -> IO () -{-# NOINLINE createDirRecursive' #-} -createDirRecursive' dest = withTmpDir dest (createDirRecursive newDirPerms) - -createRegularFile' :: ByteString -> IO () -{-# NOINLINE createRegularFile' #-} -createRegularFile' dest = withTmpDir dest (createRegularFile newFilePerms) - - -createSymlink' :: ByteString -> ByteString -> IO () -{-# NOINLINE createSymlink' #-} -createSymlink' dest sympoint = withTmpDir dest - (\x -> createSymlink x sympoint) - - -renameFile' :: ByteString -> ByteString -> IO () -{-# NOINLINE renameFile' #-} -renameFile' inputFileP outputFileP = - withTmpDir' inputFileP outputFileP $ \i o -> do - renameFile i o - renameFile o i - - -moveFile' :: ByteString -> ByteString -> CopyMode -> IO () -{-# NOINLINE moveFile' #-} -moveFile' inputFileP outputFileP cm = - withTmpDir' inputFileP outputFileP $ \i o -> do - moveFile i o cm - moveFile o i Strict - - -recreateSymlink' :: ByteString -> ByteString -> CopyMode -> IO () -{-# NOINLINE recreateSymlink' #-} -recreateSymlink' inputFileP outputFileP cm = - withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm) - - -noWritableDirPerms :: ByteString -> IO () -{-# NOINLINE noWritableDirPerms #-} -noWritableDirPerms path = withTmpDir path $ \p -> - setFileMode (P.fromAbs p) perms - where - perms = ownerReadMode - `unionFileModes` ownerExecuteMode - `unionFileModes` groupReadMode - `unionFileModes` groupExecuteMode - `unionFileModes` otherReadMode - `unionFileModes` otherExecuteMode - - -noPerms :: ByteString -> IO () -{-# NOINLINE noPerms #-} -noPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) nullFileMode - - -normalDirPerms :: ByteString -> IO () -{-# NOINLINE normalDirPerms #-} -normalDirPerms path = - withTmpDir path $ \p -> setFileMode (P.fromAbs p) newDirPerms - - -normalFilePerms :: ByteString -> IO () -{-# NOINLINE normalFilePerms #-} -normalFilePerms path = - withTmpDir path $ \p -> setFileMode (P.fromAbs p) newFilePerms - - -getFileType' :: ByteString -> IO FileType -{-# NOINLINE getFileType' #-} -getFileType' path = withTmpDir path getFileType - - -getDirsFiles' :: ByteString -> IO [P.Path P.Abs] -{-# NOINLINE getDirsFiles' #-} -getDirsFiles' path = withTmpDir path getDirsFiles - - -deleteFile' :: ByteString -> IO () -{-# NOINLINE deleteFile' #-} -deleteFile' p = withTmpDir p deleteFile - - -deleteDir' :: ByteString -> IO () -{-# NOINLINE deleteDir' #-} -deleteDir' p = withTmpDir p deleteDir - - -deleteDirRecursive' :: ByteString -> IO () -{-# NOINLINE deleteDirRecursive' #-} -deleteDirRecursive' p = withTmpDir p deleteDirRecursive - - -canonicalizePath' :: ByteString -> IO (P.Path P.Abs) -{-# NOINLINE canonicalizePath' #-} -canonicalizePath' p = withTmpDir p canonicalizePath - - -writeFile' :: ByteString -> ByteString -> IO () -{-# NOINLINE writeFile' #-} -writeFile' ip bs = - withTmpDir ip $ \p -> writeFile p Nothing bs - -writeFileL' :: ByteString -> BSL.ByteString -> IO () -{-# NOINLINE writeFileL' #-} -writeFileL' ip bs = - withTmpDir ip $ \p -> writeFileL p Nothing bs - - -appendFile' :: ByteString -> ByteString -> IO () -{-# NOINLINE appendFile' #-} -appendFile' ip bs = - withTmpDir ip $ \p -> appendFile p bs - - -allDirectoryContents' :: ByteString -> IO [ByteString] -{-# NOINLINE allDirectoryContents' #-} -allDirectoryContents' ip = - withTmpDir ip $ \p -> DT.allDirectoryContents' (P.fromAbs p) - - -readFile' :: ByteString -> IO ByteString -{-# NOINLINE readFile' #-} -readFile' p = withTmpDir p (fmap L.toStrict . readFile) -