21 Commits
0.7.0 ... 0.7.2

Author SHA1 Message Date
b603f72407 Release 0.7.2 2016-05-29 17:47:22 +02:00
98ca6c5d86 Sort module list alphabetically 2016-05-29 17:44:00 +02:00
8d948366f9 Add hspec for createSymlink 2016-05-29 17:43:43 +02:00
86e7496917 Re-add missing spec modules so they show up in sdist 2016-05-29 17:38:27 +02:00
1b9b8cc886 Set test formatter to progress 2016-05-29 17:32:22 +02:00
395621b27a Fix tests for sdist
We now create the necessary directories and files
for the tests on-the-fly.
2016-05-29 17:29:13 +02:00
51da8bf5c2 HPath.IO: add createSymlink 2016-05-29 17:28:12 +02:00
bebc96fa6d Add posix note to README 2016-05-24 15:55:36 +02:00
08fa277b31 Release 0.7.1 2016-05-24 15:36:34 +02:00
51609781b2 Add makeRelative and makeValid 2016-05-24 15:31:14 +02:00
3cb3a822d7 Add test to equalFilePath 2016-05-24 15:30:56 +02:00
7fa4c041a9 Remove -Wno-redundant-constraints since it's only in ghc >= 8.0.1 2016-05-24 03:31:01 +02:00
e66074af1c Fix stripSuffix' for bytestring < 0.10.8 2016-05-24 03:29:40 +02:00
4032629407 Add TODO 2016-05-24 03:26:07 +02:00
f2fe5a3419 Hide wrong -Wredundant-constraints messages 2016-05-24 03:26:07 +02:00
5ac7450495 Small import fix 2016-05-24 03:26:07 +02:00
b55cf6d9f3 Fix for bytestring versions less than 0.10.8 2016-05-24 03:26:01 +02:00
ae9a806c2e Fix to latest sendfile version to simplify imports 2016-05-24 03:13:36 +02:00
9c199c6da2 Rearrange, prettify and improve haddock
This also matches the documentation order from the
filepath package more.
2016-05-24 02:16:16 +02:00
eb72fce33f Add splitSearchPath, getSearchPath and stripExtension 2016-05-24 02:07:04 +02:00
65bb09d133 Update README 2016-05-23 13:52:34 +02:00
134 changed files with 1196 additions and 728 deletions

View File

@@ -1,3 +1,9 @@
0.7.2:
* fix tests, so they work with the sdist tarball too
* added the following function to HPath.IO: createSymlink
0.7.1:
* various cleanups and documentation improvements
* added the following functions to System.Posix.FilePath: splitSearchPath, getSearchPath, stripExtension, makeRelative, makeValid
0.7.0: 0.7.0:
* use 'sendfile' from 'simple-sendfile' in _copyFile and do read/write as a fallback only * use 'sendfile' from 'simple-sendfile' in _copyFile and do read/write as a fallback only
* add isFileName, hasParentDir, hiddenFile to System.Posix.FilePath * add isFileName, hasParentDir, hiddenFile to System.Posix.FilePath

View File

@@ -28,6 +28,8 @@ so it is forked as well and merged into this library.
* safe filepath manipulation, never using String as filepath, but ByteString * safe filepath manipulation, never using String as filepath, but ByteString
* still allowing sufficient control to interact with the underlying low-level calls * still allowing sufficient control to interact with the underlying low-level calls
Note: this library was written for __posix__ systems and it will probably not support other systems.
## Differences to 'path' ## Differences to 'path'
* doesn't attempt to fake IO-related information into the path, so whether a path points to a file or directory is up to your IO-code to decide... * doesn't attempt to fake IO-related information into the path, so whether a path points to a file or directory is up to your IO-code to decide...
@@ -43,9 +45,20 @@ so it is forked as well and merged into this library.
## Differences to 'posix-paths' ## Differences to 'posix-paths'
* `hasTrailingPathSeparator` behaves in the same way as `System.FilePath`
* `dropTrailingPathSeparator` behaves in the same way as `System.FilePath`
* added various functions like `isValid`, `normalise` and `equalFilePath`
* uses the `word8` package for save word8 literals instead of `OverloadedStrings` * uses the `word8` package for save word8 literals instead of `OverloadedStrings`
* has custom versions of `openFd` and `getDirectoryContents` * `hasTrailingPathSeparator` and `dropTrailingPathSeparator` behave in the same way as their `System.FilePath` counterpart
* added various functions:
* `equalFilePath`
* `getSearchPath`
* `hasParentDir`
* `hiddenFile`
* `isFileName`
* `isValid`
* `makeRelative`
* `makeValid`
* `normalise`
* `splitSearchPath`
* `stripExtension`
* has a custom versions of `openFd` which allows more control over the flags than its unix package counterpart
* adds a `getDirectoryContents'` version that works on Fd

View File

@@ -1,5 +1,5 @@
name: hpath name: hpath
version: 0.7.0 version: 0.7.2
synopsis: Support for well-typed paths synopsis: Support for well-typed paths
description: Support for well-typed paths, utilizing ByteString under the hood. description: Support for well-typed paths, utilizing ByteString under the hood.
license: GPL-2 license: GPL-2
@@ -36,7 +36,7 @@ library
, deepseq , deepseq
, exceptions , exceptions
, hspec , hspec
, simple-sendfile >= 0.2.22 , simple-sendfile >= 0.2.24
, unix >= 2.5 , unix >= 2.5
, unix-bytestring , unix-bytestring
, utf8-string , utf8-string
@@ -73,22 +73,24 @@ test-suite spec
Hs-Source-Dirs: test Hs-Source-Dirs: test
Main-Is: Main.hs Main-Is: Main.hs
other-modules: other-modules:
Spec HPath.IO.CanonicalizePathSpec
HPath.IO.CopyDirRecursiveSpec
HPath.IO.CopyDirRecursiveOverwriteSpec HPath.IO.CopyDirRecursiveOverwriteSpec
HPath.IO.CopyFileSpec HPath.IO.CopyDirRecursiveSpec
HPath.IO.CopyFileOverwriteSpec HPath.IO.CopyFileOverwriteSpec
HPath.IO.CopyFileSpec
HPath.IO.CreateDirSpec HPath.IO.CreateDirSpec
HPath.IO.CreateRegularFileSpec HPath.IO.CreateRegularFileSpec
HPath.IO.CreateSymlinkSpec
HPath.IO.DeleteDirRecursiveSpec HPath.IO.DeleteDirRecursiveSpec
HPath.IO.DeleteDirSpec HPath.IO.DeleteDirSpec
HPath.IO.DeleteFileSpec HPath.IO.DeleteFileSpec
HPath.IO.GetDirsFilesSpec HPath.IO.GetDirsFilesSpec
HPath.IO.GetFileTypeSpec HPath.IO.GetFileTypeSpec
HPath.IO.MoveFileSpec
HPath.IO.MoveFileOverwriteSpec HPath.IO.MoveFileOverwriteSpec
HPath.IO.MoveFileSpec
HPath.IO.RecreateSymlinkSpec HPath.IO.RecreateSymlinkSpec
HPath.IO.RenameFileSpec HPath.IO.RenameFileSpec
Spec
Utils Utils
GHC-Options: -Wall GHC-Options: -Wall
Build-Depends: base Build-Depends: base
@@ -98,6 +100,7 @@ test-suite spec
, hspec >= 1.3 , hspec >= 1.3
, process , process
, unix , unix
, unix-bytestring
, utf8-string , utf8-string
benchmark bench.hs benchmark bench.hs

View File

@@ -54,10 +54,10 @@ import Control.Monad.Catch (MonadThrow(..))
import Data.ByteString(ByteString, stripPrefix) import Data.ByteString(ByteString, stripPrefix)
#else #else
import Data.ByteString(ByteString) import Data.ByteString(ByteString)
import qualified Data.List as L
#endif #endif
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.Data import Data.Data
import qualified Data.List as L
import Data.Maybe import Data.Maybe
import Data.Word8 import Data.Word8
import HPath.Internal import HPath.Internal

View File

@@ -56,6 +56,7 @@ module HPath.IO
-- * File creation -- * File creation
, createRegularFile , createRegularFile
, createDir , createDir
, createSymlink
-- * File renaming/moving -- * File renaming/moving
, renameFile , renameFile
, moveFile , moveFile
@@ -140,10 +141,7 @@ import System.IO.Error
import System.Linux.Sendfile import System.Linux.Sendfile
( (
sendfileFd sendfileFd
) , FileRange(..)
import Network.Sendfile
(
FileRange(..)
) )
import System.Posix.ByteString import System.Posix.ByteString
( (
@@ -318,6 +316,7 @@ copyDirRecursiveOverwrite fromp destdirp
RegularFile -> copyFileOverwrite f newdest RegularFile -> copyFileOverwrite f newdest
_ -> return () _ -> return ()
-- |Recreate a symlink. -- |Recreate a symlink.
-- --
-- Throws: -- Throws:
@@ -629,6 +628,20 @@ createDir :: Path Abs -> IO ()
createDir dest = createDirectory (fromAbs dest) newDirPerms createDir dest = createDirectory (fromAbs dest) newDirPerms
-- |Create a symlink.
--
-- Throws:
--
-- - `PermissionDenied` if output directory cannot be written to
-- - `AlreadyExists` if destination file already exists
--
-- Note: calls `symlink`
createSymlink :: Path Abs -- ^ destination file
-> ByteString -- ^ path the symlink points to
-> IO ()
createSymlink dest sympoint
= createSymbolicLink sympoint (fromAbs dest)
---------------------------- ----------------------------

View File

@@ -213,6 +213,7 @@ sameFile fp1 fp2 =
else return False else return False
-- TODO: make this more robust when destination does not exist
-- |Checks whether the destination directory is contained -- |Checks whether the destination directory is contained
-- within the source directory by comparing the device+file ID of the -- within the source directory by comparing the device+file ID of the
-- source directory with all device+file IDs of the parent directories -- source directory with all device+file IDs of the parent directories

View File

@@ -12,6 +12,7 @@
-- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute! -- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute!
{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -Wall #-}
@@ -19,7 +20,7 @@
module System.Posix.FilePath ( module System.Posix.FilePath (
-- * Separators -- * Separator predicates
pathSeparator pathSeparator
, isPathSeparator , isPathSeparator
, searchPathSeparator , searchPathSeparator
@@ -27,7 +28,11 @@ module System.Posix.FilePath (
, extSeparator , extSeparator
, isExtSeparator , isExtSeparator
-- * File extensions -- * $PATH methods
, splitSearchPath
, getSearchPath
-- * Extension functions
, splitExtension , splitExtension
, takeExtension , takeExtension
, replaceExtension , replaceExtension
@@ -38,8 +43,9 @@ module System.Posix.FilePath (
, splitExtensions , splitExtensions
, dropExtensions , dropExtensions
, takeExtensions , takeExtensions
, stripExtension
-- * Filenames/Directory names -- * Filename\/directory functions
, splitFileName , splitFileName
, takeFileName , takeFileName
, replaceFileName , replaceFileName
@@ -48,29 +54,27 @@ module System.Posix.FilePath (
, replaceBaseName , replaceBaseName
, takeDirectory , takeDirectory
, replaceDirectory , replaceDirectory
-- * Path combinators and splitters
, combine , combine
, (</>) , (</>)
, splitPath , splitPath
, joinPath , joinPath
, splitDirectories , splitDirectories
-- * Path conversions -- * Trailing slash functions
, normalise
-- * Trailing path separator
, hasTrailingPathSeparator , hasTrailingPathSeparator
, addTrailingPathSeparator , addTrailingPathSeparator
, dropTrailingPathSeparator , dropTrailingPathSeparator
-- * Queries -- * File name manipulations
, normalise
, makeRelative
, equalFilePath
, isRelative , isRelative
, isAbsolute , isAbsolute
, isValid , isValid
, makeValid
, isFileName , isFileName
, hasParentDir , hasParentDir
, equalFilePath
, hiddenFile , hiddenFile
, module System.Posix.ByteString.FilePath , module System.Posix.ByteString.FilePath
@@ -78,15 +82,20 @@ module System.Posix.FilePath (
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.String (fromString)
import System.Posix.ByteString.FilePath import System.Posix.ByteString.FilePath
import qualified System.Posix.Env.ByteString as PE
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Data.Word8 import Data.Word8
#if !MIN_VERSION_bytestring(0,10,8)
import qualified Data.List as L
#endif
import Control.Arrow (second) import Control.Arrow (second)
-- $setup -- $setup
-- >>> import Data.Char -- >>> import Data.Char
-- >>> import Data.Maybe
-- >>> import Test.QuickCheck -- >>> import Test.QuickCheck
-- >>> import Control.Applicative -- >>> import Control.Applicative
-- >>> import qualified Data.ByteString as BS -- >>> import qualified Data.ByteString as BS
@@ -96,38 +105,84 @@ import Control.Arrow (second)
-- >>> let _chr :: Word8 -> Char; _chr = chr . fromIntegral -- >>> let _chr :: Word8 -> Char; _chr = chr . fromIntegral
------------------------
-- Separator predicates
-- | Path separator character -- | Path separator character
pathSeparator :: Word8 pathSeparator :: Word8
pathSeparator = _slash pathSeparator = _slash
-- | Check if a character is the path separator -- | Check if a character is the path separator
-- --
-- prop> \n -> (_chr n == '/') == isPathSeparator n -- prop> \n -> (_chr n == '/') == isPathSeparator n
isPathSeparator :: Word8 -> Bool isPathSeparator :: Word8 -> Bool
isPathSeparator = (== pathSeparator) isPathSeparator = (== pathSeparator)
-- | Search path separator -- | Search path separator
searchPathSeparator :: Word8 searchPathSeparator :: Word8
searchPathSeparator = _colon searchPathSeparator = _colon
-- | Check if a character is the search path separator -- | Check if a character is the search path separator
-- --
-- prop> \n -> (_chr n == ':') == isSearchPathSeparator n -- prop> \n -> (_chr n == ':') == isSearchPathSeparator n
isSearchPathSeparator :: Word8 -> Bool isSearchPathSeparator :: Word8 -> Bool
isSearchPathSeparator = (== searchPathSeparator) isSearchPathSeparator = (== searchPathSeparator)
-- | File extension separator -- | File extension separator
extSeparator :: Word8 extSeparator :: Word8
extSeparator = _period extSeparator = _period
-- | Check if a character is the file extension separator -- | Check if a character is the file extension separator
-- --
-- prop> \n -> (_chr n == '.') == isExtSeparator n -- prop> \n -> (_chr n == '.') == isExtSeparator n
isExtSeparator :: Word8 -> Bool isExtSeparator :: Word8 -> Bool
isExtSeparator = (== extSeparator) isExtSeparator = (== extSeparator)
------------------------ ------------------------
-- extension stuff -- $PATH methods
-- | Take a ByteString, split it on the 'searchPathSeparator'.
-- Blank items are converted to @.@.
--
-- Follows the recommendations in
-- <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>
--
-- >>> splitSearchPath "File1:File2:File3"
-- ["File1","File2","File3"]
-- >>> splitSearchPath "File1::File2:File3"
-- ["File1",".","File2","File3"]
-- >>> splitSearchPath ""
-- ["."]
splitSearchPath :: ByteString -> [RawFilePath]
splitSearchPath = f
where
f bs = let (pre, post) = BS.break isSearchPathSeparator bs
in if BS.null post
then g pre
else g pre ++ f (BS.tail post)
g x
| BS.null x = [BS.singleton _period]
| otherwise = [x]
-- | Get a list of 'RawFilePath's in the $PATH variable.
getSearchPath :: IO [RawFilePath]
getSearchPath = fmap (maybe [] splitSearchPath) (PE.getEnv $ fromString "PATH")
------------------------
-- Extension functions
-- | Split a 'RawFilePath' into a path+filename and extension -- | Split a 'RawFilePath' into a path+filename and extension
-- --
@@ -147,6 +202,7 @@ splitExtension x = if BS.null basename
(path,file) = splitFileNameRaw x (path,file) = splitFileNameRaw x
(basename,fileExt) = BS.breakEnd isExtSeparator file (basename,fileExt) = BS.breakEnd isExtSeparator file
-- | Get the final extension from a 'RawFilePath' -- | Get the final extension from a 'RawFilePath'
-- --
-- >>> takeExtension "file.exe" -- >>> takeExtension "file.exe"
@@ -158,12 +214,14 @@ splitExtension x = if BS.null basename
takeExtension :: RawFilePath -> ByteString takeExtension :: RawFilePath -> ByteString
takeExtension = snd . splitExtension takeExtension = snd . splitExtension
-- | Change a file's extension -- | Change a file's extension
-- --
-- prop> \path -> let ext = takeExtension path in replaceExtension path ext == path -- prop> \path -> let ext = takeExtension path in replaceExtension path ext == path
replaceExtension :: RawFilePath -> ByteString -> RawFilePath replaceExtension :: RawFilePath -> ByteString -> RawFilePath
replaceExtension path ext = dropExtension path <.> ext replaceExtension path ext = dropExtension path <.> ext
-- | Drop the final extension from a 'RawFilePath' -- | Drop the final extension from a 'RawFilePath'
-- --
-- >>> dropExtension "file.exe" -- >>> dropExtension "file.exe"
@@ -175,6 +233,7 @@ replaceExtension path ext = dropExtension path <.> ext
dropExtension :: RawFilePath -> RawFilePath dropExtension :: RawFilePath -> RawFilePath
dropExtension = fst . splitExtension dropExtension = fst . splitExtension
-- | Add an extension to a 'RawFilePath' -- | Add an extension to a 'RawFilePath'
-- --
-- >>> addExtension "file" ".exe" -- >>> addExtension "file" ".exe"
@@ -190,10 +249,6 @@ addExtension file ext
| otherwise = BS.intercalate (BS.singleton extSeparator) [file, ext] | otherwise = BS.intercalate (BS.singleton extSeparator) [file, ext]
-- | Operator version of 'addExtension'
(<.>) :: RawFilePath -> ByteString -> RawFilePath
(<.>) = addExtension
-- | Check if a 'RawFilePath' has an extension -- | Check if a 'RawFilePath' has an extension
-- --
-- >>> hasExtension "file" -- >>> hasExtension "file"
@@ -205,7 +260,13 @@ addExtension file ext
hasExtension :: RawFilePath -> Bool hasExtension :: RawFilePath -> Bool
hasExtension = isJust . BS.elemIndex extSeparator . takeFileName hasExtension = isJust . BS.elemIndex extSeparator . takeFileName
-- | Split a 'RawFilePath' on the first extension
-- | Operator version of 'addExtension'
(<.>) :: RawFilePath -> ByteString -> RawFilePath
(<.>) = addExtension
-- | Split a 'RawFilePath' on the first extension.
-- --
-- >>> splitExtensions "/path/file.tar.gz" -- >>> splitExtensions "/path/file.tar.gz"
-- ("/path/file",".tar.gz") -- ("/path/file",".tar.gz")
@@ -219,6 +280,7 @@ splitExtensions x = if BS.null basename
(path,file) = splitFileNameRaw x (path,file) = splitFileNameRaw x
(basename,fileExt) = BS.break isExtSeparator file (basename,fileExt) = BS.break isExtSeparator file
-- | Remove all extensions from a 'RawFilePath' -- | Remove all extensions from a 'RawFilePath'
-- --
-- >>> dropExtensions "/path/file.tar.gz" -- >>> dropExtensions "/path/file.tar.gz"
@@ -226,6 +288,7 @@ splitExtensions x = if BS.null basename
dropExtensions :: RawFilePath -> RawFilePath dropExtensions :: RawFilePath -> RawFilePath
dropExtensions = fst . splitExtensions dropExtensions = fst . splitExtensions
-- | Take all extensions from a 'RawFilePath' -- | Take all extensions from a 'RawFilePath'
-- --
-- >>> takeExtensions "/path/file.tar.gz" -- >>> takeExtensions "/path/file.tar.gz"
@@ -233,8 +296,48 @@ dropExtensions = fst . splitExtensions
takeExtensions :: RawFilePath -> ByteString takeExtensions :: RawFilePath -> ByteString
takeExtensions = snd . splitExtensions takeExtensions = snd . splitExtensions
-- | Drop the given extension from a FilePath, and the @\".\"@ preceding it.
-- Returns 'Nothing' if the FilePath does not have the given extension, or
-- 'Just' and the part before the extension if it does.
--
-- This function can be more predictable than 'dropExtensions',
-- especially if the filename might itself contain @.@ characters.
--
-- >>> stripExtension "hs.o" "foo.x.hs.o"
-- Just "foo.x"
-- >>> stripExtension "hi.o" "foo.x.hs.o"
-- Nothing
-- >>> stripExtension ".c.d" "a.b.c.d"
-- Just "a.b"
-- >>> stripExtension ".c.d" "a.b..c.d"
-- Just "a.b."
-- >>> stripExtension "baz" "foo.bar"
-- Nothing
-- >>> stripExtension "bar" "foobar"
-- Nothing
--
-- prop> \path -> stripExtension "" path == Just path
-- prop> \path -> dropExtension path == fromJust (stripExtension (takeExtension path) path)
-- prop> \path -> dropExtensions path == fromJust (stripExtension (takeExtensions path) path)
stripExtension :: ByteString -> RawFilePath -> Maybe RawFilePath
stripExtension bs path
| BS.null bs = Just path
| otherwise = stripSuffix' dotExt path
where
dotExt = if isExtSeparator $ BS.head bs
then bs
else extSeparator `BS.cons` bs
#if MIN_VERSION_bytestring(0,10,8)
stripSuffix' = BS.stripSuffix
#else
stripSuffix' xs ys = fmap (BS.pack . reverse) $ L.stripPrefix (reverse $ BS.unpack xs) (reverse $ BS.unpack ys)
#endif
------------------------ ------------------------
-- more stuff -- Filename/directory functions
-- | Split a 'RawFilePath' into (path,file). 'combine' is the inverse -- | Split a 'RawFilePath' into (path,file). 'combine' is the inverse
-- --
@@ -264,12 +367,14 @@ splitFileName x = if BS.null path
takeFileName :: RawFilePath -> RawFilePath takeFileName :: RawFilePath -> RawFilePath
takeFileName = snd . splitFileName takeFileName = snd . splitFileName
-- | Change the file name -- | Change the file name
-- --
-- prop> \path -> replaceFileName path (takeFileName path) == path -- prop> \path -> replaceFileName path (takeFileName path) == path
replaceFileName :: RawFilePath -> ByteString -> RawFilePath replaceFileName :: RawFilePath -> ByteString -> RawFilePath
replaceFileName x y = fst (splitFileNameRaw x) </> y replaceFileName x y = fst (splitFileNameRaw x) </> y
-- | Drop the file name -- | Drop the file name
-- --
-- >>> dropFileName "path/file.txt" -- >>> dropFileName "path/file.txt"
@@ -279,6 +384,7 @@ replaceFileName x y = fst (splitFileNameRaw x) </> y
dropFileName :: RawFilePath -> RawFilePath dropFileName :: RawFilePath -> RawFilePath
dropFileName = fst . splitFileName dropFileName = fst . splitFileName
-- | Get the file name, without a trailing extension -- | Get the file name, without a trailing extension
-- --
-- >>> takeBaseName "path/file.tar.gz" -- >>> takeBaseName "path/file.tar.gz"
@@ -288,6 +394,7 @@ dropFileName = fst . splitFileName
takeBaseName :: RawFilePath -> ByteString takeBaseName :: RawFilePath -> ByteString
takeBaseName = dropExtension . takeFileName takeBaseName = dropExtension . takeFileName
-- | Change the base name -- | Change the base name
-- --
-- >>> replaceBaseName "path/file.tar.gz" "bob" -- >>> replaceBaseName "path/file.tar.gz" "bob"
@@ -300,6 +407,7 @@ replaceBaseName path name = combineRaw dir (name <.> ext)
(dir,file) = splitFileNameRaw path (dir,file) = splitFileNameRaw path
ext = takeExtension file ext = takeExtension file
-- | Get the directory, moving up one level if it's already a directory -- | Get the directory, moving up one level if it's already a directory
-- --
-- >>> takeDirectory "path/file.txt" -- >>> takeDirectory "path/file.txt"
@@ -319,12 +427,14 @@ takeDirectory x = case () of
res = fst $ BS.spanEnd isPathSeparator file res = fst $ BS.spanEnd isPathSeparator file
file = dropFileName x file = dropFileName x
-- | Change the directory component of a 'RawFilePath' -- | Change the directory component of a 'RawFilePath'
-- --
-- prop> \path -> replaceDirectory path (takeDirectory path) `equalFilePath` path || takeDirectory path == "." -- prop> \path -> replaceDirectory path (takeDirectory path) `equalFilePath` path || takeDirectory path == "."
replaceDirectory :: RawFilePath -> ByteString -> RawFilePath replaceDirectory :: RawFilePath -> ByteString -> RawFilePath
replaceDirectory file dir = combineRaw dir (takeFileName file) replaceDirectory file dir = combineRaw dir (takeFileName file)
-- | Join two paths together -- | Join two paths together
-- --
-- >>> combine "/" "file" -- >>> combine "/" "file"
@@ -337,6 +447,7 @@ combine :: RawFilePath -> RawFilePath -> RawFilePath
combine a b | not (BS.null b) && isPathSeparator (BS.head b) = b combine a b | not (BS.null b) && isPathSeparator (BS.head b) = b
| otherwise = combineRaw a b | otherwise = combineRaw a b
-- | Operator version of combine -- | Operator version of combine
(</>) :: RawFilePath -> RawFilePath -> RawFilePath (</>) :: RawFilePath -> RawFilePath -> RawFilePath
(</>) = combine (</>) = combine
@@ -358,6 +469,17 @@ splitPath = splitter
Nothing -> [x] Nothing -> [x]
Just runlen -> uncurry (:) . second splitter $ BS.splitAt (ix+1+runlen) x Just runlen -> uncurry (:) . second splitter $ BS.splitAt (ix+1+runlen) x
-- | Join a split path back together
--
-- prop> \path -> joinPath (splitPath path) == path
--
-- >>> joinPath ["path","to","file.txt"]
-- "path/to/file.txt"
joinPath :: [RawFilePath] -> RawFilePath
joinPath = foldr (</>) BS.empty
-- | Like 'splitPath', but without trailing slashes -- | Like 'splitPath', but without trailing slashes
-- --
-- >>> splitDirectories "/path/to/file.txt" -- >>> splitDirectories "/path/to/file.txt"
@@ -373,14 +495,60 @@ splitDirectories x
where where
splitter = filter (not . BS.null) . BS.split pathSeparator splitter = filter (not . BS.null) . BS.split pathSeparator
-- | Join a split path back together
------------------------
-- Trailing slash functions
-- | Check if the last character of a 'RawFilePath' is '/'.
-- --
-- prop> \path -> joinPath (splitPath path) == path -- >>> hasTrailingPathSeparator "/path/"
-- True
-- >>> hasTrailingPathSeparator "/"
-- True
-- >>> hasTrailingPathSeparator "/path"
-- False
hasTrailingPathSeparator :: RawFilePath -> Bool
hasTrailingPathSeparator x
| BS.null x = False
| otherwise = isPathSeparator $ BS.last x
-- | Add a trailing path separator.
-- --
-- >>> joinPath ["path","to","file.txt"] -- >>> addTrailingPathSeparator "/path"
-- "path/to/file.txt" -- "/path/"
joinPath :: [RawFilePath] -> RawFilePath -- >>> addTrailingPathSeparator "/path/"
joinPath = foldr (</>) BS.empty -- "/path/"
-- >>> addTrailingPathSeparator "/"
-- "/"
addTrailingPathSeparator :: RawFilePath -> RawFilePath
addTrailingPathSeparator x = if hasTrailingPathSeparator x
then x
else x `BS.snoc` pathSeparator
-- | Remove a trailing path separator
--
-- >>> dropTrailingPathSeparator "/path/"
-- "/path"
-- >>> dropTrailingPathSeparator "/path////"
-- "/path"
-- >>> dropTrailingPathSeparator "/"
-- "/"
-- >>> dropTrailingPathSeparator "//"
-- "/"
dropTrailingPathSeparator :: RawFilePath -> RawFilePath
dropTrailingPathSeparator x
| x == BS.singleton pathSeparator = x
| otherwise = if hasTrailingPathSeparator x
then dropTrailingPathSeparator $ BS.init x
else x
------------------------
-- File name manipulations
-- |Normalise a file. -- |Normalise a file.
@@ -436,54 +604,80 @@ normalise filepath =
dropDots :: [ByteString] -> [ByteString] dropDots :: [ByteString] -> [ByteString]
dropDots = filter (BS.singleton _period /=) dropDots = filter (BS.singleton _period /=)
------------------------
-- trailing path separators
-- | Check if the last character of a 'RawFilePath' is '/'.
-- | Contract a filename, based on a relative path. Note that the resulting
-- path will never introduce @..@ paths, as the presence of symlinks
-- means @..\/b@ may not reach @a\/b@ if it starts from @a\/c@. For a
-- worked example see
-- <http://neilmitchell.blogspot.co.uk/2015/10/filepaths-are-subtle-symlinks-are-hard.html this blog post>.
-- --
-- >>> hasTrailingPathSeparator "/path/" -- >>> makeRelative "/directory" "/directory/file.ext"
-- "file.ext"
-- >>> makeRelative "/Home" "/home/bob"
-- "/home/bob"
-- >>> makeRelative "/home/" "/home/bob/foo/bar"
-- "bob/foo/bar"
-- >>> makeRelative "/fred" "bob"
-- "bob"
-- >>> makeRelative "/file/test" "/file/test/fred"
-- "fred"
-- >>> makeRelative "/file/test" "/file/test/fred/"
-- "fred/"
-- >>> makeRelative "some/path" "some/path/a/b/c"
-- "a/b/c"
--
-- prop> \p -> makeRelative p p == "."
-- prop> \p -> makeRelative (takeDirectory p) p `equalFilePath` takeFileName p
-- prop \x y -> equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y </> makeRelative y x) x
makeRelative :: RawFilePath -> RawFilePath -> RawFilePath
makeRelative root path
| equalFilePath root path = BS.singleton _period
| takeAbs root /= takeAbs path = path
| otherwise = f (dropAbs root) (dropAbs path)
where
f x y
| BS.null x = BS.dropWhile isPathSeparator y
| otherwise = let (x1,x2) = g x
(y1,y2) = g y
in if equalFilePath x1 y1 then f x2 y2 else path
g x = (BS.dropWhile isPathSeparator a, BS.dropWhile isPathSeparator b)
where (a, b) = BS.break isPathSeparator $ BS.dropWhile isPathSeparator x
dropAbs x = snd $ BS.span (== _slash) x
takeAbs x = fst $ BS.span (== _slash) x
-- |Equality of two filepaths. The filepaths are normalised
-- and trailing path separators are dropped.
--
-- >>> equalFilePath "foo" "foo"
-- True -- True
-- >>> hasTrailingPathSeparator "/" -- >>> equalFilePath "foo" "foo/"
-- True -- True
-- >>> hasTrailingPathSeparator "/path" -- >>> equalFilePath "foo" "./foo"
-- True
-- >>> equalFilePath "" ""
-- True
-- >>> equalFilePath "foo" "/foo"
-- False
-- >>> equalFilePath "foo" "FOO"
-- False
-- >>> equalFilePath "foo" "../foo"
-- False -- False
hasTrailingPathSeparator :: RawFilePath -> Bool
hasTrailingPathSeparator x
| BS.null x = False
| otherwise = isPathSeparator $ BS.last x
-- | Add a trailing path separator.
-- --
-- >>> addTrailingPathSeparator "/path" -- prop> \p -> equalFilePath p p
-- "/path/" equalFilePath :: RawFilePath -> RawFilePath -> Bool
-- >>> addTrailingPathSeparator "/path/" equalFilePath p1 p2 = f p1 == f p2
-- "/path/" where
-- >>> addTrailingPathSeparator "/" f x = dropTrailingPathSeparator $ normalise x
-- "/"
addTrailingPathSeparator :: RawFilePath -> RawFilePath
addTrailingPathSeparator x = if hasTrailingPathSeparator x
then x
else x `BS.snoc` pathSeparator
-- | Remove a trailing path separator
-- | Check if a path is relative
-- --
-- >>> dropTrailingPathSeparator "/path/" -- prop> \path -> isRelative path /= isAbsolute path
-- "/path" isRelative :: RawFilePath -> Bool
-- >>> dropTrailingPathSeparator "/path////" isRelative = not . isAbsolute
-- "/path"
-- >>> dropTrailingPathSeparator "/"
-- "/"
-- >>> dropTrailingPathSeparator "//"
-- "/"
dropTrailingPathSeparator :: RawFilePath -> RawFilePath
dropTrailingPathSeparator x
| x == BS.singleton pathSeparator = x
| otherwise = if hasTrailingPathSeparator x
then dropTrailingPathSeparator $ BS.init x
else x
------------------------
-- Filename/system stuff
-- | Check if a path is absolute -- | Check if a path is absolute
-- --
@@ -498,11 +692,6 @@ isAbsolute x
| BS.length x > 0 = isPathSeparator (BS.head x) | BS.length x > 0 = isPathSeparator (BS.head x)
| otherwise = False | otherwise = False
-- | Check if a path is relative
--
-- prop> \path -> isRelative path /= isAbsolute path
isRelative :: RawFilePath -> Bool
isRelative = not . isAbsolute
-- | Is a FilePath valid, i.e. could you create a file like it? -- | Is a FilePath valid, i.e. could you create a file like it?
-- --
@@ -518,6 +707,22 @@ isValid filepath
| _nul `BS.elem` filepath = False | _nul `BS.elem` filepath = False
| otherwise = True | otherwise = True
-- | Take a FilePath and make it valid; does not change already valid FilePaths.
--
-- >>> makeValid ""
-- "_"
-- >>> makeValid "file\0name"
-- "file_name"
--
-- prop> \p -> if isValid p then makeValid p == p else makeValid p /= p
-- prop> \p -> isValid (makeValid p)
makeValid :: RawFilePath -> RawFilePath
makeValid path
| BS.null path = BS.singleton _underscore
| otherwise = BS.map (\x -> if x == _nul then _underscore else x) path
-- | Is the given path a valid filename? This includes -- | Is the given path a valid filename? This includes
-- "." and "..". -- "." and "..".
-- --
@@ -539,6 +744,7 @@ isFileName filepath =
not (BS.null filepath) && not (BS.null filepath) &&
not (_nul `BS.elem` filepath) not (_nul `BS.elem` filepath)
-- | Check if the filepath has any parent directories in it. -- | Check if the filepath has any parent directories in it.
-- --
-- >>> hasParentDir "/.." -- >>> hasParentDir "/.."
@@ -570,28 +776,6 @@ hasParentDir filepath =
where where
pathDoubleDot = BS.pack [_period, _period] pathDoubleDot = BS.pack [_period, _period]
-- |Equality of two filepaths. The filepaths are normalised
-- and trailing path separators are dropped.
--
-- >>> equalFilePath "foo" "foo"
-- True
-- >>> equalFilePath "foo" "foo/"
-- True
-- >>> equalFilePath "foo" "./foo"
-- True
-- >>> equalFilePath "foo" "/foo"
-- False
-- >>> equalFilePath "foo" "FOO"
-- False
-- >>> equalFilePath "foo" "../foo"
-- False
--
-- prop> \p -> equalFilePath p p
equalFilePath :: RawFilePath -> RawFilePath -> Bool
equalFilePath p1 p2 = f p1 == f p2
where
f x = dropTrailingPathSeparator $ normalise x
-- | Whether the file is a hidden file. -- | Whether the file is a hidden file.
-- --
@@ -620,6 +804,8 @@ hiddenFile fp
where where
fn = takeFileName fp fn = takeFileName fp
------------------------ ------------------------
-- internal stuff -- internal stuff

View File

@@ -17,50 +17,59 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString) import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/HPath/IO/canonicalizePathSpec/"
specDir' :: String setupFiles :: IO ()
specDir' = toString specDir 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 :: Spec
spec = spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.canonicalizePath" $ do describe "HPath.IO.canonicalizePath" $ do
-- successes -- -- successes --
it "canonicalizePath, all fine" $ do it "canonicalizePath, all fine" $ do
path <- withPwd (specDir `ba` "file") return path <- withTmpDir "file" return
canonicalizePath' (specDir `ba` "file") canonicalizePath' "file"
`shouldReturn` path `shouldReturn` path
it "canonicalizePath, all fine" $ do it "canonicalizePath, all fine" $ do
path <- withPwd (specDir `ba` "dir") return path <- withTmpDir "dir" return
canonicalizePath' (specDir `ba` "dir") canonicalizePath' "dir"
`shouldReturn` path `shouldReturn` path
it "canonicalizePath, all fine" $ do it "canonicalizePath, all fine" $ do
path <- withPwd (specDir `ba` "file") return path <- withTmpDir "file" return
canonicalizePath' (specDir `ba` "fileSym") canonicalizePath' "fileSym"
`shouldReturn` path `shouldReturn` path
it "canonicalizePath, all fine" $ do it "canonicalizePath, all fine" $ do
path <- withPwd (specDir `ba` "dir") return path <- withTmpDir "dir" return
canonicalizePath' (specDir `ba` "dirSym") canonicalizePath' "dirSym"
`shouldReturn` path `shouldReturn` path
-- posix failures -- -- posix failures --
it "canonicalizePath, broken symlink" $ it "canonicalizePath, broken symlink" $
canonicalizePath' (specDir `ba` "brokenSym") canonicalizePath' "brokenSym"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "canonicalizePath, file does not exist" $ it "canonicalizePath, file does not exist" $
canonicalizePath' (specDir `ba` "nothingBlah") canonicalizePath' "nothingBlah"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)

View File

@@ -1,5 +1,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module HPath.IO.CopyDirRecursiveOverwriteSpec where module HPath.IO.CopyDirRecursiveOverwriteSpec where
@@ -20,91 +21,149 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString) import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString setupFiles :: IO ()
specDir = "test/HPath/IO/copyDirRecursiveOverwriteSpec/" 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"
specDir' :: String
specDir' = toString specDir
spec :: Spec spec :: Spec
spec = spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.copyDirRecursiveOverwrite" $ do describe "HPath.IO.copyDirRecursiveOverwrite" $ do
-- successes -- -- successes --
it "copyDirRecursiveOverwrite, all fine" $ do it "copyDirRecursiveOverwrite, all fine" $ do
copyDirRecursiveOverwrite' (specDir `ba` "inputDir") copyDirRecursiveOverwrite' "inputDir"
(specDir `ba` "outputDir") "outputDir"
removeDirIfExists $ specDir `ba` "outputDir" removeDirIfExists "outputDir"
it "copyDirRecursiveOverwrite, all fine and compare" $ do it "copyDirRecursiveOverwrite, all fine and compare" $ do
copyDirRecursiveOverwrite' (specDir `ba` "inputDir") copyDirRecursiveOverwrite' "inputDir"
(specDir `ba` "outputDir") "outputDir"
(system $ "diff -r --no-dereference " (system $ "diff -r --no-dereference "
++ specDir' ++ "inputDir" ++ " " ++ toString tmpDir ++ "inputDir" ++ " "
++ specDir' ++ "outputDir") ++ toString tmpDir ++ "outputDir")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeDirIfExists $ specDir `ba` "outputDir" removeDirIfExists "outputDir"
it "copyDirRecursiveOverwrite, destination dir already exists" $ it "copyDirRecursiveOverwrite, destination dir already exists" $ do
copyDirRecursiveOverwrite' (specDir `ba` "inputDir") (system $ "diff -r --no-dereference "
(specDir `ba` "alreadyExistsD") ++ toString tmpDir ++ "inputDir" ++ " "
++ toString tmpDir ++ "alreadyExistsD")
`shouldReturn` (ExitFailure 1)
copyDirRecursiveOverwrite' "inputDir"
"alreadyExistsD"
(system $ "diff -r --no-dereference "
++ toString tmpDir ++ "inputDir" ++ " "
++ toString tmpDir ++ "alreadyExistsD")
`shouldReturn` ExitSuccess
removeDirIfExists "outputDir"
-- posix failures -- -- posix failures --
it "copyDirRecursiveOverwrite, source directory does not exist" $ it "copyDirRecursiveOverwrite, source directory does not exist" $
copyDirRecursiveOverwrite' (specDir `ba` "doesNotExist") copyDirRecursiveOverwrite' "doesNotExist"
(specDir `ba` "outputDir") "outputDir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "copyDirRecursiveOverwrite, no write permission on output dir" $ it "copyDirRecursiveOverwrite, no write permission on output dir" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir") copyDirRecursiveOverwrite' "inputDir"
(specDir `ba` "noWritePerm/foo") "noWritePerm/foo"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursiveOverwrite, cannot open output dir" $ it "copyDirRecursiveOverwrite, cannot open output dir" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir") copyDirRecursiveOverwrite' "inputDir"
(specDir `ba` "noPerms/foo") "noPerms/foo"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursiveOverwrite, cannot open source dir" $ it "copyDirRecursiveOverwrite, cannot open source dir" $
copyDirRecursiveOverwrite' (specDir `ba` "noPerms/inputDir") copyDirRecursiveOverwrite' "noPerms/inputDir"
(specDir `ba` "foo") "foo"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursiveOverwrite, destination already exists and is a file" $ it "copyDirRecursiveOverwrite, destination already exists and is a file" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir") copyDirRecursiveOverwrite' "inputDir"
(specDir `ba` "alreadyExists") "alreadyExists"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursiveOverwrite, wrong input (regular file)" $ it "copyDirRecursiveOverwrite, wrong input (regular file)" $
copyDirRecursiveOverwrite' (specDir `ba` "wrongInput") copyDirRecursiveOverwrite' "wrongInput"
(specDir `ba` "outputDir") "outputDir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursiveOverwrite, wrong input (symlink to directory)" $ it "copyDirRecursiveOverwrite, wrong input (symlink to directory)" $
copyDirRecursiveOverwrite' (specDir `ba` "wrongInputSymL") copyDirRecursiveOverwrite' "wrongInputSymL"
(specDir `ba` "outputDir") "outputDir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
-- custom failures -- custom failures
it "copyDirRecursiveOverwrite, destination in source" $ it "copyDirRecursiveOverwrite, destination in source" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir") copyDirRecursiveOverwrite' "inputDir"
(specDir `ba` "inputDir/foo") "inputDir/foo"
`shouldThrow` `shouldThrow`
isDestinationInSource isDestinationInSource
it "copyDirRecursiveOverwrite, destination and source same directory" $ it "copyDirRecursiveOverwrite, destination and source same directory" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir") copyDirRecursiveOverwrite' "inputDir"
(specDir `ba` "inputDir") "inputDir"
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -1,5 +1,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module HPath.IO.CopyDirRecursiveSpec where module HPath.IO.CopyDirRecursiveSpec where
@@ -20,93 +21,130 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString) import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/HPath/IO/copyDirRecursiveSpec/"
specDir' :: String
specDir' = toString specDir 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 :: Spec
spec = spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.copyDirRecursive" $ do describe "HPath.IO.copyDirRecursive" $ do
-- successes -- -- successes --
it "copyDirRecursive, all fine" $ do it "copyDirRecursive, all fine" $ do
copyDirRecursive' (specDir `ba` "inputDir") copyDirRecursive' "inputDir"
(specDir `ba` "outputDir") "outputDir"
removeDirIfExists (specDir `ba` "outputDir") removeDirIfExists "outputDir"
it "copyDirRecursive, all fine and compare" $ do it "copyDirRecursive, all fine and compare" $ do
copyDirRecursive' (specDir `ba` "inputDir") copyDirRecursive' "inputDir"
(specDir `ba` "outputDir") "outputDir"
(system $ "diff -r --no-dereference " (system $ "diff -r --no-dereference "
++ specDir' ++ "inputDir" ++ " " ++ toString tmpDir ++ "inputDir" ++ " "
++ specDir' ++ "outputDir") ++ toString tmpDir ++ "outputDir")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeDirIfExists (specDir `ba` "outputDir") removeDirIfExists "outputDir"
-- posix failures -- -- posix failures --
it "copyDirRecursive, source directory does not exist" $ it "copyDirRecursive, source directory does not exist" $
copyDirRecursive' (specDir `ba` "doesNotExist") copyDirRecursive' "doesNotExist"
(specDir `ba` "outputDir") "outputDir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "copyDirRecursive, no write permission on output dir" $ it "copyDirRecursive, no write permission on output dir" $
copyDirRecursive' (specDir `ba` "inputDir") copyDirRecursive' "inputDir"
(specDir `ba` "noWritePerm/foo") "noWritePerm/foo"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, cannot open output dir" $ it "copyDirRecursive, cannot open output dir" $
copyDirRecursive' (specDir `ba` "inputDir") copyDirRecursive' "inputDir"
(specDir `ba` "noPerms/foo") "noPerms/foo"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, cannot open source dir" $ it "copyDirRecursive, cannot open source dir" $
copyDirRecursive' (specDir `ba` "noPerms/inputDir") copyDirRecursive' "noPerms/inputDir"
(specDir `ba` "foo") "foo"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, destination dir already exists" $ it "copyDirRecursive, destination dir already exists" $
copyDirRecursive' (specDir `ba` "inputDir") copyDirRecursive' "inputDir"
(specDir `ba` "alreadyExistsD") "alreadyExistsD"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
it "copyDirRecursive, destination already exists and is a file" $ it "copyDirRecursive, destination already exists and is a file" $
copyDirRecursive' (specDir `ba` "inputDir") copyDirRecursive' "inputDir"
(specDir `ba` "alreadyExists") "alreadyExists"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
it "copyDirRecursive, wrong input (regular file)" $ it "copyDirRecursive, wrong input (regular file)" $
copyDirRecursive' (specDir `ba` "wrongInput") copyDirRecursive' "wrongInput"
(specDir `ba` "outputDir") "outputDir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursive, wrong input (symlink to directory)" $ it "copyDirRecursive, wrong input (symlink to directory)" $
copyDirRecursive' (specDir `ba` "wrongInputSymL") copyDirRecursive' "wrongInputSymL"
(specDir `ba` "outputDir") "outputDir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
-- custom failures -- custom failures
it "copyDirRecursive, destination in source" $ it "copyDirRecursive, destination in source" $
copyDirRecursive' (specDir `ba` "inputDir") copyDirRecursive' "inputDir"
(specDir `ba` "inputDir/foo") "inputDir/foo"
`shouldThrow` `shouldThrow`
isDestinationInSource isDestinationInSource
it "copyDirRecursive, destination and source same directory" $ it "copyDirRecursive, destination and source same directory" $
copyDirRecursive' (specDir `ba` "inputDir") copyDirRecursive' "inputDir"
(specDir `ba` "inputDir") "inputDir"
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -20,90 +20,110 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString) import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString setupFiles :: IO ()
ba = BS.append 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"
specDir :: BS.ByteString
specDir = "test/HPath/IO/copyFileOverwriteSpec/"
specDir' :: String cleanupFiles :: IO ()
specDir' = toString specDir 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 :: Spec
spec = spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.copyFileOverwrite" $ do describe "HPath.IO.copyFileOverwrite" $ do
-- successes -- -- successes --
it "copyFileOverwrite, everything clear" $ do it "copyFileOverwrite, everything clear" $ do
copyFileOverwrite' (specDir `ba` "inputFile") copyFileOverwrite' "inputFile"
(specDir `ba` "outputFile") "outputFile"
removeFileIfExists (specDir `ba` "outputFile") removeFileIfExists "outputFile"
it "copyFileOverwrite, output file already exists, all clear" $ do it "copyFileOverwrite, output file already exists, all clear" $ do
copyFile' (specDir `ba` "alreadyExists") (specDir `ba` "alreadyExists.bak") copyFile' "alreadyExists" "alreadyExists.bak"
copyFileOverwrite' (specDir `ba` "inputFile") copyFileOverwrite' "inputFile"
(specDir `ba` "alreadyExists") "alreadyExists"
(system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " " (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " "
++ specDir' ++ "alreadyExists") ++ toString tmpDir ++ "alreadyExists")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeFileIfExists (specDir `ba` "alreadyExists") removeFileIfExists "alreadyExists"
copyFile' (specDir `ba` "alreadyExists.bak") (specDir `ba` "alreadyExists") copyFile' "alreadyExists.bak" "alreadyExists"
removeFileIfExists (specDir `ba` "alreadyExists.bak") removeFileIfExists "alreadyExists.bak"
it "copyFileOverwrite, and compare" $ do it "copyFileOverwrite, and compare" $ do
copyFileOverwrite' (specDir `ba` "inputFile") copyFileOverwrite' "inputFile"
(specDir `ba` "outputFile") "outputFile"
(system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " " (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " "
++ specDir' ++ "outputFile") ++ toString tmpDir ++ "outputFile")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeFileIfExists (specDir `ba` "outputFile") removeFileIfExists "outputFile"
-- posix failures -- -- posix failures --
it "copyFileOverwrite, input file does not exist" $ it "copyFileOverwrite, input file does not exist" $
copyFileOverwrite' (specDir `ba` "noSuchFile") copyFileOverwrite' "noSuchFile"
(specDir `ba` "outputFile") "outputFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "copyFileOverwrite, no permission to write to output directory" $ it "copyFileOverwrite, no permission to write to output directory" $
copyFileOverwrite' (specDir `ba` "inputFile") copyFileOverwrite' "inputFile"
(specDir `ba` "outputDirNoWrite/outputFile") "outputDirNoWrite/outputFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFileOverwrite, cannot open output directory" $ it "copyFileOverwrite, cannot open output directory" $
copyFileOverwrite' (specDir `ba` "inputFile") copyFileOverwrite' "inputFile"
(specDir `ba` "noPerms/outputFile") "noPerms/outputFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFileOverwrite, cannot open source directory" $ it "copyFileOverwrite, cannot open source directory" $
copyFileOverwrite' (specDir `ba` "noPerms/inputFile") copyFileOverwrite' "noPerms/inputFile"
(specDir `ba` "outputFile") "outputFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFileOverwrite, wrong input type (symlink)" $ it "copyFileOverwrite, wrong input type (symlink)" $
copyFileOverwrite' (specDir `ba` "inputFileSymL") copyFileOverwrite' "inputFileSymL"
(specDir `ba` "outputFile") "outputFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
it "copyFileOverwrite, wrong input type (directory)" $ it "copyFileOverwrite, wrong input type (directory)" $
copyFileOverwrite' (specDir `ba` "wrongInput") copyFileOverwrite' "wrongInput"
(specDir `ba` "outputFile") "outputFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "copyFileOverwrite, output file already exists and is a dir" $ it "copyFileOverwrite, output file already exists and is a dir" $
copyFileOverwrite' (specDir `ba` "inputFile") copyFileOverwrite' "inputFile"
(specDir `ba` "alreadyExistsD") "alreadyExistsD"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
-- custom failures -- -- custom failures --
it "copyFileOverwrite, output and input are same file" $ it "copyFileOverwrite, output and input are same file" $
copyFileOverwrite' (specDir `ba` "inputFile") copyFileOverwrite' "inputFile"
(specDir `ba` "inputFile") "inputFile"
`shouldThrow` isSameFile `shouldThrow` isSameFile

View File

@@ -1,5 +1,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module HPath.IO.CopyFileSpec where module HPath.IO.CopyFileSpec where
@@ -20,86 +21,105 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString) import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString setupFiles :: IO ()
ba = BS.append 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"
specDir :: BS.ByteString
specDir = "test/HPath/IO/copyFileSpec/"
specDir' :: String cleanupFiles :: IO ()
specDir' = toString specDir 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 :: Spec
spec = spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.copyFile" $ do describe "HPath.IO.copyFile" $ do
-- successes -- -- successes --
it "copyFile, everything clear" $ do it "copyFile, everything clear" $ do
copyFile' (specDir `ba` "inputFile") copyFile' "inputFile"
(specDir `ba` "outputFile") "outputFile"
removeFileIfExists (specDir `ba` "outputFile") removeFileIfExists "outputFile"
it "copyFile, and compare" $ do it "copyFile, and compare" $ do
copyFile' (specDir `ba` "inputFile") copyFile' "inputFile"
(specDir `ba` "outputFile") "outputFile"
(system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " " (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " "
++ specDir' ++ "outputFile") ++ toString tmpDir ++ "outputFile")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeFileIfExists (specDir `ba` "outputFile") removeFileIfExists "outputFile"
-- posix failures -- -- posix failures --
it "copyFile, input file does not exist" $ it "copyFile, input file does not exist" $
copyFile' (specDir `ba` "noSuchFile") copyFile' "noSuchFile"
(specDir `ba` "outputFile") "outputFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "copyFile, no permission to write to output directory" $ it "copyFile, no permission to write to output directory" $
copyFile' (specDir `ba` "inputFile") copyFile' "inputFile"
(specDir `ba` "outputDirNoWrite/outputFile") "outputDirNoWrite/outputFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile, cannot open output directory" $ it "copyFile, cannot open output directory" $
copyFile' (specDir `ba` "inputFile") copyFile' "inputFile"
(specDir `ba` "noPerms/outputFile") "noPerms/outputFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile, cannot open source directory" $ it "copyFile, cannot open source directory" $
copyFile' (specDir `ba` "noPerms/inputFile") copyFile' "noPerms/inputFile"
(specDir `ba` "outputFile") "outputFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile, wrong input type (symlink)" $ it "copyFile, wrong input type (symlink)" $
copyFile' (specDir `ba` "inputFileSymL") copyFile' "inputFileSymL"
(specDir `ba` "outputFile") "outputFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
it "copyFile, wrong input type (directory)" $ it "copyFile, wrong input type (directory)" $
copyFile' (specDir `ba` "wrongInput") copyFile' "wrongInput"
(specDir `ba` "outputFile") "outputFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "copyFile, output file already exists" $ it "copyFile, output file already exists" $
copyFile' (specDir `ba` "inputFile") copyFile' "inputFile"
(specDir `ba` "alreadyExists") "alreadyExists"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
it "copyFile, output file already exists and is a dir" $ it "copyFile, output file already exists and is a dir" $
copyFile' (specDir `ba` "inputFile") copyFile' "inputFile"
(specDir `ba` "alreadyExistsD") "alreadyExistsD"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
-- custom failures -- -- custom failures --
it "copyFile, output and input are same file" $ it "copyFile, output and input are same file" $
copyFile' (specDir `ba` "inputFile") copyFile' "inputFile"
(specDir `ba` "inputFile") "inputFile"
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -17,38 +17,47 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString) import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString setupFiles :: IO ()
ba = BS.append setupFiles = do
createDir' "alreadyExists"
createDir' "noPerms"
createDir' "noWritePerms"
noPerms "noPerms"
noWritableDirPerms "noWritePerms"
specDir :: BS.ByteString
specDir = "test/HPath/IO/createDirSpec/"
specDir' :: String
specDir' = toString specDir cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerms"
deleteDir' "alreadyExists"
deleteDir' "noPerms"
deleteDir' "noWritePerms"
spec :: Spec spec :: Spec
spec = spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.createDir" $ do describe "HPath.IO.createDir" $ do
-- successes -- -- successes --
it "createDir, all fine" $ do it "createDir, all fine" $ do
createDir' (specDir `ba` "newDir") createDir' "newDir"
removeDirIfExists (specDir `ba` "newDir") removeDirIfExists "newDir"
-- posix failures -- -- posix failures --
it "createDir, can't write to output directory" $ it "createDir, can't write to output directory" $
createDir' (specDir `ba` "noWritePerms/newDir") createDir' "noWritePerms/newDir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "createDir, can't open output directory" $ it "createDir, can't open output directory" $
createDir' (specDir `ba` "noPerms/newDir") createDir' "noPerms/newDir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "createDir, destination directory already exists" $ it "createDir, destination directory already exists" $
createDir' (specDir `ba` "alreadyExists") createDir' "alreadyExists"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)

View File

@@ -17,38 +17,47 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString) import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString setupFiles :: IO ()
ba = BS.append setupFiles = do
createRegularFile' "alreadyExists"
createDir' "noPerms"
createDir' "noWritePerms"
noPerms "noPerms"
noWritableDirPerms "noWritePerms"
specDir :: BS.ByteString
specDir = "test/HPath/IO/createRegularFileSpec/"
specDir' :: String
specDir' = toString specDir cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerms"
deleteFile' "alreadyExists"
deleteDir' "noPerms"
deleteDir' "noWritePerms"
spec :: Spec spec :: Spec
spec = spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.createRegularFile" $ do describe "HPath.IO.createRegularFile" $ do
-- successes -- -- successes --
it "createRegularFile, all fine" $ do it "createRegularFile, all fine" $ do
createRegularFile' (specDir `ba` "newDir") createRegularFile' "newDir"
removeFileIfExists (specDir `ba` "newDir") removeFileIfExists "newDir"
-- posix failures -- -- posix failures --
it "createRegularFile, can't write to destination directory" $ it "createRegularFile, can't write to destination directory" $
createRegularFile' (specDir `ba` "noWritePerms/newDir") createRegularFile' "noWritePerms/newDir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "createRegularFile, can't write to destination directory" $ it "createRegularFile, can't write to destination directory" $
createRegularFile' (specDir `ba` "noPerms/newDir") createRegularFile' "noPerms/newDir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "createRegularFile, destination file already exists" $ it "createRegularFile, destination file already exists" $
createRegularFile' (specDir `ba` "alreadyExists") createRegularFile' "alreadyExists"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)

View File

@@ -0,0 +1,63 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.CreateSymlinkSpec where
import Test.Hspec
import HPath.IO.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
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 = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.createSymlink" $ do
-- successes --
it "createSymlink, all fine" $ do
createSymlink' "newSymL" "alreadyExists/"
removeFileIfExists "newSymL"
-- posix failures --
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)

View File

@@ -21,76 +21,90 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString) import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString setupFiles :: IO ()
ba = BS.append setupFiles = do
createRegularFile' "file"
createDir' "dir"
createRegularFile' "dir/.keep"
createSymlink' "dirSym" "dir/"
createDir' "noPerms"
createRegularFile' "noPerms/.keep"
createDir' "noWritable"
createRegularFile' "noWritable/.keep"
specDir :: BS.ByteString
specDir = "test/HPath/IO/deleteDirRecursiveSpec/"
specDir' :: String cleanupFiles :: IO ()
specDir' = toString specDir cleanupFiles = do
deleteFile' "file"
deleteFile' "dir/.keep"
deleteDir' "dir"
deleteFile' "dirSym"
deleteFile' "noPerms/.keep"
deleteDir' "noPerms"
deleteFile' "noWritable/.keep"
deleteDir' "noWritable"
spec :: Spec spec :: Spec
spec = spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.deleteDirRecursive" $ do describe "HPath.IO.deleteDirRecursive" $ do
-- successes -- -- successes --
it "deleteDirRecursive, empty directory, all fine" $ do it "deleteDirRecursive, empty directory, all fine" $ do
createDir' (specDir `ba` "testDir") createDir' "testDir"
deleteDirRecursive' (specDir `ba` "testDir") deleteDirRecursive' "testDir"
getSymbolicLinkStatus (specDir `ba` "testDir") getSymbolicLinkStatus "testDir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "deleteDirRecursive, empty directory with null permissions, all fine" $ do it "deleteDirRecursive, empty directory with null permissions, all fine" $ do
createDir' (specDir `ba` "noPerms/testDir") createDir' "noPerms/testDir"
noPerms (specDir `ba` "noPerms/testDir") noPerms "noPerms/testDir"
deleteDirRecursive' (specDir `ba` "noPerms/testDir") deleteDirRecursive' "noPerms/testDir"
it "deleteDirRecursive, non-empty directory, all fine" $ do it "deleteDirRecursive, non-empty directory, all fine" $ do
createDir' (specDir `ba` "nonEmpty") createDir' "nonEmpty"
createDir' (specDir `ba` "nonEmpty/dir1") createDir' "nonEmpty/dir1"
createDir' (specDir `ba` "nonEmpty/dir2") createDir' "nonEmpty/dir2"
createDir' (specDir `ba` "nonEmpty/dir2/dir3") createDir' "nonEmpty/dir2/dir3"
createRegularFile' (specDir `ba` "nonEmpty/file1") createRegularFile' "nonEmpty/file1"
createRegularFile' (specDir `ba` "nonEmpty/dir1/file2") createRegularFile' "nonEmpty/dir1/file2"
deleteDirRecursive' (specDir `ba` "nonEmpty") deleteDirRecursive' "nonEmpty"
getSymbolicLinkStatus (specDir `ba` "nonEmpty") getSymbolicLinkStatus "nonEmpty"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
-- posix failures -- -- posix failures --
it "deleteDirRecursive, can't open parent directory" $ do it "deleteDirRecursive, can't open parent directory" $ do
createDir' (specDir `ba` "noPerms/foo") createDir' "noPerms/foo"
noPerms (specDir `ba` "noPerms") noPerms "noPerms"
(deleteDirRecursive' (specDir `ba` "noPerms/foo") (deleteDirRecursive' "noPerms/foo")
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)) (\e -> ioeGetErrorType e == PermissionDenied)
>> normalDirPerms (specDir `ba` "noPerms") normalDirPerms "noPerms"
>> deleteDir' (specDir `ba` "noPerms/foo") deleteDir' "noPerms/foo"
it "deleteDirRecursive, can't write to parent directory" $ do it "deleteDirRecursive, can't write to parent directory" $ do
createDir' (specDir `ba` "noWritable/foo") createDir' "noWritable/foo"
noWritableDirPerms (specDir `ba` "noWritable") noWritableDirPerms "noWritable"
(deleteDirRecursive' (specDir `ba` "noWritable/foo") (deleteDirRecursive' "noWritable/foo")
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)) (\e -> ioeGetErrorType e == PermissionDenied)
normalDirPerms (specDir `ba` "noWritable") normalDirPerms "noWritable"
deleteDir' (specDir `ba` "noWritable/foo") deleteDir' "noWritable/foo"
it "deleteDirRecursive, wrong file type (symlink to directory)" $ it "deleteDirRecursive, wrong file type (symlink to directory)" $
deleteDirRecursive' (specDir `ba` "dirSym") deleteDirRecursive' "dirSym"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "deleteDirRecursive, wrong file type (regular file)" $ it "deleteDirRecursive, wrong file type (regular file)" $
deleteDirRecursive' (specDir `ba` "file") deleteDirRecursive' "file"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "deleteDirRecursive, directory does not exist" $ it "deleteDirRecursive, directory does not exist" $
deleteDirRecursive' (specDir `ba` "doesNotExist") deleteDirRecursive' "doesNotExist"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)

View File

@@ -21,74 +21,88 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString) import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString setupFiles :: IO ()
ba = BS.append setupFiles = do
createRegularFile' "file"
createDir' "dir"
createRegularFile' "dir/.keep"
createSymlink' "dirSym" "dir/"
createDir' "noPerms"
createRegularFile' "noPerms/.keep"
createDir' "noWritable"
createRegularFile' "noWritable/.keep"
specDir :: BS.ByteString
specDir = "test/HPath/IO/deleteDirSpec/"
specDir' :: String cleanupFiles :: IO ()
specDir' = toString specDir cleanupFiles = do
deleteFile' "file"
deleteFile' "dir/.keep"
deleteDir' "dir"
deleteFile' "dirSym"
deleteFile' "noPerms/.keep"
deleteDir' "noPerms"
deleteFile' "noWritable/.keep"
deleteDir' "noWritable"
spec :: Spec spec :: Spec
spec = spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.deleteDir" $ do describe "HPath.IO.deleteDir" $ do
-- successes -- -- successes --
it "deleteDir, empty directory, all fine" $ do it "deleteDir, empty directory, all fine" $ do
createDir' (specDir `ba` "testDir") createDir' "testDir"
deleteDir' (specDir `ba` "testDir") deleteDir' "testDir"
getSymbolicLinkStatus (specDir `ba` "testDir") getSymbolicLinkStatus "testDir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "deleteDir, directory with null permissions, all fine" $ do it "deleteDir, directory with null permissions, all fine" $ do
createDir' (specDir `ba` "noPerms/testDir") createDir' "noPerms/testDir"
noPerms (specDir `ba` "noPerms/testDir") noPerms "noPerms/testDir"
deleteDir' (specDir `ba` "noPerms/testDir") deleteDir' "noPerms/testDir"
getSymbolicLinkStatus (specDir `ba` "testDir") getSymbolicLinkStatus "testDir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
-- posix failures -- -- posix failures --
it "deleteDir, wrong file type (symlink to directory)" $ it "deleteDir, wrong file type (symlink to directory)" $
deleteDir' (specDir `ba` "dirSym") deleteDir' "dirSym"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "deleteDir, wrong file type (regular file)" $ it "deleteDir, wrong file type (regular file)" $
deleteDir' (specDir `ba` "file") deleteDir' "file"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "deleteDir, directory does not exist" $ it "deleteDir, directory does not exist" $
deleteDir' (specDir `ba` "doesNotExist") deleteDir' "doesNotExist"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "deleteDir, directory not empty" $ it "deleteDir, directory not empty" $
deleteDir' (specDir `ba` "dir") deleteDir' "dir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == UnsatisfiedConstraints) (\e -> ioeGetErrorType e == UnsatisfiedConstraints)
it "deleteDir, can't open parent directory" $ do it "deleteDir, can't open parent directory" $ do
createDir' (specDir `ba` "noPerms/foo") createDir' "noPerms/foo"
noPerms (specDir `ba` "noPerms") noPerms "noPerms"
(deleteDir' (specDir `ba` "noPerms/foo") (deleteDir' "noPerms/foo")
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)) (\e -> ioeGetErrorType e == PermissionDenied)
>> normalDirPerms (specDir `ba` "noPerms") normalDirPerms "noPerms"
>> deleteDir' (specDir `ba` "noPerms/foo") deleteDir' "noPerms/foo"
it "deleteDir, can't write to parent directory, still fine" $ do it "deleteDir, can't write to parent directory, still fine" $ do
createDir' (specDir `ba` "noWritable/foo") createDir' "noWritable/foo"
noWritableDirPerms (specDir `ba` "noWritable") noWritableDirPerms "noWritable"
(deleteDir' (specDir `ba` "noWritable/foo") (deleteDir' "noWritable/foo")
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)) (\e -> ioeGetErrorType e == PermissionDenied)
normalDirPerms (specDir `ba` "noWritable") normalDirPerms "noWritable"
deleteDir' (specDir `ba` "noWritable/foo") deleteDir' "noWritable/foo"

View File

@@ -21,49 +21,58 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString) import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString setupFiles :: IO ()
ba = BS.append setupFiles = do
createRegularFile' "foo"
createSymlink' "syml" "foo"
createDir' "dir"
createDir' "noPerms"
noPerms "noPerms"
specDir :: BS.ByteString
specDir = "test/HPath/IO/deleteFileSpec/"
specDir' :: String cleanupFiles :: IO ()
specDir' = toString specDir cleanupFiles = do
normalDirPerms "noPerms"
deleteFile' "foo"
deleteFile' "syml"
deleteDir' "dir"
deleteDir' "noPerms"
spec :: Spec spec :: Spec
spec = spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.deleteFile" $ do describe "HPath.IO.deleteFile" $ do
-- successes -- -- successes --
it "deleteFile, regular file, all fine" $ do it "deleteFile, regular file, all fine" $ do
createRegularFile' (specDir `ba` "testFile") createRegularFile' "testFile"
deleteFile' (specDir `ba` "testFile") deleteFile' "testFile"
getSymbolicLinkStatus (specDir `ba` "testFile") getSymbolicLinkStatus "testFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "deleteFile, symlink, all fine" $ do it "deleteFile, symlink, all fine" $ do
recreateSymlink' (specDir `ba` "syml") recreateSymlink' "syml"
(specDir `ba` "testFile") "testFile"
deleteFile' (specDir `ba` "testFile") deleteFile' "testFile"
getSymbolicLinkStatus (specDir `ba` "testFile") getSymbolicLinkStatus "testFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
-- posix failures -- -- posix failures --
it "deleteFile, wrong file type (directory)" $ it "deleteFile, wrong file type (directory)" $
deleteFile' (specDir `ba` "dir") deleteFile' "dir"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "deleteFile, file does not exist" $ it "deleteFile, file does not exist" $
deleteFile' (specDir `ba` "doesNotExist") deleteFile' "doesNotExist"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "deleteFile, can't read directory" $ it "deleteFile, can't read directory" $
deleteFile' (specDir `ba` "noPerms/blah") deleteFile' "noPerms/blah"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)

View File

@@ -16,6 +16,7 @@ import Data.Maybe
fromJust fromJust
) )
import qualified HPath as P import qualified HPath as P
import HPath.IO
import Test.Hspec import Test.Hspec
import System.IO.Error import System.IO.Error
( (
@@ -34,56 +35,71 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString) import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString setupFiles :: IO ()
ba = BS.append setupFiles = do
createRegularFile' "file"
createRegularFile' "Lala"
createRegularFile' ".hidden"
createSymlink' "syml" "Lala"
createDir' "dir"
createSymlink' "dirsym" "dir"
createDir' "noPerms"
noPerms "noPerms"
specDir :: BS.ByteString
specDir = "test/HPath/IO/getDirsFilesSpec/"
specDir' :: String cleanupFiles :: IO ()
specDir' = toString specDir cleanupFiles = do
normalDirPerms "noPerms"
deleteFile' "file"
deleteFile' "Lala"
deleteFile' ".hidden"
deleteFile' "syml"
deleteDir' "dir"
deleteFile' "dirsym"
deleteDir' "noPerms"
spec :: Spec spec :: Spec
spec = spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.getDirsFiles" $ do describe "HPath.IO.getDirsFiles" $ do
-- successes -- -- successes --
it "getDirsFiles, all fine" $ do it "getDirsFiles, all fine" $
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs withRawTmpDir $ \p -> do
expectedFiles <- mapM P.parseRel [(specDir `ba ` ".hidden") expectedFiles <- mapM P.parseRel [".hidden"
,(specDir `ba ` "Lala") ,"Lala"
,(specDir `ba ` "dir") ,"dir"
,(specDir `ba ` "dirsym") ,"dirsym"
,(specDir `ba ` "file") ,"file"
,(specDir `ba ` "noPerms") ,"noPerms"
,(specDir `ba ` "syml")] ,"syml"]
(fmap sort $ getDirsFiles' specDir) (fmap sort $ getDirsFiles p)
`shouldReturn` fmap (pwd P.</>) expectedFiles `shouldReturn` fmap (p P.</>) expectedFiles
-- posix failures -- -- posix failures --
it "getDirsFiles, nonexistent directory" $ it "getDirsFiles, nonexistent directory" $
getDirsFiles' (specDir `ba ` "nothingHere") getDirsFiles' "nothingHere"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "getDirsFiles, wrong file type (file)" $ it "getDirsFiles, wrong file type (file)" $
getDirsFiles' (specDir `ba ` "file") getDirsFiles' "file"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "getDirsFiles, wrong file type (symlink to file)" $ it "getDirsFiles, wrong file type (symlink to file)" $
getDirsFiles' (specDir `ba ` "syml") getDirsFiles' "syml"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
it "getDirsFiles, wrong file type (symlink to dir)" $ it "getDirsFiles, wrong file type (symlink to dir)" $
getDirsFiles' (specDir `ba ` "dirsym") getDirsFiles' "dirsym"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
it "getDirsFiles, can't open directory" $ it "getDirsFiles, can't open directory" $
getDirsFiles' (specDir `ba ` "noPerms") getDirsFiles' "noPerms"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)

View File

@@ -18,53 +18,66 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString) import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString setupFiles :: IO ()
ba = BS.append setupFiles = do
createRegularFile' "regularfile"
createSymlink' "symlink" "regularfile"
createSymlink' "brokenSymlink" "broken"
createDir' "directory"
createSymlink' "symlinkD" "directory"
createDir' "noPerms"
noPerms "noPerms"
specDir :: BS.ByteString
specDir = "test/HPath/IO/getFileTypeSpec/"
specDir' :: String cleanupFiles :: IO ()
specDir' = toString specDir cleanupFiles = do
normalDirPerms "noPerms"
deleteFile' "regularfile"
deleteFile' "symlink"
deleteFile' "brokenSymlink"
deleteDir' "directory"
deleteFile' "symlinkD"
deleteDir' "noPerms"
spec :: Spec spec :: Spec
spec = spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.getFileType" $ do describe "HPath.IO.getFileType" $ do
-- successes -- -- successes --
it "getFileType, regular file" $ it "getFileType, regular file" $
getFileType' (specDir `ba` "regularfile") getFileType' "regularfile"
`shouldReturn` RegularFile `shouldReturn` RegularFile
it "getFileType, directory" $ it "getFileType, directory" $
getFileType' (specDir `ba` "directory") getFileType' "directory"
`shouldReturn` Directory `shouldReturn` Directory
it "getFileType, directory with null permissions" $ it "getFileType, directory with null permissions" $
getFileType' (specDir `ba` "noPerms") getFileType' "noPerms"
`shouldReturn` Directory `shouldReturn` Directory
it "getFileType, symlink to file" $ it "getFileType, symlink to file" $
getFileType' (specDir `ba` "symlink") getFileType' "symlink"
`shouldReturn` SymbolicLink `shouldReturn` SymbolicLink
it "getFileType, symlink to directory" $ it "getFileType, symlink to directory" $
getFileType' (specDir `ba` "symlinkD") getFileType' "symlinkD"
`shouldReturn` SymbolicLink `shouldReturn` SymbolicLink
it "getFileType, broken symlink" $ it "getFileType, broken symlink" $
getFileType' (specDir `ba` "brokenSymlink") getFileType' "brokenSymlink"
`shouldReturn` SymbolicLink `shouldReturn` SymbolicLink
-- posix failures -- -- posix failures --
it "getFileType, file does not exist" $ it "getFileType, file does not exist" $
getFileType' (specDir `ba` "nothingHere") getFileType' "nothingHere"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "getFileType, can't open directory" $ it "getFileType, can't open directory" $
getFileType' (specDir `ba` "noPerms/forz") getFileType' "noPerms/forz"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)

View File

@@ -18,76 +18,92 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString) import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString setupFiles :: IO ()
ba = BS.append setupFiles = do
createRegularFile' "myFile"
createSymlink' "myFileL" "myFile"
createDir' "alreadyExistsD"
createDir' "dir"
createDir' "noPerms"
createDir' "noWritePerm"
noPerms "noPerms"
noWritableDirPerms "noWritePerm"
writeFile' "myFile" "Blahfaselgagaga"
specDir :: BS.ByteString
specDir = "test/HPath/IO/moveFileOverwriteSpec/"
specDir' :: String cleanupFiles :: IO ()
specDir' = toString specDir cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerm"
deleteFile' "myFile"
deleteFile' "myFileL"
deleteDir' "alreadyExistsD"
deleteDir' "dir"
deleteDir' "noPerms"
deleteDir' "noWritePerm"
spec :: Spec spec :: Spec
spec = spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.moveFileOverwrite" $ do describe "HPath.IO.moveFileOverwrite" $ do
-- successes -- -- successes --
it "moveFileOverwrite, all fine" $ it "moveFileOverwrite, all fine" $
moveFileOverwrite' (specDir `ba` "myFile") moveFileOverwrite' "myFile"
(specDir `ba` "movedFile") "movedFile"
it "moveFileOverwrite, all fine" $ it "moveFileOverwrite, all fine" $
moveFileOverwrite' (specDir `ba` "myFile") moveFileOverwrite' "myFile"
(specDir `ba` "dir/movedFile") "dir/movedFile"
it "moveFileOverwrite, all fine on symlink" $ it "moveFileOverwrite, all fine on symlink" $
moveFileOverwrite' (specDir `ba` "myFileL") moveFileOverwrite' "myFileL"
(specDir `ba` "movedFile") "movedFile"
it "moveFileOverwrite, all fine on directory" $ it "moveFileOverwrite, all fine on directory" $
moveFileOverwrite' (specDir `ba` "dir") moveFileOverwrite' "dir"
(specDir `ba` "movedFile") "movedFile"
it "moveFileOverwrite, destination file already exists" $ it "moveFileOverwrite, destination file already exists" $
moveFileOverwrite' (specDir `ba` "myFile") moveFileOverwrite' "myFile"
(specDir `ba` "alreadyExists") "alreadyExists"
-- posix failures -- -- posix failures --
it "moveFileOverwrite, source file does not exist" $ it "moveFileOverwrite, source file does not exist" $
moveFileOverwrite' (specDir `ba` "fileDoesNotExist") moveFileOverwrite' "fileDoesNotExist"
(specDir `ba` "movedFile") "movedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "moveFileOverwrite, can't write to destination directory" $ it "moveFileOverwrite, can't write to destination directory" $
moveFileOverwrite' (specDir `ba` "myFile") moveFileOverwrite' "myFile"
(specDir `ba` "noWritePerm/movedFile") "noWritePerm/movedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "moveFileOverwrite, can't open destination directory" $ it "moveFileOverwrite, can't open destination directory" $
moveFileOverwrite' (specDir `ba` "myFile") moveFileOverwrite' "myFile"
(specDir `ba` "noPerms/movedFile") "noPerms/movedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "moveFileOverwrite, can't open source directory" $ it "moveFileOverwrite, can't open source directory" $
moveFileOverwrite' (specDir `ba` "noPerms/myFile") moveFileOverwrite' "noPerms/myFile"
(specDir `ba` "movedFile") "movedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures -- -- custom failures --
it "moveFileOverwrite, move from file to dir" $ it "moveFileOverwrite, move from file to dir" $
moveFileOverwrite' (specDir `ba` "myFile") moveFileOverwrite' "myFile"
(specDir `ba` "alreadyExistsD") "alreadyExistsD"
`shouldThrow` `shouldThrow`
isDirDoesExist isDirDoesExist
it "moveFileOverwrite, source and dest are same file" $ it "moveFileOverwrite, source and dest are same file" $
moveFileOverwrite' (specDir `ba` "myFile") moveFileOverwrite' "myFile"
(specDir `ba` "myFile") "myFile"
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -18,78 +18,96 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString) import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString setupFiles :: IO ()
ba = BS.append setupFiles = do
createRegularFile' "myFile"
createSymlink' "myFileL" "myFile"
createRegularFile' "alreadyExists"
createDir' "alreadyExistsD"
createDir' "dir"
createDir' "noPerms"
createDir' "noWritePerm"
noPerms "noPerms"
noWritableDirPerms "noWritePerm"
writeFile' "myFile" "Blahfaselgagaga"
specDir :: BS.ByteString
specDir = "test/HPath/IO/moveFileSpec/"
specDir' :: String cleanupFiles :: IO ()
specDir' = toString specDir cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerm"
deleteFile' "myFile"
deleteFile' "myFileL"
deleteFile' "alreadyExists"
deleteDir' "alreadyExistsD"
deleteDir' "dir"
deleteDir' "noPerms"
deleteDir' "noWritePerm"
spec :: Spec spec :: Spec
spec = spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.moveFile" $ do describe "HPath.IO.moveFile" $ do
-- successes -- -- successes --
it "moveFile, all fine" $ it "moveFile, all fine" $
moveFile' (specDir `ba` "myFile") moveFile' "myFile"
(specDir `ba` "movedFile") "movedFile"
it "moveFile, all fine" $ it "moveFile, all fine" $
moveFile' (specDir `ba` "myFile") moveFile' "myFile"
(specDir `ba` "dir/movedFile") "dir/movedFile"
it "moveFile, all fine on symlink" $ it "moveFile, all fine on symlink" $
moveFile' (specDir `ba` "myFileL") moveFile' "myFileL"
(specDir `ba` "movedFile") "movedFile"
it "moveFile, all fine on directory" $ it "moveFile, all fine on directory" $
moveFile' (specDir `ba` "dir") moveFile' "dir"
(specDir `ba` "movedFile") "movedFile"
-- posix failures -- -- posix failures --
it "moveFile, source file does not exist" $ it "moveFile, source file does not exist" $
moveFile' (specDir `ba` "fileDoesNotExist") moveFile' "fileDoesNotExist"
(specDir `ba` "movedFile") "movedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "moveFile, can't write to destination directory" $ it "moveFile, can't write to destination directory" $
moveFile' (specDir `ba` "myFile") moveFile' "myFile"
(specDir `ba` "noWritePerm/movedFile") "noWritePerm/movedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "moveFile, can't open destination directory" $ it "moveFile, can't open destination directory" $
moveFile' (specDir `ba` "myFile") moveFile' "myFile"
(specDir `ba` "noPerms/movedFile") "noPerms/movedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "moveFile, can't open source directory" $ it "moveFile, can't open source directory" $
moveFile' (specDir `ba` "noPerms/myFile") moveFile' "noPerms/myFile"
(specDir `ba` "movedFile") "movedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures -- -- custom failures --
it "moveFile, destination file already exists" $ it "moveFile, destination file already exists" $
moveFile' (specDir `ba` "myFile") moveFile' "myFile"
(specDir `ba` "alreadyExists") "alreadyExists"
`shouldThrow` `shouldThrow`
isFileDoesExist isFileDoesExist
it "moveFile, move from file to dir" $ it "moveFile, move from file to dir" $
moveFile' (specDir `ba` "myFile") moveFile' "myFile"
(specDir `ba` "alreadyExistsD") "alreadyExistsD"
`shouldThrow` `shouldThrow`
isDirDoesExist isDirDoesExist
it "moveFile, source and dest are same file" $ it "moveFile, source and dest are same file" $
moveFile' (specDir `ba` "myFile") moveFile' "myFile"
(specDir `ba` "myFile") "myFile"
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -18,78 +18,95 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString) import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString setupFiles :: IO ()
ba = BS.append setupFiles = do
createRegularFile' "myFile"
createSymlink' "myFileL" "myFile"
createRegularFile' "alreadyExists"
createDir' "alreadyExistsD"
createDir' "dir"
createDir' "noPerms"
createDir' "noWritePerm"
noPerms "noPerms"
noWritableDirPerms "noWritePerm"
writeFile' "myFile" "Blahfaselgagaga"
specDir :: BS.ByteString
specDir = "test/HPath/IO/recreateSymlinkSpec/"
specDir' :: String cleanupFiles :: IO ()
specDir' = toString specDir cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerm"
deleteFile' "myFile"
deleteFile' "myFileL"
deleteFile' "alreadyExists"
deleteDir' "alreadyExistsD"
deleteDir' "dir"
deleteDir' "noPerms"
deleteDir' "noWritePerm"
spec :: Spec spec :: Spec
spec = spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.recreateSymlink" $ do describe "HPath.IO.recreateSymlink" $ do
-- successes -- -- successes --
it "recreateSymLink, all fine" $ do it "recreateSymLink, all fine" $ do
recreateSymlink' (specDir `ba` "myFileL") recreateSymlink' "myFileL"
(specDir `ba` "movedFile") "movedFile"
removeFileIfExists (specDir `ba` "movedFile") removeFileIfExists "movedFile"
it "recreateSymLink, all fine" $ do it "recreateSymLink, all fine" $ do
recreateSymlink' (specDir `ba` "myFileL") recreateSymlink' "myFileL"
(specDir `ba` "dir/movedFile") "dir/movedFile"
removeFileIfExists (specDir `ba` "dir/movedFile") removeFileIfExists "dir/movedFile"
-- posix failures -- -- posix failures --
it "recreateSymLink, wrong input type (file)" $ it "recreateSymLink, wrong input type (file)" $
recreateSymlink' (specDir `ba` "myFile") recreateSymlink' "myFile"
(specDir `ba` "movedFile") "movedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
it "recreateSymLink, wrong input type (directory)" $ it "recreateSymLink, wrong input type (directory)" $
recreateSymlink' (specDir `ba` "dir") recreateSymlink' "dir"
(specDir `ba` "movedFile") "movedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
it "recreateSymLink, can't write to destination directory" $ it "recreateSymLink, can't write to destination directory" $
recreateSymlink' (specDir `ba` "myFileL") recreateSymlink' "myFileL"
(specDir `ba` "noWritePerm/movedFile") "noWritePerm/movedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink, can't open destination directory" $ it "recreateSymLink, can't open destination directory" $
recreateSymlink' (specDir `ba` "myFileL") recreateSymlink' "myFileL"
(specDir `ba` "noPerms/movedFile") "noPerms/movedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink, can't open source directory" $ it "recreateSymLink, can't open source directory" $
recreateSymlink' (specDir `ba` "noPerms/myFileL") recreateSymlink' "noPerms/myFileL"
(specDir `ba` "movedFile") "movedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink, destination file already exists" $ it "recreateSymLink, destination file already exists" $
recreateSymlink' (specDir `ba` "myFileL") recreateSymlink' "myFileL"
(specDir `ba` "alreadyExists") "alreadyExists"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
it "recreateSymLink, destination already exists and is a dir" $ it "recreateSymLink, destination already exists and is a dir" $
recreateSymlink' (specDir `ba` "myFileL") recreateSymlink' "myFileL"
(specDir `ba` "alreadyExistsD") "alreadyExistsD"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
-- custom failures -- -- custom failures --
it "recreateSymLink, source and destination are the same file" $ it "recreateSymLink, source and destination are the same file" $
recreateSymlink' (specDir `ba` "myFileL") recreateSymlink' "myFileL"
(specDir `ba` "myFileL") "myFileL"
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -18,78 +18,95 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString) import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString setupFiles :: IO ()
ba = BS.append setupFiles = do
createRegularFile' "myFile"
createSymlink' "myFileL" "myFile"
createRegularFile' "alreadyExists"
createDir' "alreadyExistsD"
createDir' "dir"
createDir' "noPerms"
createDir' "noWritePerm"
noPerms "noPerms"
noWritableDirPerms "noWritePerm"
writeFile' "myFile" "Blahfaselgagaga"
specDir :: BS.ByteString
specDir = "test/HPath/IO/renameFileSpec/"
specDir' :: String cleanupFiles :: IO ()
specDir' = toString specDir cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerm"
deleteFile' "myFile"
deleteFile' "myFileL"
deleteFile' "alreadyExists"
deleteDir' "alreadyExistsD"
deleteDir' "dir"
deleteDir' "noPerms"
deleteDir' "noWritePerm"
spec :: Spec spec :: Spec
spec = spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.renameFile" $ do describe "HPath.IO.renameFile" $ do
-- successes -- -- successes --
it "renameFile, all fine" $ it "renameFile, all fine" $
renameFile' (specDir `ba` "myFile") renameFile' "myFile"
(specDir `ba` "renamedFile") "renamedFile"
it "renameFile, all fine" $ it "renameFile, all fine" $
renameFile' (specDir `ba` "myFile") renameFile' "myFile"
(specDir `ba` "dir/renamedFile") "dir/renamedFile"
it "renameFile, all fine on symlink" $ it "renameFile, all fine on symlink" $
renameFile' (specDir `ba` "myFileL") renameFile' "myFileL"
(specDir `ba` "renamedFile") "renamedFile"
it "renameFile, all fine on directory" $ it "renameFile, all fine on directory" $
renameFile' (specDir `ba` "dir") renameFile' "dir"
(specDir `ba` "renamedFile") "renamedFile"
-- posix failures -- -- posix failures --
it "renameFile, source file does not exist" $ it "renameFile, source file does not exist" $
renameFile' (specDir `ba` "fileDoesNotExist") renameFile' "fileDoesNotExist"
(specDir `ba` "renamedFile") "renamedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "renameFile, can't write to output directory" $ it "renameFile, can't write to output directory" $
renameFile' (specDir `ba` "myFile") renameFile' "myFile"
(specDir `ba` "noWritePerm/renamedFile") "noWritePerm/renamedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "renameFile, can't open output directory" $ it "renameFile, can't open output directory" $
renameFile' (specDir `ba` "myFile") renameFile' "myFile"
(specDir `ba` "noPerms/renamedFile") "noPerms/renamedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "renameFile, can't open source directory" $ it "renameFile, can't open source directory" $
renameFile' (specDir `ba` "noPerms/myFile") renameFile' "noPerms/myFile"
(specDir `ba` "renamedFile") "renamedFile"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures -- -- custom failures --
it "renameFile, destination file already exists" $ it "renameFile, destination file already exists" $
renameFile' (specDir `ba` "myFile") renameFile' "myFile"
(specDir `ba` "alreadyExists") "alreadyExists"
`shouldThrow` `shouldThrow`
isFileDoesExist isFileDoesExist
it "renameFile, move from file to dir" $ it "renameFile, move from file to dir" $
renameFile' (specDir `ba` "myFile") renameFile' "myFile"
(specDir `ba` "alreadyExistsD") "alreadyExistsD"
`shouldThrow` `shouldThrow`
isDirDoesExist isDirDoesExist
it "renameFile, source and dest are same file" $ it "renameFile, source and dest are same file" $
renameFile' (specDir `ba` "myFile") renameFile' "myFile"
(specDir `ba` "myFile") "myFile"
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -1 +0,0 @@
nothing

View File

@@ -1 +0,0 @@
dir

View File

@@ -1 +0,0 @@
file

View File

@@ -1,8 +0,0 @@
dadasasddas
sda
!!1
sda
11

View File

@@ -1,4 +0,0 @@
dadasasddas
das
sda
sda

View File

@@ -1,8 +0,0 @@
dadasasddas
sda
!!1
sda
11

View File

@@ -1,4 +0,0 @@
dadasasddas
das
sda
sda

View File

@@ -1,8 +0,0 @@
dadasasddas
sda
!!1
sda
11

View File

@@ -1,4 +0,0 @@
dadasasddas
das
sda
sda

View File

@@ -1 +0,0 @@
inputDir/

View File

@@ -1,8 +0,0 @@
dadasasddas
sda
!!1
sda
11

View File

@@ -1 +0,0 @@
dadasasddas

View File

@@ -1,4 +0,0 @@
dadasasddas
das
sda
sda

View File

@@ -1,8 +0,0 @@
dadasasddas
sda
!!1
sda
11

View File

@@ -1,4 +0,0 @@
dadasasddas
das
sda
sda

View File

@@ -1 +0,0 @@
inputDir/

View File

@@ -1,16 +0,0 @@
adaöölsdaöl
dsalö
ölsda
ääödsf
äsdfä
öä453
öä
435
ä45343
5
453
453453453
das
asd
das

View File

@@ -1,4 +0,0 @@
abc
def
dsadasdsa

View File

@@ -1 +0,0 @@
inputFile

View File

@@ -1,2 +0,0 @@
abc
def

View File

@@ -1 +0,0 @@
inputFile

View File

@@ -1 +0,0 @@
dir

View File

@@ -1 +0,0 @@
dir

View File

@@ -1 +0,0 @@
foo

View File

@@ -1 +0,0 @@
dir

View File

@@ -1 +0,0 @@
Lala

View File

@@ -1 +0,0 @@
broken

Some files were not shown because too many files have changed in this diff Show More